vb字符串加密解密

㈠ VB文本加密解密

刚好以前写过一篇文章，提取了一部分
对敏感的数据进行加密是必要的，如用户的密码的加密。在要对数据进行加密前得确定要用何种加密方式，加密分类有很多种，从可逆角度可分为可逆和不可逆，从加密算法可分为秘密密钥算法、公开密钥算法（用于加密、数据签名和密钥管理）以及单向散列函数等。md5加密是不可逆的，md5加密的具体实现又分为许多种。

加密为什么要采用不可逆？举个例子，当你输入的密码进行加密的密文被截取，那他也要把密文解密成原文，这时由于不可逆，那他要破解密码的难度就提高，除非他可以越过加密那一步直接提供密文，这样就达到安全的目的。每当我们忘记密码进行找回密码，大多数网站要求我们输入新的密码而不是直接告诉我们原来的密码，这是由于不可逆造成的，但这又不是坏处，为什么这么说？如果在找回密码时能够知道原来的密码，那么卧底就不用修改密码来监控所有人，而所有人又不知情。但并不是所有网站都采用不可逆的算法，笔者在某网站注册过用户，有一段没登录过，那网站就会给笔者一份提醒邮件，而这提醒邮件又显示着笔者的密码，这很可能是这个网站采用的不是不可逆的算法。

今天为一个网友实现了一个简易的自定义加密方式，使用的是Visual Basic 6.0。关键代码如下：

Dim decode As String, encode As String, oldString As String, newString As String

Dim i As Integer

decode = "1234567890" '加密原文对照字符，不应该出错相同的字符

encode = "eoSDriKjsd" '加密成密文的对照字符，字符个数不能少于decode，否则极易造成出错

oldString = "87232" '待加密的字符串，所有字符都必需能够在decode里找到对应位置

newString = "" '存放加密后的字符串

For i = 1 To Len(oldString)

newString = newString + Mid$(encode, Instr(decode, Mid$(oldString, i, 1)), 1)

Next i

Print "原文："; oldString

Print "密文："; newString

decode和encode的值可以根据需要设置，oldString可以由文框输入，如果encode里的字符俩俩不相同，那么只需调换decode和encode的值，就可以实现解密，否则加密后的密文为不可逆。

当然，在实际的应用种应增加加密的算法复杂度，让密文不至于被人轻而易举破解。更多的加密知识请参考相关文档。

希望回答对你有帮助

㈡ 运用VB对文字进行加密解密

'这是我从网上找到的一段加密解密的代码，很不错，应该符合要求。
'文本框的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 = ""
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 = ""
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

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

㈣ 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

㈤ vb 加/解密字符串

Private Dict() As String

'加密函数
Private Function Encode(Txt As String) As String
Dim r As String, t As String
Dim i As Long
Dim k As Integer
Dim j As Long
Randomize Timer
For i = 1 To Len(Txt)
k = Asc(Mid(Txt, i, 1))
r = Hex(k)
r = String(4 - Len(r), "0") & r
t = ""
For j = 1 To 4
k = CDec("&h" & Mid(r, j, 1))
If k >= 14 Then
k = k + Int(Rnd() * 3) * 16
Else
k = k + Int(Rnd() * 4) * 16
End If
t = t & Dict(k)
Next j
Encode = Encode & t
Next i
End Function
'解密函数
Private Function Decode(Code As String) As String
Dim i As Long, j As Long, y As Long, l As Long
Dim k As Integer
Dim r As String, t As String
For i = 1 To Len(Code) Step 4
r = Mid(Code, i, 4)
t = ""
For j = 1 To 4
For l = 0 To UBound(Dict)
If Mid(r, j, 1) = Dict(l) Then
Exit For
End If
Next l
k = l Mod 16
t = t & Hex(k)
Next j
y = CDec("&h" & t)
If y > 32786 Then y = y - 65536
Decode = Decode & Chr(y)
Next i
End Function

Private Sub Form_Load()
'数据字典
Dict = Split("1|q|a|z|2|w|s|x|3|e|d|c|4|r|f|v|5|t|g|b|6|y|h|n|7|u|j|m|8|i|k|9|o|l|0|p|Q|W|E|R|T|Y|U|I|O|P|A|S|D|F|G|H|J|K|L|Z|X|C|V|B|N|M|", "|")
End Sub

㈥ VB 实现字符串加密 解密

Private Sub Command1_Click()
Text2 = code(Text1)
End Sub

Private Sub Command2_Click()
Text1 = jiecode(Text2)
End Sub

Private Sub Command3_Click()
Dim chang As Single
Dim mim, inp As String
inp = InputBox("请输入所需密钥的长度：(不大于500）", "(*^__^*) 嘻嘻……")
Do While inp = "" Or Val(inp) = 0
MsgBox ("输出了非数字,请重新输入")
inp = InputBox("请输入所需密钥的长度：(不大于500）", "(*^__^*) 嘻嘻……")
Loop
For i = 1 To Len(inp)
mim = Mid(inp, i, 1)
If mim <> "0" Then
If Val(mim) = 0 Then
MsgBox ("输入了非数字")
Exit For
End If
End If
Next i
If Val(inp) > 500 Then
MsgBox "错误：密钥过长", , "警告"
End
End If
Text3.Text = ""
For i = 1 To Val(inp)
Randomize
Text3.Text = Text3.Text + Trim(Str(Int(Rnd * 9) + 1))
Next i
End Sub

Private Sub Command4_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub

Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub