frmencfiles.frm

程序加密算法

' ---------------------------------------------------------------------------
' Write the encrypted data into the encrypted output file
' ---------------------------------------------------------------------------
  Open m_strEncryptName For Binary Access Write As #hFile
  Put hFile, , arData
  Close #hFile

' ---------------------------------------------------------------------------
' Empty data array and make sure we have the correct size to refill it.
'
' BUG:  The decoded file will be one byte larger than the source.  To fix
'       this, subtract 1 from the file size to accomodate the zero based array.
'
' Fix suggested by Harbinder Gill [e-mail]
' ---------------------------------------------------------------------------
  lngFileSize = FileLen(m_strEncryptName)
  Erase arData()
  ReDim arData(lngFileSize - 1)
  
' ---------------------------------------------------------------------------
' Load the byte array with the file contents from the encrypted file using
' one command then close file.
' ---------------------------------------------------------------------------
  Open m_strEncryptName For Binary Access Read As #hFile
  Get hFile, , arData
  Close #hFile

' ---------------------------------------------------------------------------
' set up parameters prior to decryption
' ---------------------------------------------------------------------------
  cCrypto.Password = arPWord()
  cCrypto.InputData = arData()

' ---------------------------------------------------------------------------
' Decrypt the data input from the encrypted file.  Convert the final data
' back to string format before writing to the output file.  If the byte array
' was PUT into the decrypted file in one command, the last character
' would be converted to a NULL.
' ---------------------------------------------------------------------------
  If cCrypto.Decrypt(g_intHashType, m_intCipher) Then
      arData = cCrypto.OutputData
      strText = cCrypto.ByteArrayToString(arData())
  Else
      GoTo CleanUp
  End If
  
' ---------------------------------------------------------------------------
' Write the decrypted data into the output file.
' ---------------------------------------------------------------------------
  Open m_strDecryptName For Binary Access Write As #hFile
  Put hFile, , strText
  Close #hFile
  
  MsgBox "Successful Finish!" & vbCrLf & _
         "Use a text editor to veiw the file formats.", _
         vbInformation Or vbOKOnly, "Encrypt Files"
  
CleanUp:
  On Error GoTo 0         ' nullify the previous "On Error"
  Set cCrypto = Nothing   ' free class from memory
  Erase arData()          ' empty the data array
  strText = String$(250, 0)
  Exit Sub
  
Process_File_Errors:
' ---------------------------------------------------------------------------
' Display error message
' ---------------------------------------------------------------------------
  MsgBox "Error: " & CStr(Err.Number) & "  " & Err.Description & vbCrLf & vbCrLf & _
         "Module:  frmEncFiles" & vbCrLf & _
         "Routine:  Process_File", vbExclamation Or vbOKOnly, "Encrypt File Error"
  
  Call CloseOpenFiles
  Resume CleanUp
  
End Sub

Private Sub cmdChoice_Click(Index As Integer)

' ***************************************************************************
' Routine:       cmdChoice_Click
'
' Description:   Based on command button selected, perform string encryption
'                of return to the main menu.
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 08-JAN-2001  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************

' ---------------------------------------------------------------------------
' Based on the button pressed
' ---------------------------------------------------------------------------
  Select Case Index
         
         Case 0
              ' if nothing there then leave
              If Len(txtData(1).Text) = 0 Then
                  Exit Sub
              End If
              
              ' encrypt the file
              Process_File
              
         ' browse for a file
         Case 1
              txtData(1).Text = FileOpen_Dialog
              
              If Len(Trim$(txtData(1).Text)) > 0 Then
                  Prep_Textboxes
              Else
                  txtData(2).Text = ""
                  txtData(3).Text = ""
              End If
  
         ' Cancel button was pressed.  Return to main menu.
         Case 2
              frmEncFiles.Hide
              frmMainMenu.Show
  End Select
  
End Sub


Private Function FileOpen_Dialog() As String

' ***************************************************************************
' Routine:       FileOpen_Dialog
'
' Description:   Opens the File Open dialog box so the user can browse for a
'                former report file.
'
' Returns:       Path and filename
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 01-NOV-2000  Kenneth Ives  [e-mail]
'              Routine created
' ***************************************************************************

  On Error GoTo FileOpen_Errhandler
' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim strFilename As String
  
' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  strFilename = ""
  CD.CancelError = True
  
' ---------------------------------------------------------------------------
' Loop until user selects a valid file or presses CANCEL
' ---------------------------------------------------------------------------
  Do
      ' Setup and display the File Open dialog box
      With CD
           ' Set flags
           .Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly Or _
                    cdlOFNLongNames Or cdlOFNPathMustExist
           
           .DialogTitle = "Browse for file to encrypt."
           ' Set filters
           .Filter = "All Files (*.*)|*.*"
           .ShowOpen                        ' Display the Open dialog box
           strFilename = .FileName          ' save the path & filename selected
      End With
  
  Loop While Len(strFilename) = 0
  
  FileOpen_Dialog = strFilename
  Exit Function
  
FileOpen_Errhandler:
' ---------------------------------------------------------------------------
' User pressed the Cancel button
' ---------------------------------------------------------------------------
  FileOpen_Dialog = ""
  Exit Function

End Function


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 frmEncFiles

' ---------------------------------------------------------------------------
' Hide this form
' ---------------------------------------------------------------------------
  frmEncFiles.Hide

End Sub

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

' ---------------------------------------------------------------------------
' 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 2 ' Return to the main menu
         Case 1: Exit Sub
         Case 2: TerminateApplication
         Case 3: TerminateApplication
         Case 4: TerminateApplication
  End Select
  
End Sub

Private Sub Prep_Textboxes()

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim intPosition As Integer
  
' ---------------------------------------------------------------------------
' get path and filename from first text box
' ---------------------------------------------------------------------------
  m_strFilename = Trim$(txtData(1).Text)
          
' ---------------------------------------------------------------------------
' look for last period in the path\filename
' ---------------------------------------------------------------------------
  intPosition = InStrRev(m_strFilename, ".", Len(m_strFilename))
  m_strEncryptName = Left$(m_strFilename, intPosition) & "enc"
  m_strDecryptName = Left$(m_strFilename, intPosition) & "dec"
          
' ---------------------------------------------------------------------------
' place filenames in text boxes
' ---------------------------------------------------------------------------
  txtData(2).Text = m_strEncryptName
  txtData(3).Text = m_strDecryptName

End Sub
Private Sub Clear_Variables()
  
  Erase arData()
  
  m_strFilename = ""
  m_strEncryptName = ""
  m_strDecryptName = ""
  
  With frmEncFiles
       .txtData(1).Text = ""
       .txtData(2).Text = ""
       .txtData(3).Text = ""
  End With
  
End Sub
Public Sub Reset_frmEncfiles()

' ---------------------------------------------------------------------------
' Display the form
' ---------------------------------------------------------------------------
  Clear_Variables
  Erase arPWord()
  optCipher_Click 0
    
  With frmEncFiles
       .txtData(0).Text = ""
       .lblMyLabel = MYNAME
       .Show vbModeless
  End With
  
End Sub

Private Sub optCipher_Click(Index As Integer)

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim intIndex As Integer
  Dim intMax   As Integer
  
' ---------------------------------------------------------------------------
' Determine number of accessable cipher options
' ---------------------------------------------------------------------------
  If g_blnEnhancedProvider Then
      intMax = 4
      optCipher(3).Enabled = True
      optCipher(3).Visible = True
      optCipher(4).Enabled = True
      optCipher(4).Visible = True
  Else
      intMax = 2
      optCipher(3).Visible = False
      optCipher(3).Enabled = False
      optCipher(4).Visible = False
      optCipher(4).Enabled = False
  End If
  
' ---------------------------------------------------------------------------
' Select the visible option selected
' ---------------------------------------------------------------------------
  For intIndex = 0 To intMax
      If intIndex = Index Then
          optCipher(intIndex).Value = True
          m_intCipher = Index + 1
      Else
          optCipher(intIndex).Value = False
      End If
  Next
  
End Sub

Private Sub txtData_LostFocus(Index As Integer)
  
' ---------------------------------------------------------------------------
' See if anything is in the filename text box
' ---------------------------------------------------------------------------
  If Len(Trim$(txtData(1).Text)) > 0 Then
      Prep_Textboxes
  Else
      txtData(2).Text = ""
      txtData(3).Text = ""
  End If
  
End Sub