frmlogin.frm

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

     End If
  End If

  Record_Found = False
  Set LoginDatabase = OpenDatabase(Database_Path & "\" & Database_Name, False, False, ";pwd=" & Database_Password)
  Login_Attempts = Login_Attempts + 1
  Set LoginRecordset = LoginDatabase.OpenRecordset("Users")
    
  Do While Not LoginRecordset.EOF
     If LoginRecordset.Fields("LoginName") = EncryptText(LOGNAME.Text, Database_Password) And _
        LoginRecordset.Fields("Password") = EncryptText(PWORD.Text, Database_Password) And _
        LoginRecordset.Fields("Accesslevel") = EncryptText(AccLevel.Text, Database_Password) Then
        Record_Found = True
        Exit Do
       Else
        LoginRecordset.MoveNext
      End If
  Loop
  
  If Record_Found = True Then
     If LoginRecordset.Fields("LoggedIn") = True Then
        MsgBox LOGNAME.Text & " is currently listed as Logged In. If you are sure that " & LOGNAME.Text & " is currently not Logged In, contact an Administrator or view readme.txt", vbInformation + vbOKOnly
        Unload Me
     End If
     
     Current_LoginName = DecryptText(LoginRecordset.Fields("LoginName"), Database_Password)
     Current_AccessLevel = DecryptText(LoginRecordset.Fields("AccessLevel"), Database_Password)
     
     WriteIniFile App.Path & "\Family2.ini", Current_LoginName, "Last-Logged-In", Format(Now, "Long Date")
     WriteIniFile App.Path & "\Family2.ini", "LOG", "Last-Used-By", Current_LoginName
     
     LoginRecordset.Edit
     LoginRecordset.Fields("LoggedIn") = True
     LoginRecordset.Update
     LoginRecordset.Close
     LoginDatabase.Close
     
     If Table_Ok(Database_Path & "\" & Database_Name, Current_LoginName) = True Then
        MsgBox "Welcome " & Current_LoginName & "...", , "Logged In Successfully"
        Load frmMain
        frmMain.Show
       Else
        MsgBox "Unable to load " & Current_LoginName & "'s database", vbCritical + vbOKOnly
        Unload Me
     End If
    Else ' Record_Found =False
     If Login_Attempts < 4 Then
        MsgBox "The entries that you have made are invalid. Note: Values are Case Sensitive.", vbInformation + vbOKOnly
       Else
        MsgBox "Contact an Administrator for a valid login name and password.", vbInformation
        Unload Me
     End If
     Call btnClear_Click
  End If
   
LoginErr:
  If Err.Number <> 0 Then
     MsgBox "An error has been encountered while trying to login. Error:" & Str(Err.Number) & " " & Err.Description, vbCritical + vbOKOnly
     Err.Clear
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnLogin_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Login"
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub exitBtn_Click()
   Unload Me
   End
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub exitBtn_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Exit"
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Form_Load()
 'Set The Database Path
  Database_Path = App.Path & "\Dbase"
 'Set Database Name
  Database_Name = "Family.FM2"
 'Set The Database Password
  Database_Password = EncryptText("SmileyOmar", "Jesus")

  Login_Attempts = 0
  LOGNAME.Text = ""
  PWORD.Text = ""
  AccLevel.Clear
  AccLevel.AddItem "Administrator"
  AccLevel.AddItem "User"
  AccLevel.ListIndex = 0
   
  WriteIniFile App.Path & "\Family2.ini", "DATABASE", "PATH", Database_Path
  WriteIniFile App.Path & "\Family2.ini", "DATABASE", "FileName", Database_Name
     
  If InitLogin <> True Then
     MsgBox "Unable to load database. View the file Readme.txt for mor Information", vbCritical + vbOKOnly
     End
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = ""
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Form_Unload(Cancel As Integer)
  Set frmAbout = Nothing
  Set frmEdit = Nothing
  Set frmHelp = Nothing
  Set frmLinks = Nothing
  Set frmMain = Nothing
  Set frmProfile = Nothing
  Set frmSearch = Nothing
  Set frmSplash = Nothing
  Set frmLogin = Nothing
  End
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = ""
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub LOGNAME_KeyPress(KeyAscii As Integer)
 'Prevent the user from entering Char(39) [']
  If (KeyAscii = 39) Or (KeyAscii = 34) Then
     MsgBox "Sorry, but the character ( " & Chr(KeyAscii) & " ) that is an invalid character", vbInformation + vbOKOnly
     KeyAscii = 0
  End If
  
  If KeyAscii = 13 Then
     Call btnLogin_Click
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub LOGNAME_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "LoginName :" & LOGNAME.Text
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub PWORD_KeyPress(KeyAscii As Integer)
 'Prevent the user from entering Char(39) [']
  If (KeyAscii = 39) Or (KeyAscii = 34) Then
     MsgBox "Sorry, but the character ( " & Chr(KeyAscii) & " ) that is an invalid character", vbInformation + vbOKOnly
     KeyAscii = 0
  End If
  
  If KeyAscii = 13 Then
     Call btnLogin_Click
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub PWORD_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StatusBar1.Panels(1).Text = "Password"
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Function InitLogin() As Boolean
  Dim Msg1 As VbMsgBoxResult
  
 'Check if the database exist
  If Database_Found(Database_Path) = True Then
    'Check the database to see if good
     If Database_Ok(Database_Path & "\" & Database_Name) = True Then
        InitLogin = True
        Exit Function
       Else
       InitLogin = False
       Exit Function
     End If
     
    Else ' Database_Found(Database_Path) <> True
     
     Msg1 = MsgBox("The database file was not found in it's destinated path [" & Database_Path & "]. Do you want to recreate the database file?", vbInformation + vbYesNo)
     If Msg1 = vbYes Then
       'Check if the database directory exist
        If DirectoryExist(Database_Path) = True Then
          'Recreate the database
           If Recreate_DB = True Then
             'Check if the database is ok
              If Database_Ok(Database_Path & "\" & Database_Name) = True Then
                 WriteIniFile App.Path & "\Family2.ini", "DATABASE", "Created", Format(Now, "Long Date")
                 InitLogin = True
                 Exit Function
                Else 'Database_Ok <> True
                 InitLogin = False
                 Exit Function
              End If
             Else 'Recreate_DB <> True
              InitLogin = False
              Exit Function
           End If ' Recreate
          Else 'DirectoryExist <> True
          'Create the database directory
           Call CreateNewDirectory(Database_Path & "\")
          'Recreate the database
           If Recreate_DB = True Then
             'Check if the database if ok
              If Database_Ok(Database_Path & "\" & Database_Name) = True Then
                 WriteIniFile App.Path & "\Family2.ini", "DATABASE", "Created", Format(Now, "Long Date")
                 InitLogin = True
                 Exit Function
                Else 'Database_Ok <> True
                 InitLogin = False
                 Exit Function
              End If
             Else 'Recreate_DB <> True
              InitLogin = False
              Exit Function
           End If 'Recreate
        End If 'Directory
     End If 'Msg1
  End If 'Database_Found(Database_Path) = True
End Function
'**********************************************************************
'**********************************************************************