vb加密解密算法

1. VB高手：设计一个加密解密程序，输入一串字符，使用加密算法对其加密，再设计一个解密算法，对其解密。

这个是最团携简单的字符替换法
Public Function Decrypt(ByVal s_text As String)
s_text = Replace(s_text, "1!", "信晌a", , , vbBinaryCompare)
s_text = Replace(s_text, "2@", "b", , , vbBinaryCompare)
s_text = Replace(s_text, "3#", "c", , , vbBinaryCompare)
s_text = Replace(s_text, "4$", "d", , , vbBinaryCompare)
s_text = Replace(s_text, "5$", "e", , , vbBinaryCompare)
s_text = Replace(s_text, "6#", "d", , , vbBinaryCompare)
s_text = Replace(s_text, "7*", "f", , , vbBinaryCompare)
s_text = Replace(s_text, "9#", "g", , , vbBinaryCompare)
s_text = Replace(s_text, "0#", "h", , , vbBinaryCompare)
s_text = Replace(s_text, "4@", "i", , , vbBinaryCompare)
s_text = Replace(s_text, "7#", "j", , , vbBinaryCompare)
s_text = Replace(s_text, "8^", "k", , , vbBinaryCompare)
s_text = Replace(s_text, "0^", "l", , , vbBinaryCompare)
s_text = Replace(s_text, "5%", "m", , , vbBinaryCompare)
s_text = Replace(s_text, "a%", "n", , , vbBinaryCompare)
s_text = Replace(s_text, "e$", "o", , , vbBinaryCompare)
s_text = Replace(s_text, "f5", "塌坦伏p", , , vbBinaryCompare)
s_text = Replace(s_text, "6$", "q", , , vbBinaryCompare)
s_text = Replace(s_text, "h&", "r", , , vbBinaryCompare)
s_text = Replace(s_text, "0.", "s", , , vbBinaryCompare)
s_text = Replace(s_text, "e`", "t", , , vbBinaryCompare)
s_text = Replace(s_text, "4r", "u", , , vbBinaryCompare)
s_text = Replace(s_text, "7@", "v", , , vbBinaryCompare)
s_text = Replace(s_text, "f^", "w", , , vbBinaryCompare)
s_text = Replace(s_text, "t%", "x", , , vbBinaryCompare)
s_text = Replace(s_text, "g@", "y", , , vbBinaryCompare)
s_text = Replace(s_text, "h0", "z", , , vbBinaryCompare)

s_text = Replace(s_text, ".2", "A", , , vbBinaryCompare)
s_text = Replace(s_text, ".3", "B", , , vbBinaryCompare)
s_text = Replace(s_text, ".4", "C", , , vbBinaryCompare)
s_text = Replace(s_text, ".5", "D", , , vbBinaryCompare)
s_text = Replace(s_text, ".6", "E", , , vbBinaryCompare)
s_text = Replace(s_text, ".7", "F", , , vbBinaryCompare)
s_text = Replace(s_text, ".8", "G", , , vbBinaryCompare)
s_text = Replace(s_text, ".9", "H", , , vbBinaryCompare)
s_text = Replace(s_text, ".0", "I", , , vbBinaryCompare)
s_text = Replace(s_text, ".1", "J", , , vbBinaryCompare)
s_text = Replace(s_text, "/3", "K", , , vbBinaryCompare)
s_text = Replace(s_text, "/5", "L", , , vbBinaryCompare)
s_text = Replace(s_text, "/7", "M", , , vbBinaryCompare)
s_text = Replace(s_text, "/9", "N", , , vbBinaryCompare)
s_text = Replace(s_text, "/1", "O", , , vbBinaryCompare)
s_text = Replace(s_text, "/0", "P", , , vbBinaryCompare)
s_text = Replace(s_text, "/8", "Q", , , vbBinaryCompare)
s_text = Replace(s_text, "/6", "R", , , vbBinaryCompare)
s_text = Replace(s_text, "/4", "S", , , vbBinaryCompare)
s_text = Replace(s_text, "/2", "T", , , vbBinaryCompare)
s_text = Replace(s_text, ";0", "U", , , vbBinaryCompare)
s_text = Replace(s_text, ";2", "V", , , vbBinaryCompare)
s_text = Replace(s_text, ";3", "W", , , vbBinaryCompare)
s_text = Replace(s_text, ";4", "X", , , vbBinaryCompare)
s_text = Replace(s_text, ";6", "Y", , , vbBinaryCompare)
s_text = Replace(s_text, ";7", "Z", , , vbBinaryCompare)

