[转帖]一个利用随机数加密字串的算法

zhuyiwen

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

选择自 rainstormmaster 的 Blog

关键字:  vb, 随机数, 加密



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

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

1. '窗体上一个按钮，两个listbox
   
   
2. Option Explicit
   
   
3. Private Sub Command1_Click()
   
   
4.     Dim i As Long
   
   
5.     Dim s As String
   
   
6.     For i = 1 To 100
   
   
7.         s = encode("这是一个测试 hello world")
   
   
8.         List1.AddItem s
   
   
9.         s = decode(s)
   
   
10.         List2.AddItem s
    
    
11.     Next
    
    
12. End Sub
    
    
13. 
    
    
14. Private Function encode(ByVal s As String) As String '加密
    
    
15.     If Len(s) = 0 Then Exit Function
    
    
16.     Dim buff() As Byte
    
    
17.     buff = StrConv(s, vbFromUnicode)
    
    
18.     Dim i As Long
    
    
19.     Dim j As Byte
    
    
20.     Dim k As Byte, m As Byte
    
    
21.     Dim mstr As String
    
    
22.     mstr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"
    
    
23.     Dim outs As String
    
    
24.     i = UBound(buff) + 1
    
    
25.     outs = Space(2 * i)
    
    
26.     Dim temps As String
    
    
27.     For i = 0 To UBound(buff)
    
    
28.         Randomize Time
    
    
29.         j = CByte(5 * (Math.Rnd()) + 0) '最大产生的随机数只能是5，不能再大了,再大的话，就要多用一个字节
    
    
30.         buff(i) = buff(i) Xor j
    
    
31.         k = buff(i) Mod Len(mstr)
    
    
32.         m = buff(i) \ Len(mstr)
    
    
33.         m = m * 2 ^ 3 + j
    
    
34.         temps = Mid(mstr, k + 1, 1) + Mid(mstr, m + 1, 1)
    
    
35.         Mid(outs, 2 * i + 1, 2) = temps
    
    
36.      Next
    
    
37.      encode = outs
    
    
38. End Function
    
    
39. 
    
    
40. Private Function decode(ByVal s As String) As String '解密
    
    
41.     On Error GoTo myERR
    
    
42.     Dim i As Long
    
    
43.     Dim j As Byte
    
    
44.     Dim k As Byte
    
    
45.     Dim m As Byte
    
    
46.     Dim mstr As String
    
    
47.     mstr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"
    
    
48.     Dim t1 As String, t2 As String
    
    
49.     Dim buff() As Byte
    
    
50.     Dim n As Long
    
    
51.     n = 0
    
    
52.     For i = 1 To Len(s) Step 2
    
    
53.         t1 = Mid(s, i, 1)
    
    
54.         t2 = Mid(s, i + 1, 1)
    
    
55.         k = InStr(1, mstr, t1) - 1
    
    
56.         m = InStr(1, mstr, t2) - 1
    
    
57.         j = m \ 2 ^ 3
    
    
58.         m = m - j * 2 ^ 3
    
    
59.         ReDim Preserve buff(n)
    
    
60.         buff(n) = j * Len(mstr) + k
    
    
61.         buff(n) = buff(n) Xor m
    
    
62.         n = n + 1
    
    
63.      Next
    
    
64.      decode = StrConv(buff, vbUnicode)
    
    
65.      Exit Function
    
    
66. myERR:
    
    
67.      decode = ""
    
    
68. End Function

复制代码

作者Blog：http://blog.csdn.netainstormmaster/

zxzx2733

din

sxm1967

首先要感谢，我去试试

quanli

收藏，一次我发现随机数字在一台机子上每次第一次运行都是相同的，不解。。。。。

情比金坚

收藏