VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsHabboRC4_23"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim di(15) As String 'Hex

Dim table(255) As Long
Dim keyWindow(1023) As Long
Dim I As Long
Dim J As Long

Public Function encipher(ByVal Data As String) As String
Dim cipher As String
Dim t As Long
Dim k As Long
Dim a As Long
Dim c As Long
t = 0
k = 0
For a = 1 To Len(Data)

I = (I + 1) Mod 256
J = (J + table(I)) Mod 256
t = table(I)
table(I) = table(J)
table(J) = t
k = table((table(I) + table(J)) Mod 256)

c = Asc(Mid(Data, a, 1)) Xor k

If c <= 0 Then
cipher = cipher & "00"
Else
cipher = cipher & di(RShift(c, 4) And &HF)
cipher = cipher & di(c And &HF)
End If
Next

encipher = cipher
End Function

Public Function decipher(ByVal Data As String) As String
Dim cipher As String
Dim t As Long
Dim k As Long
Dim a As Long
t = 0
k = 0
a = 1
Do
I = (I + 1) Mod 256
J = (J + table(I)) Mod 256
t = table(I)
table(I) = table(J)
table(J) = t
k = table((table(I) + table(J)) Mod 256)

t = HexToDec(Mid(Data, a, a + 2))
cipher = cipher & Chr(t Xor k)
a = a + 2
Loop Until a >= Len(Data)

decipher = cipher
End Function

Private Function HexToDec(ByVal Data As String) As Long
On Error Resume Next

Dim tempData As String
Dim Y As Long
Dim tStr As String
Dim tHex As String
tempData = Data
For Y = (1) To Len(Data) Step 2
tStr = Mid(Data, Y, 2)
tHex = tHex & Chr("&h" & tStr)
Next Y

HexToDec = Asc(tHex)
End Function

Public Sub Init()
Dim z As Integer

Initialize

For z = 0 To 254
table(z) = z + 1
Next z


table(0) = 0
table(255) = 1

End Sub

Private Sub Initialize()
For I = 0 To 15
Select Case I
Case 10
di(I) = "A"
Case 11
di(I) = "B"
Case 12
di(I) = "C"
Case 13
di(I) = "D"
Case 14
di(I) = "E"
Case 15
di(I) = "F"
Case Else
di(I) = I
End Select
Next

I = 0
J = 0
End Sub

Private Function Shift(ByVal lValue As Long, ByVal lNumberOfBitsToShift As Long, ByVal lDirectionToShift As Long) As Long
Const ksCallname As String = "Shift"
Dim LShift As Long
On Error GoTo Procedure_Error

If lDirectionToShift Then
LShift = lValue * (2 ^ lNumberOfBitsToShift)
Else
LShift = lValue \ (2 ^ lNumberOfBitsToShift)
End If

Procedure_Exit:
Shift = LShift
Exit Function

Procedure_Error:
Err.Raise Err.Number, ksCallname, Err.Description, Err.HelpFile, Err.HelpContext
Resume Procedure_Exit
End Function

Private Function LShift(ByVal lValue As Long, ByVal lNumberOfBitsToShift As Long) As Long
Const ksCallname As String = "LShift"
On Error GoTo Procedure_Error

LShift = Shift(lValue, lNumberOfBitsToShift, -1)

Procedure_Exit:
Exit Function

Procedure_Error:
Err.Raise Err.Number, ksCallname, Err.Description, Err.HelpFile, Err.HelpContext
Resume Procedure_Exit
End Function

Private Function RShift(ByVal lValue As Long, ByVal lNumberOfBitsToShift As Long) As Long
Const ksCallname As String = "LShift"
On Error GoTo Procedure_Error

RShift = Shift(lValue, lNumberOfBitsToShift, 0)

Procedure_Exit:
Exit Function

Procedure_Error:
Err.Raise Err.Number, ksCallname, Err.Description, Err.HelpFile, Err.HelpContext
Resume Procedure_Exit
End Function
