Anonymous
|
The last problem was that I missed to pass the hDb parameter with ByVal. The functioning code looks like (if anyone is interested): Option Public Option Declare ' Declare some c constants Const OS_TRANSLATE_UNICODE_TO_LMBCS = 23% ' Declare some c functions ' Declare Function PathNetConstruct Lib "nnotes" Alias "OSPathNetConstruct" (Byval PortName As Lmbcs String, _ Byval ServerName As Lmbcs String, Byval FileName As Lmbcs String, Byval retPathName As Lmbcs String) As Integer ' Declare Function NSFDbOpen Lib "nnotes" Alias "NSFDbOpen" (Byval dbName As Lmbcs String, hdb As Long) As Integer ' Declare Function NSFDbClose Lib "nnotes" Alias "NSFDbClose" (Byval hdb As Long) As Integer ' Declare Function SECAttachIdFileToDB Lib "nnotes" Alias "SECAttachIdFileToDB" (Byval hdb As Long, Byval ProfileNotesName As _ Lmbcs String, Byval ProfileNoteNameLength As Long, Byval UserName As Long, Byval UserNameLength As Long, _ Byval FileName As Lmbcs String, Byval Password As Lmbcs String, Byval Reserved As Long, Byval pReserved As _ Long) As Integer ' Declare Function TranslateFromStr Lib "nnotes" Alias "OSTranslate" (Byval translateMode As Integer, Byval inBuff As _ Unicode String, Byval inLen As Integer, Byval outBuff As Long, Byval outLen As Integer) As Integer ' Declare Function OSLockObject Lib "nnotes" Alias "OSLockObject" (Byval handle As Long) As Long ' Declare Sub OSUnlockObject Lib "nnotes" Alias "OSUnlockObject" (Byval handle As Long) ' Declare Function OSMemoryAllocate Lib "nnotes"(Byval dwtype As Long, Byval size As Long, rethandle As Long) As Integer ' Declare Sub OSMemoryFree Lib "nnotes" Alias "OSMemoryFree"(Byval handle As Long) ' Declare Function OSMemoryLock Lib "nnotes" Alias "OSMemoryLock" (Byval handle As Long) As Long ' Declare Sub OSMemoryUnLock Lib "nnotes" Alias "OSMemoryUnlock" (Byval handle As Long) ' Declare Sub OSLoadString Lib "nnotes" Alias "OSLoadString" (Byval null1 As Long, _ Byval sError As Integer, Byval errstr As String, Byval lenstr As Integer) ' ============================ Class memoryManager
OpenHandles List As Variant
Function LockObject (h) As Long If h=0 Then Exit Function ' make sure you do not use 0 pointer ' returned in case handle is 0 LockObject = OSLockObject(h) OpenHandles(h) = LockObject End Function
Sub UnLockObject (h) If h=0 Then Exit Sub ' do not bite If Iselement(OpenHandles(h)) Then OSUnlockObject h Erase OpenHandles(h) End If End Sub
Sub UnLockAll Forall hh In Me.OpenHandles Me.unlockObject hh End Forall End Sub
Sub Delete UnLockAll ' on delete release all locked handles End Sub
End Class ' ============================ Public Class memoryManagerExt As memoryManager
buffers List As Long
Public Function newBuffer (lenBuff As Long) As Long Dim irc As Integer, hBuff As Long ' these handles are Long in all OSes irc =OSMemoryAllocate (0, lenBuff, hBuff) If irc=0 Then If hBuff = 0 Then Exit Function ' paranoid chek - it should not be 0 if retrun code is OK buffers(hBuff)= OSMemoryLock (hBuff) newBuffer = buffers(hBuff) Else Print getError(irc) End If End Function
Public Sub Delete Forall p In Me.buffers
OSMemoryUnlock Listtag(p) OSMemoryFree Listtag(p) End Forall End Sub
End Class ' * memoryManagerExt Sub Initialize
On Error Goto errorHandler
Dim ses As New NotesSession Dim db As NotesDatabase Dim PortName As String Dim ServerName As String Dim FileName As String Dim pathName As String*1024 Dim ret As Integer Dim hdb As Long Dim ProfileNoteName As String Dim LmbcsLen As Long Dim memMan As New memoryManagerExt Dim pLmbcsStr As Long Dim IdFileName As String Dim password As String
' Set db = ses.CurrentDatabase
' Construct the path to this database PortName = "" ServerName = db.Server FileName = db.FilePath ret = PathNetConstruct(PortName, ServerName, FileName, pathName) If ret <> 0 Then Error 1212, "Something went amiss"
' Open database to get a handle opn it ret = NSFDbOpen(pathName, hdb) If ret <> 0 Then Error 1212, "Something went amiss"
ProfileNoteName = "test" pLmbcsStr = memMan.newBuffer (3 * Lenb(ProfileNoteName))
LmbcsLen = TranslateFromStr(OS_TRANSLATE_UNICODE_TO_LMBCS, ProfileNoteName, Lenb(ProfileNoteName), _ pLmbcsStr, 3 * Lenb(ProfileNoteName))
IdFileName = "c:\hto.id" Password = "********" ' Correct pwd for stated id file
ret = SECAttachIdFileToDB(hdb, ProfileNoteName, LmbcsLen, 0, 0, _ IdFileName, Password, 0, 0) If ret <> 0 Then Error 1212, "Something went amiss"
' Close the database to free its resources ret = NSFDbClose(hdb) If ret <> 0 Then Error 1212, "Something went amiss"
exitOk: Exit Sub
errorHandler: Print Error$ + " in line " + Cstr(Erl) Messagebox Error$ + " in line " + Cstr(Erl) Resume exitOk
End Sub Public Function getError (enum As Integer) As String
Dim s As String*256 OSLoadString 0, enum And &h03FFFFFFF, s, 256 getError = Strleft(s, Chr(0))
End Function
|