form1.frm

enigma 的实现 里面有源码和图形界面 希望对大家有用

            Charset         =   2
            Weight          =   700
            Underline       =   0   'False
            Italic          =   -1  'True
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00008000&
         Height          =   255
         Left            =   1530
         TabIndex        =   27
         Top             =   990
         Width           =   2895
      End
      Begin VB.Label Label5 
         Caption         =   "Enigma加密机"
         BeginProperty Font 
            Name            =   "华文彩云"
            Size            =   24
            Charset         =   134
            Weight          =   700
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   615
         Left            =   1320
         TabIndex        =   26
         Top             =   480
         Width           =   3135
      End
      Begin VB.Image Image2 
         Height          =   795
         Left            =   120
         Picture         =   "Form1.frx":1280E
         Top             =   600
         Width           =   990
      End
      Begin VB.Label Label2 
         Alignment       =   2  'Center
         Caption         =   "版权所有(C)  2004-2010  Mini@Soft Corp."
         ForeColor       =   &H00800000&
         Height          =   255
         Left            =   -74760
         TabIndex        =   21
         Top             =   1320
         Width           =   4095
      End
      Begin VB.Label Label1 
         Alignment       =   2  'Center
         Caption         =   "Enigma加密机"
         BeginProperty Font 
            Name            =   "华文彩云"
            Size            =   14.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   375
         Left            =   -74760
         TabIndex        =   20
         Top             =   960
         Width           =   4095
      End
      Begin VB.Image Image1 
         Height          =   885
         Left            =   -75000
         Picture         =   "Form1.frx":12E8D
         Stretch         =   -1  'True
         Top             =   240
         Width           =   4485
      End
   End
End
Attribute VB_Name = "Enigma"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public En_File_Path As String
Public De_File_Path As String
Public Password As String
Public New_password As String

Private Sub Decrypt_Cmd_Click()
  Dim Pwd_key As Integer
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  Dim Tmp As Integer
  Dim Plat_Rnd(0 To 255) As Integer
  Dim Plat_New(0 To 255) As Integer
  Dim Plat_Final(0 To 255) As Integer
  Dim P_Flag As Boolean
  Dim B_Tmp As Byte
  Dim FL_Tmp As Double
  Dim P_FL As Double
' **********判断文件是否存在**********
  If File_exist(De_File_Path) = False Then
     MsgBox "指定的文件不存在！", vbCritical + vbOKOnly, "错误"
     De_File_Path = ""
     Password = ""
     Password_D.Text = ""
     Password_D.Enabled = False
     Decrypt_Src.Text = ""
     Decrypt_Cmd.Enabled = False
     Exit Sub
  End If
' **********计算Randomize Key**********
  Password = Password_D.Text
  New_password = Change_password(Password)
  If Len(New_password) = Len(Password) Then
     Pwd_key = CInt(Right(New_password, 1))
  Else
     Pwd_key = Abs(Len(New_password) - Len(Password)) + CInt(Right(New_password, 1))
  End If
' **********制作第一个轮盘**********
  For k = 0 To 255
    Plat_New(k) = k
  Next k
  j = 0
  For i = 1 To Len(New_password)
    k = CInt(Mid(New_password, i, 1))
    While j < 256
      If j + k < 256 Then
         Tmp = Plat_New(j)
         Plat_New(j) = Plat_New(j + k)
         Plat_New(j + k) = Tmp
      End If
      j = j + k
    Wend
  Next i
' **********制作第二个轮盘**********
  Rnd (-1)
  Randomize Pwd_key
  i = 0
  While (i < 255)
    j = Int(Rnd(1) * 256)
    P_Flag = True
    For k = 0 To i
      If Plat_Rnd(k) = j Then P_Flag = False
    Next k
    If P_Flag = True Then
       Plat_Rnd(i) = j
       i = i + 1
    End If
  Wend
  Plat_Rnd(255) = 0
' **********制作第三个轮盘**********
  For i = 0 To 255
    Plat_Final(i) = Plat_Rnd(Plat_New(i))
  Next i
' **********文件操作**********
  If De_Settings.Value = 1 Then FileCopy De_File_Path, De_File_Path & ".Eni"
  Open De_File_Path For Binary As #1
  P_FL = FileLen(De_File_Path)
  For FL_Tmp = 1 To P_FL
    Get #1, FL_Tmp, B_Tmp
    i = 0
    While Plat_Final(i) <> CInt(B_Tmp)
      i = i + 1
    Wend
    Put #1, FL_Tmp, CByte(i)
    Enigma.Caption = "Enigma加密机  " & CStr(CInt(FL_Tmp * 100 / P_FL)) & "%"
  Next FL_Tmp
  Close #1
  Enigma.Caption = "Enigma加密机"
  MsgBox "文件解密成功！", vbOKOnly, "提示"
  En_File_Path = ""
  Password = ""
  Password_D.Text = ""
  Password_D.Enabled = False
  Decrypt_Src.Text = ""
  Decrypt_Cmd.Enabled = False
End Sub

Private Sub Encrypt_Cmd_Click()
  Dim Pwd_key As Integer
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  Dim Tmp As Integer
  Dim Plat_Rnd(0 To 255) As Integer
  Dim Plat_New(0 To 255) As Integer
  Dim Plat_Final(0 To 255) As Integer
  Dim P_Flag As Boolean
  Dim B_Tmp As Byte
  Dim FL_Tmp As Double
  Dim P_FL As Double
