?? 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 hgill@altavista.net
' ---------------------------------------------------------------------------
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 kenaso@home.com
' 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 kenaso@home.com
' 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -