modedcode.vb.svn-base

MirUnleashed vb.net Module modMainServer Public WithEvents Socket As New WinsockServer Pub

Module EDCode
    Public Structure Header
        Dim nRecog As Long
        Dim wIdent As Int32
        Dim wParam As Int32
        Dim wTag As Int32
        Dim wSeries As Int32
    End Structure

#Region "Encode/Decode String"

    Public Function EncodeString(ByVal Str As String)
        EncodeString = Encode6BitBuf(Str, 512)
    End Function

    Public Function DecodeString(ByVal Str As String)
        Dim EndString As String
        Dim i As Integer

        For i = 1 To (Len(Str) / 4)
            EndString = EndString & Decode6BitBuf(Mid(Str, (((i * 4) - 4) + 1), 4))
        Next i
        EndString = EndString & Decode6BitBuf(Mid(Str, (((i * 4) - 4) + 1), 4))
        DecodeString = EndString
    End Function

#End Region
#Region "Encode/Decode Header "
    Public Function EncodeHeader(ByVal Header As Header) As String
        Dim Buff As String
        Buff = Header.nRecog & ")" & Header.wIdent & ")" & Header.wParam & ")" & Header.wTag & ")" & Header.wSeries
        EncodeHeader = EncodeString(Buff)
    End Function

    Public Function DecodeHeader(ByVal Header As String) As Header
        On Error Resume Next
        Dim HeaderStr As String
        Dim HeaderOut As Header
        HeaderStr = DecodeString(Header)
        HeaderOut.nRecog = GetTok(HeaderStr, 0, ")")
        HeaderOut.wIdent = GetTok(HeaderStr, 1, ")")
        HeaderOut.wParam = GetTok(HeaderStr, 2, ")")
        HeaderOut.wTag = GetTok(HeaderStr, 3, ")")
        HeaderOut.wSeries = GetTok(HeaderStr, 4, ")")
        DecodeHeader = HeaderOut
    End Function

    Public Function MakeHeader(ByVal wIdent As Short, Optional ByVal nRecog As Long = 0, Optional ByVal wParam As Int32 = 0, Optional ByVal wTag As Int32 = 0, Optional ByVal wSeries As Int32 = 0) As String
        Dim Header As Header
        Header.wIdent = wIdent
        Header.nRecog = nRecog
        Header.wParam = wParam
        Header.wTag = wTag
        Header.wSeries = wSeries
        MakeHeader = EncodeHeader(Header)
    End Function
#End Region
#Region "Encode/Decode Packet"

    Public Function MakeOutPacket(ByVal Header As String, Optional ByVal Body As String = "") As String
        Dim Data As String = Header & "^j^" & Body
        Data = EncodeString(Data)
        'Data = "/" & Data & ":"
        Data = Data & Chr(30)
        Return Data
    End Function

    Public Function DecodePacketHeader(ByVal Packet As String) As Header
        Dim tHeader As String
        Dim Header As Header

        'Packet = Packet.TrimStart("/")
        'Packet = Packet.TrimEnd(":")
        Packet = Packet.TrimEnd(Chr(30))

        Packet = DecodeString(Packet)
        tHeader = GetTok(Packet, 0, "^j^")
        Header = DecodeHeader(tHeader)
        Return Header
    End Function

    Public Function DecodePacketBody(ByVal Packet As String) As String
        Dim tBody, Body As String

        'Packet = Packet.TrimStart("/")
        'Packet = Packet.TrimEnd(":")
        Packet = Packet.TrimEnd(Chr(30))

        Packet = DecodeString(Packet)
        tBody = GetTok(Packet, 1, "^j^")
        Body = DecodeString(tBody)
        Return Body
    End Function

#End Region

#Region "Bit Encode/Decode"

    Public Function Encode6BitBuf(ByVal Src As String, ByVal DestLen As Integer)
        Dim i, RestCount, DestPos, SrcLen As Integer
        Dim Made, CH, Rest As Byte
        Dim EndString As String
        SrcLen = Len(Src)
        RestCount = 0
        Rest = 0
        DestPos = 0
        For i = 0 To (SrcLen - 1)
            CH = Asc(Mid(Src, (i + 1), 1))
            Made = (Rest Or (RShift(CH, (2 + RestCount))) And 63)
            Rest = (RShift(LShift(CH, (8 - (2 + RestCount))), 2) And 63)
            RestCount = RestCount + 2
            If RestCount < 6 Then
                EndString = EndString & Chr(Made + 40)
                DestPos = DestPos + 1
            Else
                If DestPos < (DestLen - 1) Then
                    EndString = EndString & Chr(Made + 40)
                    EndString = EndString & Chr(Rest + 40)
                    DestPos = DestPos + 1
                Else
                    EndString = EndString & Chr(Made + 40)
                    DestPos = DestPos + 1
                End If
                RestCount = 0
                Rest = 0
            End If
        Next i
        If RestCount > 0 Then
            EndString = EndString & Chr(Rest + 40)
            DestPos = DestPos + 1
        End If
        Encode6BitBuf = EndString
    End Function

    Public Function Decode6BitBuf(ByVal Data As String)
        Dim i, BitPos, BufPos, MadeBit As Integer
        Dim CH, Tmp, WierdByte As Byte
        Dim Buf As String
        Dim Masks(4) As Byte
        Masks(0) = &HFC
        Masks(1) = &HF8
        Masks(2) = &HF0
        Masks(3) = &HE0
        Masks(4) = &HC0
        BitPos = 2
        MadeBit = 0
        BufPos = 0
        Tmp = 0
        For i = 1 To Len(Data)
            If (Asc(Mid(Data, i, 1)) - 40) >= 0 Then
                CH = (Asc(Mid(Data, i, 1)) - 40)
            Else
                GoTo Break
            End If
            If (MadeBit + 6) >= 8 Then
                WierdByte = (Tmp Or RShift((CH And 63), (6 - BitPos)))
                Buf = Buf & Chr(WierdByte)
                MadeBit = 0
                If BitPos < 6 Then
                    BitPos = BitPos + 2
                Else
                    BitPos = 2
                    GoTo Break
                End If
            End If
            Tmp = (LShift(CH, BitPos) And Masks(BitPos - 2))
            MadeBit = (8 - BitPos)
Break:
        Next i
        Decode6BitBuf = Buf
    End Function

#End Region

#Region "Bit Shift"

    Public Enum BitShiftDir
        Left = 1
        Right = 2
    End Enum

    Public Function Shift(ByVal lvalue As Long, ByVal lbits As Long, ByVal ldir As BitShiftDir)
        If ldir = BitShiftDir.Left Then Shift = lvalue * (2 ^ lbits)
        If ldir = BitShiftDir.Right Then Shift = lvalue \ (2 ^ lbits)
    End Function

    Public Function LShift(ByVal lvalue As Long, ByVal lbits As Long) As Long
        LShift = Shift(lvalue, lbits, BitShiftDir.Left)
    End Function
    Public Function RShift(ByVal lvalue As Long, ByVal lbits As Long) As Long
        RShift = Shift(lvalue, lbits, BitShiftDir.Right)
    End Function

#End Region

End Module