' **********判断文件是否存在**********
  If File_exist(En_File_Path) = False Then
     MsgBox "指定的文件不存在！", vbCritical + vbOKOnly, "错误"
     En_File_Path = ""
     Password = ""
     Password_E.Text = ""
     Password_Ver.Text = ""
     Password_Ver.Enabled = False
     Password_E.Enabled = False
     Encrypt_Src.Text = ""
     Encrypt_Cmd.Enabled = False
     Exit Sub
  End If
' **********判断两次密码输入是否一致**********
  If Password_E <> Password_Ver Then
     MsgBox "密码输入错误，请重新输入！", vbCritical + vbOKOnly, "错误提示"
     Exit Sub
  End If
  Password = Password_E.Text
  New_password = Change_password(Password)
  If Len(New_password) = Len(Password) Then
     Pwd_key = CInt(Right(New_password, 1))
  Else
     Pwd_key = Abs(Len(New_password) - Len(Password)) + CInt(Right(New_password, 1))
  End If
' **********制作第一个轮盘**********
  For k = 0 To 255
    Plat_New(k) = k
  Next k
  j = 0
  For i = 1 To Len(New_password)
    k = CInt(Mid(New_password, i, 1))
    While j < 256
      If j + k < 256 Then
         Tmp = Plat_New(j)
         Plat_New(j) = Plat_New(j + k)
         Plat_New(j + k) = Tmp
      End If
      j = j + k
    Wend
  Next i
' **********制作第二个轮盘**********
  Rnd (-1)
  Randomize Pwd_key
  i = 0
  While (i < 255)
    j = Int(Rnd(1) * 256)
    P_Flag = True
    For k = 0 To i
      If Plat_Rnd(k) = j Then P_Flag = False
    Next k
    If P_Flag = True Then
       Plat_Rnd(i) = j
       i = i + 1
    End If
  Wend
  Plat_Rnd(255) = 0
' **********制作第三个轮盘**********
  For i = 0 To 255
    Plat_Final(i) = Plat_Rnd(Plat_New(i))
  Next i
' **********文件操作**********
  If En_Settings.Value = 1 Then FileCopy En_File_Path, En_File_Path & ".Eni"
  Open En_File_Path For Binary As #1
  P_FL = FileLen(En_File_Path)
  For FL_Tmp = 1 To P_FL
    Get #1, FL_Tmp, B_Tmp
    Put #1, FL_Tmp, CByte(Plat_Final(CInt(B_Tmp)))
    Enigma.Caption = "Enigma加密机  " & CStr(CInt(FL_Tmp * 100 / P_FL)) & "%"
    Next FL_Tmp
  Close #1
  Enigma.Caption = "Enigma加密机"
  MsgBox "文件加密成功！", vbOKOnly, "提示"
  En_File_Path = ""
  Password = ""
  Password_E.Text = ""
  Password_Ver.Text = ""
  Password_Ver.Enabled = False
  Password_E.Enabled = False
  Encrypt_Src.Text = ""
  Encrypt_Cmd.Enabled = False
End Sub

Private Sub Form_Load()
  SSTab1.TabEnabled(1) = False
  SSTab1.TabEnabled(2) = False
  CDialog.FileName = ""
  En_File_Path = ""
  De_File_Path = ""
  Password = ""
End Sub

Private Sub Open_DFile_Click()
  CDialog.FileName = ""
  CDialog.DialogTitle = "请选择要解密的文件"
  CDialog.Filter = "所有文件|*.*"
  CDialog.Flags = cdlOFNHideReadOnly
  CDialog.ShowOpen
  If CDialog.FileName <> "" Then
     De_File_Path = CDialog.FileName
     CDialog.FileName = ""
     Decrypt_Src = De_File_Path
     Password_D.Enabled = True
  End If
End Sub

Private Sub Open_EFile_Click()
  CDialog.FileName = ""
  CDialog.DialogTitle = "请选择要加密的文件"
  CDialog.Filter = "所有文件|*.*"
  CDialog.Flags = cdlOFNHideReadOnly
  CDialog.ShowOpen
  If CDialog.FileName <> "" Then
     En_File_Path = CDialog.FileName
     CDialog.FileName = ""
     Encrypt_Src = En_File_Path
     Password_E.Enabled = True
  End If
End Sub

Private Sub Password_D_Change()
  If Len(Password_D) > 5 Then
     Decrypt_Cmd.Enabled = True
  Else
     Decrypt_Cmd.Enabled = False
  End If
End Sub

Private Sub Password_E_Change()
  If Len(Password_E) > 5 Then
     Password_Ver.Enabled = True
  Else
     Password_Ver.Text = ""
     Password_Ver.Enabled = False
  End If
End Sub

Private Sub Password_Ver_Change()
  If Len(Password_Ver) > 5 Then
     Encrypt_Cmd.Enabled = True
  Else
     Encrypt_Cmd.Enabled = False
  End If
End Sub

Private Sub Show_pwd_Click()
  If Show_pwd.Value = 0 Then
     Password_E.PasswordChar = "*"
     Password_Ver.PasswordChar = "*"
  Else
     Password_E.PasswordChar = ""
     Password_Ver.PasswordChar = ""
  End If
End Sub

Private Sub Start_CHK_Click()
  If Start_CHK.Value = 1 Then
     SSTab1.TabEnabled(1) = True
     SSTab1.TabEnabled(2) = True
  Else
     SSTab1.TabEnabled(1) = False
     SSTab1.TabEnabled(2) = False
  End If
End Sub