s_text = Replace(s_text, "%r", "0", , , vbBinaryCompare)
s_text = Replace(s_text, "#g", "1", , , vbBinaryCompare)
s_text = Replace(s_text, "1$", "2", , , vbBinaryCompare)
s_text = Replace(s_text, "j~", "3", , , vbBinaryCompare)
s_text = Replace(s_text, "j#", "4", , , vbBinaryCompare)
s_text = Replace(s_text, "3?", "5", , , vbBinaryCompare)
s_text = Replace(s_text, "*t", "6", , , vbBinaryCompare)
s_text = Replace(s_text, "u@", "7", , , vbBinaryCompare)
s_text = Replace(s_text, "n!", "8", , , vbBinaryCompare)
s_text = Replace(s_text, "&x", "9", , , vbBinaryCompare)
Decrypt = s_text
End Function
Public Function Crypt(ByVal s_text As String)
s_text = Replace(s_text, "0", "%r", , , vbBinaryCompare)
s_text = Replace(s_text, "1", "#g", , , vbBinaryCompare)
s_text = Replace(s_text, "2", "1$", , , vbBinaryCompare)
s_text = Replace(s_text, "3", "j~", , , vbBinaryCompare)
s_text = Replace(s_text, "4", "j#", , , vbBinaryCompare)
s_text = Replace(s_text, "5", "3?", , , vbBinaryCompare)
s_text = Replace(s_text, "6", "*t", , , vbBinaryCompare)
s_text = Replace(s_text, "7", "u@", , , vbBinaryCompare)
s_text = Replace(s_text, "8", "n!", , , vbBinaryCompare)
s_text = Replace(s_text, "9", "&x", , , vbBinaryCompare)

s_text = Replace(s_text, "a", "1!", , , vbBinaryCompare)
s_text = Replace(s_text, "b", "2@", , , vbBinaryCompare)
s_text = Replace(s_text, "c", "3#", , , vbBinaryCompare)
s_text = Replace(s_text, "d", "4$", , , vbBinaryCompare)
s_text = Replace(s_text, "e", "5$", , , vbBinaryCompare)
s_text = Replace(s_text, "f", "7*", , , vbBinaryCompare)
s_text = Replace(s_text, "g", "9#", , , vbBinaryCompare)
s_text = Replace(s_text, "h", "0#", , , vbBinaryCompare)
s_text = Replace(s_text, "i", "4@", , , vbBinaryCompare)
s_text = Replace(s_text, "j", "7#", , , vbBinaryCompare)
s_text = Replace(s_text, "k", "8^", , , vbBinaryCompare)
s_text = Replace(s_text, "l", "0^", , , vbBinaryCompare)
s_text = Replace(s_text, "m", "5%", , , vbBinaryCompare)
s_text = Replace(s_text, "n", "a%", , , vbBinaryCompare)
s_text = Replace(s_text, "o", "e$", , , vbBinaryCompare)
s_text = Replace(s_text, "p", "f5", , , vbBinaryCompare)
s_text = Replace(s_text, "q", "6$", , , vbBinaryCompare)
s_text = Replace(s_text, "r", "h&", , , vbBinaryCompare)
s_text = Replace(s_text, "s", "0.", , , vbBinaryCompare)
s_text = Replace(s_text, "t", "e`", , , vbBinaryCompare)
s_text = Replace(s_text, "u", "4r", , , vbBinaryCompare)
s_text = Replace(s_text, "v", "7@", , , vbBinaryCompare)
s_text = Replace(s_text, "w", "f^", , , vbBinaryCompare)
s_text = Replace(s_text, "x", "t%", , , vbBinaryCompare)
s_text = Replace(s_text, "y", "g@", , , vbBinaryCompare)
s_text = Replace(s_text, "z", "h0", , , vbBinaryCompare)

