我的东西你不知——用VB打造个人版恺撒密码转换器

Krz duh brx ?
  看了这一段英文，是不是觉得有点摸不着头脑？这段英文的原文是How are you ?，只不过被我加密了，而我加密的算法则是著名的恺撒(Caesar)密码。现在，我们就一起来学习使用VB打造一个个人版的恺撒密码^_^

   知己知彼
  首先我们要来了解一下恺撒密码：
公元前60年(大约两千年前)，古罗马统帅“朱利叶斯·凯撒”(Caesar),第一个用当时发明的“凯撒密码”书写军事文书，用于战时通信。后来他成了古罗马帝王,就是“凯撒”(Caesar)大帝。
凯撒加密法简而言之，就是字母替换加密，消息中每一个字母换成向后三个字母的字母的。大家请看下表

QUOTE:
原文：abcdefghijklmnopqrstuvwxyz  或者  ABCDEFGHIJKLMNOPQRSTUVWXYZ
密文：defghijklmnopqrstuvwxyzabc  或者  DEFGHIJKLMNOPQRSTUVWXYZABC

设计算法
  了解了恺撒密码之后，我们要设计算法。请看流程图


图片附件: [流程图] SpxImage1.jpg (2007-1-13 19:18, 127.74 K)


  大家可以看到，我们这里首先需要定义一个字母表，然后使用Len获取长度，接着使用For遍历要转换的每一个字符，最后使用在将获取字符在字母表内查找，并用IF判断是否是英文字母，如果是，则进行相关转换，如果不是，则不执行任何操作。

   代码编写
  确定算法之后，我们可以开始编写代码

[Copy to clipboard]
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  '//容错处理

或许有人对 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"

[Copy to clipboard]
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  '//容错处理

如此这般，加密和解密的功能都解决了。至于其他的大家可以自己编写。我的全部代码如下：

[Copy to clipboard]
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下调试成功。

最后的程序效果入图


图片附件: [效果图] Ceasar.png (2007-1-13 19:18, 27.42 K)


大家可以从后文给出的链接下载文件


附件: [程序] 恺撒密码转换器.rar (2007-1-13 19:18, 8.12 K)
该附件被下载次数 7

PS：由于时代发展的原因，凯萨密码的加密性已经大大降低，所以不宜在重要密码中使用此密码。对于其他的人有更好的方法，本人洗耳恭听！