用VB打造個人版愷撒密碼轉換器

我的東西你不知——用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：由於時代發展的原因，凱薩密碼的加密性已經大大降低，所以不宜在重要密碼中使用此密碼。對於其他的人有更好的方法，本人洗耳恭聽！