Montag, 14. Februar 2011

Managing userIDs in Lotus Notes databases

Based on a post by Leif Lagerbrand ( which you may find here: http://www.ls2capi.com/web/ls2capi/ls2capihome.nsf/vwThreadsMain/37A36B2F89E940E8852571EA002FAEF7?OpenDocument ), I once wrote a quick-and-dirty Lotus script agent in order to manage Lotus Notes user.id-files in their various possible locations depending on the usage purpose. As soon as you get in touch with Notes-encryption and/or S/MIME-Encryption in Lotus Notes in combination with Roaming-, Blackberry- or iNotes-users, this little tool could become handy to you. If you want to read Notes- and/or S/MIME-encrypted documents via iNotes, you'll quite probably need to import your Lotus Notes user.id-file into your mail database. Normally, this would be done in the preferences dialog of the iNotes webinterface. Now you may choose the help of the following Lotus Script agent. The ID-File for iNotes is usually saved to a profile document with the title "$shimmerid".
In case that you're dealing with a Blackberry user, you'll also want to import his user.id so he is able to decrypt encrypted messages on his device. In this case, the profile document which stores the user.id is called "$rimid".
The last use-case is the roaming user functionality. For roaming users, the id-file isn't stored within the mail-file, but within the personal addressbook (names.nsf). The corresponding profile document has the title "roaminguserid".
As soon as your user needs to change the password for his main user.id, you'll probably love to use the Lotus Script agent.

Here are some screenshots:



Save the following code as an agent to your mail-database:
 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 SECExtractIdFileFromDB Lib "nnotes" Alias "SECExtractIdFileFromDB" (Byval hdb As Long, Byval ProfileNotesName As _  
 Lmbcs String, Byval ProfileNoteNameLength As Long, Byval UserName As Long, Byval UserNameLength As Long, _  
 Byval Password As Lmbcs String, Byval FileName As Lmbcs String, Byval Reserved As Long, Byval pReserved As _  
 Long) As Integer  
 Declare Function SECRefreshIdFile Lib "nnotes" Alias "SECRefreshIdFile" (Byval FileName As Lmbcs String,Byval Password As Lmbcs String, _  
 Byval Server As Lmbcs String , Byval retFlags As Long, Byval Reserved As Long, Byval preserved As Long) As Integer  
 Declare Function SECKFMChangePassword Lib "nnotes.dll" Alias "SECKFMChangePassword" ( Byval Filename As Lmbcs String , _  
 Byval Password As Lmbcs String , Byval NewPassword As Lmbcs String ) 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  
 ' Autor: Patrick Tippner  
 Sub Initialize  
 On Error Goto errorHandler  
 Dim ws As New NotesUIWorkspace  
 Dim ses As New NotesSession  
 Dim db As NotesDatabase  
 Dim doc As NotesDocument  
 Dim item As NotesItem  
 Dim PortName As String  
 Dim ServerName As String  
 Dim FileName As String  
 Dim pathName As String*1024  
 Dim ret As Integer  
 Dim retflag As Long  
 Dim hdb As Long  
 Dim ProfileNoteName As String  
 Dim LmbcsLen As Long  
 Dim memMan As New memoryManagerExt  
 Dim pLmbcsStr As Long  
 Dim IdFileName As Variant  
 Dim Password As String  
 Dim newPassword1 As String  
 Dim newPassword2 As String  
 Dim response As Variant  
 Dim values(2) As Variant  
 Dim choices(4) As Variant  
 Dim itemname As String  
 Dim temppath As String  
   
 retflag = 0  
 values(0) = "Roaming"  
 values(1) = "Blackberry"  
 values(2) = "Webmail"  
   
 choices(0) = "Import"  
 choices(1) = "Export"  
 choices(2) = "Delete"  
 choices(3) = "Change Password"  
   
 response = ws.Prompt (PROMPT_OKCANCELCOMBO, "ID-Management - Choose intended usage", "Select the usage-context of the user.id to be managed.", values(0), values)  
   '  
 If response="Roaming" Then  
  PortName = ""  
  ServerName = ""  
  FileName = "names.nsf"  
 Else  
  Set db = ses.CurrentDatabase  
   ' Construct the path to the user's mail database  
  PortName = ""  
  ServerName = db.Server  
  FileName = db.FilePath  
 End If  
 ret = PathNetConstruct(PortName, ServerName, FileName, pathName)  
 If ret <> 0 Then Error 1212, "Something went wrong"  
   ' Open database to get a handle opn it  
 ret = NSFDbOpen(pathName, hdb)  
 If ret <> 0 Then Error 1212, "Something went wrong"  
   
 If Isempty (response) Then  
  Messagebox "User canceled", , "ID-File has not been imported"  
  ret = NSFDbClose(hdb)  
  If ret <> 0 Then Error 1212, "Something went wrong"  
  Goto exitOk  
 Else  
  Select Case response  
  Case "Roaming"  : ProfileNoteName = "roaminguserid"  
  Case "Blackberry" : ProfileNoteName = "$rimid"  
  Case "Webmail"  : ProfileNoteName = "$shimmerid"  
  End Select  
   
  response = ws.Prompt (PROMPT_OKCANCELCOMBO, "ID-Management - Choose management option", "Please select what you intend to do:", choices(0), choices)  
   
  Select Case response  
  Case "Import"  
   pLmbcsStr = memMan.newBuffer (3 * Lenb(ProfileNoteName))  
   LmbcsLen = TranslateFromStr(OS_TRANSLATE_UNICODE_TO_LMBCS, ProfileNoteName, Lenb(ProfileNoteName), pLmbcsStr, 3 * Lenb(ProfileNoteName))  
  ' Get filename from user  
   IDfilename = ws.OpenFileDialog( False, "ID-Management - Please choose your personal user.id","ID-Files|*.id", "%userprofile%\Lokale Einstellungen\Anwendungsdaten\Lotus\Notes\data\","user.id")  
   If Not(Isempty(IDfilename)) Then  
   While Not Len(Password)>0  
    Password = ws.Prompt(PROMPT_PASSWORD, "ID-Management - Password prompt", "Please type your Notes ID password.")  
   Wend  
   ret = SECAttachIdFileToDB(hdb, ProfileNoteName, LmbcsLen, 0, 0, IdFileName(0), Password, 0, 0)  
   If ret <> 0 Then Error 1212, "Something went wrong"  
   ' Close the database to free its resources  
   ret = NSFDbClose(hdb)  
   End If  
   If ret <> 0 Then Error 1212, "Something went wrong"  
  Case "Export"  
   pLmbcsStr = memMan.newBuffer (3 * Lenb(ProfileNoteName))  
   LmbcsLen = TranslateFromStr(OS_TRANSLATE_UNICODE_TO_LMBCS, ProfileNoteName, Lenb(ProfileNoteName), pLmbcsStr, 3 * Lenb(ProfileNoteName))  
  ' Get filename from user  
   IDfilename = ws.SaveFileDialog( False, "Please specify where the extracted user.id should be saved:","ID-Files|*.id", "%userprofile%\Desktop\","user.id")  
   If Not(Isempty(IDfilename)) Then  
   While Not Len(Password)>0  
    Password = ws.Prompt(PROMPT_PASSWORD, "ID-Management - Password prompt", "Please type your Notes ID password.")  
   Wend  
   ret = SECExtractIdFileFromDB(hdb, ProfileNoteName, LmbcsLen, 0, 0, Password, IdFileName(0), 0, 0)  
    
   If ret <> 0 Then Error 1212, "Something went wrong"  
   ' Close the database to free its resources  
   ret = NSFDbClose(hdb)  
   End If  
   If ret <> 0 Then Error 1212, "Something went wrong"  
  Case "Delete"  
   Set db=ses.GetDatabase(Servername,Filename,False)  
   Set doc=db.GetProfileDocument(ProfileNoteName)  
   If doc.HasItem("$FILE") Then  
   Forall items In doc.items  
    'Set item = doc.getfirstitem("$FILE")  
    If (items.Name = "$FILE") Then  
    If items.Values(0) = "UserID" Then  
     If ws.Prompt(PROMPT_YESNO,"ID-Management - Confirmation","Do you really want to delete the file from the profile-document?") Then  
     Call items.Remove  
     Call doc.Save(True,False)  
     End If  
    End If  
    End If  
   End Forall  
   Else  
   Call ws.prompt(PROMPT_OK,"ID-Management - no ID found","The profile-document does not contain a user.id.")  
   End If  
    
  Case "Change Password"  
   Set db=ses.GetDatabase(Servername,Filename,False)  
   Set doc=db.GetProfileDocument(ProfileNoteName)  
   If doc.HasItem("$FILE") Then  
    
   pLmbcsStr = memMan.newBuffer (3 * Lenb(ProfileNoteName))  
   LmbcsLen = TranslateFromStr(OS_TRANSLATE_UNICODE_TO_LMBCS, ProfileNoteName, Lenb(ProfileNoteName), pLmbcsStr, 3 * Lenb(ProfileNoteName))  
  ' Get filename from user  
   temppath = Environ$("TEMP")  
   IDfilename = temppath & "\tempid.id"  
   While Not Len(Password)>0  
    Password = ws.Prompt(PROMPT_PASSWORD, "ID-Management - Password prompt", "Please type your current Notes ID password.")  
   Wend  
   ret = SECExtractIdFileFromDB(hdb, ProfileNoteName, LmbcsLen, 0, 0, Password, IdFileName, 0, 0)  
   If ret <> 0 Then Error 1212, "Something went wrong"  
    
   ret = SECRefreshIdFile(IDFileName, Password, Servername, retFlag, 0, 0)  
    
   While Not Len(newPassword1)>0 And (newpassword1=newpassword2)  
    newPassword1 = ws.Prompt(PROMPT_PASSWORD, "ID-Management - Password prompt", "Please type your new Notes ID password.")  
    newPassword2 = ws.Prompt(PROMPT_PASSWORD, "ID-Management - Password prompt", "Please confirm your new Notes ID password.")  
    If newpassword1<>newpassword2 Then  
    Call ws.Prompt(PROMPT_OK, "ID-Management - Password failure", "The password confirmation did not match the previously entered password. Please re-type your new Notes ID password.")  
    End If  
   Wend  
   ret = SECKFMChangePassword(IDfilename, Password, newPassword1)  
   If ret <> 0 Then Error 1212, "Something went wrong"  
   ret = SECAttachIdFileToDB(hdb, ProfileNoteName, LmbcsLen, 0, 0, IdFileName, newPassword1, 0, 0)  
   If ret <> 0 Then Error 1212, "Something went wrong"   
   ' Close the database to free its resources  
   ret = NSFDbClose(hdb)    
   If ret <> 0 Then Error 1212, "Something went wrong"  
   Kill IdFilename  
   Else  
   Call ws.prompt(PROMPT_OK,"ID-Management - no ID found","The profile-document does not contain a user.id.")  
   End If  
    
  End Select  
 End If  
   
 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   

1 Kommentar:

  1. BTW: The source code was posted using a nifty little tool that can be found here:

    http://codeformatter.blogspot.com/2009/06/about-code-formatter.html

    AntwortenLöschen