我编写了一个小的自定义类来在 Lotus Notes 8.5.2 中运行审计跟踪。我在自定义类中设置了 NotesRichTextItem 的值，一切看起来都很好。当我退出我的自定义类时，回到 Querysave 并检查 Source.Document 我可以看到该值很好。一旦查询保存完成（我的自定义类调用之后的行是 End Sub），我检查文档属性并且该字段为空。我将在下面包含所有代码，尽管从我的 querysave 调用的函数是 querySaveCheckValues（我传入 Source）。
自定义类
Option Public
Option Declare
Public Class AuditTrail
REM boolean to audit all document items or use item list
Private includeAllItems As Boolean
Private currentDoc As NotesDocument
Private session As NotesSession
Private AUDIT_FIELD_LIST As String
Private AUDIT_FIELD As string
Private auditFieldList As NotesItem
Private postOpenValues List As String
Private auditField As NotesRichTextItem
Private MULTI_VALUE_SEPARATOR As String
'default message value insert strings
Private INSERT_FIELD_NAME As String
Private INSERT_OLD_VALUE As String
Private INSERT_NEW_VALUE As string
'message string defaults
Private DEFAULT_MESSAGE_CHANGE As String
'********** Sub new **********
Sub New(Source As NotesUIDocument)
dim currentDoc As NotesDocument
'put received uiDoc into NotesDocument
Set currentDoc = source.Document
REM set some class variables
setDefaultStrings
includeAllItems = True 'Details to all items on document
Set session = New NotesSession()
REM Check if the pre-defined audit field exists. If it doesn't we will audit all fields
If currentDoc.hasItem(AUDIT_FIELD_LIST) Then
'check if audit field list has at least one value
If UBound(currentDoc.GetItemValue(AUDIT_FIELD_LIST)) > 0 Then
includeAllItems = False
'assign field to NotesItem
Set auditFieldList = currentDoc.GetFirstItem(AUDIT_FIELD_LIST)
End If
End If
'get handle to audit field
If Source.Isnewdoc Then
Set auditField = New NotesRichTextItem(currentDoc, AUDIT_FIELD)
End If
Set auditField = currentDoc.GetFirstItem(AUDIT_FIELD)
End Sub
'********** collect values from current document **********
Function postOpenCollectValues(Source As NotesUIDocument)
Dim currentDoc As NotesDocument
Dim docItem As NotesItem
Dim fieldName As String
Dim fieldValue As String
Set currentDoc = Source.Document
If includeAllItems = False then
If Not auditFieldList Is Nothing Then
'list through values, find field and add to list
Dim i%
For i = 0 To UBound(auditFieldList.Values)
fieldName = auditFieldList.Values(i)
'look for item on document
If currentDoc.Hasitem(fieldName) Then
Set docItem = currentDoc.GetFirstItem(fieldName)
'check if item is multivalue
If UBound(docItem.Values) > 0 Then
fieldValue = Join(docItem.Values,MULTI_VALUE_SEPARATOR)
Else
fieldValue = docItem.Values(0)
End If
'convert value to string and put into list
postOpenValues(fieldName) = fieldValue
End If
Next
End If
End if
End Function
'********** Query save check to see if any values have changed **********
Function querySaveCheckValues(Source As NotesUIDocument)
Dim docItem As NotesItem
Dim fieldName As String
Dim oldValue, newValue As String
Set currentDoc = Source.Document
'Use list of fields generated during post open to save from etting errors when new fields
'are added to forms
ForAll x In postOpenValues
'eliminate mess if field has been removed from form
If currentDoc.hasItem(ListTag(x)) Then
Set docItem = currentDoc.GetFirstItem(ListTag(x))
fieldName = ListTag(x)
'compare old and new value
oldValue = x
If UBound(docItem.Values) > 0 Then
newValue = Join(docItem.Values,MULTI_VALUE_SEPARATOR)
Else
newValue = docItem.Values(0)
End If
Call me.compareValues(fieldName, CStr(oldValue), Newvalue)
End If
End ForAll
'make sure any changes added to audit field in backend and not overwriten
' Call Source.Refresh(true)
End Function
'********** Simple function to write lines to audit **********
Private Function writeAudit(message As String)
Dim tmpItem As NotesRichTextItem
Dim dateTime As New NotesDateTime(Now)
Dim nameItem As New NotesName(session.Username)
'take a copy of the current audit field content and blank audit
Set tmpItem = New NotesRichTextItem(currentDoc, "tmpAudit")
Call tmpItem.AppendRTItem(AuditField)
Call auditField.Remove()
'create a new audit field item and add new message
Set AuditField = New NotesRichTextItem(currentDoc, AUDIT_FIELD)
Call AuditField.AppendText(CStr(dateTime.LSLocalTime))
Call AuditField.AddTab(1)
Call AuditField.AppendText(nameItem.Abbreviated)
Call AuditField.AddTab(1)
Call AuditField.AppendText(message)
'append previous audit field content
Call AuditField.AppendRtItem(tmpItem)
Call tmpItem.remove()
End Function
'********** Function to compare single and multi values **********
Private Function compareValues(fieldName As String, oldValue As String, newValue As String)
Dim Message As String
'check for multi value
If InStr(oldValue,MULTI_VALUE_SEPARATOR) = 0 Then
'single value
If newValue <> oldValue Then
'prepare message
Message = prepareMessage(fieldName, oldValue, newValue, "CHANGE")
Call writeAudit(Message)
End If
End If
End Function
'********** Replace values in default message with old and new values **********
Private Function prepareMessage(fieldName As String, oldValue As String, newValue As String, messageType As String) As string
Dim tmpMessage As String
'case statement for type
Select Case messageType
Case "CHANGE"
tmpMessage = DEFAULT_MESSAGE_CHANGE
'replace default insert text with real field name
tmpMessage = Replace(tmpMessage,INSERT_FIELD_NAME,fieldName)
'old value
tmpMessage = Replace(tmpMessage,INSERT_OLD_VALUE,oldValue)
'new value
tmpMessage = Replace(tmpMessage,INSERT_NEW_VALUE,newValue)
End Select
prepareMessage = tmpMessage
Exit function
End Function
'********** Little function to setup our equivelant of constants **********
Private Function setDefaultStrings
AUDIT_FIELD_LIST = "auditFieldList" 'default audit field list name
AUDIT_FIELD = "AuditField" 'field used to store audit
MULTI_VALUE_SEPARATOR = "~" 'Used to combine and split values in a multi value item
'Default message insert strings
INSERT_FIELD_NAME = "%FIELDNAME%"
INSERT_OLD_VALUE = "%OLDVALUE%"
INSERT_NEW_VALUE = "%NEWVALUE%"
'Messages Strings
DEFAULT_MESSAGE_CHANGE = "Value of field '" & INSERT_FIELD_NAME & _
"' amended from '" & INSERT_OLD_VALUE & "' to '" & INSERT_NEW_VALUE & "'"
End Function
'********** handle error messages generated by this code **********
Private Function handleErrors
const DEFAULT_ERROR_MESSAGE = "Unable to write audit information - an error occured"
'if we have a handle on the audit field write an entry
If Not auditField Is Nothing Then
writeAudit(DEFAULT_ERROR_MESSAGE)
End If
End Function
End Class