?? frmkrypt.frm
字號:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmkrypt
BorderStyle = 3 'Fixed Dialog
Caption = "Encrypt / Decrypt Files"
ClientHeight = 4500
ClientLeft = 2310
ClientTop = 2520
ClientWidth = 6585
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
PaletteMode = 2 'Custom
ScaleHeight = 4500
ScaleWidth = 6585
Begin VB.TextBox txtcancel
Height = 285
Left = 3885
TabIndex = 11
Top = 135
Visible = 0 'False
Width = 1335
End
Begin VB.CommandButton cmdabout
Caption = "&About"
Height = 375
Left = 3360
TabIndex = 4
Top = 3600
Width = 1455
End
Begin MSComDlg.CommonDialog cdlg1
Left = 2940
Top = 45
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin VB.CommandButton cmdcancel
Cancel = -1 'True
Caption = "&Cancel"
Height = 375
Left = 4920
TabIndex = 5
Top = 3600
Width = 1455
End
Begin VB.CommandButton cmddecrypt
Caption = "&Decrypt"
Height = 375
Left = 240
TabIndex = 2
Top = 3600
Width = 1455
End
Begin VB.CommandButton cmdkrypt
Caption = "&Encrypt"
Height = 375
Left = 1800
TabIndex = 3
Top = 3600
Width = 1455
End
Begin VB.CommandButton cmdbrowse2
Caption = "&Browse"
Height = 375
Left = 5040
TabIndex = 1
Top = 2280
Width = 1215
End
Begin VB.CommandButton cmdbrowse1
Caption = "&Browse"
Default = -1 'True
Height = 375
Left = 5040
TabIndex = 0
Top = 840
Width = 1215
End
Begin VB.TextBox txtdestination
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
Locked = -1 'True
TabIndex = 7
Top = 2280
Width = 4815
End
Begin VB.TextBox txtsource
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
Locked = -1 'True
TabIndex = 6
Top = 840
Width = 4815
End
Begin VB.TextBox txtpaxz
Height = 375
Left = 45
TabIndex = 10
Top = 45
Visible = 0 'False
Width = 2295
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "Destination File"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 225
TabIndex = 9
Top = 1980
Width = 2535
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Source File"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 8
Top = 540
Width = 2655
End
End
Attribute VB_Name = "frmkrypt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdabout_Click()
'' Display About Box
MsgBox "This Program Encrypts and Decrypts files using the same algorithm" & Chr(13) & "used in EasyByte EasyMailer" & Chr(13) & Chr(13) & Chr(13) & "Go to www.easybyte.com to get a FREE copy of the SOURCE CODE for this program", vbInformation
End Sub
Private Sub cmdbrowse1_Click()
''
'' This Procedure Lets the user Choose a file to Encrypt / Decrypt
''
On Error GoTo errhandler
'open text file
Dim CRTF_Text As Integer
CRTF_Text = 1
cdlg1.Filter = "All Files (*.*)|*.*"
cdlg1.FilterIndex = 0
cdlg1.DialogTitle = "Choose Source File"
cdlg1.InitDir = App.Path
cdlg1.Flags = cdlOFNHideReadOnly
cdlg1.ShowOpen
txtsource.Text = cdlg1.Filename
cmdbrowse2.SetFocus
errhandler:
eds:
End Sub
Private Sub cmdbrowse2_Click()
''
'' This Procedure Lets the user Choose where the Encrypted / Decrypted
'' Source File is Placed.
On Error GoTo errhandler
If txtsource.Text = "" Then
MsgBox "You Must Select a Source File First", 64
cmdbrowse1.SetFocus
GoTo eds
End If
'open text file
Dim CRTF_Text As Integer
CRTF_Text = 1
cdlg1.Filter = "All Files (*.*)|*.*"
cdlg1.FilterIndex = 0
cdlg1.DialogTitle = "Choose Destination File"
cdlg1.InitDir = App.Path
cdlg1.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
cdlg1.ShowSave
txtdestination.Text = cdlg1.Filename
FileCopy txtsource.Text, txtdestination.Text
GoTo eds
errhandler:
Select Case Err.Number
Case 75
MsgBox "You have not Chosen a Source File Yet.", 64
txtdestination.Text = ""
cmdbrowse1.SetFocus
Resume Next
Case Else
GoTo eds
End Select
eds:
End Sub
Private Sub cmdcancel_Click()
End
End Sub
Private Sub cmddecrypt_Click()
On Error GoTo errorhandler ' Enable error-handling routine.
'' The procedure for decrypting files
Dim Password As String
Dim Filename As String
Dim Message As String
Dim TryPass As String
Dim charnum As Currency, randominteger As Currency
Dim singlechar As String * 1
Dim keyvalue As Currency
Dim secondkey As Currency
Dim CurrChar As String
Dim msg As String
Dim ctxt As Integer
Dim Q As Currency
Dim filenum As Currency
Dim X As Currency
Dim I As Currency
If txtsource.Text = "" Then
MsgBox "You must Choose a Source File.", 64
cmdbrowse1.SetFocus
GoTo eds
End If
If txtdestination.Text = "" Then
MsgBox "You must Choose a Destination File.", 64
cmdbrowse2.SetFocus
GoTo eds
End If
frmpass.Caption = "Enter Password to Decrypt Message"
frmpass.Show vbModal
TryPass = txtpaxz.Text
'' If the user clicked on Cancel on the Password entry dialog
'' box.
If txtcancel.Text = "yes" Then
GoTo eds
End If
'' Change mouse to hour glass
MousePointer = 11
Password = TryPass
'' All of the code below de-ciphers the message
'' get each ascii from each letter in password
For Q = Len(Password) To 1 Step -1
CurrChar = Mid(Password$, Q, 1)
keyvalue = Asc(CurrChar)
filenum = FreeFile
X = Rnd(-keyvalue)
Filename$ = txtdestination.Text
'The following code is labeled with obvious variables
'So it is easy to follow what is going on
Open Filename$ For Binary As #filenum 'open the file name for output/input.
For I = 1 To LOF(filenum)
Get #filenum, I, singlechar
charnum = Asc(singlechar)
randominteger = Int(256 * Rnd)
charnum = charnum Xor randominteger
singlechar = Chr$(charnum)
Put #filenum, I, singlechar
Next I
Close #filenum
Next Q
Close #filenum
errorhandler: ' Error-handling routine.
Select Case Err.Number ' Evaluate error number.
Case 0
Resume Next
Case 20
Resume Next
Case Else
MsgBox "Error Number " & Err.Number & " Happened"
GoTo eds
End Select
Close #1
eds:
txtcancel.Text = "no"
MousePointer = 0
End Sub
Private Sub ReKrypt()
MsgBox "ReKrypt"
End Sub
Private Sub cmdkrypt_Click()
On Error GoTo errorhandler ' Enable error-handling routine.
'' The procedure for Encrypting files
Dim Password As String
Dim Filename As String
Dim Message As String
Dim TryPass As String
Dim charnum As Currency, randominteger As Currency
Dim singlechar As String * 1
Dim keyvalue As Currency
Dim secondkey As Currency
Dim CurrChar As String
Dim msg As String
Dim ctxt As Integer
Dim Q As Currency
Dim filenum As Currency
Dim X As Currency
Dim I As Currency
Dim XX As Currency
If txtsource.Text = "" Then
MsgBox "You must Choose a Source File.", 64
cmdbrowse1.SetFocus
GoTo eds
End If
If txtdestination.Text = "" Then
MsgBox "You must Choose a Destination File.", 64
cmdbrowse2.SetFocus
GoTo eds
End If
frmpass.Caption = "Enter Password to Encrypt Message"
frmpass.Show vbModal
TryPass = txtpaxz.Text
'' If the user clicked on Cancel on the Password entry dialog
'' box.
If txtcancel.Text = "yes" Then
GoTo eds
End If
'' Change mouse to hour glass
MousePointer = 11
Password = TryPass
'' All of the code below ciphers the message
'' get each ascii from each letter in password
For Q = 1 To Len(Password)
CurrChar = Mid(Password$, Q, 1)
keyvalue = Asc(CurrChar)
filenum = FreeFile
X = Rnd(-keyvalue)
Filename$ = txtdestination.Text
'The following code is labeled with obvious variables
'So it is easy to follow what is going on
Open Filename$ For Binary As #filenum 'open the file name for output/input.
For I = 1 To LOF(filenum)
Get #filenum, I, singlechar
charnum = Asc(singlechar)
randominteger = Int(256 * Rnd)
charnum = charnum Xor randominteger
singlechar = Chr$(charnum)
Put #filenum, I, singlechar
Next I
Close #filenum
Next Q
Close #filenum
errorhandler: ' Error-handling routine.
Select Case Err.Number ' Evaluate error number.
Case 0
Resume Next
Case 20
Resume Next
Case Else
MsgBox "Error Number " & Err.Number & " Happened"
GoTo eds
End Select
Close #1
eds:
txtcancel.Text = "no"
MousePointer = 0
End Sub
Private Sub txtdestination_GotFocus()
cmdbrowse2.SetFocus
End Sub
Private Sub txtsource_GotFocus()
cmdbrowse1.SetFocus
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -