ChatEncoding.txt

Script("Name") = "Chat Encoding"
Script("Author") = "Pyro"
Script("Major") = 1
Script("Minor") = 0
Script("Description") = "Allows sending and receiving messages in various encoded formats."


Const EVENT_PROCESSOR_SCRIPT = "Chat Event Pre-Processor"

Const ENCODE_COMMAND = "encode"
Const DECODE_COMMAND = "decode"
Const ENCODE_CHAT_COMMAND = "cencode"
Const ENCODE_LIST_COMMAND = "encodings"

Public AvailableEncodings

Private TempUTF8


Sub Event_Load()
    If Scripts(EVENT_PROCESSOR_SCRIPT) Is Nothing Then
        AddChat Color.Red, "[ENC] Error: The script '" & EVENT_PROCESSOR_SCRIPT & "' could not be found."
        Exit Sub
    End If
    
    Set AvailableEncodings = CreateObject("Scripting.Dictionary")
    With AvailableEncodings
        .CompareMode = vbTextCompare
        
        .Add "HEX", New HexEncoding
        .Add "ROT13", New Rot13Encoding
        .Add "ROT47", New Rot47Encoding
        .Add "INVIG", New InvigorationEncoding
        .Add "BASE64", New Base64Encoding
    End With
    
    Call ObserveScript(EVENT_PROCESSOR_SCRIPT)
    
    Call InitCommands
End Sub

Sub Event_Command(Command)   
    If Command.Name = ENCODE_LIST_COMMAND Then
        list = vbNullString
        For Each Encoding In AvailableEncodings.Items()
            list = list & Encoding.ShortID & ", "
        Next
        list = Left(list, Len(list) - 2)
        Command.Respond "Available encodings: " & list
    Else
        Encoding = Command.Argument("encoding")
        Message = Command.Argument("text")
    
        If Not AvailableEncodings.Exists(Encoding) Then
            Command.Respond StringFormat("Unrecognized encoding: {0}.", Encoding)
            Exit Sub
        End If
        
        Set oEncoding = AvailableEncodings.Item(Encoding)
        Select Case Command.Name
            Case ENCODE_COMMAND
                Command.Respond StringFormat("{0} encoded: {1}", oEncoding.ShortID, oEncoding.Encode(Message))
            Case DECODE_COMMAND
                Command.Respond StringFormat("{0} decoded: {1}", oEncoding.ShortID, oEncoding.Decode(Message))
            Case ENCODE_CHAT_COMMAND
                Call SendInternal(oEncoding, Message)
        End Select
    End If
End Sub

Sub Event_Close()
    Set AvailableEncodings = Nothing
End Sub


Public Sub Event_MessageSent(MessageID, Message, Tag)
    If Left(Tag, 8) = "Encoded " Then
        Config.UseUTF8 = TempUTF8
        
        Encoding = Split(Tag, " ")(1)
        If AvailableEncodings.Exists(Encoding) Then
            Set oEncoding = AvailableEncodings.Item(Encoding)
            DecodedMessage = oEncoding.Decode(Mid(Message, 2))
            If Len(DecodedMessage) > 0 Then
                AddChat Color.Red, "[ENC-" & oEncoding.ShortID & "] ", Color.Carats, "<", Color.TalkBotUsername, Channel.Self.Name, Color.Carats, "> ", Color.TalkNormalText, DecodedMessage
            End If
        End If
    End If
End Sub

Public Sub Event_ChatEventReceived(EventID, Flags, Ping, IP, Account, RegAuth, Username, Message)
    If EventID <> &H5 Then Exit Sub
    If Len(Message) < 2 Then Exit Sub
    
    IsEncoded = False
    For Each Encoding In AvailableEncodings.Items()
        If Left(Message, 1) = Encoding.MessageIndicator Then
            DecodedMessage = Encoding.Decode(Mid(Message, 2))
            
            If Len(DecodedMessage) > 0 Then
                VetoThisMessage
                AddChat Color.Red, "[ENC-" & Encoding.ShortID & "] ", Color.Carats, "<", Color.TalkUsernameNormal, Username, Color.Carats, "> ", Color.TalkNormalText, DecodedMessage
            End If
        End If
    Next
End Sub


Public Sub Send(ID, Message)
    If Not AvailableEncodings.Exists(ID) Then Exit Sub
    
    Set Encoding = AvailableEncodings(ID)
	Call SendInternal(Encoding, Message)
