mirror of
https://e.coding.net/circlecloud/MCServer_Protocol.git
synced 2024-11-22 14:58:49 +00:00
113 lines
3.3 KiB
QBasic
113 lines
3.3 KiB
QBasic
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
|
||
|
||
'**********************************************************************************************************
|
||
'***过程名：Sleep()
|
||
'***功 能 ：延时
|
||
'***输入值：(延时大小 As Long[毫秒])
|
||
'***输出值：Null
|
||
'***说 明：用于延时
|
||
'**********************************************************************************************************
|
||
Public Sub Sleep(n As Long)
|
||
Savetime = timeGetTime
|
||
While timeGetTime < Savetime + n
|
||
DoEvents
|
||
Wend
|
||
End Sub
|
||
|
||
Function NotObject(Obj As Object) As Boolean '判断控件数组元素对象是否存在
|
||
'存在返回 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
|
||
|
||
Private 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
|
||
|
||
|
||
|