b.frm

加密解密之退一进三算法

VERSION 5.00
Begin VB.Form B 
   Caption         =   "加密算法B"
   ClientHeight    =   7050
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7260
   LinkTopic       =   "Form1"
   ScaleHeight     =   7050
   ScaleWidth      =   7260
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox Text3 
      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            =   2400
      TabIndex        =   10
      Top             =   2400
      Width           =   735
   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          =   495
      Left            =   5760
      TabIndex        =   8
      Top             =   6120
      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            =   5760
      TabIndex        =   7
      Top             =   720
      Width           =   1335
   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          =   495
      Left            =   5760
      TabIndex        =   6
      Top             =   5160
      Width           =   1335
   End
   Begin VB.TextBox Text2 
      BackColor       =   &H8000000F&
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   1455
      Left            =   360
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   5
      Top             =   5160
      Width           =   5175
   End
   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            =   5760
      TabIndex        =   3
      Top             =   1560
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "加密"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3360
      TabIndex        =   2
      Top             =   2400
      Width           =   1335
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1455
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   720
      Width           =   5055
   End
   Begin VB.Label Label4 
      Caption         =   "1、变换一：定长加密     2、变换二：首字符触发加密  3、变换三：任意点触发加密"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   480
      TabIndex        =   11
      Top             =   3120
      Width           =   3135
   End
   Begin VB.Label Label3 
      Caption         =   "请选择加密方法："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   480
      TabIndex        =   9
      Top             =   2520
      Width           =   2055
   End
   Begin VB.Line Line1 
      BorderWidth     =   2
      X1              =   360
      X2              =   7080
      Y1              =   4320
      Y2              =   4320
   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             =   4560
      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            =   480
      TabIndex        =   0
      Top             =   240
      Width           =   1575
   End
End
Attribute VB_Name = "B"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Rem 加密算法B，退一进三算法

Option Explicit
Dim method(1 To 3) As Integer, trigger
Function change(j As Integer, strlen As Integer) As Integer
Rem 识别j的正确位置，若j=0，则j是第strlen个数，否则，是第j个数
If j Mod strlen = 0 Then
  change = strlen
Else
  change = j
End If
End Function
Function TYJS(i As Integer, j As Integer, strlen As Integer, Str1 As String, Str2 As String, ch As String)
Rem 实现退一进三操作的函数，开始位置为j，在此位置退一，再进三，再退一，再进三
Do While i < strlen
   If i < strlen Then
     j = (strlen + j - 1) Mod strlen
     ch = Mid(Str1, change(j, strlen), 1)
     Str2 = Str2 & ch
     i = i + 1
   End If
   If i < strlen Then
     j = (j + 3) Mod strlen
     ch = Mid(Str1, change(j, strlen), 1)
     Str2 = Str2 & ch
      i = i + 1
   End If
Loop
End Function

Function FTYJS(i As Integer, j As Integer, strlen As Integer, Str1 As String, Str2 As String, Astr() As String)
Rem 退一进三逆操作函数，i是该字符在str2中的位置，它在明文中的位置应为j，将第i个字符往插入第j个位置
Do While i < strlen
   If i < strlen Then
     i = i + 1
     j = (strlen + j - 1) Mod strlen
     Astr(change(j, strlen)) = Mid(Str2, i, 1)
   End If
   If i < strlen Then
     i = i + 1
     j = (j + 3) Mod strlen
     Astr(change(j, strlen)) = Mid(Str2, i, 1)
   End If
Loop
For i = 1 To strlen
Str1 = Str1 & Astr(i)
Next i
Rem 再按顺序赋值给str1
End Function


Private Sub Command1_Click()
Dim Str1 As String, Str2 As String, ch As String
Dim strlen As Integer, i As Integer, j As Integer, flag

Str1 = Trim(Text1.Text)
Rem 将输入文本框的字符串的前后空格去掉后赋值给Str1

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

If strlen Mod 2 <> 0 Then
     MsgBox "你输入的明文不满足要求，加密后的密文可能无法正确解密！" & Chr(13) & "注意：明文应为偶数个英文字符的一个排列！", vbOKOnly, "警告"
End If


flag = Val(Text3.Text)
For i = 1 To 3
   method(i) = 0
   If flag = i Then
   method(i) = 1
   End If
Next i

If method(1) = 1 Then
Rem 选择定长加密
   
For i = 1 To strlen
  If i Mod 2 = 0 Then
    j = (i + 3) Mod strlen
    Rem 第偶数个字符作"进三"变换
   Else
    j = (strlen + i - 1) Mod strlen
    Rem 第奇数个字符作"退一"变换
   End If
   ch = Mid(Str1, change(j, strlen), 1)
   Rem 函数change()能正确识别j的位置
   Str2 = Str2 & ch
Next i

     
ElseIf method(2) = 1 Then
Rem 选择首字符加密
Str2 = Mid(Str1, 1, 1)
i = 1
j = i
Call TYJS(i, j, strlen, Str1, Str2, ch)
Rem 调用退一进三操作的函数TYJS（）
   
   
ElseIf method(3) = 1 Then
Rem 选择任意点作为触发点加密
j = 0
Do While j = 0
ch = InputBox("请选择明文中某一字符作为触发点：", "输入触发点", "a")
  If ch <> "" Then
    For i = 1 To strlen
      If ch = Mid(Str1, i, 1) Then
      j = i
      Rem 确定触发点的位置
      trigger = j
      Rem 在此处把触发点的位置记录下来,以便解密时可直接使用
      End If
    Next i
  Else
  Exit Do
  Rem 若触发点不合要求，则需重新输入
  End If
Loop

If j <> 0 Then
Str2 = Mid(Str1, j, 1)
i = 1
Call TYJS(i, j, strlen, Str1, Str2, ch)
Rem 调用退一进三操作的函数TYJS（）
End If

Else
MsgBox "请选择加密方法", vbOKOnly, "提示"
End If

Text2.Text = Str2
End Sub

Private Sub Command2_Click()

End
End Sub

Private Sub Command3_Click()
Text1.BackColor = &H8000000F
Dim Str1 As String, Str2 As String, ch As String, Astr() As String
Dim strlen As Integer, i As Integer, j As Integer
Str2 = Trim(Text2.Text)
strlen = Len(Str2)
ReDim Astr(1 To strlen)

If method(1) = 1 Then
  For i = 1 To strlen
     If i Mod 2 = 0 Then
     j = (i + 1) Mod strlen
     Rem 第偶数个字符作“进一”替换
     Else
     j = (strlen + i - 3) Mod strlen
     Rem 第奇数个字符作“退三”替换
     End If
     
     ch = Mid(Str2, change(j, strlen), 1)
     Str1 = Str1 & ch
   Next i

ElseIf method(2) = 1 Then
Astr(1) = Mid(Str2, 1, 1)
i = 1: j = i
Call FTYJS(i, j, strlen, Str1, Str2, Astr)
Rem 调用退一进三的逆操作函数FTYJS

ElseIf method(3) = 1 Then
j = trigger
Astr(j) = Mid(Str2, 1, 1)
i = 1
Call FTYJS(i, j, strlen, Str1, Str2, Astr)
Rem 调用退一进三的逆操作函数FTYJS

End If
Text1.Text = Str1
End Sub

Private Sub Command4_Click()
Text1.Text = ""

End Sub

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

End Sub