一个利用随机数加密字串的算法

首先这个算法没什么特殊之处，只是怕以后找不到，所以放到了这上面

每个字节加密后有6种结果（占两个字节，如果需要大于6种的话，就要多用1个字节，即占3 个字节），也就是说如果字串占n个字节的话，可能产生的结果为6的n次方个，这个算法破解的强度不大，大家可以完善一下：

'窗体上一个按钮，两个listbox

Option Explicit

Private Sub Command1_Click()

Dim i As Long

Dim s As String

For i = 1 To 100

s = encode("这是一个测试 hello world")

List1.AddItem s

s = decode(s)

List2.AddItem s

Next

End Sub

Private Function encode(ByVal s As String) As String '加密

If Len(s) = 0 Then Exit Function

Dim buff() As Byte

buff = StrConv(s, vbFromUnicode)

Dim i As Long

Dim j As Byte

Dim k As Byte, m As Byte

Dim mstr As String

mstr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"

Dim outs As String

i = UBound(buff) + 1

outs = Space(2 * i)

Dim temps As String

For i = 0 To UBound(buff)

Randomize Time

j = CByte(5 * (Math.Rnd()) + 0) '最大产生的随机数只能是5，不能再大了,再大的话，就要多用一个字节

buff(i) = buff(i) Xor j

k = buff(i) Mod Len(mstr)

m = buff(i) \ Len(mstr)

m = m * 2 ^ 3 + j

temps = Mid(mstr, k + 1, 1) + Mid(mstr, m + 1, 1)

Mid(outs, 2 * i + 1, 2) = temps

Next

encode = outs

End Function

Private Function decode(ByVal s As String) As String '解密

On Error GoTo myERR

Dim i As Long

Dim j As Byte

Dim k As Byte

Dim m As Byte

Dim mstr As String

mstr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"

Dim t1 As String, t2 As String

Dim buff() As Byte

Dim n As Long

n = 0

For i = 1 To Len(s) Step 2

t1 = Mid(s, i, 1)

t2 = Mid(s, i + 1, 1)

k = InStr(1, mstr, t1) - 1

m = InStr(1, mstr, t2) - 1

j = m \ 2 ^ 3

m = m - j * 2 ^ 3

ReDim Preserve buff(n)

buff(n) = j * Len(mstr) + k

buff(n) = buff(n) Xor m

n = n + 1

Next

decode = StrConv(buff, vbUnicode)

Exit Function

myERR:

decode = ""

End Function