fixlogin2.frm

这是一个家庭信息管理的小软件！

VERSION 5.00
Begin VB.Form fixLogin2 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Loggout Database User"
   ClientHeight    =   1725
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5085
   Icon            =   "fixLogin2.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1725
   ScaleWidth      =   5085
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton LogExitBtn1 
      Caption         =   "&Exit"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   9
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   120
      TabIndex        =   4
      ToolTipText     =   " Exit "
      Top             =   1320
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Height          =   1215
      Left            =   10
      TabIndex        =   5
      Top             =   0
      Width           =   5055
      Begin VB.CommandButton LoginClear 
         Caption         =   "&Clear"
         BeginProperty Font 
            Name            =   "Times New Roman"
            Size            =   9
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   3720
         TabIndex        =   3
         ToolTipText     =   " Clear Entries "
         Top             =   720
         Width           =   1215
      End
      Begin VB.CommandButton LoginBtn1 
         Caption         =   "&Login"
         BeginProperty Font 
            Name            =   "Times New Roman"
            Size            =   9
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   3720
         TabIndex        =   2
         ToolTipText     =   " Login "
         Top             =   360
         Width           =   1215
      End
      Begin VB.TextBox LogName 
         BeginProperty Font 
            Name            =   "Times New Roman"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         Left            =   1320
         MaxLength       =   20
         TabIndex        =   0
         Text            =   "01234567890123456789"
         ToolTipText     =   " Enter Your Login Name Here "
         Top             =   360
         Width           =   2000
      End
      Begin VB.TextBox Pword 
         BeginProperty Font 
            Name            =   "Times New Roman"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   285
         IMEMode         =   3  'DISABLE
         Left            =   1320
         MaxLength       =   20
         PasswordChar    =   "*"
         TabIndex        =   1
         Text            =   "01234567890123456789"
         ToolTipText     =   " Enter Your Password Here "
         Top             =   720
         Width           =   2000
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "Password"
         BeginProperty Font 
            Name            =   "Times New Roman"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   225
         Left            =   120
         TabIndex        =   7
         Top             =   720
         Width           =   780
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "Login Name"
         BeginProperty Font 
            Name            =   "Times New Roman"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   225
         Left            =   120
         TabIndex        =   6
         Top             =   360
         Width           =   990
      End
   End
End
Attribute VB_Name = "fixLogin2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
  Dim CmdSQL As String
  Dim ATTEMPTS As Integer
  Dim Max_Attempts As Integer


Private Sub Form_Load()
  DatabaseName = "Family.FM2"
  
 'Set The Database Path
  Database_Path = App.Path & "\Dbase"
  Database_Password = EncryptText("SmileyOmar", "Jesus")
  
  If Len(Database_Path) = 0 Then
     MsgBox "Unable to load the database path from Family2.ini." & vbNewLine & _
            "Make sure that the file exist and the database path is correct.", vbCritical + vbOKOnly
     End
  End If
     
  ATTEMPTS = 0
  Max_Attempts = 4
  
  If InitCMDLogin <> True Then
      Unload Me
      End
  End If
   
End Sub


Private Sub LogExitBtn1_Click()
  Unload Me
  End
End Sub

Private Sub LoginBtn1_Click()
  Dim CmdDB As Database
  Dim CmdRec As Recordset
  Dim Record_Found As Boolean
  On Error GoTo LogErr
  
  Record_Found = False
  ATTEMPTS = ATTEMPTS + 1
  If (Len(LogName.Text) > 0) And (Len(Pword.Text) > 0) Then
     Set CmdDB = OpenDatabase(Database_Path & "\" & DatabaseName, False, True, ";pwd=" & Database_Password)
     Set CmdRec = CmdDB.OpenRecordset("Users")
     Do While Not CmdRec.EOF
        If CmdRec.Fields("LoginName") = EncryptText(LogName.Text, Database_Password) And _
           CmdRec.Fields("Password") = EncryptText(Pword.Text, Database_Password) And _
           CmdRec.Fields("Accesslevel") = EncryptText("Administrator", Database_Password) Then
           Record_Found = True
           Exit Do
          Else
           CmdRec.MoveNext
        End If
     Loop
      
     If Record_Found = True Then
        Unload Me
        Load frmFix
        frmFix.Show
       Else
        Call LoginClear_Click
        MsgBox "The entries that you have made are invalid" _
             , vbExclamation + vbOKOnly, App.ProductName & " [" & Str(ATTEMPTS) & "/" & Str(Max_Attempts) & "]"
     End If
    Else
     Call LoginClear_Click
     MsgBox "Please make sure that you enter a valid Administrator Login Name and Password"
  End If
      
  If ATTEMPTS = Max_Attempts Then
     MsgBox "Contact your local Administrator for a Login Name and Password.", vbExclamation + vbOKOnly
     Call LogExitBtn1_Click
  End If
 
LogErr:
 If Err.Number <> 0 Then
   MsgBox "Error : " & Err.Description & " " & Err.Number, vbCritical + vbOKOnly
   Err.Clear
 End If
End Sub

Private Sub LoginClear_Click()
  LogName.Text = ""
  Pword.Text = ""
  LogName.SetFocus
End Sub

Private Function InitCMDLogin() As Boolean
  Dim tmpDB As Database
  Dim tmpRec As Recordset
  On Error GoTo initErr
  
  LogName.Text = ""
  Pword.Text = ""
  
  Set tmpDB = OpenDatabase(Database_Path & "\" & DatabaseName, False, True, ";pwd=" & Database_Password)
  Set tmpRec = tmpDB.OpenRecordset("Users")
  tmpRec.Fields.Refresh
  tmpRec.Close
  tmpDB.Close
  InitCMDLogin = True
    
initErr:
  If Err.Number <> 0 Then
    InitCMDLogin = False
    Set tmpDB = Nothing
    Set tmpRec = Nothing
    MsgBox " Unable to open " & DatabaseName & vbNewLine & "Error : " & Err.Description & " " & Err.Number, vbCritical + vbOKOnly
  End If
End Function

Private Sub Pword_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
    Call LoginBtn1_Click
  End If
End Sub