455 lines
12 KiB
Plaintext
455 lines
12 KiB
Plaintext
VERSION 5.00
|
|
Begin VB.Form frmLogin
|
|
BorderStyle = 3 'Fixed Dialog
|
|
Caption = "Login"
|
|
ClientHeight = 1410
|
|
ClientLeft = 1830
|
|
ClientTop = 5040
|
|
ClientWidth = 5805
|
|
ClipControls = 0 'False
|
|
ControlBox = 0 'False
|
|
ForeColor = &H80000008&
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
PaletteMode = 1 'UseZOrder
|
|
ScaleHeight = 1410
|
|
ScaleWidth = 5805
|
|
Begin VB.ComboBox cboNames
|
|
Height = 300
|
|
Left = 1200
|
|
Sorted = -1 'True
|
|
Style = 2 'Dropdown List
|
|
TabIndex = 0
|
|
Top = 120
|
|
Width = 3375
|
|
End
|
|
Begin VB.TextBox txtName
|
|
Height = 300
|
|
Left = 1200
|
|
MaxLength = 20
|
|
TabIndex = 6
|
|
Top = 60
|
|
Visible = 0 'False
|
|
Width = 1335
|
|
End
|
|
Begin VB.CommandButton cmdOK
|
|
Caption = "&OK"
|
|
Default = -1 'True
|
|
Enabled = 0 'False
|
|
Height = 315
|
|
Left = 4680
|
|
TabIndex = 5
|
|
Top = 120
|
|
Width = 1035
|
|
End
|
|
Begin VB.CommandButton cmdCancel
|
|
Cancel = -1 'True
|
|
Caption = "&Cancel"
|
|
Height = 300
|
|
Left = 4680
|
|
TabIndex = 4
|
|
Top = 540
|
|
Width = 1035
|
|
End
|
|
Begin VB.TextBox txtPassword
|
|
Height = 300
|
|
IMEMode = 3 'DISABLE
|
|
Left = 1200
|
|
MaxLength = 20
|
|
PasswordChar = "*"
|
|
TabIndex = 1
|
|
Top = 540
|
|
Width = 3375
|
|
End
|
|
Begin VB.Label lblAppName
|
|
Alignment = 2 'Center
|
|
BorderStyle = 1 'Fixed Single
|
|
Height = 315
|
|
Left = 120
|
|
TabIndex = 7
|
|
Top = 1020
|
|
Width = 5595
|
|
End
|
|
Begin VB.Label lblUserID
|
|
AutoSize = -1 'True
|
|
BackStyle = 0 'Transparent
|
|
Caption = "User ID"
|
|
Height = 192
|
|
Left = 120
|
|
TabIndex = 2
|
|
Top = 180
|
|
Width = 540
|
|
End
|
|
Begin VB.Label lblPass
|
|
AutoSize = -1 'True
|
|
BackStyle = 0 'Transparent
|
|
Caption = "Password"
|
|
Height = 195
|
|
Left = 120
|
|
TabIndex = 3
|
|
Top = 600
|
|
Width = 690
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmLogin"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
'***************************************************************
|
|
'* Author : Paul D. Sheriff
|
|
'* Notice : Copyright 1995-1996 PDSA
|
|
'* Part of the PDSA Toolset
|
|
'* This version has been created specifically for
|
|
'* inclusion in this courseware
|
|
'* Date Created: December, 1995
|
|
'* Form Name : s_login.frm
|
|
'* Description :
|
|
'*
|
|
'* The PDSA Toolset is a generic application builder and
|
|
'* set of templates for building Client/Server applications
|
|
'* using Visual Basic.
|
|
'* For more information on the PDSA Toolset browse our web
|
|
'* page at http://www.pdsa.com for a complete feature list.
|
|
'***************************************************************
|
|
Option Explicit
|
|
|
|
Private mintTimesTried As Integer
|
|
Private mboolCancel As Boolean
|
|
Private mboolValidLogon As Boolean
|
|
Private mboolDisplayUsers As Boolean
|
|
Private mboolCheckUserTable As Boolean
|
|
Private mstrInitLoginID As String
|
|
Private mstrInitPassword As String
|
|
Private mboolError As Boolean
|
|
Private mstrAppName As String
|
|
|
|
Private mlngTop As Long
|
|
Private mlngLeft As Long
|
|
|
|
Private mstrInfoMsg As String
|
|
|
|
' Connection Class
|
|
'Private moDataConn As DataConnection
|
|
|
|
Property Get InfoMsg()
|
|
InfoMsg = mstrInfoMsg
|
|
End Property
|
|
|
|
Property Let AppName(ByVal strValue As String)
|
|
mstrAppName = strValue
|
|
End Property
|
|
|
|
Property Let InitTop(ByVal lngTop As Long)
|
|
mlngTop = lngTop
|
|
End Property
|
|
|
|
Property Let InitLeft(ByVal lngLeft As Long)
|
|
mlngLeft = lngLeft
|
|
End Property
|
|
|
|
Property Get DataConnection() As DataConnection
|
|
Set DataConnection = moDataConn
|
|
End Property
|
|
|
|
Property Set DataConnection(oConnect As DataConnection)
|
|
Set moDataConn = oConnect
|
|
End Property
|
|
|
|
Property Get DisplayUsers() As Boolean
|
|
DisplayUsers = mboolDisplayUsers
|
|
End Property
|
|
|
|
Property Let DisplayUsers(ByVal boolValue As Boolean)
|
|
mboolDisplayUsers = boolValue
|
|
End Property
|
|
|
|
Property Get CheckUserTable() As Boolean
|
|
CheckUserTable = mboolCheckUserTable
|
|
End Property
|
|
|
|
Property Let CheckUserTable(ByVal boolValue As Boolean)
|
|
mboolCheckUserTable = boolValue
|
|
End Property
|
|
|
|
Property Get Cancel() As Boolean
|
|
Cancel = mboolCancel
|
|
End Property
|
|
|
|
Property Get ValidLogon() As Boolean
|
|
ValidLogon = mboolValidLogon
|
|
End Property
|
|
|
|
Property Get InitLoginID() As String
|
|
InitLoginID = mstrInitLoginID
|
|
End Property
|
|
|
|
Property Let InitLoginID(ByVal strValue As String)
|
|
mstrInitLoginID = strValue
|
|
End Property
|
|
|
|
Property Get InitPassword() As String
|
|
InitPassword = mstrInitPassword
|
|
End Property
|
|
|
|
Property Let InitPassword(ByVal strValue As String)
|
|
mstrInitPassword = strValue
|
|
End Property
|
|
|
|
Property Let Password(ByVal strValue As String)
|
|
mstrInitPassword = strValue
|
|
End Property
|
|
|
|
Private Function UserNameLoad() As Boolean
|
|
Dim strOldMsg As String
|
|
Dim strLine As String
|
|
Dim oUser As clsUsers
|
|
Dim oConn As DataConnection
|
|
|
|
Set oConn = New DataConnection
|
|
With oConn
|
|
.DataSource = moDataConn.DataSource
|
|
.Provider = moDataConn.Provider
|
|
.ProviderConst = moDataConn.ProviderConst
|
|
.DatabaseName = moDataConn.DatabaseName
|
|
.DSN = moDataConn.DSN
|
|
.InitialCatalog = moDataConn.InitialCatalog
|
|
.UseODBC = moDataConn.UseODBC
|
|
.LoginId = mstrInitLoginID
|
|
.Password = mstrInitPassword
|
|
End With
|
|
|
|
If oConn.DataOpen() Then
|
|
Set oUser = New clsUsers
|
|
With oUser
|
|
Set .DataConnection = oConn
|
|
.SelectFilter = dacSelectclsUsersAll
|
|
|
|
' Retrieve first record
|
|
If .OpenRecordset() Then
|
|
UserNameLoad = True
|
|
cboNames.Clear
|
|
|
|
Do Until .EOF
|
|
strLine = .LastName & ", "
|
|
strLine = strLine & .FirstName & _
|
|
Space$(100) & vbTab
|
|
strLine = strLine & .LoginId
|
|
|
|
cboNames.AddItem strLine
|
|
cboNames.ItemData(cboNames.NewIndex) = .userId
|
|
|
|
' Retrieve next record
|
|
Call .MoveNext
|
|
Loop
|
|
Else
|
|
mstrInfoMsg = oConn.ErrorMsg
|
|
UserNameLoad = False
|
|
End If
|
|
.CloseRecordset
|
|
End With
|
|
Else
|
|
mstrInfoMsg = oConn.ErrorMsg & vbCrLf & "Did you fill in the InitLoginID & InitPassword?"
|
|
UserNameLoad = False
|
|
End If
|
|
oConn.DataClose
|
|
End Function
|
|
|
|
Private Sub cboNames_Click()
|
|
cmdOK.Enabled = True
|
|
End Sub
|
|
|
|
Private Sub cmdCancel_Click()
|
|
mstrInfoMsg = "User Cancelled Login Process"
|
|
mboolCancel = True
|
|
Me.Hide
|
|
End Sub
|
|
|
|
Private Sub cmdOK_Click()
|
|
Dim strLoginId As String
|
|
Dim lngUserId As Long
|
|
Dim strUserName As String
|
|
Dim strPassword As String
|
|
Dim boolPerform As Boolean
|
|
|
|
mintTimesTried = mintTimesTried + 1
|
|
mboolCancel = False
|
|
|
|
' Did they fill in name and password correctly
|
|
boolPerform = FormCheck()
|
|
|
|
If boolPerform Then
|
|
' Get Password from Text Box
|
|
strPassword = Trim$(txtPassword.Text)
|
|
|
|
' Set Properties of DataConnection Class
|
|
If mboolDisplayUsers Then
|
|
strLoginId = Trim$(cboNames.Text)
|
|
strLoginId = Mid$(strLoginId, InStr(strLoginId, vbTab) + 1)
|
|
strUserName = Trim$(Left$(cboNames.Text, InStr(cboNames.Text, vbTab) - 1))
|
|
lngUserId = cboNames.ItemData(cboNames.ListIndex)
|
|
Else
|
|
strLoginId = Trim$(txtName.Text)
|
|
strUserName = ""
|
|
lngUserId = -1
|
|
End If
|
|
With moDataConn
|
|
.LoginId = strLoginId
|
|
.userName = strUserName
|
|
.Password = strPassword
|
|
.userId = lngUserId
|
|
End With
|
|
End If
|
|
|
|
If boolPerform Then
|
|
boolPerform = moDataConn.DataOpen()
|
|
If Not boolPerform Then
|
|
MsgBox "Invalid User ID and/or Password" & vbCrLf & vbCrLf & moDataConn.ErrorMsg, , "PDSASecurity.Login"
|
|
End If
|
|
End If
|
|
|
|
If boolPerform Then
|
|
If mboolCheckUserTable Then
|
|
mboolValidLogon = UserTableCheck()
|
|
If mboolValidLogon Then
|
|
mboolValidLogon = True
|
|
Unload Me
|
|
Else
|
|
MsgBox mstrInfoMsg, , "PDSASecurity.Login"
|
|
End If
|
|
Else
|
|
' Nothing else to do, leave validation
|
|
' for another routine.
|
|
mboolValidLogon = True
|
|
Unload Me
|
|
End If
|
|
Else
|
|
If mintTimesTried > 2 Then
|
|
MsgBox "Exceeded the number of tries to login", , "PDSASecurity.Login"
|
|
Unload Me
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Public Function UserTableCheck()
|
|
Dim oUser As clsUsers
|
|
|
|
Set oUser = New clsUsers
|
|
With oUser
|
|
Set .DataConnection = moDataConn
|
|
' Fill in Login ID so we can look them up in our
|
|
' pdsaUser table. We will need to get their user
|
|
' group for security, and their full name for
|
|
' display on the screen.
|
|
.LoginId = moDataConn.LoginId
|
|
.WhereFilter = dacWherepdsaUsersLoginId
|
|
If .Find() Then
|
|
' NOTE: You might want to add some encryption here
|
|
If .Password = moDataConn.Password Then
|
|
moDataConn.GroupId = .GroupId
|
|
moDataConn.userName = .LastName & ", " & .FirstName
|
|
UserTableCheck = True
|
|
Else
|
|
mstrInfoMsg = "Password does not match the password in the Users Table"
|
|
UserTableCheck = False
|
|
End If
|
|
Else
|
|
If .InfoMsg <> "" Then
|
|
mstrInfoMsg = .InfoMsg
|
|
MsgBox mstrInfoMsg, , "PDSASecurity.Login"
|
|
Else
|
|
mstrInfoMsg = "Can't Find User ID in the pdsaUsers Table, please re-enter."
|
|
MsgBox mstrInfoMsg, , "PDSASecurity.Login"
|
|
End If
|
|
|
|
mboolValidLogon = False
|
|
End If
|
|
.CloseRecordset
|
|
End With
|
|
End Function
|
|
|
|
Private Sub Form_Activate()
|
|
If mboolDisplayUsers Then
|
|
cboNames.SetFocus
|
|
Else
|
|
If txtName.Text = "" Then
|
|
txtName.SetFocus
|
|
Else
|
|
txtPassword.SetFocus
|
|
End If
|
|
End If
|
|
If mboolError Then
|
|
mboolValidLogon = False
|
|
Unload Me
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Form_Initialize()
|
|
mlngTop = -1
|
|
mlngLeft = -1
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
Screen.MousePointer = vbHourglass
|
|
|
|
If mlngTop = -1 Then
|
|
Me.Top = Screen.Height - Me.Height - 1000
|
|
Else
|
|
Me.Top = mlngTop
|
|
End If
|
|
If mlngLeft = -1 Then
|
|
Me.Left = (Screen.Width / 2) - (Me.Width / 2)
|
|
Else
|
|
Me.Left = mlngLeft
|
|
End If
|
|
|
|
lblAppName.caption = mstrAppName
|
|
|
|
mboolValidLogon = False
|
|
If mboolDisplayUsers Then
|
|
' Load Combo Box of Users
|
|
If Not UserNameLoad() Then
|
|
mboolError = True
|
|
End If
|
|
Else
|
|
' Ask user for LoginID/Password
|
|
cboNames.Visible = False
|
|
With txtName
|
|
.Top = cboNames.Top
|
|
.Left = cboNames.Left
|
|
.Width = cboNames.Width
|
|
.Text = moDataConn.LoginId
|
|
.Visible = True
|
|
End With
|
|
cboNames.Width = 0
|
|
End If
|
|
|
|
Screen.MousePointer = vbDefault
|
|
End Sub
|
|
|
|
Private Function FormCheck()
|
|
Dim boolValid As Integer
|
|
boolValid = True
|
|
|
|
If mboolDisplayUsers Then
|
|
If Trim$(cboNames.Text) = "" Then
|
|
MsgBox "Please Fill In Your User Name", , "PDSASecurity.Login"
|
|
cboNames.SetFocus
|
|
boolValid = False
|
|
End If
|
|
Else
|
|
If Trim$(txtName.Text) = "" Then
|
|
MsgBox "Please Fill In Your User Name", , "PDSASecurity.Login"
|
|
txtName.SetFocus
|
|
boolValid = False
|
|
End If
|
|
End If
|
|
|
|
FormCheck = boolValid
|
|
End Function
|
|
|
|
Private Sub txtName_Change()
|
|
cmdOK.Enabled = True
|
|
End Sub
|