Dim Key As String
Dim m As String
Dim c As String
Dim z(7, 10) As Long
Dim DK(7, 10) As Long
Const one = 65535
Const maxim = 65537

Public Sub de_key()
    Dim j As Integer
    For j = 1 To 9
        DK(1, 10 - j) = inv(z(1, j))
        DK(4, 10 - j) = inv(z(4, j))
        If j = 1 Or j = 9 Then
            DK(2, 10 - j) = (65536 - z(2, j)) And 65535
            DK(3, 10 - j) = (65536 - z(3, j)) And 65535
        Else
            DK(2, 10 - j) = (65536 - z(3, j)) And 65535
            DK(3, 10 - j) = (65536 - z(2, j)) And 65535
        End If
    Next
    For j = 1 To 9
        DK(5, 9 - j) = z(5, j)
        DK(6, 9 - j) = z(6, j)
    Next
End Sub
Public Function mul(a As Long, b As Long) As Long
    Dim c, d As Long
    Dim e As Double, f As Double, g As Double
    e = a
    f = b
    If a = 0 Then
        d = maxim - b
    ElseIf b = 0 Then
        d = maxim - a
    Else
        e = e * f
        g = e - 65536 * (Int(e / 65536 - 32767) + 32767)
        d = g - (Int(e / 65536 - 32767) + 32767)
        If d <= 0 Then d = d + maxim
    End If
    mul = d And 65535
End Function
Public Function inv(a As Long) As Long
    Dim n1 As Long, n2 As Long, q As Long, r As Long, b1 As Long, b2 As Long, t As Long
    If a = 0 Then
        b2 = 0
    Else
        n1 = maxim: n2 = a: b2 = 1: b1 = 0
        Do
            r = n1 Mod n2: q = (n1 - r) \ n2
            If r = 0 Then Exit Do
               n1 = n2: n2 = r
                t = b2
                b2 = b1 - q * b2: b1 = t
        Loop While (r <> 0)
        If b2 < 0 Then b2 = maxim + b2
    End If
    inv = b2
End Function
Function shift(a As Long, b As Integer) As Long
If b > 0 Then   'left to
    shift = (a Mod (2 ^ (16 - b))) * (2 ^ b)
Else            'right to
    shift = a \ (2 ^ (-b))
End If
End Function
Public Sub subkey()
Dim i As Integer
    Dim s(54) As Long
    For i = 0 To 7
        s(i) = t16_10(Mid(Key, 1 + i * 4, 1)) * (2 ^ 12) + _
               t16_10(Mid(Key, 2 + i * 4, 1)) * (2 ^ 8) + _
               t16_10(Mid(Key, 3 + i * 4, 1)) * (2 ^ 4) + _
               t16_10(Mid(Key, 4 + i * 4, 1))
    Next
    For i = 8 To 53
        If (i + 2) Mod 8 = 0 Then
            s(i) = (shift(s(i - 7), 9) + (shift(s(i - 14), -7))) And one
        ElseIf ((i + 1) Mod 8 = 0) Then
            s(i) = (shift(s(i - 15), 9) + (shift(s(i - 14), -7))) And one
        Else
            s(i) = (shift(s(i - 7), 9) + (shift(s(i - 6), -7))) And one
        End If
    Next
    For i = 1 To 9
        For j = 1 To 6
            z(j, i) = s(6 * (i - 1) + j - 1)
        Next
    Next
