c.frm

adfgx密表密码

VERSION 5.00
Begin VB.Form C 
   Caption         =   "ADFGX密表密码"
   ClientHeight    =   6810
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6900
   LinkTopic       =   "Form1"
   ScaleHeight     =   6810
   ScaleWidth      =   6900
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command2 
      Caption         =   "置换加密"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   5400
      TabIndex        =   9
      Top             =   1800
      Width           =   1335
   End
   Begin VB.CommandButton Command5 
      Caption         =   "重新操作"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   5400
      TabIndex        =   8
      Top             =   5640
      Width           =   1335
   End
   Begin VB.CommandButton Command4 
      Caption         =   "清除明文"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   480
      TabIndex        =   7
      Top             =   2760
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "解密"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   5400
      TabIndex        =   6
      Top             =   4680
      Width           =   1335
   End
   Begin VB.TextBox Text2 
      BackColor       =   &H8000000F&
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   1575
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   5
      Top             =   4680
      Width           =   4455
   End
   Begin VB.CommandButton Command6 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   2880
      TabIndex        =   3
      Top             =   2760
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "替代加密"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   5400
      TabIndex        =   2
      Top             =   840
      Width           =   1335
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1575
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   840
      Width           =   4455
   End
   Begin VB.Line Line1 
      BorderWidth     =   2
      X1              =   240
      X2              =   6720
      Y1              =   3720
      Y2              =   3720
   End
   Begin VB.Label Label2 
      Caption         =   "输出密文："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   360
      TabIndex        =   4
      Top             =   4080
      Width           =   1455
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "输入明文："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   360
      TabIndex        =   0
      Top             =   360
      Width           =   1575
   End
End
Attribute VB_Name = "C"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Rem 这是ADFGX密表加密算法
Option Explicit

Dim seq(4) As Integer, j, k
Dim a(1 To 5, 1 To 5), b(1 To 5) As String

Private Sub Command1_Click()
Rem 替代加密

Dim Str1 As String, Str2 As String, ch As String
Dim strlen As Integer, i As Integer

b(1) = "A": b(2) = "D": b(3) = "F": b(4) = "G": b(5) = "X"

a(1, 1) = "n": a(1, 2) = "b": a(1, 3) = "x": a(1, 4) = "r": a(1, 5) = "u"
a(2, 1) = "q": a(2, 2) = "o": a(2, 3) = "k": a(2, 4) = "d": a(2, 5) = "v"
a(3, 1) = "a": a(3, 2) = "h": a(3, 3) = "s": a(3, 4) = "g": a(3, 5) = "f"
a(4, 1) = "m": a(4, 2) = "z": a(4, 3) = "c": a(4, 4) = "l": a(4, 5) = "t"
a(5, 1) = "e": a(5, 2) = "i": a(5, 3) = "p": a(5, 4) = "j": a(5, 5) = "w"
Str1 = Trim(Text1.Text)
Rem 将输入文本框的字符串的前后空格去掉后赋值给Str1

strlen = Len(Str1)
Rem 求字符串的长度

i = 1
Do While i <= strlen

ch = Mid(Str1, i, 1)

   If Asc(ch) = 32 Or Asc(ch) = 13 Then
   i = i + 1
   Rem 如果该字符为空格或回车，则考虑下一个字符

   ElseIf ch >= "a" And ch <= "z" And ch <> "y" Then
     For j = 1 To 5
       For k = 1 To 5
        If ch = a(j, k) Then
        ch = b(j) & b(k)
        End If
       Next k
     Next j
   Str2 = Str2 & ch
   i = i + 1
   Rem 该字符合法，则按规则进行替换，若该字符与a(j,k)相等，则用字符对b(j)b(k)替换
   Else
   MsgBox "你输入了非法字符，请重新输入！" & Chr(13) & "注意：输入字符的范围为26个小写英文字符且不含'y'！", vbOKOnly, "警告"
   Exit Do

   End If

Loop

Text2.Text = Str2

End Sub

Private Sub Command2_Click()
Rem 置换加密

Dim Str1(49, 4) As String, Str2 As String, Str3 As String, method As String, b(4) As String
Dim strlen As Integer, i, row, col As Integer, rowmax, flag As Integer

flag = 1
method = InputBox("请输入1——5的数字乱序作为置换密码的规则，即输入一个1——5的排列：", "输入规则", "12345")
i = 0
Do While i < 5
b(i) = Mid(method, i + 1, 1)
seq(i) = Val(b(i))
If seq(i) < 1 Or seq(i) > 5 Then
flag = 0
End If
i = i + 1
Loop
 
If flag = 0 Then
MsgBox "你输入的乱序规则不合要求，请重新选择'置换加密'！" & Chr(13) & "注意：规则应是1——5的一个排列！", vbOKOnly, "警告"
Rem 判断输入的规则是否合理，即输入的应是1——5的一个排列
  
Else
Str2 = Text2.Text
i = 0
 Do While i <= Len(Str2)
 row = i \ 5: rowmax = row
 col = i Mod 5: col = seq(col) - 1
 Rem imod5后得到的列数应变换为实际的列，它们的变换关系为col=seq(col)-1
 Str1(row, col) = Mid(Str2, i + 1, 1)
 i = i + 1
 Loop
 Rem 将替换解密后得到的字符串依次存入一个n*5的数组Str1(49,4)
 
 For col = 0 To 4
   For row = 0 To rowmax
     If Str1(row, col) <> "" Then
     Str3 = Str3 & Str1(row, col)
     End If
   
   Next row
 Next col
 Rem 将数组Str1(49,4)按实际的列序排列存入字符串Str3
 
 Text2.Text = Str3

End If

End Sub

Private Sub Command3_Click()
Rem 解密

Text1.BackColor = &H8000000F
Dim Str1 As String, Str2 As String, Str3, Astr(1 To 50, 1 To 5), ch As String
Dim strlen, i, chx, row, rowmax, rowc(1 To 5), col, p, flag(1 To 5) As Integer

Str2 = Trim(Text2.Text)
strlen = Len(Str2)
p = strlen Mod 5

  For i = 1 To p
  flag(i) = 1
  Next i
 
  Rem 若余数为p，则这p列的最大行数比另外5-p的行数大1,这几列的标志位为1
  rowmax = strlen \ 5
  For i = 1 To 5
  rowc(seq(i - 1)) = rowmax + flag(i)
  Next i
  Rem 每一列的行数为rowc(col),乱序列转换为实际列：col=seq(col-1)

  i = 1
     For col = 1 To 5
        For row = 1 To rowc(col)
        Astr(row, col) = Mid(Str2, i, 1)
        i = i + 1
        Next row
     Next col
     Rem 将密文字符串按列序存入数组
  
  For row = 1 To strlen \ 5 + 1
     For col = 1 To 5
       If Astr(row, seq(col - 1)) <> "" Then
       Str1 = Str1 & Astr(row, seq(col - 1))
       End If
     Next col
  Next row
  Rem 乱序排列后，按行序赋值给Str1
  
  i = 1
  Do While i <= Len(Str1)
     For j = 1 To 5
       If b(j) = Mid(Str1, i, 1) Then
       row = j
       End If
     Next j
    
     i = i + 1
     For k = 1 To 5
       If b(k) = Mid(Str1, i, 1) Then
       col = k
       End If
     Next k
     i = i + 1
   Rem 查ADFGX密表，找出每两个密文字符对应的明文
   Str3 = Str3 & a(row, col)
    Loop
  Text1.Text = Str3
End Sub

Private Sub Command4_Click()
Text1.Text = ""

End Sub

Private Sub Command5_Click()
Text1.Text = ""
Text2.Text = ""
Text1.BackColor = &H80000005

End Sub

Private Sub Command6_Click()
End

End Sub