sync: auto-sync from GURU-5070 at 2026-06-14 05:33:01
Author: Mike Swanson Machine: GURU-5070 Timestamp: 2026-06-14 05:33:01
This commit is contained in:
@@ -0,0 +1,454 @@
|
||||
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
|
||||
Reference in New Issue
Block a user