frmmain.frm

加密的模块包含了大多数的加密拴法 可以下载

Private Sub AddEncryption(Object As Object, Name As String, Optional Homepage As String)

  'Add encryption to internal array
  ReDim Preserve EncryptObjects(EncryptObjectsCount)
  With EncryptObjects(EncryptObjectsCount)
    Set .Object = Object
    .Name = Name
    .Homepage = Homepage
  End With
  EncryptObjectsCount = EncryptObjectsCount + 1
  
  'Add encryption to combobox
  Call Combo1.AddItem(Name)
  Combo1.ItemData(Combo1.NewIndex) = (EncryptObjectsCount - 1)
  
End Sub
Private Function CmpFile(File1 As String, File2 As String)

  Dim a As Long
  Dim S1 As String
  Dim S2 As String
  
  Open File1 For Binary As #1
  S1 = Space$(LOF(1))
  Get #1, , S1
  Close #1
  
  Open File2 For Binary As #2
  S2 = Space$(LOF(2))
  Get #2, , S2
  Close #2
  
  CmpFile = (S1 = S2)
  
End Function

Private Sub Combo1_Click()

  With EncryptObjects(Combo1.ItemData(Combo1.ListIndex))
    Set EncryptObject = .Object
    lblHomepage.Enabled = (Len(.Homepage) > 0)
  End With
  
