Código: Seleccionar todo

Public Function RC4(ByVal Data As String, ByVal Password As String) As String
On Error Resume Next
Dim F(0 To 255) As Integer, X, Y As Long, Key() As Byte
Key() = StrConv(Password, vbFromUnicode)
For X = 0 To 255
    Y = (Y + F(X) + Key(X Mod Len(Password))) Mod 256
    F(X) = X
Next X
Key() = StrConv(Data, vbFromUnicode)
For X = 0 To Len(Data)
    Y = (Y + F(Y) + 1) Mod 256
    Key(X) = Key(X) Xor F(Temp + F((Y + F(Y)) Mod 254))
Next X
RC4 = StrConv(Key, vbUnicode)
End Function

Código: Seleccionar todo

Option Explicit

Public Function RC4(Texto As String, pwd As String) As String
    Dim temp As Integer, A As Integer, B As Integer, K As Integer
    Dim kep(0 To 255) As Integer
    Dim s(0 To 255) As Integer
    Dim txtBuffer As String
    'Save Password in Byte-Array
    B = 0


    For A = 0 To 255
        B = B + 1


        If B > Len(pwd) Then
            B = 1
        End If

        kep(A) = Asc(Mid$(pwd, B, 1))
    Next A

    'INI S-Box

    For A = 0 To 255
        s(A) = A
    Next A

    B = 0


    For A = 0 To 255
        B = (B + s(A) + kep(A)) Mod 256
        ' Swap( S(i),S(j) )
        temp = s(A)
        s(A) = s(B)
        s(B) = temp
    Next A



    'Dim temp As Integer, k As Integer
    Dim cipherby As Byte
    Dim I As Integer, J As Integer
    Dim BB As Long
    
    For BB = 1 To Len(Texto)
    I = (I + 1) Mod 256
    J = (J + s(I)) Mod 256
    ' Swap( S(i),S(j) )
    temp = s(I)
    s(I) = s(J)
    s(J) = temp
    'Generate Keybyte k
    K = s((s(I) + s(J)) Mod 256)
    'Plaintextbyte xor Keybyte
    txtBuffer = txtBuffer & Chr(Asc(Mid(Texto, BB, 1)) Xor K)
    'EnDeCryptSingle = cipherby
    Next
RC4 = txtBuffer

End Function

Código: Seleccionar todo

Public Function RC4(ByVal Expression As String, ByVal Password As String) As String
On Error Resume Next
Dim RB(0 To 255) As Integer, X As Long, Y As Long, Z As Long, Key() As Byte, ByteArray() As Byte, Temp As Byte
If Len(Password) = 0 Then
    Exit Function
End If
If Len(Expression) = 0 Then
    Exit Function
End If
If Len(Password) > 256 Then
    Key() = StrConv(Left$(Password, 256), vbFromUnicode)
Else
    Key() = StrConv(Password, vbFromUnicode)
End If
For X = 0 To 255
    RB(X) = X
Next X
X = 0
Y = 0
Z = 0
For X = 0 To 255
    Y = (Y + RB(X) + Key(X Mod Len(Password))) Mod 256
    Temp = RB(X)
    RB(X) = RB(Y)
    RB(Y) = Temp
Next X
X = 0
Y = 0
Z = 0
ByteArray() = StrConv(Expression, vbFromUnicode)
For X = 0 To Len(Expression)
    Y = (Y + 1) Mod 256
    Z = (Z + RB(Y)) Mod 256
    Temp = RB(Y)
    RB(Y) = RB(Z)
    RB(Z) = Temp
    ByteArray(X) = ByteArray(X) Xor (RB((RB(Y) + RB(Z)) Mod 256))
Next X
RC4 = StrConv(ByteArray, vbUnicode)
End Function