2011-07-08 17 views
0

我寫了一個小的自定義類來在Lotus Notes 8.5.2中運行審計跟蹤。我在我的自定義類中設置了NotesRichTextItem的值,並且一切都很正常。當我退出我的自定義類時,回到Querysave,並檢查Source.Document,我可以看到值很好。 querysave完成後(我的自定義類調用後的行是End Sub),我檢查文檔屬性,並且該字段爲空。我將包括下面的所有代碼,雖然從我的querysave調用的函數是querySaveCheckValues(我通過源代碼)。問題在querysave中通過自定義類保存文檔的值

自定義類

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 
+0

爲什麼要刪除現有的審計字段並創建一個新的?追加新的審計信息會不會更容易? –

回答

2

我想,如果移動電話到您的類的PostSave事件,而不是QuerySave您的代碼會工作。

我基於你改變QuerySave事件中的後端文檔的事實,並且在事件運行後,它應該用前端的新值覆蓋後端文檔。不過,只是一個預感,因爲我沒有證實這是事實。

+0

我添加了後端保存後,工作完美。非常感謝! – Stephen

相關問題