我的东西你不知——用VB打造个人版恺撒密码转换器Krz duh brx ?
看了这一段英文，是不是觉得有点摸不着头脑？这段英文的原文是How are you ?，只不过被我加密了，而我加密的算法则是著名的恺撒(Caesar)密码。现在，我们就一起来学习使用VB打造一个个人版的恺撒密码^_^
知己知彼
首先我们要来了解一下恺撒密码：
公元前60年(大约两千年前)，古罗马统帅“朱利叶斯·凯撒”(Caesar),第一个用当时发明的“凯撒密码”书写军事文书，用于战时通信。后来他成了古罗马帝王,就是“凯撒”(Caesar)大帝。
凯撒加密法简而言之，就是字母替换加密，消息中每一个字母换成向后三个字母的字母的。大家请看下表
设计算法
了解了恺撒密码之后，我们要设计算法。请看流程图
![]()
图片附件: [流程图] SpxImage1.jpg (2007-1-13 19:18, 127.74 K)
![]()
大家可以看到，我们这里首先需要定义一个字母表，然后使用Len获取长度，接着使用For遍历要转换的每一个字符，最后使用在将获取字符在字母表内查找，并用IF判断是否是英文字母，如果是，则进行相关转换，如果不是，则不执行任何操作。
代码编写
确定算法之后，我们可以开始编写代码
或许有人对strPasswordOne = "abcdefghijklmnopqrstuvwxyzabcABCDEFGHIJKLMNOPQRSTUVWXYZABC"这段代码感到疑惑，为什么xyz和XYZ之后又有abc和ABC。其实我们想想看，如果要加密的字母是xzy或者XYZ，那凯撒密文就是abc和ABC，这样，又必须想方设法转到开头，而后面的abc和ABC则很好的绕过了这个问题。况且Instr函数指挥查找相应字符第一次出现的位置。或许你还会发现，小写字母在大写的前面，这是因为一般英文文章小写字母居多，所以放在前面。
还有Mid$(strEncrypt, lngTime, 1) = Mid$(strPasswordOne, bytMove + 3, 1) '//////////填充转换后的数据这段，前面的Mid和后面的Mid是完全不同的两种作用。前者是函数，作用是查找文字，后者是语句，用于填充原来的数据。（更详细请看MSDN）
至于有些字符串函数后面添加$，这是为了增加处理速度，后面的$表示不对数据进行检查，而且操作数据越多，表现越明显。
而后面的出错设计则是为了防止恶意输入^_^
然后我们在编写解密代码。或许你会认为解密和加密除了字母后移之外一模一样的话，那么恭喜你，你错了...-_-!
如果你用Instr函数在加密的字母表内查找的话，会出现一个问题，如果密文是abc的话，原文是xyz，但是如果你往左移三行，发现移不下去了，或许你会想在abc前面加xyz，但是别忘了，Instr函数查找的时字符第一次出现的位置，如果查到xyz的话，又是死路...
不过，幸运的时，VB6为我们提供了一个解决这个问题的函数——InstrRev。该函数与Instr函数类似，只是从字符串末尾开始查找。所以，我们只要将字符如此定义即可：
strPasswordTow = "XYZABCDEFGHIJKLMNOPQRSTUVWXYZxyzabcdefghijklmnopqrstuvwxyz"
如此这般，加密和解密的功能都解决了。至于其他的大家可以自己编写。我的全部代码如下：
最后的程序效果入图
![]()
图片附件: [效果图] Ceasar.png (2007-1-13 19:18, 27.42 K)
![]()
大家可以从后文给出的链接下载文件
![]()
附件: [程序] 恺撒密码转换器.rar (2007-1-13 19:18, 8.12 K)
该附件被下载次数 7
PS：由于时代发展的原因，凯萨密码的加密性已经大大降低，所以不宜在重要密码中使用此密码。对于其他的人有更好的方法，本人洗耳恭听！
看了这一段英文，是不是觉得有点摸不着头脑？这段英文的原文是How are you ?，只不过被我加密了，而我加密的算法则是著名的恺撒(Caesar)密码。现在，我们就一起来学习使用VB打造一个个人版的恺撒密码^_^
知己知彼
首先我们要来了解一下恺撒密码：
公元前60年(大约两千年前)，古罗马统帅“朱利叶斯·凯撒”(Caesar),第一个用当时发明的“凯撒密码”书写军事文书，用于战时通信。后来他成了古罗马帝王,就是“凯撒”(Caesar)大帝。
凯撒加密法简而言之，就是字母替换加密，消息中每一个字母换成向后三个字母的字母的。大家请看下表
QUOTE:
原文：abcdefghijklmnopqrstuvwxyz 或者 ABCDEFGHIJKLMNOPQRSTUVWXYZ
密文：defghijklmnopqrstuvwxyzabc 或者 DEFGHIJKLMNOPQRSTUVWXYZABC
密文：defghijklmnopqrstuvwxyzabc 或者 DEFGHIJKLMNOPQRSTUVWXYZABC
设计算法
了解了恺撒密码之后，我们要设计算法。请看流程图
图片附件: [流程图] SpxImage1.jpg (2007-1-13 19:18, 127.74 K)
大家可以看到，我们这里首先需要定义一个字母表，然后使用Len获取长度，接着使用For遍历要转换的每一个字符，最后使用在将获取字符在字母表内查找，并用IF判断是否是英文字母，如果是，则进行相关转换，如果不是，则不执行任何操作。
代码编写
确定算法之后，我们可以开始编写代码
CODE:
加密的代码：
If Len(txtBefore.Text) = 0 Then
MsgBox "请输入要加密的原文!", vbExclamation
End If
On Error GoTo Fal
Dim strPasswordOne As String, strEncrypt As String, lngEncrypt As Long, lngTime As Long, strOne As String, bytMove As Byte
strPasswordOne = "abcdefghijklmnopqrstuvwxyzabcABCDEFGHIJKLMNOPQRSTUVWXYZABC"
strEncrypt = txtBefore.Text '//////////获取文本
lngEncrypt = Len(strEncrypt) '//////////获取要转换的字符个数
For lngTime = 1 To lngEncrypt '//////////使用For遍历读取每一个字符，合法的转换，不合法的保留
strOne = Mid$(strEncrypt, lngTime, 1): bytMove = InStr(1, strPasswordOne, strOne, vbBinaryCompare) '//////////查找字母的位置
If bytMove <> 0 Then
Mid$(strEncrypt, lngTime, 1) = Mid$(strPasswordOne, bytMove + 3, 1) '//////////填充转换后的数据
End If
Next
txtAfter.Text = strEncrypt '//////////显示
Exit Sub
Fal:
MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation '//////////容错处理
If Len(txtBefore.Text) = 0 Then
MsgBox "请输入要加密的原文!", vbExclamation
End If
On Error GoTo Fal
Dim strPasswordOne As String, strEncrypt As String, lngEncrypt As Long, lngTime As Long, strOne As String, bytMove As Byte
strPasswordOne = "abcdefghijklmnopqrstuvwxyzabcABCDEFGHIJKLMNOPQRSTUVWXYZABC"
strEncrypt = txtBefore.Text '//////////获取文本
lngEncrypt = Len(strEncrypt) '//////////获取要转换的字符个数
For lngTime = 1 To lngEncrypt '//////////使用For遍历读取每一个字符，合法的转换，不合法的保留
strOne = Mid$(strEncrypt, lngTime, 1): bytMove = InStr(1, strPasswordOne, strOne, vbBinaryCompare) '//////////查找字母的位置
If bytMove <> 0 Then
Mid$(strEncrypt, lngTime, 1) = Mid$(strPasswordOne, bytMove + 3, 1) '//////////填充转换后的数据
End If
Next
txtAfter.Text = strEncrypt '//////////显示
Exit Sub
Fal:
MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation '//////////容错处理
或许有人对strPasswordOne = "abcdefghijklmnopqrstuvwxyzabcABCDEFGHIJKLMNOPQRSTUVWXYZABC"这段代码感到疑惑，为什么xyz和XYZ之后又有abc和ABC。其实我们想想看，如果要加密的字母是xzy或者XYZ，那凯撒密文就是abc和ABC，这样，又必须想方设法转到开头，而后面的abc和ABC则很好的绕过了这个问题。况且Instr函数指挥查找相应字符第一次出现的位置。或许你还会发现，小写字母在大写的前面，这是因为一般英文文章小写字母居多，所以放在前面。
还有Mid$(strEncrypt, lngTime, 1) = Mid$(strPasswordOne, bytMove + 3, 1) '//////////填充转换后的数据这段，前面的Mid和后面的Mid是完全不同的两种作用。前者是函数，作用是查找文字，后者是语句，用于填充原来的数据。（更详细请看MSDN）
至于有些字符串函数后面添加$，这是为了增加处理速度，后面的$表示不对数据进行检查，而且操作数据越多，表现越明显。
而后面的出错设计则是为了防止恶意输入^_^
然后我们在编写解密代码。或许你会认为解密和加密除了字母后移之外一模一样的话，那么恭喜你，你错了...-_-!
如果你用Instr函数在加密的字母表内查找的话，会出现一个问题，如果密文是abc的话，原文是xyz，但是如果你往左移三行，发现移不下去了，或许你会想在abc前面加xyz，但是别忘了，Instr函数查找的时字符第一次出现的位置，如果查到xyz的话，又是死路...
不过，幸运的时，VB6为我们提供了一个解决这个问题的函数——InstrRev。该函数与Instr函数类似，只是从字符串末尾开始查找。所以，我们只要将字符如此定义即可：
strPasswordTow = "XYZABCDEFGHIJKLMNOPQRSTUVWXYZxyzabcdefghijklmnopqrstuvwxyz"
CODE:
If Len(txtAfter.Text) = 0 Then
MsgBox "请输入要解密的密文!", vbExclamation
End If
On Error GoTo Fal
Dim strPasswordTow As String, strDecrypt As String, lngDecrypt As Long, lngTime As Long, strOne As String, bytMove As Byte
strPasswordTow = "XYZABCDEFGHIJKLMNOPQRSTUVWXYZxyzabcdefghijklmnopqrstuvwxyz"
strDecrypt = txtBefore.Text '//////////获取文本
lngDecrypt = Len(strDecrypt) '//////////获取要转换的字符个数
For lngTime = 1 To lngDecrypt '//////////使用For遍历读取每一个字符，合法的转换，不合法的保留
strOne = Mid$(strDecrypt, lngTime, 1): bytMove = InStrRev(strPasswordTow, strOne, 58, vbBinaryCompare) '//////////查找字母的位置
If bytMove <> 0 Then
Mid$(strDecrypt, lngTime, 1) = Mid$(strPasswordTow, bytMove - 3, 1) '//////////填充转换后的数据
End If
Next
txtAfter.Text = strDecrypt '//////////显示
Exit Sub
Fal:
MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation '//////////容错处理
MsgBox "请输入要解密的密文!", vbExclamation
End If
On Error GoTo Fal
Dim strPasswordTow As String, strDecrypt As String, lngDecrypt As Long, lngTime As Long, strOne As String, bytMove As Byte
strPasswordTow = "XYZABCDEFGHIJKLMNOPQRSTUVWXYZxyzabcdefghijklmnopqrstuvwxyz"
strDecrypt = txtBefore.Text '//////////获取文本
lngDecrypt = Len(strDecrypt) '//////////获取要转换的字符个数
For lngTime = 1 To lngDecrypt '//////////使用For遍历读取每一个字符，合法的转换，不合法的保留
strOne = Mid$(strDecrypt, lngTime, 1): bytMove = InStrRev(strPasswordTow, strOne, 58, vbBinaryCompare) '//////////查找字母的位置
If bytMove <> 0 Then
Mid$(strDecrypt, lngTime, 1) = Mid$(strPasswordTow, bytMove - 3, 1) '//////////填充转换后的数据
End If
Next
txtAfter.Text = strDecrypt '//////////显示
Exit Sub
Fal:
MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation '//////////容错处理
如此这般，加密和解密的功能都解决了。至于其他的大家可以自己编写。我的全部代码如下：
CODE:
Option Explicit
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Sub cmdAbout_Click()
Load frmAbout
frmAbout.Show 1
End Sub
Private Sub cmdClear_Click()
If MsgBox("此操作会清理掉所有文本,确定要执行吗?", vbQuestion + vbYesNo) = vbYes Then
txtBefore.Text = "": txtAfter.Text = ""
End If
End Sub
Private Sub cmdDecrypt_Click()
If Len(txtAfter.Text) = 0 Then
MsgBox "请输入要解密的密文!", vbExclamation
End If
On Error GoTo Fal
Dim strPasswordTow As String, strDecrypt As String, lngDecrypt As Long, lngTime As Long, strOne As String, bytMove As Byte
strPasswordTow = "XYZABCDEFGHIJKLMNOPQRSTUVWXYZxyzabcdefghijklmnopqrstuvwxyz"
strDecrypt = txtBefore.Text '//////////获取文本
lngDecrypt = Len(strDecrypt) '//////////获取要转换的字符个数
For lngTime = 1 To lngDecrypt '//////////使用For遍历读取每一个字符，合法的转换，不合法的保留
strOne = Mid$(strDecrypt, lngTime, 1): bytMove = InStrRev(strPasswordTow, strOne, 58, vbBinaryCompare) '//////////查找字母的位置
If bytMove <> 0 Then
Mid$(strDecrypt, lngTime, 1) = Mid$(strPasswordTow, bytMove - 3, 1) '//////////填充转换后的数据
End If
Next
txtAfter.Text = strDecrypt '//////////显示
Exit Sub
Fal:
MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation '//////////容错处理
End Sub
Private Sub Form_Initialize()
InitCommonControls
End Sub
Private Sub cmdEncrypt_Click()
If Len(txtBefore.Text) = 0 Then
MsgBox "请输入要加密的原文!", vbExclamation
End If
On Error GoTo Fal
Dim strPasswordOne As String, strEncrypt As String, lngEncrypt As Long, lngTime As Long, strOne As String, bytMove As Byte
strPasswordOne = "abcdefghijklmnopqrstuvwxyzabcABCDEFGHIJKLMNOPQRSTUVWXYZABC"
strEncrypt = txtBefore.Text '//////////获取文本
lngEncrypt = Len(strEncrypt) '//////////获取要转换的字符个数
For lngTime = 1 To lngEncrypt '//////////使用For遍历读取每一个字符，合法的转换，不合法的保留
strOne = Mid$(strEncrypt, lngTime, 1): bytMove = InStr(1, strPasswordOne, strOne, vbBinaryCompare) '//////////查找字母的位置
If bytMove <> 0 Then
Mid$(strEncrypt, lngTime, 1) = Mid$(strPasswordOne, bytMove + 3, 1) '//////////填充转换后的数据
End If
Next
txtAfter.Text = strEncrypt '//////////显示
Exit Sub
Fal:
MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation '//////////容错处理
End Sub
以上代码在XpSP2+VB6下调试成功。
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Sub cmdAbout_Click()
Load frmAbout
frmAbout.Show 1
End Sub
Private Sub cmdClear_Click()
If MsgBox("此操作会清理掉所有文本,确定要执行吗?", vbQuestion + vbYesNo) = vbYes Then
txtBefore.Text = "": txtAfter.Text = ""
End If
End Sub
Private Sub cmdDecrypt_Click()
If Len(txtAfter.Text) = 0 Then
MsgBox "请输入要解密的密文!", vbExclamation
End If
On Error GoTo Fal
Dim strPasswordTow As String, strDecrypt As String, lngDecrypt As Long, lngTime As Long, strOne As String, bytMove As Byte
strPasswordTow = "XYZABCDEFGHIJKLMNOPQRSTUVWXYZxyzabcdefghijklmnopqrstuvwxyz"
strDecrypt = txtBefore.Text '//////////获取文本
lngDecrypt = Len(strDecrypt) '//////////获取要转换的字符个数
For lngTime = 1 To lngDecrypt '//////////使用For遍历读取每一个字符，合法的转换，不合法的保留
strOne = Mid$(strDecrypt, lngTime, 1): bytMove = InStrRev(strPasswordTow, strOne, 58, vbBinaryCompare) '//////////查找字母的位置
If bytMove <> 0 Then
Mid$(strDecrypt, lngTime, 1) = Mid$(strPasswordTow, bytMove - 3, 1) '//////////填充转换后的数据
End If
Next
txtAfter.Text = strDecrypt '//////////显示
Exit Sub
Fal:
MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation '//////////容错处理
End Sub
Private Sub Form_Initialize()
InitCommonControls
End Sub
Private Sub cmdEncrypt_Click()
If Len(txtBefore.Text) = 0 Then
MsgBox "请输入要加密的原文!", vbExclamation
End If
On Error GoTo Fal
Dim strPasswordOne As String, strEncrypt As String, lngEncrypt As Long, lngTime As Long, strOne As String, bytMove As Byte
strPasswordOne = "abcdefghijklmnopqrstuvwxyzabcABCDEFGHIJKLMNOPQRSTUVWXYZABC"
strEncrypt = txtBefore.Text '//////////获取文本
lngEncrypt = Len(strEncrypt) '//////////获取要转换的字符个数
For lngTime = 1 To lngEncrypt '//////////使用For遍历读取每一个字符，合法的转换，不合法的保留
strOne = Mid$(strEncrypt, lngTime, 1): bytMove = InStr(1, strPasswordOne, strOne, vbBinaryCompare) '//////////查找字母的位置
If bytMove <> 0 Then
Mid$(strEncrypt, lngTime, 1) = Mid$(strPasswordOne, bytMove + 3, 1) '//////////填充转换后的数据
End If
Next
txtAfter.Text = strEncrypt '//////////显示
Exit Sub
Fal:
MsgBox "密码转换出错,请检查所输入的数据!", vbExclamation '//////////容错处理
End Sub
以上代码在XpSP2+VB6下调试成功。
最后的程序效果入图
图片附件: [效果图] Ceasar.png (2007-1-13 19:18, 27.42 K)
大家可以从后文给出的链接下载文件
附件: [程序] 恺撒密码转换器.rar (2007-1-13 19:18, 8.12 K)该附件被下载次数 7
PS：由于时代发展的原因，凯萨密码的加密性已经大大降低，所以不宜在重要密码中使用此密码。对于其他的人有更好的方法，本人洗耳恭听！