vb对字符串加密
‘壹’ 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 简单字符串加密优化
PrivateSub加密_Click()
Dimb()AsByte,iAsLong
b=StrConv(Text1.Text,vbFromUnicode)
Fori=0ToUBound(b)
b(i)=b(i)Xor50
Next
Text2.Text=StrConv(b,vbUnicode)
EndSub
PrivateSub解密_Click()
Dimb()AsByte,iAsLong
b=StrConv(Text2.Text,vbFromUnicode)
Fori=0ToUBound(b)
b(i)=b(i)Xor50
Next
Text1.Text=StrConv(b,vbUnicode)
EndSub
把文本框转为字节数组，然后对这个字节数组进行加密或解密处理，最后再把字节数组赋值给文本框即可。
另外，你可以发现，加密和解密其实是同一个算法！这就是Xor（异或运算）的神奇之处！
‘叁’ vb如何加密字符串
是随机数方式，不是md5，一般用也不错
放到标准模块里，调用那加密和解密的函数就行了
'加密解密字符串
Option Explicit
' Encipher the text using the pasword.加密
Public Function cipher(ByVal password As String, ByVal from_text As String)
Const MIN_ASC = 32 ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
Dim to_text As String
' Initialize the random number generator.
offset = NumericPassword(password)
Rnd -1
Randomize offset
' Encipher the string.
str_len = Len(from_text)
For i = 1 To str_len
ch = Asc(Mid$(from_text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch + offset) Mod NUM_ASC)
ch = ch + MIN_ASC
to_text = to_text & Chr$(ch)
End If
Next i
cipher = to_text
End Function
' Encipher the text using the pasword.解密
Public Function Decipher(ByVal password As String, ByVal from_text As String)
Const MIN_ASC = 32 ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
Dim to_text As String
' Initialize the random number generator.
offset = NumericPassword(password)
Rnd -1
Randomize offset
' Encipher the string.
str_len = Len(from_text)
For i = 1 To str_len
ch = Asc(Mid$(from_text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch - offset) Mod NUM_ASC)
If ch < 0 Then ch = ch + NUM_ASC
ch = ch + MIN_ASC
to_text = to_text & Chr$(ch)
End If
Next i
Decipher = to_text
End Function
' Translate a password into an offset value.
Private Function NumericPassword(ByVal password As String) As Long
Dim value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer
str_len = Len(password)
For i = 1 To str_len
' Add the next letter.
ch = Asc(Mid$(password, i, 1))
value = value Xor (ch * 2 ^ shift1)
value = value Xor (ch * 2 ^ shift2)
' Change the shift offsets.
shift1 = (shift1 + 7) Mod 19
shift2 = (shift2 + 13) Mod 23
Next i
NumericPassword = value
End Function
‘肆’ vb对字符串加密（偏移3位）
Private Sub Command1_Click()
Dim a() As String, b() As Integer, n As Integer
n = Len(txtinputbox)
Print n
ReDim a(n)
ReDim b(n + 3)
For i = 1 To n
a(i) = Mid(txtinputbox, i, 1)
b(i) = Asc(a(i)) + 3
If b(i) > Asc("Z") And b(i) < Asc("a") Then b(i) = Asc("A") + b(i) - Asc("Z") - 1
If b(i) > Asc("z") Then b(i) = Asc("a") + b(i) - Asc("z") - 1
a(i) = Chr(b(i))
codelabel.Caption = codelabel.Caption & a(i)
Next
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
‘陆’ 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编写程序，实现对任意字符串的加密和解密操作。
http://..com/question/215182971.html
LZ可以去看看、
或者在BAIDU里找找BASE 64的加密解密，
‘捌’ 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 字母 加密字符串
PrivateSubCommand1_Click()'加密
DimpAsString,sAsString,tAsString
DimiAsInteger,kAsInteger
p=""
s=Text1.Text
Fori=1ToLen(s)
k=InStr(p,Mid(s,i,1))
Ifk=0Then
MsgBox"数据有误"
ExitSub
Else
t=t&Mid(p,((k+4)Mod52)+1,1)
EndIf
Next
Text2.Text=t
Text1.Text=""
EndSub
PrivateSubCommand2_Click()'解密
DimpAsString,sAsString,tAsString
DimiAsInteger,kAsInteger
p=""
s=Text2.Text
Fori=1ToLen(s)
k=InStr(p,Mid(s,i,1))
Ifk=0Then
MsgBox"数据有误"
ExitSub
Else
t=t&Mid(p,((k+46)Mod52)+1,1)
EndIf
Next
Text1.Text=t
Text2.Text=""
EndSub
以上代码用到四个控件：Text1放加密前的数据，Text2放加密后的数据，Command1点击加密，Command2点击解密