vb 加密字符串的方法

Private Sub Command1_Click()   '加密

Dim b() As Byte, i As Long

Open "d:\1.txt" For Binary As #1

b = InputB(LOF(1), #1)

Close #1

Randomize

For i = 0 To UBound(b) - 1

    b(i) = b(i) Xor b(i + 1)

Next

b(i) = b(i) Xor 93

Open "d:\2.txt" For Binary As #1

Put #1, , b

Close #1

MsgBox "1.txt已加密为2.txt"

End Sub

Private Sub Command2_Click()   '解密

Dim b() As Byte, i As Long

Open "d:\2.txt" For Binary As #1

b = InputB(LOF(1), #1)

Close #1

Randomize

b(UBound(b)) = b(UBound(b)) Xor 93

For i = UBound(b) - 1 To 0 Step -1

    b(i) = b(i) Xor b(i + 1)

Next

Open "d:\3.txt" For Binary As #1

Put #1, , b

Close #1

MsgBox "2.txt已解密为3.txt"

End Sub

1.txt加密后存为2.txt

2.txt解密后存为3.txt

请注意，这个程序是可以加密解密任何文件的（包括exe可执行文件），不单单是文本文件。

就这样了，大概还行

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

---