Class ViewNavBase As ErrorHandler
Private AutoSave As Boolean
Private logDoc As NotesDocument
Private columns List As Integer
Private db As NotesDatabase
Private dbsource As NotesDatabase
Private dbtarget As NotesDatabase
Private view As NotesView
Private key As String
Private nav As NotesViewNavigator
Private lastAU As Boolean 'last autoupdate state
Private first As NotesViewEntry
Private last As NotesViewEntry
Private debug As Boolean
Private safe As Boolean 'for safe update (don't replace "existing" value)
Private NDChave2save() As NotesDocument
Private UNIDS2save() As String
Private UNIDS4missmatch() As String
Private isTmpl As String
%REM
*--------------------------------------------
Sub New
Description: Comments for Sub
%END REM
Sub New(db As NotesDatabase, viewName As String, key As String)
Dim routineName As String
routineName="New"
On Error GoTo ErrH
'your code here
me.AutoSave=True
me.isTmpl={0}
'Print {Class->} TypeName(Me){;View name:} viewName
If db Is Nothing Then Error 1024, {DB is Nothing}
Dim ses As New NotesSession
Set me.db=db
'Print {Database RID:} me.db.Replicaid
Set me.logDoc=me.db.CreateDocument
Call me.logDoc.Replaceitemvalue({form}, {log})
Set me.rtTrace=me.logDoc.Createrichtextitem({body})
Call me.logDoc.Computewithform(False, False)
me.key=key
Set me.view=me.db.Getview(Viewname)
me.lastAU=me.view.AutoUpdate
me.view.AutoUpdate= False
me.view.Refresh
Dim entry As NotesViewEntry
Dim NEC As NotesViewEntryCollection
'Print {Class:} TypeName(Me) {->} {Key:} me.key
Set NEC=view.Getallentriesbykey(me.key, True)
If Not NEC Is Nothing Then Set entry=NEC.Getfirstentry()
If entry Is Nothing Then
Print {Class:} TypeName(Me) {->} {First Entry Is Nothing}
Set nav=view.Createviewnav()'escape error if key doesn't match any entries
Else
'Print {Class:} TypeName(Me) {->} {Entries Count} NEC.Count
Set me.nav=view.Createviewnavfrom(entry)
'https://www-10.lotus.com/ldd/ddwiki.nsf/dx/Fast_Retrieval_of_View_Data_Using_the_ViewNavigator_Cache
nav.BufferMaxEntries = NAV_BUF
nav.EntryOptions = Vn_entryopt_nocountdata
Set me.first=entry
Set entry=NEC.Getlastentry()
Set me.last=nav.Getentry(entry)
ForAll col In me.view.Columns
Dim tmp As NotesViewColumn
Set tmp=col
'Print {Column name/pos:}tmp.ItemName {/} tmp.Position-1
me.columns(tmp.ItemName)=tmp.Position-1
End ForAll
End If
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Function Add2Missmathc
Description: add to array for missmatch entries
%END REM
Function Add4Missmatch(entry As NotesViewEntry) As NotesViewEntry
Dim routineName As String
routineName="Add4Missmatch"
On Error GoTo ErrH
'your code here
Dim cnt As Long
If IsArrayInitialized(me.UNIDS4missmatch) Then
cnt=UBound(me.UNIDS4missmatch)+1
End If
ReDim Preserve me.UNIDS4missmatch(cnt) As String
me.UNIDS4missmatch(cnt)=entry.Universalid
Set Add4Missmatch=entry
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function Add2Save
Description: Comments for Function
%END REM
Private Function Add2Save(doc As NotesDocument) As NotesDocument
Dim routineName As String
routineName="Add2Save"
On Error GoTo ErrH
'your code here
Dim cnt As Long
If IsArrayInitialized(me.NDChave2save) Then
cnt=UBound(me.NDChave2save)+1
End If
ReDim Preserve me.NDChave2save(cnt) As NotesDocument
ReDim Preserve me.UNIDS2save(cnt) As String
Set me.NDChave2save(cnt)=doc
me.UNIDS2save(cnt)=doc.Universalid
Set Add2Save=doc
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Sub Terminate
Description: destroy object
%END REM
Sub Delete()
Dim routineName As String
routineName="Delete"
On Error GoTo ErrH
'your code here
'try to save document have been marked for save
If me.AutoSave Then Me.Save
Quit:
Exit Sub
ErrH:
Error Err, Me.RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Function Save
Description: Comments for Function
%END REM
Private Function Save()
Dim routineName As String
routineName="Save"
On Error GoTo ErrH
'your code here
If Not me.view Is Nothing Then
me.view.Refresh
me.view.Autoupdate=me.lastAU
End If
'Print {Class:} TypeName(Me){->Destroy; Key:}key
If Not IsArrayInitialized(me.NDChave2save) Then GoTo Quit
'Print {Class:} TypeName(Me){->Saving Documents...} UBound(me.NDChave2save)+1
Dim lastTry2Save As String
ForAll obj In me.NDChave2save
Dim doc As NotesDocument
Set doc=obj
If Not doc Is Nothing Then
lastTry2Save={*Saved Doc Parent/UNID/Form/Name:} & _
doc.Parentdocumentunid & {/} & _
doc.Universalid & {/} & _
doc.GetItemValue({Form})(0)&{/}&doc.Getitemvalue(NAME_FLD)(0) &{*}
Call doc.Save(True, False)
'Print {Class:} TypeName(Me){->Saved Doc name:}doc.Getitemvalue(NAME_FLD)(0)
End If
End ForAll
ReDim me.NDChave2save(0) As NotesDocument
Set me.NDChave2save(0)=Nothing
'Save=
Quit:
Exit Function
ErrH:
Dim s As String
s=Me.RaiseError
If Len(lastTry2Save)>0 Then s=s & Chr(10) & lastTry2Save & Chr(10)
Error Err, s
Resume Quit
End Function
%REM
*--------------------------------------------
Property Set IsDebug
Description: Comments for Property Set
%END REM
Property Set IsDebug As Boolean
Dim routineName As String
routineName="IsDebug"
On Error GoTo ErrH
'your code here
me.debug=IsDebug
Quit:
Exit Property
ErrH:
Error Err, RaiseError
Resume Quit
End Property
%REM
*--------------------------------------------
Property Set IsTemplate
Description: return ISTEMPLATE_FLD value
%END REM
Private Property Get IsTemplate As String
Dim routineName As String
routineName="IsTemplate"
On Error GoTo ErrH
'your code here
IsTemplate=me.isTmpl
Quit:
Exit Property
ErrH:
Error Err, RaiseError
Resume Quit
End Property
%REM
*--------------------------------------------
Property Set IsTemplate
Description: Comments for Property Set
%END REM
Private Property Set IsTemplate As String
Dim routineName As String
routineName="IsTemplate"
On Error GoTo ErrH
'your code here
me.isTmpl=IsTemplate
Quit:
Exit Property
ErrH:
Error Err, RaiseError
Resume Quit
End Property
%REM
*--------------------------------------------
Property Get Changes
Description: Comments for Property Get
%END REM
Property Get Changes As Long
Dim routineName As String
routineName="Changes"
On Error GoTo ErrH
'your code here
If IsArray(me.NDChave2save)Then Changes=UBound(me.NDChave2save)+1
Quit:
Exit Property
ErrH:
Error Err, RaiseError
Resume Quit
End Property
%REM
*--------------------------------------------
Property Get ChangesUNIDS
Description: Comments for Property Get
%END REM
Property Get ChangesUNIDS
Dim routineName As String
routineName="ChangesUNIDS"
On Error GoTo ErrH
'your code here
If IsArrayInitialized(me.UNIDS2save)Then
ChangesUNIDS=me.UNIDS2save
Else
ChangesUNIDS=Split({},{})
End If
Quit:
Exit Property
ErrH:
Error Err, RaiseError
Resume Quit
End Property
%REM
*--------------------------------------------
Function GetFirst
Description: Comments for Function
%END REM
Function GetFirst() As NotesViewEntry
Dim routineName As String
routineName="GetFirst"
On Error GoTo ErrH
'your code here
Set GetFirst=me.first
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function GetPrev
Description: Comments for Function
%END REM
Function GetPrev(entry As NotesViewEntry) As NotesViewEntry
Dim routineName As String
routineName="GetPrev"
On Error GoTo ErrH
'your code here
If entry.Getposition(POS_SEP) = me.first.Getposition(POS_SEP) Then GoTo Quit
Set GetPrev=nav.Getprev(entry)
'If Me.GetPrev.Columnvalues(0)<>key Then Set GetPrev=NOTHING
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function GetNext
Description: Comments for Function
%END REM
Function GetNext(entry As NotesViewEntry) As NotesViewEntry
Dim routineName As String
routineName="GetNext"
On Error GoTo ErrH
'your code here
If entry.Getposition(POS_SEP) = me.last.Getposition(POS_SEP) Then GoTo Quit
Set GetNext=me.nav.Getnext(entry)
'If Me.GetNext.Columnvalues(0)<>me.key Then Set GetNext=Nothing
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Sub Get HashMap
Description: return List Array
should be overrided
%END REM
Sub GetHashMap(lst List As Variant)
Dim routineName As String
routineName="HashMap"
On Error GoTo ErrH
'your code here
'HashMap=
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Sub ShowLog
Description: Comments for Sub
%END REM
Function ShowLog As NotesUIDocument
Dim routineName As String
routineName="ShowLog"
On Error GoTo ErrH
'your code here
Dim wks As New NotesUIWorkspace
me.rtTrace.Update
Set ShowLog=wks.Editdocument(True, me.logDoc)
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function Filter
Description: return True if value have not to be updated
%END REM
Function Filter(key As String) As Boolean
Dim routineName As String
routineName="Filter"
On Error GoTo ErrH
'your code here
'Filter=False
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function UpdateByHashMap
Description: update "collection" according HashMap
all additional documents will be added
vnav is another object
%END REM
Function UpdateByHashMap(vnav As ViewNavBase)
Dim routineName As String
routineName="UpdateByHashMap"
On Error GoTo ErrH
'your code here
If Not (TypeName(vnav) = TypeName(Me)) Then _
Error 1024, CM_NAVTYPEMISMATCH &TypeName(Me) &{/} &TypeName(vnav)
Set vnav.dbsource=me.db
Set me.dbtarget=vnav.db
'Print {Target DB RID:} vnav.db.Replicaid
Dim lst List As Variant
Call Me.GetHashMap(lst)
Dim entry As NotesViewEntry
Set entry=vnav.GetFirst()
Do While Not entry Is Nothing
Dim tmpkey As String
tmpkey=entry.Columnvalues(vnav.GetKeyValueCol())
'check target view key according source key list
If IsElement(lst(tmpkey)) Then
'check if key should not be updated
If Not Filter(tmpkey) Then
Dim docres As NotesDocument
If vnav.UpdateValues(lst(tmpkey), entry, docres) Then
'Call entry.Document.Save(True, False, False)
'Print {Add to Save:} docres.Getitemvalue(NAME_FLD)(0) {/} docres.Getitemvalue(VALUE_FLD)(0)
Call Add2Save(docres)
End If
End If
'remove hash element if it has been found
Erase lst(tmpkey)
Else
Call Me.Add4Missmatch(entry)
End If
Set entry=vnav.GetNext(entry)
Loop
'create document according filter
'itarate reamin keys
ForAll m In lst
Dim doc As NotesDocument
Set doc=Nothing
If Not Filter(ListTag(m)) Then Set doc=vnav.CreateDocument(ListTag(m),m)
If Not doc Is Nothing Then
SetType doc
'Call doc.Save(True, False, False)
Call Add2save(doc)
End If
End ForAll
'UpdateByHashMap=
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function GetKeyValue
Description: return column Index (view entry) for hash key
should be overrided
%END REM
Function GetKeyValueCol() As Integer
Dim routineName As String
routineName="GetKeyValue"
On Error GoTo ErrH
'your code here
'GetKeyValueCol=
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function CreateDocument
Description: should be overrided
will be called from UpdateByHashMap
%END REM
Function CreateDocument(keyfld As String, values) As NotesDocument
Dim routineName As String
routineName="CreateDocument"
On Error GoTo ErrH
'your code here
'CreateDocument=
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function RemoveMissmatch
Description: Comments for Function
%END REM
Function RemoveMissmatch()
Dim routineName As String
routineName="RemoveMissmatch"
On Error GoTo ErrH
'your code here
If IsArrayInitialized(me.UNIDS4missmatch) Then
ForAll m In me.UNIDS4missmatch
Dim unid As String
unid=CStr(m)
Dim doc As NotesDocument
Set doc=GetDocumentByUNIDSilent(me.db, unid)
If Not doc Is Nothing Then
Call doc.Remove(True)
End If
End ForAll
End If
'RemoveMissmatch=
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function SetType
Description: should be overrided
%END REM
Private Function SetType(doc As NotesDocument)
Dim routineName As String
routineName="SetType"
On Error GoTo ErrH
'your code here
'SetType=
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Property Set IsSafe
Description: replace or not (true - not) to new value with UpdateValues
%END REM
Property Set IsSafe As Boolean
Dim routineName As String
routineName="IsSafe"
On Error GoTo ErrH
'your code here
me.safe=IsSafe
Quit:
Exit Property
ErrH:
Error Err, RaiseError
Resume Quit
End Property
%REM
*--------------------------------------------
Function UpdateValues
Description: assign nev values to entry
shoul be overrided
%END REM
Function UpdateValues(values, entry As NotesViewEntry, docres As NotesDocument) As Boolean
Dim routineName As String
routineName="UpdateValues"
On Error GoTo ErrH
'your code here
'UpdateValues=
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
End Class
