form1.frm

一个较为简单的维吉尼亚算法

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "维吉尼亚密码法"
   ClientHeight    =   3375
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5700
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3375
   ScaleWidth      =   5700
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox Text3 
      Height          =   735
      Left            =   960
      MultiLine       =   -1  'True
      TabIndex        =   8
      Top             =   2040
      Width           =   3135
   End
   Begin VB.CommandButton Command2 
      Caption         =   "解密"
      Height          =   375
      Left            =   4320
      TabIndex        =   6
      Top             =   2280
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "加密"
      Height          =   375
      Left            =   4320
      TabIndex        =   5
      Top             =   600
      Width           =   975
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   960
      TabIndex        =   1
      Top             =   1440
      Width           =   3135
   End
   Begin VB.TextBox Text1 
      Height          =   735
      Left            =   960
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   480
      Width           =   3135
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "维吉尼亚密码法"
      Height          =   180
      Left            =   1560
      TabIndex        =   7
      Top             =   120
      Width           =   1260
   End
   Begin VB.Label Label3 
      Caption         =   "密钥："
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   1440
      Width           =   615
   End
   Begin VB.Label Label2 
      Caption         =   "密文："
      Height          =   375
      Left            =   240
      TabIndex        =   3
      Top             =   2280
      Width           =   615
   End
   Begin VB.Label Label1 
      Caption         =   "明文："
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   720
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim str1 As String
Dim k As Integer
Dim keylen As Integer
Dim keylens As Integer
Dim key()

Public Function makekey()

 keylen = Len(Text1.Text)
 keylens = Len(Text2.Text)
 i = 1
 ReDim key(1 To keylen)
 While (i <= keylen)
    For j = 1 To keylens
        key(i) = Mid(Text2.Text, j, 1)
        Debug.Print key(i)
        i = i + 1
        If (i > keylen) Then
        GoTo out
        End If

    Next
Wend
out:
End Function

Public Function encode(ch As String) As String

If (ch >= "A" And ch <= "Z") Then
    ch = Chr$((Asc(ch) - Asc("A") + Asc(key(k)) - Asc("A")) Mod 26 + Asc("A"))
Else

  If (ch >= "a" And ch <= "z") Then
     ch = Chr$((Asc(ch) - Asc("a") + Asc(key(k)) - Asc("a")) Mod 26 + Asc("a"))
  
  End If

End If
   
   Text3.Text = Text3.Text + ch

End Function


Public Function decode(ch As String) As String

If (ch >= "A" And ch <= "Z") Then

 For j = 0 To 26

   If ((Asc(ch) - Asc("A") - (j + Asc(key(k)) - Asc("A"))) Mod 26 = 0) Then
    
     Text3.Text = Text3.Text + Chr$(Asc("A") + j)
     
     Exit For
   End If
   
   Next
Else
    
If (ch >= "a" And ch <= "z") Then
    
   For j = 0 To 26

   If ((Asc(ch) - Asc("a") - (j + Asc(key(k)) - Asc("a"))) Mod 26 = 0) Then
    
     Text3.Text = Text3.Text + Chr$(Asc("a") + j)
     
     Exit For
   End If
   
   Next
  
Else

 Text3.Text = Text3.Text + ch

End If
End If
End Function


Public Function crake(ch As String) As String

If (ch >= "A" And ch <= "Z") Then
    ch = Chr$((Asc(ch) - Asc("A") - k) Mod 26 + Asc("A"))
Else

  If (ch >= "a" And ch <= "z") Then
     ch = Chr$((Asc(ch) - Asc("a") - k) Mod 26 + Asc("a"))
  
  End If

End If
   
   Text1.Text = Text1.Text + ch

End Function


Private Sub Command1_Click()
If Text1.Text = "" Or Text2.Text = "" Then
MsgBox "明文和密钥不能为空！"
Else

Call makekey
k = 1
Text3.Text = ""
For i = 1 To Len(Text1.Text)
  str1 = Mid(Text1.Text, i, 1)
  encode (str1)
  k = k + 1
Next
End If

End Sub

Private Sub Command2_Click()
If Text2.Text = "" Or Text3.Text = "" Then
MsgBox "密钥和密文不能为空！"
Else

Text1.Text = ""
k = 1
For i = 1 To Len(Text3.Text)
  str1 = Mid(Text3.Text, i, 1)
  decode (str1)
  k = k + 1
Next
End If

End Sub