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