s_text = Replace(s_text, "A", ".2", , , vbBinaryCompare)
s_text = Replace(s_text, "B", ".3", , , vbBinaryCompare)
s_text = Replace(s_text, "C", ".4", , , vbBinaryCompare)
s_text = Replace(s_text, "D", ".5", , , vbBinaryCompare)
s_text = Replace(s_text, "E", ".6", , , vbBinaryCompare)
s_text = Replace(s_text, "F", ".7", , , vbBinaryCompare)
s_text = Replace(s_text, "G", ".8", , , vbBinaryCompare)
s_text = Replace(s_text, "H", ".9", , , vbBinaryCompare)
s_text = Replace(s_text, "I", ".0", , , vbBinaryCompare)
s_text = Replace(s_text, "J", ".1", , , vbBinaryCompare)
s_text = Replace(s_text, "K", "/3", , , vbBinaryCompare)
s_text = Replace(s_text, "L", "/5", , , vbBinaryCompare)
s_text = Replace(s_text, "M", "/7", , , vbBinaryCompare)
s_text = Replace(s_text, "N", "/9", , , vbBinaryCompare)
s_text = Replace(s_text, "O", "/1", , , vbBinaryCompare)
s_text = Replace(s_text, "P", "/0", , , vbBinaryCompare)
s_text = Replace(s_text, "Q", "/8", , , vbBinaryCompare)
s_text = Replace(s_text, "R", "/6", , , vbBinaryCompare)
s_text = Replace(s_text, "S", "/4", , , vbBinaryCompare)
s_text = Replace(s_text, "T", "/2", , , vbBinaryCompare)
s_text = Replace(s_text, "U", ";0", , , vbBinaryCompare)
s_text = Replace(s_text, "V", ";2", , , vbBinaryCompare)
s_text = Replace(s_text, "W", ";3", , , vbBinaryCompare)
s_text = Replace(s_text, "X", ";4", , , vbBinaryCompare)
s_text = Replace(s_text, "Y", ";6", , , vbBinaryCompare)
s_text = Replace(s_text, "Z", ";7", , , vbBinaryCompare)

Crypt = s_text
End Function

2. vb中如何对字符串进行加密和解密（有汉字的）

源程序如下：

Public Function StringEnDeCodecn(strSource As String, MA) As String
'该函数只对中西文起到加密作用
'参数为：源文件，密码
On Error GoTo ErrEnDeCode
Dim X As Single
Dim CHARNUM As Long, RANDOMINTEGER As Integer
Dim SINGLECHAR As String * 1
Dim strTmp As String
If MA < 0 Then
MA = MA * (-1)
End If
X = Rnd(-MA)
For i = 1 To Len(strSource) Step 1 '取单字节内容
SINGLECHAR = Mid(strSource, i, 1)
CHARNUM = Asc(SINGLECHAR)
g: RANDOMINTEGER = Int(127 * Rnd)
If RANDOMINTEGER < 30 Or RANDOMINTEGER > 100 Then GoTo g
CHARNUM = CHARNUM Xor RANDOMINTEGER
strTmp = strTmp & Chr(CHARNUM)
Next i
StringEnDeCodecn = strTmp
Exit Function
ErrEnDeCode:
StringEnDeCodecn = ""
MsgBox Err.Number & "\" & Err.Description
End Function

使用方法：
tmp=stringEnDecn("中华人民共和国",75)
如果要解密的话，只须键入以下语句：
tmp1=stringendecn(tmp,75)

3. VB加密解密

obyte(i) = 21 Xor obyte(i) '这里obyte应该是一个数字型的数组，Xor是异或操作，其特点是二进制数字每经过2次异或同一个值，会得到初始值。也就是说，如果你的密文是通过把原文异或21而得到指散巧的掘空，那么将密文再次与21进行异或，就会得到原文。
temp(i) = Chr(obyte(i)) '这个是将Ascii数字转换为相应的字符。
假设唯键A是一个字符，B是一个数字，那么：
如果Asc(A)=B，则
Chr(B)=A

