frmprofile.frm

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

  Public TmpUserName As String
  Public TmpAccessLevel As String
  Public TmpPassword As String
  Public Last_AccessLevel As String
  Public Last_NameAccessed As String
  Public pCurrently_Editting As Boolean
  Public pCurrently_Adding As Boolean
  Public LVState As Long


'**********************************************************************
'**********************************************************************
Private Sub Form_Load()
  pCurrently_Editting = False
  pCurrently_Adding = False
  Last_AccessLevel = Current_AccessLevel
  Last_NameAccessed = Current_LoginName
  frmMain.Hide
  Call Init_Profile_DB
  Call Clear_Profile_Fields
 'Call pNo_Changes
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_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  If (pCurrently_Editting = True) Or (pCurrently_Adding = True) Then
     Cancel = True
     Exit Sub
  End If

  Load frmMain
  frmMain.Enabled = True
  frmMain.Init_Main
  frmMain.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Form_Resize()
  'Minimized
  If Me.WindowState = 1 Then
     If Minimize_To_Tray Then
        Set TrayArea1.Icon = Me.Icon
        TrayArea1.ToolTip = " Double-Click To Restore " & Me.Caption & " "
        TrayArea1.Visible = True
        Me.Hide
     End If
  End If
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 mnuRestore_Click()
  On Error Resume Next
  TrayArea1.Visible = False
  frmProfile.WindowState = 0
  frmProfile.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub pAdd_Click()
  usrName1.SetFocus
  pCurrently_Adding = True
  pCurrently_Editting = False
  Clear_Profile_Fields
  Call pMaking_Changes
End Sub
'**********************************************************************
'**********************************************************************


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


'**********************************************************************
'**********************************************************************
Private Sub pCancel_Click()
 'Profile_Data1.Recordset.CancelUpdate
 'Call Init_Profile_DB
  Call pNo_Changes
  Call Clear_Profile_Fields
End Sub
'**********************************************************************
'**********************************************************************



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


'**********************************************************************
'**********************************************************************
Private Sub pDelete_Click()
  Dim Qs As VbMsgBoxResult
  
 'Check if user trying to remove his/her own record
  If usrName1.Text = Current_LoginName Then
     MsgBox Current_LoginName & " you can't remove your own record.", vbInformation + vbOKOnly
     Exit Sub
  End If
  
 'Check if user logged in
  If UserLoggedIn(usrName1.Text) = True Then
     MsgBox "The Database states that the User [" & usrName1.Text & "] is Currently Logged in." & vbNewLine & _
            "If you are sure that [" & usrName1.Text & "] is currently not logged in" & vbNewLine & _
            "you can correct this problem by using the Menu Option [Logout User] " & vbNewLine & vbNewLine & _
            "This error may have occured because " & usrName1.Text & " did not log-out properly" & vbNewLine & _
            "For more information please view the [Help]", vbCritical + vbOKOnly
     Exit Sub
  End If
  
  Qs = MsgBox("Are you sure that you want to remove " & Last_AccessLevel & " " & Last_NameAccessed, vbQuestion + vbYesNo)
  If Qs = vbYes Then
     If Remove_User(Last_NameAccessed) = True Then
        MsgBox Last_NameAccessed & " has been removed successfully.", vbInformation + vbOKOnly
        Call Init_Profile_DB
        Call pNo_Changes
        Call Clear_Profile_Fields
        Exit Sub
       Else
        MsgBox Last_NameAccessed & " was not removed successfully.", vbInformation + vbOKOnly
        Call Init_Profile_DB
        Call pNo_Changes
        Exit Sub
     End If
    Else
     Call pNo_Changes
     Exit Sub
  End If
End Sub
'**********************************************************************
'**********************************************************************


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


'**********************************************************************
'**********************************************************************
Private Sub pEdit_Click()
 'Temporarily Store the Name and Access Level
 'of the user to be edited
  usrName1.SetFocus
  TmpUserName = usrName1.Text
  TmpAccessLevel = usrAccLvl.Text
  TmpPassword = usrPassword
  
  usrAccLvl.Locked = True
  
  If UserLoggedIn(usrName1.Text) = True Then
     If Current_LoginName <> usrName1.Text Then
        MsgBox "The user [" & TmpUserName & "] is currently Logged-In." & vbNewLine & vbNewLine & _
               "If you are sure that [" & TmpUserName & "] is currently not Logged-In, use the Menu Option " & vbNewLine & _
               "[Fix - Logout User] to correct this problem." & vbNewLine & vbNewLine & _
               "Please view the [Help] for more information.", vbExclamation + vbOKOnly
        Exit Sub
     End If
  End If
  
 'Set pCurrently_Editing = True
  pCurrently_Editting = True
 'Set pCurrently_Adding = False
  pCurrently_Adding = False
   
 'Administrator
  If Current_AccessLevel = "Administrator" Then
    'Allow the Administrator to change another
    'User's Accesslevel
     If (Current_LoginName <> TmpUserName) Then
         Call pMaking_Changes
         usrAccLvl.Locked = False
         Exit Sub
     End If
     
     
     If (AdminCount > 1) Then
         Call pMaking_Changes
         usrAccLvl.Locked = False
         Exit Sub
        Else 'AdminCount < 1
         Call pMaking_Changes
         usrAccLvl.Locked = True
         Exit Sub
     End If
     
    Else 'User
     Call pMaking_Changes
     usrAccLvl.Locked = True
     Exit Sub
  End If
End Sub
'**********************************************************************
'**********************************************************************


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


'**********************************************************************
'**********************************************************************
Private Sub prAbout_Click()
  Load frmAbout
  frmAbout.Show
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub prHelp_Click()
  Load frmHelp
  frmHelp.Show
End Sub
'**********************************************************************
'**********************************************************************


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


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



'**********************************************************************
'**********************************************************************
Private Sub Profile_Data1_Reposition()
  On Error Resume Next
  usrName1.Text = DecryptText(Profile_Data1.Recordset.Fields("LoginName"), Database_Password)
  usrPassword.Text = DecryptText(Profile_Data1.Recordset.Fields("Password"), Database_Password)
  usrAccLvl.Text = DecryptText(Profile_Data1.Recordset.Fields("AccessLevel"), Database_Password)
  usrCStatus.Text = Profile_Data1.Recordset.Fields("LoggedIn")
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub pSave_Click()
  On Error GoTo pSaveErr
  usrName1.Text = Trim$(usrName1.Text)
  usrPassword.Text = Trim$(usrPassword.Text)
  
  If (Len(usrName1.Text) < 4) Or (Len(usrPassword.Text) < 4) Then
     MsgBox "The login name and the password field, should both have at least 4 characters.", vbInformation + vbOKOnly
     Exit Sub
  End If
  
'Check For Apostrophes
 If (InStr(usrName1.Text, "'") > 0) Then
    MsgBox " Please Remove the Apostrophe(/s) ['] from the User Name field", vbInformation + vbOKOnly
    Exit Sub
   Else
    If (InStr(usrPassword.Text, "'") > 0) Then
        MsgBox " Please Remove the Apostrophe(/s) ['] from the Password field", vbInformation + vbOKOnly
        Exit Sub
    End If
 End If


'Check For Quotes
 If (InStr(usrName1.Text, Chr$(34)) > 0) Then
    MsgBox " Please Remove the Quote(/s) [" & Chr$(34) & "] from the User Name field", vbInformation + vbOKOnly
    Exit Sub
   Else
    If (InStr(usrPassword.Text, Chr$(34)) > 0) Then
        MsgBox " Please Remove the Quote(/s) [" & Chr$(34) & "] from the Password field", vbInformation + vbOKOnly
        Exit Sub
    End If
 End If

'Don't Allow the users to use the following (User - Users - Administrator - Administrators)
 If (LCase$(usrName1.Text) = LCase$("Users")) Or (LCase$(usrName1.Text) = LCase$("User")) Or _
    (LCase$(usrName1.Text) = LCase$("Administrator")) Or (LCase$(usrName1.Text) = LCase$("Administrators")) Then
    MsgBox "You are not allowed to use " & usrName1.Text & " as a Login Name.", vbInformation + vbOKOnly
    Exit Sub
 End If

'pCurrently_Editing = True
 If pCurrently_Editting = True Then
   'Checks if user name was changed if
   'and if so check if the user already exist
    If (TmpUserName <> usrName1.Text) And (User_Exist(usrName1.Text) = True) Then
       MsgBox "The User Name (" & usrName1.Text & ") already Exist.  Try using a different loginname.", vbInformation + vbOKOnly, usrName1.Text & " already exist."
       Exit Sub
      Else
       Profile_Data1.Recordset.Edit
       Profile_Data1.Recordset.Fields("LoginName") = EncryptText(usrName1.Text, Database_Password)
       Profile_Data1.Recordset.Fields("Password") = EncryptText(usrPassword.Text, Database_Password)
       Profile_Data1.Recordset.Fields("AccessLevel") = EncryptText(usrAccLvl.Text, Database_Password)
       Last_AccessLevel = usrAccLvl.Text
      
      
       If TmpUserName = usrName1.Text Then
              
         'Check if is edditing his or her own record
          If TmpUserName = Current_LoginName Then
            'Update the global variables
             Current_LoginName = usrName1.Text
             Current_Password = usrPassword.Text
             Current_AccessLevel = usrAccLvl.Text
             Profile_Data1.Recordset.Fields("LoggedIn") = True
            Else
             Profile_Data1.Recordset.Fields("LoggedIn") = False
          End If 'If TmpUserName = Current_LoginName Then
                  
          Profile_Data1.Recordset.Update
          Profile_Data1.Refresh