End Sub

Private Sub SendInternal(Encoding, Message)
    If Encoding Is Nothing Then Exit Sub
    
    TempUTF8 = Config.UseUTF8
    Config.UseUTF8 = False
    AddQ Encoding.MessageIndicator & Encoding.Encode(Message), -1, "Encoded " & Encoding.ShortID
End Sub

Public Sub TestEncoding(ID, Message)
    If Not AvailableEncodings.Exists(ID) Then Exit Sub
    
    Set Encoding = AvailableEncodings(ID)
    AddChat Color.Red, "[ENC-" & Encoding.ShortID & "] ", Color.Orange, "Input: " & Message
    
    EncodedMessage = Encoding.Encode(Message)
    AddChat Color.Red, "[ENC-" & Encoding.ShortID & "] ", Color.Orange, "Encoded: " & EncodedMessage
    
    Output = Encoding.Decode(EncodedMessage)
    AddChat Color.Red, "[ENC-" & Encoding.ShortID & "] ", Color.Orange, "Output: " & Output
    
    IsMatch = CBool(Message = Output)
    AddChat Color.Red, "[ENC-" & Encoding.ShortID & "] ", IIf(IsMatch, Color.Green, Color.Yellow), "Success: " & CStr(IsMatch)
End Sub

Function PadLeft(str, c, i)
	PadLeft = Right(String(i, c) & str, i)
End Function


Sub InitCommands()
    Call InitEncodingCommand(ENCODE_COMMAND, "Encodes the specified text.", 20, "G")
    Call InitEncodingCommand(DECODE_COMMAND, "Decodes the specified text.", 20, "G")
    Call InitEncodingCommand(ENCODE_CHAT_COMMAND, "Sends a message using the specified encoding.", 60, "T")
    
    If OpenCommand(ENCODE_LIST_COMMAND) Is Nothing Then
        Set cmd = CreateCommand(ENCODE_LIST_COMMAND)
        With cmd
            .Description = "Lists the available chat encodings."
            .RequiredRank = 20
            .RequiredFlags = "G"
            .Save
        End With
    End If
End Sub

Sub InitEncodingCommand(CommandName, Description, Rank, Flags)
    If OpenCommand(CommandName) Is Nothing Then
        Set cmd = CreateCommand(CommandName)
        With cmd
            Set param = .NewParameter("encoding", False, "word")
            param.Description = "The encoding to use."
            .Parameters.Add param
            
            Set param = .NewParameter("text", False, "string")
            param.Description = "The text to be encoded or decoded."
            .Parameters.Add param
            
            .Description = Description
            .RequiredRank = Rank
            .RequiredFlags = Flags
            .Save
        End With
    End If
End Sub

Class HexEncoding
    Public ShortID
    Public MessageIndicator
    
    Public Sub Class_Initialize()
        ShortID = "HEX"
        MessageIndicator = Chr(&HA3)
    End Sub
    
    Public Function Encode(Text)
        Encode = vbNullString
        For i = 1 To Len(Text)
            Encode = Encode & LCase(PadLeft(CStr(Hex(Asc(Mid(Text, i, 1)))), "0", 2))
        Next
    End Function
    
    Public Function Decode(Text)
        Text = Replace(Text, Space(1), vbNullString)
        
        Decode = vbNullString
        For i = 1 To Len(Text) Step 2
            Decode = Decode & Chr("&H" & Mid(Text, i, 2))
        Next
    End Function
End Class

Class Rot13Encoding
    Public ShortID
    Public MessageIndicator
    
    Public Sub Class_Initialize()
        ShortID = "ROT13"
        MessageIndicator = Chr(&HA5)
    End Sub
    
    Public Function Encode(Text)
        Encode = vbNullString
        For i = 1 To Len(Text)
            val = Asc(Mid(Text, i, 1))
            If ((val > 64 And val < 78) Or (val > 96 And val < 110)) Then Encode = Encode & Chr(val + 13)
            If ((val > 77 And val < 90) Or (val > 108 And val < 123)) Then Encode = Encode & Chr(val - 13)
        Next
    End Function
    
    Public Function Decode(Text)
        Decode = Encode(Text)
    End Function
End Class