4. vb加密算法

PrivateSubCommand1_Click()
DimtAsString
t=Text1.Text
Text2.Text=Encrypt(t,177,86)
EndSub

PrivateSubCommand2_Click()
DimtAsString
t=Text2.Text
Text4.Text=Encrypt(t,177,86)
End坦芦滑Sub

亲，你这两个按钮里面的代码都是加密让腊的啊！
最基本的知识你都没有理解！哪有加密和解密都用一样哗答的代码！

5. VB 字符串加密解密[高分]

就这样了，大概还行
Private Function Encrypt(ByVal StrSource As String) As String '加密
Dim BLowData As Byte
Dim BHigData As Byte
Dim i As Long
Dim k As Integer
Dim StrEncrypt As String
Dim StrChar As String
Dim KeyTemp As String
Dim Key1 As Byte
For k = 1 To 30
KeyTemp = KeyTemp & CStr(Int(Rnd * (9) + 1))
Next
Key1 = CByte(Mid(KeyTemp, 11, 1) & Mid(KeyTemp, 27, 1))
For i = 1 To Len(StrSource)
StrChar = Mid(StrSource, i, 1) '从待加密字符串中取出一个字符
BLowData = AscB(MidB(StrChar, 1, 1)) Xor Key1 '取字符的低字节和Key1进行异或运算
SHigData = AscB(MidB(StrChar, 2, 1)) '取字符的高字节
StrEncrypt = StrEncrypt & ChrB(BLowData) & ChrB(BHigData) '将运算后的数据合成新的字符
Next i
Encrypt = KeyTemp & StrEncrypt
End FunctionPrivate Function Decrypt(ByVal StrSource As String) As String '解密
Dim BLowData As Byte
Dim BHigData As Byte
Dim i As Long
Dim k As Integer
Dim StrDecrypt As String
Dim StrChar As String
Dim KeyTemp As String
Dim Key1 As Byte
KeyTemp = Mid(StrSource, 1, 30)
Key1 = CByte(Mid(KeyTemp, 11, 1) & Mid(KeyTemp, 27, 1))
For i = 31 To Len(StrSource)
StrChar = Mid(StrSource, i, 1) '从待解密字符串中取出一个字符
BLowData = AscB(MidB(StrChar, 1, 1)) Xor Key1 '取字符的低字节和Key1进行异或运算
BHigData = AscB(MidB(StrChar, 2, 1)) '取字符的高字节
StrDecrypt = StrDecrypt & ChrB(BLowData) & ChrB(BHigData) '将运算后的数据合成新的字符
Next i
Decrypt = StrDecryptEnd Function
Private Sub Command2_Click()
MsgBox Decrypt(InputBox(""))
End SubPrivate Sub Command1_Click()
Text1.Text = Encrypt(InputBox(""))
End Sub

6. vb加解密

最简单的设置一个公共变量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个控件，都用默认属性，然后把代码复制过去，再运行一下试试。

7. 使用VB做出加密，密钥和解密

下面代码稍加修改就成。
Private Sub Command1_Click()
Dim a As String
Dim b As String
a = Text3
For i = 1 To Len(a)
b = b & JiaMi(Mid(a, i, 1))
Next i
Text2 = b
a = Text2
b = ""
For i = 1 To Len(a)
b = b & JiaMi(Mid(a, i, 1))
Next i
Text1 = b
End Sub
Private Function JiaMi(a As String) As String
Dim IntAsc As Integer
IntAsc = Asc(a)
If IntAsc Mod 2 Then
IntAsc = IntAsc + 47
If IntAsc > 126 Then IntAsc = IntAsc - 47
Else
IntAsc = IntAsc - 47
If IntAsc < 33 Then IntAsc = IntAsc + 47
End If
JiaMi = Chr(IntAsc)
End Function

8. VB 加密与解密的程序代码