End Sub
Public Function idea(mm As String, b As Integer) As String
Dim i As Integer
    Dim inp(4) As Long
    Dim oup(4) As Long
    Dim r As Long, x1 As Long, x2 As Long, x3 As Long, x4 As Long
    Dim kk As Long, t1 As Long, t2 As Long, a As Long
    Dim s1 As String, s2 As String
    For i = 0 To 3      '分割输入数据
        inp(i) = t16_10(Mid(mm, i * 4 + 1, 1)) * (2 ^ 12) + _
            t16_10(Mid(mm, i * 4 + 2, 1)) * (2 ^ 8) + _
            t16_10(Mid(mm, i * 4 + 3, 1)) * (2 ^ 4) + _
            t16_10(Mid(mm, i * 4 + 4, 1))
    Next
    x1 = inp(0): x2 = inp(1): x3 = inp(2): x4 = inp(3)
    For r = 1 To 8
        If b = 1 Then x1 = mul(x1, z(1, r)) Else x1 = mul(x1, DK(1, r))
        If b = 1 Then x4 = mul(x4, z(4, r)) Else x4 = mul(x4, DK(4, r))
        If b = 1 Then x2 = (x2 + z(2, r)) And one Else x2 = (x2 + DK(2, r)) And one
        If b = 1 Then x3 = (x3 + z(3, r)) And one Else x3 = (x3 + DK(3, r)) And one
        If b = 1 Then kk = mul(z(5, r), (x1 Xor x3)) Else kk = mul(DK(5, r), (x1 Xor x3))
        If b = 1 Then t1 = mul(z(6, r), (kk + (x2 Xor x4)) And one) Else t1 = mul(DK(6, r), _
        (kk + (x2 Xor x4)) And one)
        t2 = (kk + t1) And one
        x1 = x1 Xor t1
        x4 = x4 Xor t2
        a = x2 Xor t2
        x2 = x3 Xor t1
        x3 = a
    Next
    If b = 1 Then oup(0) = mul(x1, z(1, 9)) Else oup(0) = mul(x1, DK(1, 9))
    If b = 1 Then oup(3) = mul(x4, z(4, 9)) Else oup(3) = mul(x4, DK(4, 9))
    If b = 1 Then oup(1) = (x3 + z(2, 9)) And one Else oup(1) = (x3 + DK(2, 9)) And one
    If b = 1 Then oup(2) = (x2 + z(3, 9)) And one Else oup(2) = (x2 + DK(3, 9)) And one
    s2 = ""
    For i = 0 To 3
        s1 = Hex(oup(i))
        For j = Len(s1) To 3
            s1 = "0" & s1
        Next
        s2 = s2 & s1
    Next
    idea = s2
End Function
 
Public Function t16_10(a As String) As Long
    Select Case a
    Case "A"
        t16_10 = 10
    Case "B"
        t16_10 = 11
    Case "C"
        t16_10 = 12
    Case "D"
        t16_10 = 13
    Case "E"
        t16_10 = 14
    Case "F"
        t16_10 = 15
    Case Else
        t16_10 = Val(a)
    End Select
End Function
Public Function str_16(a As String) As String
Dim i As Integer
Dim l As String
Dim j As String
Dim k As String
j = ""
For i = 1 To Len(a)
  l = Mid(a, i, 1)
  k = Hex(Asc(l) \ 16)
  j = j & k
  k = Hex(Asc(l) Mod 16)
  j = j & k
Next
str_16 = j
 
End Function
Public Function ideastr(a As String, k As String) As String
Dim i As Integer
Dim s As String
Dim out As String
Dim mids As String
s = a
out = ""
mids = ""
Key = k
subkey
de_key
i = Len(s) Mod 8
If i <> 0 Then
  For j = i To 7
    s = s & " "
  Next
End If
i = Len(s) \ 8
For j = 1 To i
  mids = Mid(s, (j - 1) * 8 + 1, 8)
  mids = str_16(mids)
  mids = idea(mids, 1)
  out = out & mids
Next
ideastr = out
End Function
Public Function str16(a As String) As String
Dim i As Integer
Dim j As Integer
Dim out As String
Dim l As String
For i = 1 To Len(a) / 2
  l = Mid(a, (i - 1) * 2 + 1, 1)
  j = t16_10(l) * 16
  l = Mid(a, (i - 1) * 2 + 2, 1)
  j = j + t16_10(l)
  out = out & Chr(j)
Next
str16 = out
End Function
Public Function ideastr2(a As String, k As String) As String
Key = k
subkey
de_key
Dim i As Integer, j As Integer, l As Integer
Dim out As String, mids As String
j = Len(a) \ 16
For i = 0 To j - 1
  mids = Mid(a, i * 16 + 1, 16)
  mids = idea(mids, 0)
  out = out & mids
Next
ideastr2 = RTrim(str16(out))
End Function

[课程]FART 脱壳王！加量不加价！FART作者讲授！