众香之主 发表于 2007-5-27 17:15:05

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

一个利用随机数加密字串的算法       首先这个算法没什么特殊之处,只是怕以后找不到,所以放到了这上面
       每个字节加密后有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
页: [1]
查看完整版本: 一个利用随机数加密字串的算法