frmadduser.frm

程序加密算法

Private Sub ClearVariables()

' ---------------------------------------------------------------------------
' clear variables
' ---------------------------------------------------------------------------
  Erase arUserID()
  Erase arPWord1()
  Erase arPWord2()
  
  m_strUserID = String$(250, 0)
  m_strPWord1 = String$(250, 0)
  m_strPWord2 = String$(250, 0)
  
  m_strUserID = ""
  m_strPWord1 = ""
  m_strPWord2 = ""
  
End Sub

Private Sub Form_Initialize()

' ---------------------------------------------------------------------------
' Center form on the screen.  I use this statement here because of a
' bug in the Form property "Startup Position".  In the VB IDE, under
' Tools\Options\Advanced, when you place a checkmark in the SDI
' Development Environment check box and set the form property to
' startup in the center of the screen, it works while in the IDE.
' Whenever you leave the IDE, the property reverts back to the default
' of 0-Manual.  This is a known bug with Microsoft.
' ---------------------------------------------------------------------------
  Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2

End Sub

Private Sub Form_Load()

' ---------------------------------------------------------------------------
' Center the form caption
' ---------------------------------------------------------------------------
  Me.Caption = g_strVersion
  CenterCaption frmAddUser

' ---------------------------------------------------------------------------
' Hide this form
' ---------------------------------------------------------------------------
  frmAddUser.Hide

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

' ---------------------------------------------------------------------------
' Empty variables
' ---------------------------------------------------------------------------
  ClearVariables
  
' ---------------------------------------------------------------------------
' Based on the the unload code the system passes,
' we determine what to do
'
' Unloadmode codes
'     0 - Close from the control-menu box
'         or Upper right "X"
'     1 - Unload method from code elsewhere
'         in the application
'     2 - Windows Session is ending
'     3 - Task Manager is clostrIng the app
'     4 - MDI Parent is clostrIng
' ---------------------------------------------------------------------------
  Select Case UnloadMode
         
         Case 0: cmdChoice_Click 1   ' Return to the main menu
         Case 1: Exit Sub
         Case 2: TerminateApplication
         Case 3: TerminateApplication
         Case 4: TerminateApplication
  End Select
  
End Sub

Public Sub Reset_frmAddUser()

' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  ClearVariables
  
' ---------------------------------------------------------------------------
' Display the form
' ---------------------------------------------------------------------------
  With frmAddUser
       .txtPassword(0).Text = ""
       .txtPassword(1).Text = ""
       .txtPassword(2).Text = ""
       .lblMyLabel = MYNAME
       .Show vbModeless
       .Refresh
  End With
  
' ---------------------------------------------------------------------------
' place cursor in first text box
' ---------------------------------------------------------------------------
  txtPassword(0).SetFocus
  
End Sub

Private Sub Reset_PWD_Boxes()

' ---------------------------------------------------------------------------
' Empty password arrays and the bottom two text boxes
' ---------------------------------------------------------------------------
  Erase arPWord1()
  Erase arPWord2()
  
  txtPassword(1).Text = ""
  txtPassword(2).Text = ""
  
  m_strPWord1 = ""
  m_strPWord2 = ""
  
End Sub

Private Sub txtPassword_GotFocus(Index As Integer)
  
' ---------------------------------------------------------------------------
' Highlight all the text in the box
' ---------------------------------------------------------------------------
  SendKeys "{Home}{End}"
  
End Sub

Private Sub txtPassword_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim CtrlDown    As Integer
  Dim PressedKey  As Integer
  
' ---------------------------------------------------------------------------
' Initialize  variables
' ---------------------------------------------------------------------------
  CtrlDown = (Shift And vbCtrlMask) > 0   ' Define control key
  
  If Len(Trim$(KeyCode)) > 0 Then
      ' Convert to uppercase
      PressedKey = CInt(Asc(StrConv(Chr$(KeyCode), vbUpperCase)))
  End If
    
