%REM
*********************************************
Class ViewNav
Description: creates view Navigator
only string key accepted, as first sorted column value
%END REM
Class ViewNav As ErrorHandler
Private logDoc As NotesDocument
Private columns List As Integer
Private db 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)
%REM
*--------------------------------------------
Sub New
Description: Comments for Sub
%END REM
Sub New(viewName As String, key As String)
Dim routineName As String
routineName="New"
On Error GoTo ErrH
'your code here
Dim ses As New NotesSession
Set me.db=ses.Currentdatabase
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 view=db.Getview(Viewname)
me.lastAU=me.view.AutoUpdate
me.view.AutoUpdate= False
me.view.Refresh
Dim entry As NotesViewEntry
' Set entry=view.Getentrybykey(me.key, true)
Dim NEC As NotesViewEntryCollection
Print {Class:} TypeName(Me) {->} {Key:} me.key
Set NEC=view.Getallentriesbykey(me.key, true)
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
me.columns(tmp.ItemName)=tmp.Position-1
End ForAll
End If
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
Resume Quit
End Sub
%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
*--------------------------------------------
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
%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
Sub Delete()
If Not me.view Is Nothing Then
me.view.Refresh
me.view.Autoupdate=me.lastAU
End If
End Sub
%REM
*--------------------------------------------
Sub ShowLog
Description: Comments for Sub
%END REM
Sub ShowLog
Dim routineName As String
routineName="ShowLog"
On Error GoTo ErrH
'your code here
Dim wks As New NotesUIWorkspace
me.rtTrace.Update
Call wks.Editdocument(True, me.logDoc)
Quit:
Exit Sub
ErrH:
Error Err, RaiseError
Resume Quit
End Sub
%REM
*--------------------------------------------
Function UpdateByHashMap
Description: update "collection" according HashMap
all additional documents will be added
%END REM
Function UpdateByHashMap(vnav As ViewNav)
Dim routineName As String
routineName="UpdateByHashMap"
On Error GoTo ErrH
'your code here
If Not vnav IsA TypeName(Me) Then _
Error 1024, CM_NAVTYPEMISMATCH &TypeName(Me) &{/} &TypeName(vnav)
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())
If IsElement(lst(tmpkey)) Then
If vnav.UpdateValues(lst(tmpkey), entry) Then
Call entry.Document.Save(True, False, False)
End If
Erase lst(tmpkey)
End If
Set entry=vnav.GetNext(entry)
Loop
ForAll m In lst
Dim doc As NotesDocument
Set doc=vnav.CreateDocument(ListTag(m),m)
If Not doc Is Nothing Then
SetType doc
Call doc.Save(True, False, False)
End If
End ForAll
'UpdateByHashMap=
Quit:
Exit Function
ErrH:
Error Err, RaiseError
Resume Quit
End Function
%REM
*--------------------------------------------
Function GetKeyValue
Description: return Index for key column
%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: Comments for Function
%END REM
Function CreateDocument(keyfld As String, values)
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 SetType
Description: Comments for Function
%END REM
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: Comments for Property Set
%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
%END REM
Function UpdateValues(values, entry As NotesViewEntry) 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
бадн-бадн получился