首先这个算法没什么特殊之处,只是怕以后找不到,所以放到了这上面
每个字节加密后有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
没有相关教程
|