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"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' http://script-o-matic.net
' Cracked by: Mike[Office.boy] & Erik[Sage]
' Shoutouts to: Stephen[Totov], Matthew Parlane
' This should remain. If it doesn't, I don't like you >:[

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

    'Call extraPremixEncodeSbox
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
Dim PacketHeaderCounter As Boolean 'X
Dim PacketHeaderCount As Long 'X
Dim tmpPacketHeader As String 'X
Dim PacketHeader As String 'X
Dim PacketHeaderSkip As Boolean 'X
Dim PacketHeaderSkipCountStart As Long 'X
Dim PacketHeaderSkipCountEnd As Long 'X

Call SplitData(Data, "SckClient")
Call PacketLog(Data, False, True)

    t = 0
    K = 0
    a = 1
    PacketHeaderSkip = False 'X
    PacketHeaderSkipCountStart = 0 'X
    PacketHeaderSkipCountEnd = 0 'X
    PacketHeaderCounter = False 'X
    PacketHeaderCount = 0 'X
    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)
        
        
        
        If (t Xor K) = 64 And PacketHeaderSkip = False Then 'If Decoded Chr = @
        PacketHeaderCounter = True
        End If
        
        If PacketHeaderCounter = True Then
        PacketHeaderCount = PacketHeaderCount + 1
        End If
        
        If PacketHeaderCount = 2 Then
        tmpPacketHeader = Chr(t Xor K)
        End If
        
        If PacketHeaderCount = 3 Then
        PacketHeader = tmpPacketHeader & Chr(t Xor K)
        PacketHeaderSkip = True
        'PacketHeaderSkipCountEnd = decodeB64(PacketHeader)
        PacketHeaderCounter = False
        PacketHeaderCount = 0
        End If
        
        If PacketHeaderSkip = True Then
        PacketHeaderSkipCountStart = PacketHeaderSkipCountStart + 1
            If PacketHeaderSkipCountStart = PacketHeaderSkipCountEnd + 1 Then
            Dim Packet As String
            Packet = cipher
            If FrmBrowser.ClientPacketsFunction = True Then
                FrmBrowser.ClientPackets.Enqueue Packet
            End If
            Call extraPremixEncodeSbox
            decipher = cipher
            cipher = ""
            Call SplitData(Packet, "SckClient")
            Call PacketLog(Packet, False, False)
            PacketHeaderSkip = False
            PacketHeaderSkipCountStart = 0
            PacketHeaderSkipCountEnd = 0
            End If
        End If
        
        a = a + 2
    Loop Until a >= Len(Data)

End Function

Public Function extraPremixEncodeSbox()
Dim tmpString As String
Dim tmpCount As Long

tmpString = "riMUcVB[rTVypVYADlk"
tmpCount = 11

Call preMixTable(tmpString, tmpCount)
End Function

Public 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()
' You should call this first...
Dim z As Integer

Initialize

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

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

' Habbo started using preMixEncodeSbox...
Call preMixTable("oeVD^yocjsGeXDT`TSjuOXBLNqueHOEruCWLiNRDyZXYb", 21)

End Sub

Public Sub preMixTable(Data As String, Count As Long)
Dim i As Long
Dim TEMP As String
  
  For i = 1 To Count
    TEMP = encipher(Data)
  Next
End Sub

Public Sub Initialize()
    ' This is for Hexing
    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
    ' This is for init
    i = 0
    J = 0
End Sub

Public 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

Public 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

Public Function RShift(ByVal lValue As Long, ByVal lNumberOfBitsToShift As Long) As Long
Const ksCallname As String = "RShift"
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