End Sub
Private Sub Command1_Click()

  Dim OldTimer As Single
  
  On Error GoTo ErrorHandler
  
  'Reset the labels
  Label2(0).Caption = "<unknown>"
  Label2(1).Caption = "<unknown>"
  Label2(2).Caption = "<unknown>"
  
  'If the text fields contain filenames we
  'want to encrypt the file given
  If (Mid$(Text1(0).Text, 2, 2) = ":\") Then
    If (Mid$(Text1(1).Text, 2, 2) = ":\") Then
      Label2(0).Caption = FileLen(Text1(0).Text) & " bytes"
      OldTimer = Timer
      Call EncryptObject.EncryptFile(Text1(0).Text, Text1(1).Text, Text1(3).Text)
      Label2(1).Caption = Timer - OldTimer
      Call MsgBox("File Encryption successful.")
      Exit Sub
    End If
  End If

  'Encrypt the content of the first textbox and
  'store it in the Tag property for future use
  '(putting it into the Text property directly
  'will let VB reformat it)
  OldTimer = Timer
  Text1(1).Tag = EncryptObject.EncryptString(Text1(0).Text, Text1(3).Text)
  Text1(1).Text = Text1(1).Tag
  Label2(1).Caption = Timer - OldTimer
  Exit Sub
  
Finished:
  Call MsgBox("Encryption/Decryption successful.", vbExclamation)
  Exit Sub
  
ErrorHandler:
  Call MsgBox("Hrmm.. something went terribly wrong." & vbCrLf & vbCrLf & Err.Description, vbExclamation)

End Sub
Private Sub Command2_Click()

  Dim OldTimer As Single

  On Error GoTo ErrorHandler
  
  'Reset the labels
  Label2(0).Caption = "<unknown>"
  Label2(1).Caption = "<unknown>"
  Label2(2).Caption = "<unknown>"
  
  'If the text fields contain filenames we
  'want to encrypt the file given
  If (Mid$(Text1(0).Text, 2, 2) = ":\") Then
    If (Mid$(Text1(1).Text, 2, 2) = ":\") Then
      Label2(0).Caption = FileLen(Text1(1).Text) & " bytes"
      OldTimer = Timer
      Call EncryptObject.DecryptFile(Text1(1).Text, Text1(2).Text, Text1(3).Text)
      Label2(1).Caption = Timer - OldTimer
      Call MsgBox("File Decryption successful.")
      Exit Sub
    End If
  End If

  'Decrypt the content of the second textbox
  'making sure to use the value from the Tag
  'property instead of the Text property
  Text1(2).Text = EncryptObject.DecryptString(Text1(1).Tag, Text1(3).Text)
    
  Exit Sub
  
ErrorHandler:
  Call MsgBox("Hrmm.. something went terribly wrong." & vbCrLf & vbCrLf & Err.Description, vbExclamation)

End Sub

Private Sub Command4_Click()

  On Error Resume Next
  
  Label2(0).Caption = BENCHMARKSIZE & " bytes"
  Label2(1).Caption = "<unknown>"
  Label2(2).Caption = "<unknown>"
  
  Call frmBenchmark.Show(vbModal, Me)
  
End Sub

Private Sub EncryptBlowfish_Progress(Percent As Long)

  'Update the progress label
  Label2(2).Caption = Percent & "%"
  DoEvents

End Sub

Private Sub EncryptDES_Progress(Percent As Long)

  'Update the progress label
  Label2(2).Caption = Percent & "%"
  DoEvents

End Sub


Private Sub EncryptGost_Progress(Percent As Long)
  
  'Update the progress label
  Label2(2).Caption = Percent & "%"
  DoEvents

End Sub

Private Sub EncryptRC4_Progress(Percent As Long)

  'Update the progress label
  Label2(2).Caption = Percent & "%"
  DoEvents

End Sub


Private Sub EncryptSkipJack_Progress(Percent As Long)

  'Update the progress label
  Label2(2).Caption = Percent & "%"
  DoEvents

End Sub


Private Sub EncryptTEA_Progress(Percent As Long)

  'Update the progress label
  Label2(2).Caption = Percent & "%"
  DoEvents

End Sub


Private Sub EncryptTwofish_Progress(Percent As Long)

  'Update the progress label
  Label2(2).Caption = Percent & "%"
  DoEvents

End Sub


Private Sub EncryptXOR_Progress(Percent As Long)

  'Update the progress label
  Label2(2).Caption = Percent & "%"
  DoEvents

End Sub


Private Sub Form_Load()

  'Create instances of encryption classes
  Set EncryptSkipJack = New clsSkipjack
  Set EncryptBlowfish = New clsBlowfish
  Set EncryptCryptAPI = New clsCryptAPI
  Set EncryptTwofish = New clsTwofish
  Set EncryptXOR = New clsSimpleXOR
  Set EncryptGost = New clsGost
  Set EncryptTEA = New clsTEA
  Set EncryptRC4 = New clsRC4
  Set EncryptDES = New clsDES
  
  'Add all encryption classes to an
  'internal array for easier access
  Call AddEncryption(EncryptBlowfish, "Blowfish", "http://www.counterpane.com/blowfish.html")
  Call AddEncryption(EncryptCryptAPI, "CryptAPI")
  Call AddEncryption(EncryptDES, "DES (Data Encryption Standard)", "http://csrc.nist.gov/fips/fips46-3.pdf")
  Call AddEncryption(EncryptGost, "Gost", "http://www.jetico.sci.fi/index.htm#/gost.htm")
  Call AddEncryption(EncryptXOR, "Simple XOR", "http://tuath.pair.com/docs/xorencrypt.html")
  Call AddEncryption(EncryptRC4, "RC4", "http://www.rsasecurity.com/rsalabs/faq/3-6-3.html")
  Call AddEncryption(EncryptSkipJack, "Skipjack", "http://csrc.nist.gov/encryption/skipjack-kea.htm")
  Call AddEncryption(EncryptTEA, "TEA, A Tiny Encryption Algorithm", "http://www.cl.cam.ac.uk/Research/Papers/djw-rmn/djw-rmn-tea.html")
  Call AddEncryption(EncryptTwofish, "Twofish", "http://www.counterpane.com/twofish.html")
  
  'Pre-select the first item in the list
  Combo1.ListIndex = 0

End Sub
Function Run(strFilePath As String, Optional strParms As String, Optional strDir As String) As String
       
  Const SW_SHOW = 5
  
  'Run the Program and Evaluate errors
  Select Case ShellExecute(0, "Open", strFilePath, strParms, strDir, SW_SHOW)
  Case 0
    Run = "Insufficent system memory or corrupt program file"
  Case 2
    Run = "File not found"
  Case 3
    Run = "Invalid path"
  Case 5
    Run = "Sharing or Protection Error"
  Case 6
    Run = "Seperate data segments are required for each task"
  Case 8
    Run = "Insufficient memory to run the program"
  Case 10
    Run = "Incorrect Windows version"
  Case 11
    Run = "Invalid program file"
  Case 12
    Run = "Program file requires a different operating system"
  Case 13
    Run = "Program requires MS-DOS 4.0"
  Case 14
    Run = "Unknown program file type"
  Case 15
    Run = "Windows program does not support protected memory mode"
  Case 16
    Run = "Invalid use of data segments when loading a second instance of a program"
  Case 19
    Run = "Attempt to run a compressed program file"
  Case 20
    Run = "Invalid dynamic link library"
  Case 21
    Run = "Program requires Windows 32-bit extensions"
  Case Else
    Run = ""
  End Select

End Function

Private Sub lblHomepage_Click()

  Call Run(EncryptObjects(Combo1.ItemData(Combo1.ListIndex)).Homepage)

End Sub