Sub Initialize
' this agent populates the RP form during the wqo event.
' agent populates lookupfields and also checks/finds username entered by web user
Dim s As New NotesSession
Dim doc As NotesDocument ' current RP form doc
Dim db As NotesDatabase ' this db
Dim booksLst As Variant ' list of directories to search for user
Dim bV As NotesView ' ($Users) lookup view in b (b is directory in booksLst)
Dim bDoc As NotesDocument ' user doc in nDb
Dim acctidnm As String ' account id/name entered by user
Dim debugmode As String ' developer debug breadcrumbs
' setup environment
debugmode="0"
Set doc = s.DocumentContext
Set db = s.CurrentDatabase
acctidnm = Trim(doc.RP_Name(0))
' test acctidnm
If (acctidnm="") Then
' no user entered, cancel
Print "Oops-No user account id/name entered. Please check what you entered and try again."
Exit Sub
End If
If (debugmode="1") Then
Print "(Initialize - debug) Starting ...
"
End If
' get list of directories
booksLst = s.AddressBooks
' loop through directories and find user (stop at first match)
Forall b In booksLst
' test book for directory (we only want directories and secondary directories, not dircats)
If ( b.IsPublicAddressBook ) Then
' open
Call b.Open( "", "" )
If Not (b.IsOpen) Then
' log if in debug mode
If (debugmode="1") Then
Print "Unabled to open directory: " & b.Title & ". Skipped database.
"
End If
Else
' book is open, get lookup view
Set bV = b.GetView("($Users)")
Set bDoc = bV.GetDocumentByKey(acctidnm, True)
If Not (bDoc Is Nothing) Then
If (debugmode="1") Then
Print "(Initialize - debug) Found User ...
"
End If
' found the user, need to update password
Goto FoundUser
End If
End If ' b.IsOpen test
End If ' b.IsPublicAddressBook test
End Forall
' if to this point, user account was not found.
Print |
Error
|
Print |Unable to find your user account.
|
Print |Please go back and check the account id/name you entered.
|
Print |If you get this message again, contact the Lotus Administrator / Help Desk.|
Exit Sub
FoundUser:
' process user (update with random password and e-mail that password to user)
If (ProcessUser(s, db, bDoc, debugmode) <>1) Then
' return failure msg
Print |Error
|
Print |Your user account was found but could not be updated
|
Print |due to an issue sending you your password or saving your new password to your user account.
|
Print |Your password has not been changed.
|
Print |Close window.
|
Print |Contact the Lotus Administrator / Help Desk for assistance.|
Else
' return success msg
Print |Success
|
Print |Your new password has been set.
|
Print |The password has been sent to you in an e-mail. Please check your e-mail account.
|
Print |Note: It will take some moments for your new password to propagate across all Lotus Domino servers.
|
Print |Close window.
|
End If
Exit Sub
End Sub
Function ProcessUser(s As NotesSession, db As NotesDatabase, doc As NotesDocument, debugmode As String) As Integer
' function updates password to random password and e-mails password to user
' s - current session
' db - current database, needed to create memo
' doc - current user doc
' debugmode - developer bread crumbs
' password/user doc dims
Dim newpwd As String ' password
Dim pwdhash As Variant ' @Password of newpwd, needed to pre-hash for replacement in user doc
' memo dims
Dim mName As NotesName ' used for salutation
Dim mnm As String ' user's name, used with msal
Dim msub As String ' msg subject
Dim msal As String ' msg salutation
Dim mbody As String ' msg body text
Dim msig As String ' msg signature
' build new password
newpwd = Cstr( Int(9 * Rnd) + 1)
newpwd = newpwd & Cstr( Int(9 * Rnd) + 1)
newpwd = newpwd & Chr$( Int(9 * Rnd) + 112)
newpwd = newpwd & Chr$( Int(9 * Rnd) + 65)
newpwd = newpwd & Chr$( Int(9 * Rnd) + 65)
newpwd = newpwd & Cstr( Int(9 * Rnd) + 1)
newpwd = newpwd & Chr$( Int(9 * Rnd) + 112)
newpwd = newpwd & Cstr( Int(9 * Rnd) + 1)
newpwd = newpwd & Chr$( Int(9 * Rnd) + 112)
newpwd = newpwd & Cstr( Int(9 * Rnd) + 1)
newpwd = newpwd & Chr$( Int(9 * Rnd) + 65)
If (debugmode="1") Then
Print "(ProcessUser - debug) Password: " & newpwd & ".
"
End If
' email password first (just in case e-mail error) before replacing password
Set mName = New NotesName(doc.FullName(0))
If Not (mName Is Nothing) Then
mnm = mName.Common
msal = "Hi " & mnm & ":"
Else
mnm = doc.FullName(0)
msal = "Hi:"
End If
msub = "Lotus Password Change Request"
mbody = "Your Lotus Internet password has just been reset. The new password is " & newpwd & ". "
mbody = mbody & "If you did not submit the request or have questions contact your Lotus Help Desk/Administrator."
msig = "Thank you. (System Agent)"
If (DoMemo(db, msub, mnm, mnm, msal, mbody, msig, debugmode) <>1 ) Then
' failure, cancel
ProcessUser=0
Exit Function
End If
' replace password
Call doc.ReplaceItemValue("HTTPPassword", newpwd) ' gives evaluate someplace to hash the password
pwdhash = Evaluate("@Password(HTTPPassword)", doc)
Call doc.ReplaceItemValue("HTTPPassword", pwdhash) ' replaces with hashed password
If (doc.Save(True, False)) Then
' good save
ProcessUser=1
Else
' bad save
ProcessUser=0
End If
If (debugmode="1") Then
Print "(ProcessUser - debug) Password updated.
"
End If
Exit Function
End Function
Function DoMemo(db As NotesDatabase, subjectstr As String, sendtonm As String, fromnm As String,_
salutationstr As String, bodymsg As String, signaturestr As String, debugmode As String) As Integer
' e-mails password to user
' db - this db, needed to create memo doc
' subjectstr - subject of memo
' sendtonm - recipient of memo (SendTo)
' fromnm - from & replyto of memo
' salutationstr - lead-in salutation of memo
' bodymsg - body message text
' signaturestr - wrap-up signature line of memo
' debugmode - developer breadcrumbs
Dim mDoc As NotesDocument ' new memo
Dim tmpItem As NotesItem ' reusable item for placing item values in mDoc
Dim mBody As NotesRichTextItem ' memo Body field
Dim tmpstring As String ' temporary reusable String
On Error Goto FunctionErrorHandler
On Error 4294 Goto UserNotFoundHandler
' set up memo
Set mDoc = db.CreateDocument()
Set mBody = New NotesRichTextItem(mDoc, "Body")
mDoc.Form = "Memo"
mDoc.SaveMessageOnSend = False
mDoc.Subject = subjectstr
mDoc.From = fromnm
mDoc.ReplyTo = fromnm
mDoc.Principal = fromnm
If (debugmode="1") Then
' set to developer
mDoc.SendTo= "Tripp Black"
Else
' set to actual recipient
mDoc.SendTo= sendtonm
End If
Call mBody.AppendText(salutationstr)
Call mBody.AddNewline(2)
Call mBody.AppendText(bodymsg)
Call mBody.AddNewline(2)
Call mBody.AppendText(signaturestr)
Call mBody.AddNewline(1)
' send memo
Call mDoc.Send(False)
' return success
DoMemo=1
Exit Function
FunctionErrorHandler:
Print "(DoMemo Function) Error" & Str(Err) & ": " & Error$ & " at line # " & Cstr(Erl)
DoMemo=0
Exit Function
UserNotFoundHandler:
If (debugmode="1") Then
Print "(DoMemo - debug) An email name was not found in the Domino Directory(s). Skipping..."
End If
Resume Next
End Function