MCServer_Protocol/MC_TCP.bas

Attribute VB_Name = "MC_TCP"
Option Explicit
'=================================Sleep========================================
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Savetime As Double
Private UseTime As Double

Public Enum EncodeType
    EncodeIP
    EncodeCommand
    EncodeChat
    EncodeUser
    EncodeNormal
    EncodeRcon
End Enum

'**********************************************************************************************************
'***<2A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Sleep()
'***<2A><> <20><> <20><><EFBFBD><EFBFBD>ʱ
'***<2A><><EFBFBD><EFBFBD>ֵ<EFBFBD><D6B5>(<28><>ʱ<EFBFBD><CAB1>С As Long[<5B><><EFBFBD><EFBFBD>])
'***<2A><><EFBFBD><EFBFBD>ֵ<EFBFBD><D6B5>Null
'***˵  <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ
'**********************************************************************************************************
Public Sub Sleep(n As Long)
    Savetime = timeGetTime
    While timeGetTime < Savetime + n
        DoEvents
    Wend
End Sub

Function NotObject(Obj As Object) As Boolean  '<27>жϿؼ<CFBF><D8BC><EFBFBD><EFBFBD><EFBFBD>Ԫ<EFBFBD>ض<EFBFBD><D8B6><EFBFBD><EFBFBD>Ƿ<EFBFBD><C7B7><EFBFBD><EFBFBD><EFBFBD>
'<27><><EFBFBD>ڷ<EFBFBD><DAB7><EFBFBD> true
    Dim chk
    On Error GoTo Errh
    NotObject = False
    chk = Obj.Index
    Exit Function
Errh:
    If Err > 0 Then NotObject = True
End Function

Function hextobyte(hex As String)
    Dim bytes() As Byte
    Dim data() As String
    Dim i As Long
    If hex = "" Then Exit Function
    hex = Replace(hex, "-", " ")
    data = Split(hex, " ")
    ReDim bytes(UBound(data))
    For i = LBound(data) To UBound(data)
        If IsNumeric(data(i)) Then data(i) = Trim(Val(data(i)))
        If data(i) <> "" Then bytes(i) = "&H" & data(i)
        DoEvents
    Next
    hextobyte = bytes
End Function

Public Function hhex(data As Long) As String
    Dim Temp As String
    Temp = hex(data)
    If Len(Temp) = 1 Then Temp = "0" + Temp
    hhex = Temp
End Function

Private Function porthex(ByVal port As Long) As String
    Dim Temp As String
    Temp = hex(port)
    If Len(Temp) = 4 Then porthex = Left(Temp, 2) & " " & Right(Temp, 2)
End Function

Function Encode(ByVal Code As String, ByVal CD As EncodeType, Optional ByVal Flags As String, Optional ByVal EFlags As String) As String
    Dim Codelen As Long
    Dim i As Long
    Dim Temp As String
    Dim eip As String
    Dim eport As Long
    If Code = "" Then Exit Function
    Select Case CD
    Case EncodeIP
        If InStr(1, Code, ":") = 0 Then Exit Function
        eip = Split(Code, ":")(0)
        eport = Split(Code, ":")(1)
        Codelen = SEncode(eip, Temp)
        Encode = hhex(Codelen + 6) & " " & Flags & " " & hhex(Codelen) & " " & _
                 Temp & " " & porthex(eport) & " " & EFlags
    Case EncodeUser, EncodeNormal
        Codelen = SEncode(Code, Temp)
        Encode = hhex(Codelen + 2) & " " & Flags & " " & hhex(Codelen) & " " & Temp
    Case EncodeChat, EncodeCommand
        Codelen = SEncode(Code, Temp)
        Encode = hhex(Codelen + 2) & " 01 " & hhex(Codelen) & " " & Temp
    Case EncodeRcon
        Codelen = SEncode(Code, Temp)
        Encode = hhex(Codelen + 9) & " 00 00 00 00 00 00 00 " & Flags & " 00 00 00 " & Temp & " 00"
    End Select
    Encode = Trim(Encode)
End Function

Function SEncode(ByVal Code As String, ByRef Coded As String) As Long
    Dim i As Long
    Dim Codedata() As Byte
    Dim Temp As String
    Codedata = UTF8_Encode(Code)
    SEncode = UBound(Codedata) + 1
    For i = LBound(Codedata) To UBound(Codedata)
        Temp = Temp + hex(Codedata(i)) + " "
    Next
    Coded = Trim(Temp)
End Function