Was Deine Klassen-Methoden angeht: Du kannst entweder die sowieso erforderliche Methode New dafür hernehmen, um
- alle globalen Variablen (als members Deiner Klasse) mit dem Ausgangsstatus zu versehen (in PostOpen) oder
- dieser erstmal nur "leer" zu instantiieren. Dann müsstest Du in PostOpen gleich nachschieben, die Methode "GetOriginalValues" zu verwenden (die das tun sollte, was ihr Name verspricht)
Du kannst die Behandlung von Events, die von der Maske ausgelöst werden, an die Klasse delegieren (das steht auch in dem Artikel, den Bernhard anführt).
Stichwort 'On Event x From y Call z'
Was mir noch überhaupt nicht klar ist:
Ich habe bisher u.a. folgenden Code in der Maske (Auszüge):
Global Declarations
Dim vGlobalHistoryFields As Variant
Dim vGlobalHistoryFieldTitles As Variant
Dim vGlobalHistorySource As Variant
PostOpen
vGlobalHistoryFields = fExplode(CHISTORYFIELDS, "##")
vGlobalHistoryFieldTitles = fExplode(CHISTORYFIELDTITLES, "##")
If Not Source.IsNewDoc Then
'Write field values in global variable
vGlobalHistorySource = fHistoryStoreItemValuesInArray(doc, vGlobalHistoryFields)
End If
Was passiert da:
Es werden die zu überwachenden Feldnamen und die Item-Inhalte als Array in die globalen Variablen der Maske gesetzt.
Warum mach ich das:
Im Postsave hole ich mir die globalen Variable-Inhalte und mach was damit (vergleichen, etc.).
Jetzt die Frage:
Was kann ich davon in eine Klasse 'outsourcen' ? Kann ich die in der Maske ge-dim-ten Variablen in einer Klasse setzen (ich will ja im PostSave wieder auf die im Postopen gesetzten Variablen wieder zurückgreifen können)? Oder muss ich das im Masken-Event erledigen?
(Ich hoffe dass ich die Frage einigermaßen klar rüberbringe....)
... zur Demo reicht es heute nicht mehr - aber zu einer kleinen Anleitung:
' # ###################################################
%REM
ata - 23.06.2004
In dieser kleinen Demo möchte ich zeigen, wie
Text als LS-Code ausgeführt werden kann.
Als Beispiel verwende ich
... Globale Variablen
... Globale Funktionen
... normaler Code
'
Was für einen Wert gibt in diesem Beispiel die MsgBox zurück?
Die Rückgabe erscheint in der Statuszeile...
'
Man benötigt
... ein Feld "Code"
... ein Event - zum Beispiel eine Schaltfläche
'
Als Schaltflächen-Code zur Ausführung dient:
'
Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim docThis As NotesDocument
Set docThis = ws.CurrentDocument.Document
If docTHis.Code(0) <> "" Then
vCode = docThis.Code
sCode = ""
For i = 0 To Ubound( docThis.Code )
sCode = sCode + vCode( i ) + Chr(10)
Next
Execute( sCode )
End If
End Sub
'
Das Feld "Code" ist ein Mehrfachwerte-Feld
... Mehrere Werte werden nur mit neuen Zeilen getrennt
%END REM
' # ###################################################
' # ... im Feld "Code" kann dann der folgende Code verwendet werden....
'
' # Globale Deklarationen
Option Explicit
' Use "Deine LS-Library"
' %INCLUDE "C:\Temp\deineLSS-Datei.lss" ' lässt sich auch später noch einbauen...
Dim sPos As String
'
' ... dann lassen sich Klassen, Type's und Funktionen einbauen
Function makeMsg( sText As String , iTyp As Integer ) As Integer
sPos = "Sub makeMsg."
On Error Goto ErrorHandle ' # innerhalb von Sub's und Function's sind Sprunmarken möglich
makeMsg = MsgBox( "Ausgabe: " + sText , iTyp , "Ausgabe einer Meldung" )
Exit Function
'
ErrorHandle:
Print "Fehler: " + sPos + Cstr( Erl )+ " - " + Error
Resume Next
End Function
'
' # ... letztendlich dann der eigentliche Code, der ausgeführt werden soll - hier sind keine Sprungmarken (GoTo) möglich...
Dim sText As String
Dim res As Integer
sText = "Hallole"
res = makeMsg( sText , 2 )
'
Print res
... der obige Code kann komplett in das Feld "Code" kopiert werden.
Mit der Schaltfläche wird dann der Code ausgeführt...
... es liese sich auch ein Rich-Text-Feld in der Maske plazieren, in der dann ein Button eingefügt wird. Als Code dient dann der "Click()"-Code aus dem Beispiel...
... und es gibt noch viel weitere Spielarten... ;D ;D ;D
ata
RTF habe ich vorerst nicht eingebaut. In der jetzigen Lösung schreibe ich die Werte in 1 Textfeld (Liste).
Die Unterscheidung würde ich in der "HistoryMain" machen in der "Private Sub writeHistory()".
Das ist übrigens mein bisheriger Code-Draft der Klasse "HistoryEntry":
Public Class HistoryEntry
Private m_itmHistory As NotesItem
Private m_vAction As Variant
Private m_strHistoryEntry As String
'------------------------------------------------------------------------------------------------
Public Sub new()
End Sub
'------------------------------------------------------------------------------------------------
'Get/Set-Methoden
Public Property Set Action As Variant
m_vAction = Action
End Property
'------------------------------------------------------------------------------------------------
Public Sub write(doc As NotesDocument)
'neuen History - Eintrag schreiben
Call assembleHistory()
Set m_itmHistory = doc.GetFirstItem("History")
Call m_itmHistory.AppendToTextList( m_strHistoryEntry )
' Call doc.Save(True, True)
End Sub
'------------------------------------------------------------------------------------------------
Private Sub assembleHistory()
'History zusammenstellen
'Output ist in m_strHistoryEntry
Dim session As New notessession
Dim strName As String
Dim strDate As String
Dim i As Integer
strName = session.CommonUsername
strDate = Format$( Now , "dd.mm.yyyy hh:mm")
For i = 0 To Ubound(m_vAction)
If i=0 Then
m_strHistoryEntry = strDate & Chr(9) & strName & Chr(9) & m_vAction(i)
Else
m_strHistoryEntry = m_strHistoryEntry & Chr(13)+Chr(10) & Chr(9) & Chr(9) & m_vAction(i)
End If
Next
End Sub
'------------------------------------------------------------------------------------------------
End Class
Was aber nicht heißen soll, dass Deine Aufteilung nicht gut ist - war mir nur als Anfänger etwas zu kompliziert.
Was hier in der HistoryEntry - Klasse imho u.a. noch nicht perfekt ist:
- Datumsformat ist statisch
- Username ist statisch (vielleicht brauche ich mal ein anderes Format)
- Prüfung wieviele History-Zeilen existieren ist noch nicht eingebaut.
zu den Hilfsfunktionen:
Explode und ErrorHandler sind Kandidaten für eine 'Hilfsfunktions-Bibliothek'
Hmm, stimmt. Ziel ist allerdings für mich hier, die Klassen per Copy'n'Paste in beliebigen DB's einzusetzen (auch wenn diese sonst keine Klassen haben). Aber vielleicht macht man da dann einfach eine "HistoryHilfsfunktionen" - Lib, die dann immer mitkopiert wird... ?!
die anderen haben alle was mit Feldern zu tun (gib mir Werte, zeig mir Unterschiede, ...) damit haben wir einen neuen Kandidaten für eine Klasse 'Feld'. die all diese Funktionalität zur Verfügung stellt.
Ah ja..... gute Idee :-)
Eine Frage jenseits von OO:
welchen Grund hat es, dass du die Namen der Felder, die überwacht werden sollen, in einem String hältst und nicht in einer Liste/Array/...?
In Konstanten (hier: Global Declarations der Maske) sind leider Arrays nicht möglich afaik. Daher schreibe ich die dort in ein String mit Trennzeichen "##", übergebe diese dann an das Objekt "HistoryMonitorDoc", von da aus weiter an das "HistoryMain"-Objekt und im HistoryMain-Objekt wandle ich die dann in ein Array um (mittels der ExtExplode - Function):
Private Sub getHistoryFields(strNames As String, strTitles As String)
'die zu prüfenden Felder ermitteln
m_vaHistoryFields = ExtExplode(strNames, "##")
m_vaHistoryFieldTitles = ExtExplode(strTitles, "##")
Bin da aber aufgeschlossen, wenn Du 'ne bessere Idee zur Umsetzung hast :-)
Nochmal zu diesem Bug (Initial-Values werden nicht neu gesetzt nach dem Speichern):
(....)
du hast die neuen Werte ja schon. du müsstest nur sowas hier in deiner History-Klasse machen, nachdem der Eintrag gemacht wurde:
m_vaInitialFieldValues = m_SavedFieldValues
Jo mei, Du hast natürlich Recht, so geht's:
Private Sub writeHistory()
'Werte vergleichen und Ergebnisse an den HistoryEntry geben
m_HistoryEntry.Action = m_vDifferences
'History-Eintrag ins Dokument schreiben
Call m_HistoryEntry.write(m_doc)
'Neue Werte in das InitialValue-Array schreiben, für den Fall dass erneut gespeichert wird
m_vaInitialFieldValues = m_SavedFieldValues
End Sub
Hab grad sowas versucht:
Public Class HistoryMain
On Error goto ErrorHandler
Dann kommt die Meldung:
HistoryMain: (Declarations): 10: Statement illegal in CLASS block: ON
Heißt das man müsste das Errorhandling in jede Sub/Function der Klasse einzeln schreiben?
Schade....
Ich bin übrigens gerade dabei, eine Logik einzubauen, um diese blöde Textfeld-Größenbeschränkung zu überwachen.
Nicht dass wer meint ich wäre mittlerweile eingeschlafen :-) (na ja, im Rahmen von MultiTasking mach ich auch nebenbei noch andere Dinge, hab ja auch parallel noch die Book-Rezension gemacht :))
Private Sub removeEntries()
'Ziel ist es die Größenbeschränkung von Textfeldern zu beachten.
'Zusätzlich kann der History-Klasse eine Max-Anzahl Einträge übergeben werden.
'Wenn Max-Anzahl = "", dann wird gleich die Größenüberprüfung eingeleitet.
'Wenn Max-Anzahl vorgegeben, dann wird erst mal gekürzt und der neue Wert
'angehängt. Wenn immer noch zu lang: Solange alte Einträge rauswerfen, bis es passt.
While-Wend Schleifen, eine "DeleteArrayPosition"-Function etc. sind dabei hilfreich....
Hi,
Total offtopic:
trotz anders angekündigt, komme ich später zum code zurück.
Das ganze hier finde ich ziemlich interessant. Ich mache nur am Mittwoch meine letzte Websphere certi und WAS gibt mir momentan eine harte Zeit mit zahlreichen kleinlichen ErrorMeldungen, wie
In der JMSConnection für MDB SampleMDB, JMSDestination jms/sampleQ ist ein Fehler aufgetreten: javax.jms.JMSException: MQJMS2008: Fehler beim Öffnen der MQ-Warteschlange.
Thomas, ich hab hier mal (nicht UML-konform) zusammengestellt wie ich Deine Vorgehensweise verstehe:
(http://217.160.137.156/user/bp/tmc/_threaduploads/history/historyclass_12.gif)
Was ich hier nicht kapiere:
Wie würde den der Code aussehen, wenn ich unabhängig eine neue Zeile der History hinzufügen will?
Aktuell kann ich ja folgendes machen:
Sub Click(Source As Button)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim uiws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim HistoryEntry As HistoryEntry
Dim strEntry(0) As String
Set db = session.CurrentDatabase
Set uidoc = uiws.CurrentDocument
Set doc = uidoc.Document
strEntry(0) = uiws.Prompt(PROMPT_OKCANCELEDIT,"Historien-Eintrag", "Hier einen Text eingeben:" , "" ,"")
Set HistoryEntry = New HistoryEntry(doc, 10)
HistoryEntry.Action = strEntry
Call HistoryEntry.write()
Call doc.save(True,True)
Call uidoc.refresh
End Sub
HistoryMain 1 -------- * HistoryField
Public Function AuxSize(vaSource As Variant, strNewEntry As String, iMaxSizeBytes As Integer, iMaxSizeEntries As Integer) As Variant
On Error Goto ERRORHANDLER
Dim i As Integer
Dim j As Integer
Dim iStart As Integer
Dim iEnd As Integer
Dim iAmount As Integer
Dim iSize As Integer
Dim iStartNew As Integer
Dim vaNewValues() As Variant
If ( Isscalar(vaSource) ) Or ( vaSource(Lbound(vaSource)) = "" ) Then
Redim vaNewValues(0)
vaNewValues(0) = strNewEntry
AuxSize = vaNewValues
Goto EXITSCRIPT
End If
iStart = Lbound(vaSource)
iEnd = Ubound(vaSource) + 1
'----> Neuen Eintrag dem Array anhängen
Redim Preserve vaSource(iStart To iEnd)
vaSource(iEnd) = strNewEntry
'<---
'---> Prüfe wieviele Einträge möglich sind
iAmount = 0
'Als erstes ermitteln wir die Anzahl möglicher Einträge anhand der Bytes
'Als Ergebnis haben wir die Anzahl Einträge in "iAmount"
For i = iEnd To iStart Step -1
iSize = iSize + Len(vaSource(i))
If iSize > iMaxSizeBytes Then
'Die Byte-Größe wurde überschritten
Exit For 'Schleife verlassen
Else
iAmount = iAmount + 1
End If
Next
'Nun prüfen wir ob die Anzahl erlaubter Einträge dadurch nicht überschritten wird
If iAmount > iMaxSizeEntries Then
iAmount = iMaxSizeEntries
End If
'---> Jetzt stellen wir das neue Ziel-Array zusammen
Redim vaNewValues(0 To iAmount-1)
For j = 0 To iAmount-1
'--> Wenn das History-Array kleiner wie die max. erlaubte Anzahl-1; starte bei 0;
'sonst starten wir bei der Differenz (History-Array-Ende - Max.erlaubteAnz. + 1)
If (iEnd <= iAmount -1 ) Then
iStartNew = 0
Else
iStartNew = iEnd - iAmount + 1
End If
'<--
vaNewValues(j) = vaSource(iStartNew + j)
Next
'<---
AuxSize = vaNewValues
EXITSCRIPT:
Exit Function
ERRORHANDLER:
Call AuxErrorHandler("History ScriptLibrary: Function AuxSize")
Resume EXITSCRIPT
End Function
Was macht die Function:
Man kippt folgendes rein:
- Item-Inhalt des History-Feldes (Variant Array)
- neuen Eintrag (str), den wir hinzufügen möchten
- die maximale Anzahl Bytes die wir zulassen für ein Textfeld
- die maximale Anzahl Einträge, die das History-Feld haben darf
Zurück bekommt man dann ein Array, welches entsprechend bereinigt ist und man dann direkt ins History-Textfeld setzen kann.
Die Function habe ich geschrieben, um zu zeigen was wir machen müssen.
Nun sollte imho der nächste Step sein, diese Logik via Klassen abzubilden.
Noch eine Frage:
Warum gibt es diese Sub in der History Main?
Private Sub clear()
Call m_doc.ReplaceItemValue("History", "")
End Sub
Nun hänge ich wieder fest:
Ich habe 1 sozusagen abstrakte Klasse.
Da steht u.a. drin:
Public Property Get myDifference As Variant
myDifference = .getDifference("Wert 1")
End Property
Dann habe ich eine Unterklasse ("HistoryField2Text"), da ist u.a. folgende Function:
Private Function getDifference(strTest As String) As String
getDifference = strTest & "bla bla"
End Function
Nun habe ich einen Button in einer Maske mit folgendem Code:
Sub Click(Source As Button)
Dim myHiFiText As HistoryField2Text
Dim test As Variant
test = myHiFiText.myDifference
Msgbox test
End Sub
Beim Ausführen kommt in der Zeile "test = myHiFiText.myDifference" die Fehlermeldung "Object Variable not set".
Any idea?
Ich habe bewusst nicht den ganzen Code zwecks Übersichtlichkeit gepostet. Wenn nötig hänge ich den aber natürlich rein.
OK, ich stecke nun mittendrin.
Damit das nun überhaupt noch wer kapiert von was ich rede, hole ich etwas weiter aus:
Wir haben als Aufgabe, Feldänderungen einer Maske in eine History zu schreiben.
Um das zu machen, habe ich
+ alle Feldnamen
+ alle Feldtitel (die ja abweichen können vom Feldnamen, z.B. Titel "Inhalt", Name aber "Sbj1")
+ alle Feldinhalte
jeweils in einem Array.
Um z.B. das Array "Feldinhalte" zu erzeugen, nutze ich eine Function:
Private Function ExtItemValuesToArray(doc As NotesDocument, vFieldList As Variant) As Variant
Nun sagt Thomas zurecht: Du hast ja da eine ScriptLib, wo Du Felder behandelst, mach doch daraus eine Klasse "Field".
Ein Objekt der Klasse 'Feld' repräsentiert genau ein zu überwachendes Feld aus dem Notesdokument.
D.h., wenn ich drei Felder überwachen will, dann brauche ich drei Objekte. Jedes Objekt kann mir Auskunft darüber
geben, welchen Wert 'sein' Feld hat, welchen es ürsprünglich hatte bzw. worin der Unterschied zwischen den beiden Werten besteht.
Das mache ich auch jetzt dann.
Mein Problem ist jetzt:
Ich muss ja den einzelnen Objekten u.a. Feldinhalte geben.
Bisher mach ich es mir einfach.
Private Function ExtItemValuesToArray(doc As NotesDocument, vFieldList As Variant) As Variant
'**************************************************************************************************
'Purpose: Loops through the provided field list and puts the item values to an Array
'
'In case of RichTextField, it sets a prefix "I_AM_A_RTF" and the last modified date. So we
'are easily able to find out if the array-entry-source was richtext.
'**************************************************************************************************
On Error Goto ERRORHANDLER
Dim item As NotesItem
Dim vItemValues() As Variant
Dim strItemValue As String
Dim i As Integer
'We loop through the field list and set the item values to the HistorySourceArray
Redim vItemValues(Ubound(vFieldList))
For i = 0 To Ubound(vFieldList)
Set item = doc.GetFirstItem( vFieldList(i) )
If item.Type = RICHTEXT Then
vItemValues(i) = "I_AM_A_RTF" & Cstr(item.LastModified)
Else
'--> We find out if the item contains more than one value; if so: we put 'em together in a string
strItemValue = ""
Forall v In item.values
If strItemValue = "" Then
strItemValue = Cstr(v)
Else
strItemValue = strItemValue & " / " & Cstr(v)
End If
End Forall
'<--------------
vItemValues(i) = strItemValue
End If 'item.Type = RICHTEXT Then
Next
ExtItemValuesToArray = vItemValues
EXITSCRIPT:
Exit Function
ERRORHANDLER:
Call AuxErrorHandler("ExtItemValuesToArray")
Resume EXITSCRIPT
End Function
Damit mache ich mir ein Array aus den Feldinhalten eines Dokumentes. Ich sehe dabei auch sofort, ob ein Array-Eintrag aus einem RT-Feld stammt und kann das dann weiterbearbeiten.
Unser Zielanspruch ist aber, mehrere Unterklassen zu haben (FieldText, FieldRTF, etc.).
Wie gebe ich jetzt die Feldinhalte in die Klassen FieldText und FieldRTF?
Ich müsste dann ja im Code abfragen, um was es sich für ein Feld handelt, und dann die entsprechende Klasse erstellen.
Dann habe ich eine Ansammlung an Objekte als Ergebnis: Einige FieldText-Objekte und einige FieldRTF-Objekte (kunterbunt gemischt).
Bisher war die Ausgabe der Reihenfolge in die Historie vorgegeben durch die Reihenfolge im Array. Jetzt muss ich wohl zusätzlich noch einen Zähler mitlaufen lassen um die Reihenfolge zu beizubehalten.
Außerdem blähe ich so den Code auf in dem ich die Objekte erstelle. All das hatte ich mit der Function vermieden.
Fazit:
Mittlerweile sehe ich nicht mehr so ganz den Sinn, eine Field-Klasse zu erstellen um z.B. obengenannte Function abzulösen.
Aber vielleicht kann mir das wer erklären (wenn da jetzt überhaupt noch wer durchsteigt ::) )
Danke
Hier noch ein wenig Code als Ansatz für die Field-Klasse.
a) Die abstrakte Klasse
Public Class HistoryField2
Private m_vInitialValue As Variant
Private m_vNewValue As Variant
Private m_strTitle As String
Private m_vDifference As Variant
'-------------------------------------------------------------------------------------------------
'Get/Set-Methoden
Public Property Set NewValue As Variant
m_vNewValue = NewValue
End Property
Public Property Get Difference As Variant
Difference = getDifference(m_strTitle, m_vInitialValue, m_vNewValue)
End Property
'-------------------------------------------------------------------------------------------------
Public Sub new(strTitle As String, vInitialValue As Variant)
m_strTitle = strTitle
m_vInitialValue = vInitialValue
End Sub
'-------------------------------------------------------------------------------------------------
Private Function getDifference(strName As String, vSource As Variant, vTarget As Variant) As String
'Nichts. Code wird in der abgeleiteten Klasse ausgeführt !
End Function
'-------------------------------------------------------------------------------------------------
End Class
b) Eine Unterklasse
Public Class HistoryField2Text As HistoryField2
%REM
Diese Klasse nutzt die abstrakte Klasse "HistoryField2 !
%END REM
'-------------------------------------------------------------------------------------------------
Public Sub new(strName As String, vInitialValue As Variant)
End Sub
'-------------------------------------------------------------------------------------------------
Private Function getDifference(strName As String, vSource As Variant, vTarget As Variant) As String
Dim strResult As String
If vSource = vTarget Then
Else 'Nein, Quelle und Ziel sind nicht identisch
strResult = AuxImplode(vSource, " / ") 'erstmal alles in ein String
strResult = AuxRemoveLinebrakes(strResult, " ")
strResult = "Changed Field '" & strName & "' (former value: '" & strResult & "')"
End If
End Function
'-------------------------------------------------------------------------------------------------
End Class
Hier brauch ich aber noch eben die ursprünglichen Feldinhalte, und dann auch die neuen Feldinhalte.
Ich hab jetzt mal die Klasse "HistoryField" neu erstellt. Ich glaube hier brauchts gar keine Auftrennung Abstrakte Klasse / Unterklassen. Aber bestimmt noch an anderer Stelle der History-Klassen.
Public Class HistoryField
Private m_itmField As NotesItem
Private m_strFieldTitle As String
Private m_vInitialValue As Variant
Private m_vNewValue As Variant
'-------------------------------------------------------------------------------------------------
Public Sub new(itmField As NotesItem, strItemTitle As String)
Dim iItemType As Integer
'Das Item und den Item-Titel in die Membervariable
Set m_itmField = itmField
m_strFieldTitle = strItemTitle
'----> Den Iteminhalt auslesen
m_vInitialValue = GetFieldValue()
'<----
End Sub
'-------------------------------------------------------------------------------------------------
Public Sub setInitialValue()
'Setzt den aktuellen Feldinhalt als InitialValue. Vielleicht brauchen wir
'das irgendwann einmal :-)
m_vInitialValue = GetFieldValue()
End Sub
'-------------------------------------------------------------------------------------------------
'########################################################
'Get/Set-Methoden
'-------------------------------------------------------------------------------------------------
Public Property Get difference As String
Dim strDiff As String
Dim iItemType As Integer
'Der neue Iteminhalt
m_vNewValue = GetFieldValue()
'---> Item-Typ
On Error 91 Goto OBJECTNOTSET 'If it is a new doc and field is RTF
iItemType = m_itmField.Type
On Error Goto 0 'Fehlerbehandlungsroutine wieder zurücksetzen
'<---
Select Case iItemType
Case RICHTEXT:
If m_vInitialValue = m_vNewValue Then
'Keine Feldänderung
strDiff = ""
Else
'Feldinhalt hat sich geändert
strDiff = "Changed Richtext-Field '" & m_strFieldTitle & "'"
End If
Case Else:
m_vNewValue = m_itmField.Values
If m_vInitialValue = m_vNewValue Then
'Keine Feldänderung
strDiff = ""
Else
'Feldinhalt hat sich geändert
strDiff = AuxImplode(m_vInitialValue, " / ") 'erstmal alles in ein String
strDiff = AuxRemoveLinebrakes(strDiff, " ")
strDiff = "Changed Field '" & m_strFieldTitle & "' (former value: '" & strDiff & "')"
End If
End Select 'Case iItemType
difference = strDiff
EXITSCRIPT:
Exit Property
OBJECTNOTSET:
iItemType = RICHTEXT
Resume Next
End Property
'########################################################
'-------------------------------------------------------------------------------------------------
Private Function GetFieldValue() As Variant
'Den Item-Inhalt bzw. bei RTF Datum letzter Änderung auslesen .........
Dim iItemType As Integer
'-> Item-Typ
On Error 91 Goto OBJECTNOTSET 'If it is a new doc and field is RTF
iItemType = m_itmField.Type
On Error Goto 0 'Fehlerbehandlungsroutine wieder zurücksetzen
'<-
Select Case iItemType
Case RICHTEXT:
GetFieldValue = m_itmField.LastModified
Case Else:
GetFieldValue = m_itmField.Values
End Select
'<----
EXITSCRIPT:
Exit Function
OBJECTNOTSET:
GetFieldValue = "NEWRTF"
Resume EXITSCRIPT
End Function
'-------------------------------------------------------------------------------------------------
End Class
Mit dem Rest mache ich noch gelegentlich weiter...
*Edit*
Hier hab ich noch die Klasse beschrieben:
(http://www.atnotes.de/attachments/klassenbeschr_02.gif)
OK, habe den aktuellen Stand angehängt.
Aufgrund des R5-Debug-Problems entwickle ich das jetzt in ND6 (versuche aber R5-kompatibel zu bleiben).
Hier noch die HistoryMain-Klasse als Code:
'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