RC4Encrypt

Dim Character() As String * 1
Function RC43(inp As String, key As String, Job As Boolean) As String
Dim S() As Byte
Dim K() As Byte
Dim i As Long
Dim j As Long
Dim temp As Byte
Dim Y As Byte
Dim t As Long
Dim x As Long
Dim Outp As String
Dim r As Integer
Dim TempOutPut As Integer
Dim HoldChar As String
Dim Length As Integer
On Error Goto ErrorHandler:
HoldChar = " $(%&'*+,-)./0123456789:?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]" & _
"^_`abcdefghijklmnopqrstuvwxyz{|}~€¡¢£¤¥¦§¨©ª«­®¯°±²³´µ" & _
"·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßa'áâãäåæçe'e'êëi'" & _
"íîïðño'óôõö÷øu'úûüýþ"
ReDim Character(Length)
For x = 0 To (Length - 1)
Character(x) = Mid(HoldChar, (x + 1), 1)
Next x
ReDim S(Length)
ReDim K(Length)
For i = 0 To (Length - 1)
S(i) = i
Next
j = 1
For i = 0 To (Length - 1)
If j > Len(key) Then j = 1
K(i) = Ascii(Mid(key, j, 1))
j = j + 1
Next i
j = 0
For i = 0 To (Length - 1)
j = (j + S(i) + K(i)) Mod (Length)
temp = S(i)
S(i) = S(j)
S(j) = temp
Next i
i = 0
j = 0
For x = 1 To Len(inp)
i = (i + 1) Mod (Length)
j = (j + S(i)) Mod (Length)
temp = S(i)
S(i) = S(j)
S(j) = temp
t = (S(i) + (S(j) Mod (Length))) Mod (Length)
Y = S(t)
TempOutPut = (Ascii(Mid(inp, x, 1)))
If Job = False And (TempOutPut - Y) < 0 Then
TempOutPut = ((Length) + (TempOutPut - Y))
ElseIf Job = False Then
TempOutPut = (TempOutPut - Y)
End If
If Job = True Then
Outp = Outp & Character((TempOutPut + Y) Mod (Length))
Else
Outp = Outp & Character((TempOutPut) Mod (Length))
End If
Next
RC43 = Outp
Exit Function
ErrorHandler:
MsgBox "Error # " & vbCrLf & Error & vbCrLf & "Outp = " & _
Outp & vbCrLf & "Character = " & Character(hold) & _
vbCrLf & "Ascii = " & hold2 & vbCrLf & "Y = " & Y, , "Error"
End Function

Function Ascii(value As String) As Byte
'Find Value in Character Must be used instead of asc

'because some characters are eliminated

x = 0
While Not Character(x) = value
x = x + 1
Wend
Ascii = (x)
End Function

'es.Hold = RC43(string, "password",True)

'True = Encrypt, False = Decrypt