Macro to Save User ID and Password to Registry
PASSPORT PC to Host, PASSPORT Web to Host
TN3270, TN5250, VT, SCO ANSI, Wyse 60
How can I write a macro to prompt users for their credentials, save this information to the registry, then read these saved values from the registry during subsequent connections to the host?
Below is a sample macro, when assigned as a startup macro, will present a dialog box prompting the user for credentials the first time it is run. The dialog box contains a save username and password option and also has the ability to handle invalid and expired passwords. With the save username and password option enabled, user credentials are written to the local registry (see below). Once these values are stored, the macro will attempt to read the values from the registry and pass them to the host for automatic login. If an invalid or expired password is sent, the user will be prompted to correct this situation and the new password will be saved to the registry.
Registry Key:
HKEY_CURRENT_USER\Software\VB and VBA Program Settings
Note: You will need to modify the below macro to handle each user's requirements differently. Also, each SendKeys and GetString command should be modified to match the screens from your host system.
Below is a sample PASSPORT macro that copies an area of text from one session, pastes it into a specific area of a second session, then issues an ENTER command:
Sub Main
Dim objSys
Dim objSess, objScr
Dim strPasswd As String
Dim strUser As String
Dim bSavePasswd As Boolean
Dim bFirstTry As Boolean
Set objSys = CreateObject ("PASSPORT.SYSTEM")
Set objSess = objSys.ActiveSession
Set objScr = objSess.Screen
bSavePasswd = True
strUser = GetSetting ("PASSPORT", "Autologin", "username", "")
strPasswd = GetSetting ("PASSPORT", "Autologin", "password", "")
If strPasswd = "" Or strUser = "" Then
Begin Dialog UserDialog 450,203 ' %GRID:10,7,1,1
Text 30,21,90,14,"User:"
Text 30,70,90,14,"Password:"
TextBox 30,42,290,20,.txtUser
TextBox 30,91,290,20,.txtPasswd,-1
CheckBox 30,133,270,14,"Save username and password",.chkSave
OKButton 30,168,110,21
CancelButton 310,168,110,21
PushButton 170,168,110,21,"Help",.btnHelp
End Dialog
Dim dlgPrompt As UserDialog
dlgPrompt.txtUser = strUser
dlgPrompt.txtPasswd = strPasswd
' turn on save settings
dlgPrompt.chkSave = 1
Dim rc As Integer
Do
rc = Dialog( dlgPrompt )
' help button
If rc = 1 Then
MsgBox "Enter your username and password."
End If
' cancel button
If rc = 0 Then
Exit Sub
End If
Loop While rc = 1 Or dlgPrompt.txtUser="" Or dlgPrompt.txtPasswd=""
strUser = dlgPrompt.txtUser
strPasswd = dlgPrompt.txtPasswd
' save username and password to registry
If dlgPrompt.chkSave Then
SaveSetting( "PASSPORT", "Autologin", "username", strUser )
SaveSetting( "PASSPORT", "Autologin", "password", strPasswd )
Else
bSavePasswd = False
End If
End If
objScr.SendKeys "tso<ENTER>"
objScr.WaitHostQuiet 2000
objScr.SendKeys strUser
objScr.SendKeys "<ENTER>"
objScr.WaitHostQuiet 2000
objScr.SendKeys strPasswd
objScr.SendKeys "<ENTER>"
objScr.WaitHostQuiet 2000
bFirstTry = True
lbRetry:
' handle expired or wrong password
If ( objScr.GetString(2, 12, 28) = "CURRENT PASSWORD HAS EXPIRED" Or _
objScr.GetString(2, 12, 34) = "PASSWORD NOT AUTHORIZED FOR USERID" ) Then
strPasswd = HandleExpiredOrWrongPassword( objScr.GetString(2, 12, 34) )
If ( strPasswd = "" ) Then ' user cancelled
Exit Sub
End If
objScr.SendKeys strPasswd
objScr.SendKeys "<ENTER>"
' handle operator changed password
If ( objScr.GetString(2, 12, 28) = "CURRENT PASSWORD HAS EXPIRED" And bFirstTry ) Then
bFirstTry = False
GoTo lbRetry
End If
' send confirm password
objScr.SendKeys strPasswd
objScr.SendKeys "<ENTER>"
objScr.WaitHostQuiet 2000
' save password
SaveSetting( "PASSPORT", "Autologin", "password", strPasswd )
End If
End Sub
Function HandleExpiredOrWrongPassword(szTitle) As String
Begin Dialog UserDialog 450,175, szTitle ' %GRID:10,7,1,1
Text 30,21,180,14,"New Password:"
Text 30,70,220,14,"New Password Confirm:"
TextBox 30,42,290,20,.txtPW,-1
TextBox 30,91,290,20,.txtPW2,-1
OKButton 30,140,110,21
CancelButton 310,140,110,21
PushButton 170,140,110,21,"Help",.btnHelp
End Dialog
Dim dlgPw As UserDialog
Dim rc As Integer
Dim bErr As Boolean
Do
bErr = False
rc = Dialog( dlgPw )
If rc = 1 Then ' help button
MsgBox "Enter your new password."
ElseIf rc = 0 Then ' cancel button
HandleExpiredOrWrongPassword = ""
Exit Function
Else ' ok button
If dlgPw.txtPW <> dlgPw.txtPW2 Then
MsgBox "The two passwords you have entered are different."
bErr = True
ElseIf Len(dlgPw.txtPW) > 8 Or Len(dlgPw.txtPW)=0 Then
MsgBox "Password must be at lease one character and no more than 8 characters."
bErr = True
End If
' add other checking of the password if necessary...
End If
Loop While rc = 1 Or bErr
HandleExpiredOrWrongPassword = dlgPw.txtPW
End Function
|
macro, dialog, box, prompt, login, user, id, password, registry