Class Rot47Encoding
    Public ShortID
    Public MessageIndicator
    
    Public Sub Class_Initialize()
        ShortID = "ROT47"
        MessageIndicator = Chr(&HA6)
    End Sub
    
    Public Function Encode(Text)
        Encode = vbNullString
        For i = 1 To Len(Text)
            val = Asc(Mid(Text, i, 1))
            If val >= 33 And k <= 126 Then
                Encode = Encode & Chr(33 + ((val + 14) Mod 94))
            Else
                Encode = Encode & Chr(val)
            End If
        Next
    End Function
    
    Public Function Decode(Text)
        Decode = Encode(Text)
    End Function
End Class

Class InvigorationEncoding
    Public ShortID
    Public MessageIndicator
    
    Public Sub Class_Initialize()
        ShortID = "INVIG"
        MessageIndicator = Chr(&H95)
    End Sub
    
    Public Function Encode(Text)
        Combine = vbNullString
	
        For i = 1 To Len(Text)
            Combine = Combine & PadLeft(CStr(Asc(Mid(Text, i, 1))), "0", 3)
        Next
	
        Encode = vbNullString
        For i = 1 To Len(Combine)
            Encode = Encode & Chr(Asc(Mid(Combine, i, 1)) + 101)
        Next
    End Function
    
    Public Function Decode(Text)
    	Combine = vbNullString
	
        For i = 1 To Len(Text)
            Combine = Combine & Chr(Asc(Mid(Text, i, 1)) - 101)
        Next
	
        Decode = vbNullString
        For i = 1 To Len(Combine) Step 3
            Decode = Decode & Chr(Mid(Combine, i, 3))
        Next
    End Function
End Class

Class Base64Encoding
    Public ShortID
    Public MessageIndicator
    
    Private B64
    
    Public Sub Class_Initialize()
        ShortID = "BASE64"
        MessageIndicator = Chr(&HE6)
        
        B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"  
    End Sub
    
    Public Function Encode(Text)
        For i = 1 To Len(Text) Step 3
            group = &H10000 * Asc(Mid(Text, i, 1)) + &H100 * SafeAsc(Mid(Text, i + 1, 1)) + SafeAsc(Mid(Text, i + 2, 1))
            group = Oct(group)
            group = String(8 - Len(group), "0") & group
            
            out = Mid(B64, CLng("&o" & Mid(group, 1, 2)) + 1, 1) + _
                  Mid(B64, CLng("&o" & Mid(group, 3, 2)) + 1, 1) + _
                  Mid(B64, CLng("&o" & Mid(group, 5, 2)) + 1, 1) + _
                  Mid(B64, CLng("&o" & Mid(group, 7, 2)) + 1, 1)
                  
            Encode = Encode & out
        Next
        
        Select Case Len(Text) Mod 3
            Case 1: Encode = Left(Encode, Len(Encode) - 2) + "=="
            Case 2: Encode = Left(Encode, Len(Encode) - 1) + "="
        End Select
    End Function
    
    Public Function Decode(Text)
        Text = Replace(Text, " ", "")
        
        If length Mod 4 <> 0 Then
            AddChat Color.Red, "[ENC-" & ShortID & "] Invalid base64 string: ", Color.Orange, Text
            Exit Function
        End If
        
        For i = 1 To Len(Text) Step 4
            numBytes = 3
            group = 0
            
            For cnt = 0 To 3
                c = Mid(Text, i + cnt, 1)
                
                If c = "=" Then
                    numBytes = numBytes - 1
                    d = 0
                Else
                    d = InStr(1, B64, c, vbBinaryCompare) - 1
                End If
                
                If d = -1 Then
                    AddChat Color.Red, "[ENC-" & ShortID & "] Invalid character in base64 string: ", Color.Orange, c
                    Exit Function
                End If
                
                group = 64 * group + d
            Next
            
            group = Hex(group)
            group = String(6 - Len(group), "0") & group
            
            out = Chr(CByte("&H" & Mid(group, 1, 2))) + _
                  Chr(CByte("&H" & Mid(group, 3, 2))) + _
                  Chr(CByte("&H" & Mid(group, 5, 2)))
                  
            Decode = Decode & Left(out, numBytes)
        Next
    End Function
    
    Private Function SafeAsc(c)
        If c = "" Then SafeAsc = 0 Else SafeAsc = Asc(c)
    End Function
End Class