花了点时间写了一个凯撒算法的实现[人懒,不做中文的移位算法咯,其实可以演变出来十几种其他的算法,只要设置私匙以及字码位就可以了]

动态创建控件,你只需要把代码复制到一个窗体中就可以了。

Option Explicit

Dim WithEvents txtInput As VB.TextBox

Dim WithEvents txtOutput As VB.TextBox

Dim WithEvents txtNums As VB.TextBox

Dim WithEvents cmdGen As VB.CommandButton

Dim intLetterL(97 To 122) As Integer

Dim intLetterU(65 To 90) As Integer

Dim lngIndex As Long

Private Sub Form_Load()

With Me
.Caption = "凯撒加密算法 示例 by 苏洋"
.Width = 4800
.Height = 3600

End With

Me.Show

Set txtInput = Controls.Add("VB.TextBox", "txtInput", Me)

With txtInput

.Top = 500
.Left = 500
.Height = 500
.Width = Me.Width - 1000

.Visible = True
End With

Set txtOutput = Controls.Add("VB.TextBox", "txtOutput", Me)

With txtOutput

.Top = 1500
.Left = 500
.Height = 500
.Width = Me.Width - 1000

.Visible = True
End With

Set txtNums = Controls.Add("VB.TextBox", "txtNums", Me)

With txtNums

.Top = 2500
.Left = 500
.Height = 300
.Width = 500
.Text = 3
.Visible = True
End With

Set cmdGen = Controls.Add("VB.CommandButton", "cmdGen", Me)

With cmdGen
.Top = 2500
.Left = 1200
.Width = 3300
.Height = 300
.Caption = "在左边输入要偏移的量,然后点击按钮"
.Visible = True
End With

Call cmdGen_Click

End Sub

Private Sub cmdGen_Click()
Call IntArry
Call EncodeLetterU
Call EncodeLetterL
End Sub

Private Sub IntArry()

For lngIndex = 65 To 90

intLetterU(lngIndex) = lngIndex

Next

For lngIndex = 97 To 122

intLetterL(lngIndex) = lngIndex

Next

End Sub

Private Sub EncodeLetterU(Optional MoveL As Boolean = True)

Dim lngTmp As Long

Select Case MoveL

Case True

For lngIndex = 65 To 90
lngTmp = lngIndex + Val(txtNums.Text)

If lngTmp > 90 Then
'- 90 + 65
intLetterU(lngIndex) = lngTmp - 25
Else

intLetterU(lngIndex) = lngTmp

End If

Next

Case False

For lngIndex = 65 To 90
lngTmp = lngIndex - Val(txtNums.Text)

If lngTmp < 65 Then
'90-65-lngtmp
intLetterU(lngIndex) = 25 - lngTmp
Else

intLetterU(lngIndex) = lngTmp

End If

Next

End Select

End Sub

Private Sub EncodeLetterL(Optional MoveL As Boolean = True)

Dim lngTmp As Long

Select Case MoveL

Case True

For lngIndex = 97 To 122
lngTmp = lngIndex + Val(txtNums.Text)

If lngTmp > 122 Then
'- 122 + 97
intLetterL(lngIndex) = lngTmp - 25
Else

intLetterL(lngIndex) = lngTmp

End If

Next

Case False

For lngIndex = 97 To 122
lngTmp = lngIndex - Val(txtNums.Text)

If lngTmp < 97 Then
'122-97-lngtmp
intLetterL(lngIndex) = 25 - lngTmp
Else

intLetterL(lngIndex) = lngTmp

End If

Next

End Select

End Sub

Private Sub txtInput_KeyDown(KeyCode As Integer, Shift As Integer)

txtOutput = txtInput

End Sub

Private Sub txtInput_Change()

txtOutput = ""

Dim lngTmp As Long, lngLen As Long, intCodes As Integer, strTmp As String

lngLen = Len(txtInput)

For lngTmp = 1 To lngLen

strTmp = Mid$(txtInput, lngTmp, 1)
intCodes = Asc(strTmp)

Select Case intCodes

Case 65 To 90
txtOutput = txtOutput & Chr(intLetterU(intCodes))

Case 97 To 122
txtOutput = txtOutput & Chr(intLetterL(intCodes))
End Select

Next

End Sub

Private Sub txtInput_KeyPress(KeyAscii As Integer)

If Not Chr(KeyAscii) Like "[a-zA-Z]" Then KeyAscii = 0

End Sub
恺撒加密算法

“恺撒密码”相传是古罗马恺撒大帝用来保护重要军情的加密手段。
它主要是一种使用字符替换的加密算法,通过将字母顺序依次推后数位[原始是3位],混淆原始密文来起到加密的作用。

原始信息如下:
RETURN TO ROME
密文信息如下“
UHWXUA WR URPH 

这样无法从字面上直接看出信息的内容了。
这种加密方法还可以依据移位的不同产生新的变化,将每个字母左19位,就产生这样一个明密对照表:

明:A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
密:T U V W X Y Z A B C D E F G H I J K L M N O P Q R S

在这个加密表下,明文与密文的对照关系就变成:

明文:THE FAULT, DEAR BRUTUS, LIES NOT IN OUR STARS BUT IN OURSELVES.
密文:MAX YTNEM, WXTK UKNMNL, EBXL GHM BG HNK LMTKL UNM BG HNKLXEOXL.