| 'HistoryMainClass: |
| |
| Option Declare |
| ' |
| Use "HistoryAuxiliaryRoutines" |
| Use "HistoryFieldClass" |
| Use "HistoryEntryClass" |
| '-------------------------------------------------------------------- |
| 'Konstanten |
| Const MAX_SIZE# = 5000 'Maximale Größe in Bytes des History-Feldes |
| Const FIELDNAME_HISTORY$ = "History" 'Feldname des History-Feldes |
| '-------------------------------------------------------------------- |
| Public Class HistoryMain |
| |
| Private m_doc As NotesDocument |
| Private m_strHistoryFieldNames As String |
| Private m_vaHistoryFieldNames As Variant |
| Private m_strHistoryFieldTitles As String |
| Private m_vaHistoryFieldTitles As Variant |
| Private m_iHistoryFieldAmount As Integer 'Anzahl zu überwachender Felder |
| Private m_iMaxEntryAmount As Integer |
| Private m_strTextNew As String |
| Private m_HistoryFields() As HistoryField |
| Private m_strDifferences() As String |
| Private m_strHistoryFieldname As String |
| '--> Klasse 'HistoryEntry' |
| Private m_HistoryEntry As HistoryEntry 'Neuer Eintrag |
| Private m_HistoryEntries() As HistoryEntry 'Array aller History-Einträge |
| Private m_EntryCount As Integer 'Anzahl der Einträge des HistoryFeldes |
| '<--- |
| |
| ' |
| Public Sub new(doc As NotesDocument, strHistoryFieldNames As String, strHistoryFieldTitles As String, iMaxEntryAmount As Integer, strTextNew As String) |
| Dim iLB As Integer |
| Dim iUB As Integer |
| |
| '---> Setze Membervariablen |
| Set m_doc = doc |
| m_strHistoryFieldNames = strHistoryFieldNames |
| m_strHistoryFieldTitles = strHistoryFieldTitles |
| m_iMaxEntryAmount = iMaxEntryAmount |
| m_strTextNew = strTextNew |
| '< |
| |
| '---> Die zu prüfenden Felder ermitteln |
| m_vaHistoryFieldNames = AuxExplode(m_strHistoryFieldNames, "##") |
| m_vaHistoryFieldTitles = AuxExplode(m_strHistoryFieldTitles, "##") |
| 'Prüfen ob beide Arrays die gleiche Anzahl an Einträgen haben; falls nicht werden als Titel die Feldnamen übernommen. |
| iLB = Lbound(m_vaHistoryFieldNames) - Lbound(m_vaHistoryFieldTitles) |
| iUB = Ubound(m_vaHistoryFieldNames) - Ubound(m_vaHistoryFieldTitles) |
| If (iLB <> 0) Or (iUB <> 0) Then |
| m_vaHistoryFieldTitles = m_vaHistoryFieldNames |
| End If |
| 'Ermitteln der Anzahl zu überwachender Felder |
| m_iHistoryFieldAmount = Ubound(m_vaHistoryFieldNames) - Lbound(m_vaHistoryFieldNames) + 1 |
| 'So, nun haben wir: |
| ' m_vaHistoryFieldNames = die zu überwachenden Item-Namen in Array |
| ' m_vaHistoryFieldTitles = die Titel der Felder |
| ' m_iHistoryFieldAmount = die Anzahl der Felder |
| '< |
| |
| 'Erstellen der HistoryField - Objekte in einem Array |
| Call initHistoryFields() |
| 'Nun erzeugen wir noch die HistoryEntry-Objekte. Pro bisherigen Eintrag im History-Feld erzeugen wir 1 HistoryEntryObjekt |
| Call initHistoryEntries() |
| End Sub |
| '------------------------------------------------------------------------------------------------------------------------- |
| Private Sub initHistoryFields() |
| 'Erstellen der HistoryField - Objekte in einem Array |
| Dim itmField As NotesItem |
| Dim i As Integer |
| For i = 0 To m_iHistoryFieldAmount - 1 |
| Set itmField = m_doc.GetFirstItem(m_vaHistoryFieldNames(i)) |
| Redim Preserve m_HistoryFields(i) |
| Set m_HistoryFields(i) = New HistoryField(itmField, m_vaHistoryFieldTitles(i)) |
| Next |
| End Sub |
| '------------------------------------------------------------------------------------------------------------------------- |
| Private Sub initHistoryEntries() |
| 'Erstellt HistoryEntry - Objekte. Pro History-Eintrag wird ein HistoryEntry-Objekt erzeugt |
| 'Ergebnis steht im Array 'm_HistoryEntries' |
| Dim Entry As HistoryEntry |
| Dim iContinue As Integer |
| m_EntryCount = 0 |
| |
| iContinue = True |
| Do |
| Set Entry = New HistoryEntry |
| Call Entry.readFromDoc(m_doc, m_EntryCount) |
| If Entry.size > 0 Then |
| Redim Preserve m_HistoryEntries(m_EntryCount) |
| Set m_HistoryEntries(m_EntryCount) = Entry |
| m_EntryCount = m_EntryCount + 1 |
| Else |
| iContinue = False |
| End If |
| Loop While (iContinue = True) |
| End Sub |
| ' |
| Public Sub save() |
| 'Wir schreiben hier die Änderungen in das History-Feld |
| ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
| 'Änderungen in das Array 'm_strDifferences' |
| Call getHistoryDifferences() |
| |
| 'History schreiben |
| If Not (m_strDifferences(0) = "NOCHANGES") Then 'History nur schreiben wenn Änderungen stattgefunden haben |
| Call writeHistory() |
| Call m_doc.Save(True, True) |
| End If |
| |
| 'Aufräumen und neu initiieren |
| Call CleanupAndInitiate() |
| |
| End Sub |
| '------------------------------------------------------------------------------------------------------------------------- |
| Private Sub getHistoryDifferences() |
| Dim i As Integer |
| Dim iCount As Integer |
| Dim strDifference As String |
| |
| If m_doc.IsNewNote Then 'Falls es sich um ein neues Doc handelt |
| Redim m_strDifferences(0) |
| m_strDifferences(0) = m_strTextNew |
| Exit Sub |
| End If |
| |
| 'Wir bekommen die Unterschiede in das Array "m_strDifferences" |
| iCount = -1 |
| For i = 0 To m_iHistoryFieldAmount - 1 |
| strDifference = m_HistoryFields(i).difference |
| If Not strDifference = "" Then |
| iCount = iCount + 1 |
| Redim Preserve m_strDifferences(iCount) |
| m_strDifferences(iCount) = strDifference |
| End If |
| Next |
| If iCount = -1 Then 'Es gab keine Unterschiede |
| Redim m_strDifferences(0) |
| m_strDifferences(0) = "NOCHANGES" 'Es gab keine Änderung ! |
| End If |
| |
| 'Nun stehen die Änderungen in "m_strDifferences" |
| End Sub |
| '------------------------------------------------------------------------------------------------------------------------- |
| Private Sub writeHistory() |
| |
| 'Klasse für Historyeintrag |
| Set m_HistoryEntry = New HistoryEntry |
| Redim Preserve m_HistoryEntries(m_EntryCount) |
| Set m_HistoryEntries(m_EntryCount) = m_HistoryEntry |
| m_EntryCount = m_EntryCount + 1 |
| |
| |
| 'Werte vergleichen und Ergebnisse an den HistoryEntry geben |
| m_HistoryEntry.Action = m_strDifferences |
| |
| Dim nHowManyEntries As Integer |
| Dim nStart As Integer |
| Dim i As Integer |
| |
| Call clear() |
| |
| nHowManyEntries = getMaxEntries() |
| |
| nStart = (Ubound(m_HistoryEntries)+1) - nHowManyEntries |
| For i = nStart To Ubound(m_HistoryEntries) |
| 'History-Eintrag ins Dokument schreiben |
| Set m_HistoryEntry = m_HistoryEntries(i) |
| Call m_HistoryEntry.write(m_doc) |
| Next |
| |
| End Sub |
| '------------------------------------------------------------------------------------------------------------------------- |
| Private Sub clear() |
| Call m_doc.ReplaceItemValue(FIELDNAME_HISTORY, "") |
| End Sub |
| ' |
| Private Function getMaxEntries() As Integer |
| Dim i As Integer |
| Dim entry As HistoryEntry |
| Dim iTotalSize As Integer |
| getMaxEntries = 0 |
| |
| For i = Ubound(m_HistoryEntries) To Lbound(m_HistoryEntries) Step -1 |
| Set entry = m_HistoryEntries(i) |
| iTotalSize = iTotalSize + entry.size |
| If iTotalSize > MAX_SIZE Then |
| Msgbox "Maximal erlaubte Größe in Bytes (" & Cstr(MAX_SIZE) & ") wurde überschritten" |
| Exit For 'Exit Function |
| End If |
| getMaxEntries = getMaxEntries + 1 |
| Next |
| 'Nun prüfen wir ob die Anzahl erlaubter Einträge dadurch nicht überschritten wird |
| If getMaxEntries > m_iMaxEntryAmount Then |
| Print "Max. Anzahl Einträge (" & Cstr(m_iMaxEntryAmount) & ") wurde überschritten" |
| getMaxEntries = m_iMaxEntryAmount |
| End If |
| End Function |
| '------------------------------------------------------------------------------------------------------------------------- |
| Private Sub CleanupAndInitiate() |
| 'Neue Werte in als InitialValue schreiben, für den Fall dass erneut gespeichert wird |
| Dim i As Integer |
| For i = 0 To m_iHistoryFieldAmount - 1 |
| Call m_HistoryFields(i).setInitialValue |
| Next |
| |
| 'HistoryEntries neu initiieren |
| Erase m_HistoryEntries |
| Call initHistoryEntries() |
| |
| End Sub |
| ' |
| End Class |