加密：

PrivateFunction 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

NextI

JiaMi = strJiaMi

EndFunction

解密函数：

PrivateFunction 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))

NextI

JieMi = varFinalPass

EndFunction

(8)vb加密解密算法扩展阅读：

注意事项

编写加密程序，将用户输入的一个英文句子加密为加密字符串，然后输出加密字符串。假设句子长度不超过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 指向加密字符串的字符串指针；

字符加密宏歼好函数代码。

9. 怎样用VB编写一个文件加密程序

字节逐位倒排序加密法是以比特为单位的换位加密方法，用VB实现的具体算法是：
(1) 以二进制模式打开源文件；
(2) 从源文件第I位读取一个字节，假设为字母“A”，得到“A”的ASCII值为65；
(3) 将65转换成八位二进制串为“01000001”；
(4) 将“01000001”按字节逐位倒排序得另一个八位二进制串“10000010”；
(5) 将“10000010”转换成十进制再写回源文件第I位置，完成一个字节的加密；
(6) 重复(2)、(3)、(4)和(5)，直到所有字节加密结束。
为了使程序模块化，我们用函数过程ByteToBin完成将字节型数据转换成二进制串（其实质就是将十进制数转换成八位二进制串）；用函数过程BinToByte将二进制串转换成字节型数据（实质是将八位二进制串转换成十进制数）：用函数过程Reverse将八位二进制串逐位倒排序。具体程序如下：
Function ByteToBin(m As Byte) As String ' 将字节型数据转换成八位二进制字符串
Dim c$
c$ = ""
Do While m <> 0
r = m Mod 2
m = m \ 2
c$ = r & c$
Loop
c$ = Right("00000000" & c$, 8)
ByteToBin = c$
End Function
Function Reverse(m As String) As String ' 将八位二进制字符串颠倒顺序
Dim i%, x$
x = ""
For i = 1 To 8
x = Mid(m, i, 1) & x
Next i
Reverse = x
End Function
Function BinToByte(m As String) As Byte ' 将八位二进制串转换成十进制
Dim x As String * 1, y%, z%
z = 0
For i = 1 To 8
x = Mid(m, i, 1)
y = x * 2 ^ (8 - i)
z = z + y
Next i
BinToByte = z
End Function
Private Sub Command1_Click()
Dim x As Byte, i%, fname$
fname = InputBox("请输入要加密的文件名！注意加上路径名：")
If Dir(fname) = "" Then
MsgBox "文件不存在！"
Exit Sub
End If
Open fname For Binary As #1 ' 以二进制访问模式打开待加悔穗扒密文件
For i = 1 To LOF(1) ' LOF函数是求文件长度的内部函数
Get #1, i, x ' 取出第i个字节
x = BinToByte(Reverse(ByteToBin(x))) ' 这里调用了三个自定义函数
Put #1, i, x ' 将加密后的这个字节写回到文件原位置
Next i
Close
MsgBox "任务完成！"
End Sub
本例可以完成对任意文件的加密与解密，对同一文件作第一次处理为加密，第二次处理为解族搭密。要调试本程序，碧昌可用记事本在C盘根目录下任意建立一个文本文件（假设为文件名为aaa.txt），其中的内容任意（可以包括字母、汉字、数字、回车符、换行符等）。运行本程序后，在输入文件名的对话框中输入文件名（如：“C:\aaa.txt”）后回车，即可完成对文件的加密。文件加密后，可以在记事本中打开该文件查看加密效果。如果想解密，可再次运行该程序并输入相同文件名。

10. 简单VB.NET加密与解密

Private Function myEncrypt(ByVal Code As String) As String
Dim Result As String = ""

Dim CurrentChar As Char

For i As Integer = 0 To Code.Length - 1

CurrentChar = Code.Substring(i, 1)

Select Case Code.Substring(i, 1)
Case "Z"
Result &= "a"
Case "z"
Result &= "A"
Case Else
Result &= Chr(Asc(CurrentChar) + 1)
End Select
Next
Return Result
End Function

'vb.net 2005 调试通过