frmprofile.frm

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

        
          Call Init_Profile_DB
          Call pNo_Changes
          Call Clear_Profile_Fields
          Exit Sub
          
         Else
         
          If Rename_Database_Table(TmpUserName, usrName1.Text) = True Then
             MsgBox usrName1.Text & " has been updated successfully", vbInformation + vbOKOnly
            
            '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
             Call Init_Profile_DB
             Call pNo_Changes
             Call Clear_Profile_Fields
             Exit Sub
            Else 'Rename db = false
             MsgBox usrName1.Text & " has not been updated successfully", vbCritical + vbOKOnly
             Call Init_Profile_DB
             Call pNo_Changes
             Call Clear_Profile_Fields
             Exit Sub
          End If 'Rename_Database_Table(TmpUserName, usrName1.Text) = True
       End If 'TmpUserName = usrName1.Text
    End If '(TmpUserName <> usrName1.Text) And (User_Exist(usrName1.Text) = True)
    Exit Sub
 End If 'pCurrently_Editing = True
 
 
'pCurrently_Adding
 If pCurrently_Adding = True Then
    If (Table_Exist(usrName1.Text) = False) And (User_Exist(usrName1.Text) = False) Then
       If Create_User(usrName1.Text, usrPassword.Text, usrAccLvl.Text) = True Then
          MsgBox usrName1.Text & " has successfully been added to the database.", vbInformation + vbOKOnly
          Call Init_Profile_DB
          Call pNo_Changes
          Call Clear_Profile_Fields
          Exit Sub
         Else
          MsgBox "Unable To Add " & usrName1.Text & " to the Database.", vbCritical + vbOKOnly
          Call Init_Profile_DB
          Call pNo_Changes
          Call Clear_Profile_Fields
          Exit Sub
       End If
      Else
       MsgBox usrName1.Text & " already exist. Use a different Login Name.", vbInformation + vbOKOnly
       Call Init_Profile_DB
       Call pNo_Changes
       Call Clear_Profile_Fields
       Exit Sub
    End If
    Exit Sub
 End If
 
pSaveErr:
 If Err.Number <> 0 Then
    MsgBox "An error has been encountered while trying to save a record. Error:" & Str$(Err.Number) & " :" & Err.Description, vbCritical + vbOKOnly
    Err.Clear
 End If
End Sub
'**********************************************************************
'**********************************************************************



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


