VB 加密与解密的程序代码

加密：

Private Function JiaMi(ByVal varPass As String) As String '参数varPass是需要加密的文本内容

Dim varJiaMi As String * 20

Dim varTmp As Double

Dim strJiaMi As String

Dim I

For I = 1 To Len(varPass)

varTmp = AscW(Mid$(varPass, I, 1))

varJiaMi = Str$(((((varTmp * 1.5) / 5.6) * 2.7) * I))

strJiaMi = strJiaMi &varJiaMi

Next I

JiaMi = strJiaMi

End Function

解密函数：

Private Function JieMi(ByVal varPass As String) As String '参数varPass是需要解密的密文内容

Dim varReturn As String * 20

Dim varConvert As Double

Dim varFinalPass As String

Dim varKey As Integer

Dim varPasslenth As Long

varPasslenth = Len(varPass)

For I = 1 To varPasslenth / 20

varReturn = Mid(varPass, (I - 1) * 20 + 1, 20)

varConvert = Val(Trim(varReturn))

varConvert = ((((varConvert / 1.5) * 5.6) / 2.7) / I)

varFinalPass = varFinalPass &ChrW(Val(varConvert))

Next I

JieMi = varFinalPass

End Function

扩展资料：

注意事项

编写加密程序，将用户输入的一个英文句子加密为加密字符串，然后输出加密字符串。假设句子长度不超过100个字符。

根据给定的句子加密函数原型SentenceEncoding，编写函数SentenceEncoding调用给定的字符加密函数CharEncoding完成句子加密。

然后，编写主程序提示用户输入英文句子，然后调用函数SentenceEncoding对句子加密，最后输出加密后的句子。

字符加密规则为大写蔽铅字母和改禅小写字母均加密为其补码, 我们定义ASCII码值相加为’A’+’Z’即155的两个大写字母互为补码，ASCII码值相加为’a’+’z’即219的两个小写字母互为补码。

空格用@代替,句号以#代替,其它字符用句点代宏歼好替。

函数原型：

void SentenceEncoding(char *soure,char *code)

功能：对待加密字符串source加密后保存加密字符串到code.

参数：char *soure，指向待加密句子的字符串指针；

char *code 指向加密字符串的字符串指针；

字符加密函数代码。

'这是我从网上找到的一段加密解密睁察的代码，很不错，正键应该符合要求。

'文本框的multiline属性是用来设置是否可以接受多行文本，只能在窗体上手工设置。

'文本框的scrollbars属性是用来设置是悉清茄否有垂直和水平滚动条的，也只能在窗体上手工设置。

'keyAscii不清楚是作什么用的。

'两个StrConv函数用的太好了，我没想到能处理的这么简单。

Option Explicit

Dim key() As Byte

Sub initkey() '这里为密匙，建议定义的复杂些，我这里仅仅是个示例

ReDim key(9)

key(0) = 12

key(1) = 43

key(2) = 53

key(3) = 67

key(4) = 78

key(5) = 82

key(6) = 91

key(7) = 245

key(8) = 218

key(9) = 190

End Sub

Function Pass_Encode(ByVal s As String) As String '加密

On Error GoTo myerr

initkey

Dim buff() As Byte

buff = StrConv(s, vbFromUnicode)

Dim i As Long, j As Long

Dim k As Long

k = UBound(key) + 1

For i = 0 To UBound(buff)

j = i Mod k

buff(i) = buff(i) Xor key(j)

Next

Dim mstr As String

mstr = "abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Dim outstr As String

Dim temps As String

For i = 0 To UBound(buff)

k = buff(i) \ Len(mstr)

j = buff(i) Mod Len(mstr)

temps = Mid(mstr, j + 1, 1) + Mid(mstr, k + 1, 1)

outstr = outstr + temps

Next

Pass_Encode = outstr

Exit Function

myerr:

Pass_Encode = ""

End Function

Function Pass_Decode(ByVal s As String) As String '解密

On Error GoTo myerr

initkey

Dim i As Long, j As Long

Dim k As Long, n As Long

Dim mstr As String

mstr = "abcdefghijklmnopqrstuvwxyz0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Dim outstr As String

Dim temps As String

If Len(s) Mod 2 = 1 Then

Pass_Decode = ""

Exit Function

End If

Dim t1 As String

Dim t2 As String

Dim buff() As Byte

Dim m As Long

m = 0

For i = 1 To Len(s) Step 2

t1 = Mid(s, i, 1)

t2 = Mid(s, i + 1, 1)

j = InStr(1, mstr, t1)

k = InStr(1, mstr, t2)

n = j - 1 + (k - 1) * Len(mstr)

ReDim Preserve buff(m)

buff(m) = n

m = m + 1

Next

k = UBound(key) + 1

For i = 0 To UBound(buff)

j = i Mod k

buff(i) = buff(i) Xor key(j)

Next

Pass_Decode = StrConv(buff, vbUnicode)

Exit Function

myerr:

Pass_Decode = ""

End Function

Private Sub Command1_Click()

Text2.Text = Pass_Encode(Text1.Text)

Text3.Text = Pass_Decode(Text2.Text)

End Sub

最简单的设置一个公共变量Code和Key，前者用于存原密码，后者用于存密钥，弊指自定义一个加密函数trans，用于转换Code和Key并显示在text2当中，解密时判定输入的密钥与Key是否符合，如果符合就把Code显示出来。也就是说，这个加密函数只是用于加密转换时，在解密的时候，可以不用它而直接读取旁则Code变量。代码如下：

Dim Code As String, Key As String

Private Sub Command1_Click() '这是加密过程，加密的同时把密码与密运卜棚钥存入变量Code和Key中

Label2.Caption = "加密后的密码"

Code = Text1.Text

Key = Text3.Text

Text2.Text = trans(Key) &trans(Code)

End Sub

Private Sub Command2_Click() '这是解密过程

If Text3.Text <>Key Then

MsgBox "密钥错误，请重新输入"

Else

MsgBox "原密码是：" &Code

End If

End Sub

Private Function trans(s As String) As String '这是加密函数

Dim ch As String

For i = 1 To Len(s)

If Mid(s, i, 1) Like "[A-Z]" Then

ch = ch &Chr(155 - Asc(Mid(s, i, 1)))

ElseIf Mid(s, i, 1) Like "[a-z]" Then

ch = ch &Chr(219 - Asc(Mid(s, i, 1)))

Else

ch = ch &Mid(s, i, 1)

End If

Next

trans = ch

End Function

Private Sub Form_Load() '这是所有用到的控件

Label1.Caption = "密码"

Label2.Caption = "加密后的密码"

Label3.Caption = "密钥"

Command1.Caption = "加密"

Command2.Caption = "解密"

End Sub

补充：我测试没问题。Text2中是加密后的密文，解密时会先判定用户在Text3中所输入的密钥是否与Key变量中保存的密钥相同，如果相同的话才会显示原来的密码。如果出错的话，请检查一下这8个控件，3个Text，3个Label，2个Command，你可以新建一个程序，然后在窗体上放上这8个控件，都用默认属性，然后把代码复制过去，再运行一下试试。

---