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點擊解密