'**********************************************************************
'**********************************************************************
Private Sub resExit_Click()
  Call mnuRestore_Click
  Call profClose_Click
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub TrayArea1_DblClick()
  Call mnuRestore_Click
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub TrayArea1_MouseDown(Button As Integer)
  PopupMenu mnuRestorer
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub TVUsers_Collapse(ByVal Node As ComctlLib.Node)
  If (pCurrently_Editting = True) Or (pCurrently_Adding = True) Then
     Exit Sub
  End If
    
  Select Case Node.Text
   Case "Users"
        Last_AccessLevel = "Administrator"
        Call Clear_Profile_Fields
  
    Case "Administrator", "User"
         Last_AccessLevel = Node.Text
         Call Clear_Profile_Fields
  End Select
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub TVUsers_Expand(ByVal Node As ComctlLib.Node)
  If (pCurrently_Editting = True) Or (pCurrently_Adding = True) Then
     Exit Sub
  End If
  
  If (Node.Text = "Administrator") And (Current_AccessLevel = "User") Then
      Node.Expanded = False
      MsgBox Current_LoginName & ", your current access is " & Current_AccessLevel & ". You are not allowed to expand " & Node.Text & ".", vbInformation + vbOKOnly
      Exit Sub
  End If
  
  Select Case Node.Text
   Case "Users"
        Last_AccessLevel = "Administrator"
        Call Clear_Profile_Fields
  
    Case "Administrator", "User"
         Last_AccessLevel = Node.Text
         Call Clear_Profile_Fields
  End Select
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub TVUsers_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim t As Node
  Set t = TVUsers.HitTest(X, Y)
  If t Is Nothing Then
     StatusBar1.Panels(1).Text = ""
     Exit Sub
    Else
     StatusBar1.Panels(1).Text = t.Text
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub TVUsers_NodeClick(ByVal Node As ComctlLib.Node)
  If pCurrently_Editting = True Then
     Exit Sub
  End If
  
  If pCurrently_Adding = True Then
     Exit Sub
  End If
 
 'Root
  If (Node.Text = "Users") Then
     Last_AccessLevel = "Administrator"
     Call Clear_Profile_Fields
  End If

  
  If (Node.Text <> "Administrator") And (Node.Text <> "User") And (Node.Text <> "Users") Then
     Last_AccessLevel = Node.Parent
     If (Current_AccessLevel = "User") And (Node.Text = Current_LoginName) Then
        Profile_Data1.RecordSource = "SELECT * FROM Users WHERE LoginName = '" & Apostrophe(EncryptText(Node.Text, Database_Password)) & "'"
        Profile_Data1.Refresh
        pEdit.Enabled = True
        pDelete.Enabled = True
        Last_NameAccessed = Node.Text
        Last_AccessLevel = "User"
     End If
  
     If (Current_AccessLevel = "User") And (Node.Text <> Current_LoginName) Then
        Last_AccessLevel = "User"
        Call Clear_Profile_Fields
     End If
     
     If (Current_AccessLevel = "Administrator") Then
        Profile_Data1.RecordSource = "SELECT * FROM Users WHERE LoginName = '" & Apostrophe(EncryptText(Node.Text, Database_Password)) & "'"
        Profile_Data1.Refresh
        pEdit.Enabled = True
        pDelete.Enabled = True
        Last_NameAccessed = Node.Text
        Last_AccessLevel = Node.Parent.Text
     End If
  End If
  
  If (Node.Text = "Administrator") Or (Node.Text = "User") Then
     Last_AccessLevel = Node.Text
     Clear_Profile_Fields
  End If
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub usrName1_KeyPress(KeyAscii As Integer)
 'Prevent the user from entering Char(39) ['] or char(34) ["]
  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
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Init_Profile_DB()
  TmpUserName = ""
  TmpAccessLevel = ""
  TmpPassword = ""
  
  usrAccLvl.Clear
  usrAccLvl.AddItem "Administrator"
  usrAccLvl.AddItem "User"
  usrAccLvl.ListIndex = 0
  usrCStatus.Clear
  usrCStatus.AddItem False
  usrCStatus.AddItem True
  usrCStatus.ListIndex = 0
  
  If Current_AccessLevel = "Administrator" Then
     pAdd.Enabled = True
    Else
     pAdd.Enabled = False
  End If

  Profile_Data1.DatabaseName = Database_Path & "\" & Database_Name
  Profile_Data1.Connect = ";pwd=" & Database_Password
  Profile_Data1.RecordSource = "SELECT * FROM Users WHERE LoginName = '" & Apostrophe(EncryptText(Current_LoginName, Database_Password)) & "'"
  Profile_Data1.Refresh
 'Loads The Users Database Into The Tree View
  Load_User_DB_TO_Treeview TVUsers, ImageList1
  
  TVUsers.Nodes(Last_AccessLevel).Expanded = True
  TVUsers.Nodes(Last_AccessLevel).Selected = True
  Me.Caption = " User Profile(s) [" & Current_LoginName & "-" & Current_AccessLevel & "] "
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Clear_Profile_Fields()
  usrName1.Text = ""
  usrName1.Locked = True
  usrPassword.Text = ""
  usrPassword.Locked = True
  usrAccLvl.Text = Last_AccessLevel
  usrAccLvl.Locked = True
  usrCStatus.ListIndex = 0
  usrCStatus.Locked = True
  pEdit.Enabled = False
  pDelete.Enabled = False
  pSave.Enabled = False
  pCancel.Enabled = False
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub pMaking_Changes()
'Unlock Fields
 usrName1.Locked = False
 usrPassword.Locked = False

'Enable and Disable Butttons
 pSave.Enabled = True
 pCancel.Enabled = True
 profClose.Enabled = False
 pAdd.Enabled = False
 pEdit.Enabled = False
 pDelete.Enabled = False
 
 If Current_AccessLevel <> "Administrator" Then
    usrAccLvl.Locked = True
 End If
 
 If Current_AccessLevel = "Administrator" Then
    If pCurrently_Editting Then
       If AdminCount > 1 Then
          usrAccLvl.Locked = False
         Else
          usrAccLvl.Locked = True
       End If
    End If
    
    If pCurrently_Adding = True Then
       usrAccLvl.Locked = False
    End If
 End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub pNo_Changes()
'Lock Fields
 usrName1.Locked = True
 usrPassword.Locked = True
 usrAccLvl.Locked = True
'Enable and Disable Butttons
 pSave.Enabled = False
 pCancel.Enabled = False
 profClose.Enabled = True
 pEdit.Enabled = True
 pDelete.Enabled = True
 If (Current_AccessLevel = "Administrator") Then
    pAdd.Enabled = True
   Else
    pAdd.Enabled = False
 End If
 pCurrently_Adding = False
 pCurrently_Editting = False
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub usrPassword_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
End Sub
'**********************************************************************
'**********************************************************************