' ---------------------------------------------------------------------------
' Check to see if it is okay to make changes
' ---------------------------------------------------------------------------
  If CtrlDown And PressedKey = vbKeyX Then
      Edit_Cut            ' Ctrl + X was pressed
  ElseIf CtrlDown And PressedKey = vbKeyA Then
      SendKeys "{Home}{End}"
  ElseIf CtrlDown And PressedKey = vbKeyC Then
      Edit_Copy           ' Ctrl + C was pressed
  ElseIf CtrlDown And PressedKey = vbKeyV Then
      Edit_Paste          ' Ctrl + V was pressed
  ElseIf PressedKey = vbKeyDelete Then
      Edit_Delete         ' Delete key was pressed
  End If

End Sub

Private Sub txtPassword_KeyPress(Index As Integer, KeyAscii As Integer)

' ---------------------------------------------------------------------------
' If ENTER is pressed then nullify keystroke and press the OK button
' ---------------------------------------------------------------------------
  If KeyAscii = 13 Then
      KeyAscii = 0                        ' Nullify keystroke
      txtPassword_Validate Index, False   ' force validate event to fire
      cmdChoice_Click 0                   ' Press the OK button
      Exit Sub
  End If
  
' ---------------------------------------------------------------------------
' If TAB is pressed then nullify keystroke and TAB to the next tabstop
' ---------------------------------------------------------------------------
  If KeyAscii = 9 Then
      KeyAscii = 0
      SendKeys "{TAB}"
  End If
  
' ---------------------------------------------------------------------------
' Accept on valid characters
' ---------------------------------------------------------------------------
  Select Case KeyAscii
  
         ' backspace and other printable
         ' keyboard characters
         Case 8, 32 To 126:
              Exit Sub      ' Good input
              
         ' Bad input
         Case Else:
              KeyAscii = 0  ' Nullify keystroke
  End Select
  
End Sub

Private Sub txtPassword_Validate(Index As Integer, Cancel As Boolean)

' ---------------------------------------------------------------------------
' Validate Event - Occurs before the focus shifts to a (second) control that
' has its CausesValidation property set to True.  Also, I make sure the
' "Cancel" parameter is set to FALSE, otherwise, I could get trapped in a
' text box and not be allowed to select the exit button.
' ---------------------------------------------------------------------------

' ---------------------------------------------------------------------------
' Remove leading and trailing blank spaces
' ---------------------------------------------------------------------------
  Cancel = False
  txtPassword(Index).Text = Trim$(txtPassword(Index).Text)
  
' ---------------------------------------------------------------------------
' Initial test of the input data
' ---------------------------------------------------------------------------
  Select Case Index
  
         ' User ID
         Case 0:
              ' something may have changed
              Erase arUserID()
              m_strUserID = ""
              Reset_PWD_Boxes
              
              If Len(txtPassword(0).Text) > 0 Then
                  If Not g_blnCaseSensitiveUserID Then
                      txtPassword(0).Text = StrConv(txtPassword(0).Text, vbUpperCase)
                  End If
                  
                  m_strUserID = txtPassword(0).Text
              End If
              
         ' New Password
         Case 1:
              ' if something is in the password box, then convert from
              ' string data to a byte array and then fill the text box
              ' with 30 asteriks
              If Len(txtPassword(1).Text) > 0 Then
                  If Not g_blnCaseSensitivePWord Then
                      txtPassword(1).Text = StrConv(txtPassword(1).Text, vbUpperCase)
                  End If
                  
                  m_strPWord1 = txtPassword(1).Text
                  txtPassword(1).Text = String$(30, "*")
              Else
                  ' else empty both of the password text boxes
                  Reset_PWD_Boxes
              End If
  
         ' Verifiy password
         Case 2:
              ' if something is in the password box, then convert from
              ' string data to a byte array and then fill the text box
              ' with 30 asteriks
              If Len(txtPassword(2).Text) > 0 Then
                  If Not g_blnCaseSensitivePWord Then
                      txtPassword(2).Text = StrConv(txtPassword(2).Text, vbUpperCase)
                  End If
                  
                  m_strPWord2 = txtPassword(2).Text
                  txtPassword(2).Text = String$(30, "*")
              Else
                  ' else empty bottom password text box
                  txtPassword(2).Text = ""
                  m_strPWord2 = ""
                  Erase arPWord2()
              End If
  End Select
  
End Sub