Option Public
Option Declare
Const wAPIModule = "nnotes"
Type AssistInfo
Version As Integer
TriggerType As Integer ' 0 none, 1 schedule, 2 new mail, 3 paste, 4 manual, 5 update, 6 router
SearchType As Integer ' 0 none, 1 all, 2 new, 3 new/mod, 4 selected, 5 view, 6 unread, 7 prompt, 8 UI
IntervalType As Integer ' 0 none, 1 minutes, 2 days, 3 weeks, 4 months
Interval As Integer
Time1 As Variant ' Start time (ms since midnight)
Time2 As Variant ' Long (weekday or day of month) or end time (ms since midnight)
StartTime As Variant ' Time/Date
EndTime As Variant ' Time/Date
Flags As Long ' 1 hidden, 2 no weekends, 4 store highlights, 8 mail/paste, 16 choose server
Spare(15) As Long
End Type
Type BlockID
hPool As Long
Block As Long
End Type
Declare Private Function W64_NSFDbClose Lib wAPIModule Alias "NSFDbClose" (Byval DBHANDLE As Long) As Integer
Declare Private Function W64_NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" (Byval strPathName As String, DBHANDLE As Long) As Integer
Declare Private Function W64_NSFItemInfo Lib wAPIModule Alias "NSFItemInfo" (Byval NOTEHANDLE As Long, Byval strItemName As String, Byval wItemNameLength As Integer, BLOCKID_Item As BlockID, wDataType As Integer, BLOCKID_Value As BlockID, dwValueLength As Long) As Integer
Declare Private Function W64_NSFNoteClose Lib wAPIModule Alias "NSFNoteClose" (Byval NOTEHANDLE As Long) As Integer
Declare Private Function W64_NSFNoteOpen Lib wAPIModule Alias "NSFNoteOpen" (Byval DBHANDLE As Long, Byval NOTEID As Long, Byval WORD_FLAGS As Integer, NOTEHANDLE As Long) As Integer
Declare Private Function W64_OSLoadString Lib wAPIModule Alias "OSLoadString" (Byval HMODULE_hModule As Long, Byval STATUS_StringCode As Integer, Byval CharFar_RetBuffer As String, Byval WORD_BufferLength As Integer) As Integer
Declare Private Function W64_OSLockObject Lib wAPIModule Alias "OSLockObject" (Byval HANDLE As Double) As Double
Declare Private Function W64_OSPathNetConstruct Lib wAPIModule Alias "OSPathNetConstruct" (Byval lngPortName As Long, Byval strServerName As String, Byval strFileName As String, Byval strPathName As String) As Integer
Declare Private Function W64_OSUnlockObject Lib wAPIModule Alias "OSUnlockObject" (Byval HANDLE As Double) As Boolean
Sub Initialize
Dim ai As AssistInfo
Dim bid_item As BLOCKID
Dim bid_value As BLOCKID
Dim ag As NotesAgent
Dim db As NotesDatabase
Dim dbl_pointer As Double
Dim doc As NotesDocument
Dim int_apiresult As Integer
Dim int_valuedatatype As Integer
Dim lng_dbhandle As Long
Dim lng_notehandle As Long
Dim lng_noteid As Long
Dim lng_valuelen As Long
Dim s As NotesSession
Dim str_filepath As String
Dim str_netfilepath As String
Dim str_server As String
Dim str_unid As String
Const NULLHANDLE = 0&
Const NOERROR = 0
Const ASSIST_INFO_ITEM = "$AssistInfo"
' ### initialize ###
Set s = New NotesSession
Set db = s.CurrentDatabase
Set ag = s.CurrentAgent
lng_dbhandle = NULLHANDLE
' ### get agent's design document ###
str_unid = Strleft(Strright(ag.NotesURL, ".nsf/"), "?OpenAgent")
Print {Universal ID = } & str_unid
Set doc = db.GetDocumentByUNID(str_unid)
If doc Is Nothing Then
Print {Could not find agent's design document by universal ID "} & str_unid & {"!}
Goto terminate
End If
' ### get the network file name ###
str_server = db.Server
str_filepath = db.FilePath
str_netfilepath = Space(1024)
int_apiresult = W64_OSPathNetConstruct(0, str_server, str_filepath, str_netfilepath)
If Not(int_apiresult = NOERROR) Then
Print "Error due calling OSPathNetConstruct: " & APIError(int_apiresult)
Goto terminate
End If
' ### open database handle ###
int_apiresult = W64_NSFDbOpen(str_netfilepath, lng_dbhandle)
If Not(int_apiresult = NOERROR) Then
Print "Error due calling NSFDbOpen: " & APIError(int_apiresult)
Goto terminate
Else
Print "lng_dbhandle = " & lng_dbhandle
End If
' ### open agent's note handle ###
lng_noteid = Clng("&H" & doc.NoteID)
Print "lng_noteid = " & lng_noteid
int_apiresult = W64_NSFNoteOpen(lng_dbhandle, lng_noteid, 0, lng_notehandle)
If Not(int_apiresult = 0) Then
Print "Error due calling NSFNoteOpen: " & APIError(int_apiresult)
Goto close_db_handle
Else
Print "lng_notehandle = " & lng_notehandle
End If
' ### read assist info item ###
int_apiresult = W64_NSFItemInfo(lng_notehandle, ASSIST_INFO_ITEM, Len(ASSIST_INFO_ITEM), bid_item, int_valuedatatype, bid_value, lng_valuelen)
If Not(int_apiresult = NOERROR) Then
Print "Error due calling NSFItemInfo: " & APIError(int_apiresult)
Goto close_note_handle
Else
Print "bid_item.hPool = " & bid_item.hPool
Print "bid_item.Block = " & bid_item.Block
Print "int_valuedatatype = " & int_valuedatatype
Print "bid_value.hPool = " & bid_value.hPool
Print "bid_value.Block = " & bid_value.Block
Print "lng_valuelen = " & lng_valuelen
End If
' ### lock object ###
' !!! because of a NULLBLOCK (bid_value.Block) the next call causes a PANIC on a server running on a 64 bit system
'dbl_pointer = W64_OSLockObject(bid_value.hPool&) + (bid_value.Block&)
' ### unlock object ###
'If W64_OSUnlockObject(bid_value.hPool) = False Then
' Print "Error due calling apiOSUnlockObject"
'End If
' ### close note handle ###
close_note_handle:
int_apiresult = W64_NSFNoteClose(lng_notehandle)
If Not(int_apiresult = NOERROR) Then
Print "Error due calling NSFNoteClose: " & APIError(int_apiresult)
Goto terminate
End If
' ### close database handle ###
close_db_handle:
int_apiresult = W64_NSFDbClose(lng_dbhandle)
If Not(int_apiresult = NOERROR) Then
Print "Error due calling NSFDbClose: " & APIError(int_apiresult)
Goto terminate
End If
' ### termiante ####
terminate:
Set doc = Nothing
Set ag = Nothing
Set db = Nothing
Set s = Nothing
End Sub
Function APIError(int_code As Integer)
Dim str_text As String
str_text = String$(1024, " ")
Call W64_OSLoadString(0, int_code And &H3FFF, str_text, 1024)
If Not(Instr(str_text, Chr$(0)) = 0) Then str_text = Left$(str_text, Instr(str_text, Chr$(0)) - 1)
If str_text = "" Or str_text = "No error" Then str_text = "Unknown error (&H" & Hex$(int_code) & ")"
APIError = str_text
End Function