1
0
mirror of https://e.coding.net/circlecloud/MCServer_Protocol.git synced 2024-11-25 15:28:49 +00:00

首次提交...

Signed-off-by: j502647092 <jtb1@163.com>
This commit is contained in:
j502647092 2015-08-03 16:32:06 +08:00
commit bfc0bdebf6
5 changed files with 842 additions and 0 deletions

607
Frm_Main.frm Normal file
View File

@ -0,0 +1,607 @@
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Frm_Main
BorderStyle = 1 'Fixed Single
Caption = "MCServer_Protocol"
ClientHeight = 8385
ClientLeft = 825
ClientTop = 1530
ClientWidth = 8880
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8385
ScaleWidth = 8880
Begin VB.ListBox List1
Height = 2220
Left = 105
TabIndex = 1
Top = 1455
Width = 8625
End
Begin VB.TextBox datachr
Height = 300
Left = 105
TabIndex = 42
Top = 1110
Width = 8640
End
Begin VB.TextBox resenddelay
Height = 270
Left = 7590
TabIndex = 41
Text = "100"
Top = 7710
Width = 435
End
Begin VB.CheckBox resendc
Caption = "开始发送"
Height = 225
Left = 7605
TabIndex = 40
Top = 7425
Width = 1035
End
Begin VB.TextBox resenddata
Height = 930
Left = 105
MultiLine = -1 'True
TabIndex = 39
Top = 7335
Width = 7350
End
Begin VB.Timer resend
Index = 0
Left = 8025
Top = 8925
End
Begin VB.TextBox rconcommand
Height = 300
Left = 105
TabIndex = 38
Top = 6525
Width = 1515
End
Begin VB.TextBox Text1
Height = 300
Index = 5
Left = 1620
TabIndex = 37
Top = 6525
Width = 5850
End
Begin VB.TextBox rconpassword
Height = 300
Left = 105
TabIndex = 36
Top = 6225
Width = 1515
End
Begin VB.TextBox Text1
Height = 300
Index = 3
Left = 1620
TabIndex = 35
Top = 6225
Width = 5850
End
Begin VB.CommandButton Command1
Caption = "数据发送"
Height = 345
Index = 6
Left = 7500
TabIndex = 34
Top = 6930
Width = 1245
End
Begin VB.TextBox Text1
Height = 300
Index = 6
Left = 105
TabIndex = 33
Top = 6945
Width = 7365
End
Begin VB.CommandButton Command1
Caption = "RCON命令"
Height = 345
Index = 5
Left = 7500
TabIndex = 32
Top = 6525
Width = 1245
End
Begin VB.CheckBox getdatac
Caption = "接受数据"
Height = 195
Left = 3990
TabIndex = 31
Top = 240
Width = 1125
End
Begin VB.CheckBox checkwsk
Caption = "自动检测"
Height = 195
Left = 3990
TabIndex = 30
Top = 30
Width = 1125
End
Begin VB.ComboBox port
Height = 300
Left = 2940
TabIndex = 29
Text = "25565"
Top = 60
Width = 840
End
Begin VB.ComboBox addr
Height = 300
Left = 585
TabIndex = 28
Text = "127.0.0.1"
Top = 60
Width = 1815
End
Begin VB.TextBox chrinfo
Height = 300
Left = 105
TabIndex = 27
Top = 795
Width = 8640
End
Begin VB.TextBox finfo
Height = 300
Left = 105
TabIndex = 26
Top = 480
Width = 8640
End
Begin VB.CheckBox heart
Caption = "心跳包"
Height = 195
Left = 5190
TabIndex = 25
Top = 240
Width = 1125
End
Begin VB.TextBox commandT
Height = 300
Left = 105
TabIndex = 24
Top = 5535
Width = 7365
End
Begin VB.CheckBox autosend
Caption = "自动发送"
Height = 195
Left = 5190
TabIndex = 23
Top = 30
Width = 1125
End
Begin VB.Timer check
Enabled = 0 'False
Interval = 1000
Left = 8205
Top = 8730
End
Begin VB.CommandButton addwsk
Caption = "添加"
Height = 300
Left = 7755
TabIndex = 22
Top = 60
Width = 600
End
Begin VB.Timer keeplive
Enabled = 0 'False
Index = 0
Interval = 500
Left = 8445
Top = 8610
End
Begin VB.TextBox user
Height = 300
Left = 810
TabIndex = 21
Text = "Badbody"
Top = 4050
Width = 795
End
Begin VB.TextBox wskindex
Alignment = 2 'Center
Height = 300
Left = 8460
TabIndex = 20
Text = "0"
Top = 60
Width = 240
End
Begin VB.TextBox Text1
Height = 300
Index = 4
Left = 105
TabIndex = 19
Top = 5835
Width = 7365
End
Begin VB.CommandButton Command1
Caption = "命令-聊天 数据包发送"
Height = 600
Index = 4
Left = 7515
TabIndex = 18
Top = 5535
Width = 1245
End
Begin VB.CommandButton Command1
Caption = "RCON登录"
Height = 345
Index = 3
Left = 7500
TabIndex = 17
Top = 6195
Width = 1245
End
Begin VB.CommandButton Command1
Caption = "Ping包"
Height = 345
Index = 2
Left = 7515
TabIndex = 16
Top = 5130
Width = 1245
End
Begin VB.TextBox Text1
Height = 300
Index = 2
Left = 105
TabIndex = 15
Top = 5145
Width = 7365
End
Begin VB.CommandButton Command1
Caption = "信息获取包"
Height = 345
Index = 1
Left = 7515
TabIndex = 14
Top = 4800
Width = 1245
End
Begin VB.TextBox Text1
Height = 300
Index = 1
Left = 105
TabIndex = 13
Top = 4815
Width = 7365
End
Begin VB.CommandButton Command1
Caption = "握手包-信息"
Height = 345
Index = 0
Left = 7515
TabIndex = 12
Top = 4470
Width = 1245
End
Begin VB.TextBox Text1
Height = 300
Index = 0
Left = 105
TabIndex = 11
Top = 4485
Width = 7365
End
Begin VB.CommandButton connect
Caption = "连接"
Height = 300
Left = 6495
TabIndex = 7
Top = 60
Width = 600
End
Begin VB.CommandButton stop
Caption = "断开"
Height = 300
Left = 7125
TabIndex = 6
Top = 60
Width = 600
End
Begin VB.TextBox username
Height = 300
Left = 1605
TabIndex = 5
Top = 4050
Width = 1650
End
Begin VB.TextBox userdata
Height = 300
Left = 3285
TabIndex = 4
Top = 4050
Width = 4185
End
Begin VB.CommandButton userdataC
Caption = "用户名发送"
Height = 345
Left = 7515
TabIndex = 3
Top = 4050
Width = 1245
End
Begin MSWinsockLib.Winsock Wsk
Index = 0
Left = 8400
Top = 8730
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.CommandButton logindataC
Caption = "握手包-登录"
Height = 345
Left = 7515
TabIndex = 2
Top = 3720
Width = 1245
End
Begin VB.TextBox logindata
Height = 300
Left = 105
TabIndex = 0
Top = 3750
Width = 7365
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "用户名:"
Height = 180
Left = 105
TabIndex = 10
Top = 4110
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "端口:"
Height = 180
Index = 1
Left = 2460
TabIndex = 9
Top = 120
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "地址:"
Height = 180
Index = 0
Left = 135
TabIndex = 8
Top = 120
Width = 540
End
End
Attribute VB_Name = "Frm_Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'=================================Sleep========================================
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Savetime As Double
Private UseTime As Double
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal byteLen As Long)
'**********************************************************************************************************
'***过程名Sleep()
'***功 能 :延时
'***输入值:(延时大小 As Long[毫秒])
'***输出值Null
'***说 明:用于延时
'**********************************************************************************************************
Public Sub Sleep(n As Long)
Savetime = timeGetTime
While timeGetTime < Savetime + n
DoEvents
Wend
End Sub
Private Sub addwsk_Click()
Load Wsk(Wsk.Count)
Load keeplive(keeplive.Count)
wskindex = Wsk.UBound
End Sub
Private Sub check_Timer()
On Error Resume Next
Dim i As Long
For i = Wsk.LBound To Wsk.UBound
If autosend.Value = 1 Then GoTo relink
If keeplive(i).Enabled = True And Wsk(i).State <> sckConnected Then
relink:
Wsk(i).Close
Wsk(i).connect addr, port
End If
Next
End Sub
Private Sub checkwsk_Click()
If checkwsk.Value = 1 Then
check.Enabled = True
Else
check.Enabled = False
End If
End Sub
Private Sub Command1_Click(Index As Integer)
If Wsk(wskindex).State = sckConnected And Text1(Index).Text <> "" Then
Wsk(wskindex).SendData hextobyte(Text1(Index).Text)
End If
End Sub
Private Sub commandT_Change()
Text1(4).Text = Encode(commandT.Text, EncodeNormal, "01")
End Sub
Private Sub connect_Click()
If Wsk(wskindex).State = sckClosed Then
Wsk(wskindex).connect addr, port
List1.Clear
End If
End Sub
Private Sub finfo_Change()
On Error Resume Next
Dim info() As Byte
Dim cinfo() As String
Dim i As Long
cinfo = Split(finfo, " ")
If UBound(cinfo) = 0 Then Exit Sub
ReDim info(UBound(cinfo) + 1)
For i = LBound(cinfo) To UBound(cinfo)
info(i) = "&H" & cinfo(i)
Next
chrinfo = ""
chrinfo = UTF8_Decode(info)
Dim datainfo() As Byte
ReDim datainfo(UBound(info))
Call CopyMemory(datainfo(0), info(3), UBound(datainfo))
datachr = ""
datachr = UTF8_Decode(datainfo)
End Sub
Private Sub heart_Click()
Dim i As Long
If heart.Value = 1 Then
For i = keeplive.LBound To keeplive.UBound
keeplive(i).Enabled = True
List1.AddItem "端口" & i & " 开始发送心跳包"
Next
Else
For i = keeplive.LBound To keeplive.UBound
keeplive(i).Enabled = False
List1.AddItem "端口" & i & " 停止发送心跳包"
Next
End If
End Sub
Private Sub keeplive_Timer(Index As Integer)
On Error Resume Next
If Wsk(Index).State = sckConnected Then Wsk(Index).SendData hextobyte("02 03 01")
End Sub
Private Sub List1_Click()
finfo = List1.List(List1.ListIndex)
End Sub
Private Sub List1_DblClick()
List1.Height = Me.Height - List1.Top
End Sub
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And List1.Height = 2220 Then List1.Height = Me.Height - List1.Top - 500 Else List1.Height = 2220
End Sub
Private Sub logindataC_Click()
Wsk(wskindex).SendData hextobyte(logindata)
End Sub
Private Sub rconcommand_Change()
Text1(5).Text = Encode(rconcommand, EncodeRcon, "02")
End Sub
Private Sub rconpassword_Change()
Text1(3).Text = Encode(rconpassword, EncodeRcon, "03")
End Sub
Private Sub resend_Timer(Index As Integer)
If Wsk(Index).State = sckConnected Then Wsk(Index).SendData hextobyte(resenddata)
resend(Index).Interval = Val(resenddelay)
End Sub
Private Sub resendc_Click()
resend(wskindex).Enabled = resendc.Value
End Sub
Private Sub stop_Click()
Wsk(wskindex).Close
keeplive(wskindex).Enabled = False
End Sub
Private Sub userdataC_Click()
Wsk(wskindex).SendData hextobyte(userdata.Text)
End Sub
Private Sub username_Change()
userdata.Text = Encode(username, EncodeNormal, "00")
End Sub
Private Sub Wsk_Close(Index As Integer)
List1.AddItem Index & " 连接已断开!"
Wsk(Index).Close
If autosend.Value = 1 Then Wsk(Index).connect addr, port
keeplive(Index).Enabled = False
End Sub
Private Sub Wsk_Connect(Index As Integer)
Dim tempip As String
Dim rndusername As String
List1.AddItem Index & " 连接到服务器!"
List1.AddItem Wsk(Index).RemoteHostIP
Text1(0) = Encode(addr & ":" & port, EncodeIP, "00-2F", "01")
logindata = Encode(addr & ":" & port, EncodeIP, "00-04", "02")
Text1(1) = "01 00"
Text1(2) = "09 01 00 00 00 00 00 94-CA 29"
If autosend.Value = 1 Then
If Index / 2 = 0 Then
Sleep (100)
If Wsk(Index).State = sckConnected Then Wsk(Index).SendData hextobyte(Text1(0).Text)
Sleep (100)
If Wsk(Index).State = sckConnected Then Wsk(Index).SendData hextobyte(Text1(1).Text)
Else
Sleep (200)
If Wsk(Index).State = sckConnected Then Wsk(Index).SendData hextobyte(Text1(2))
Randomize
rndusername = user.Text + hex(Rnd() * 100000)
username = rndusername
userdata = Encode(rndusername, EncodeNormal, "00")
Sleep (200)
If Wsk(Index).State = sckConnected Then Wsk(Index).SendData hextobyte(userdata)
End If
End If
List1.ListIndex = List1.ListCount - 1
End Sub
Private Sub Wsk_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim bytes() As Byte
Dim Temp As String
Dim i As Long
Wsk(Index).GetData bytes, vbByte + vbArray
If getdatac.Value = 1 Then
For i = LBound(bytes) To UBound(bytes)
Temp = Temp & hex(bytes(i)) & " "
DoEvents
Next
List1.AddItem Temp
List1.ListIndex = List1.ListCount - 1
End If
End Sub
Private Sub wskindex_Change()
Dim wskindexid
wskindexid = Val(wskindex)
If NotObject(Wsk(wskindexid)) Then Load Wsk(wskindexid)
If NotObject(resend(wskindexid)) Then Load resend(wskindexid)
If NotObject(keeplive(wskindexid)) Then Load keeplive(wskindexid)
End Sub

33
MCServer_Protocol.vbp Normal file
View File

@ -0,0 +1,33 @@
Type=Exe
Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX
Module=MC_TCP; MC_TCP.bas
Form=Frm_Main.frm
Module=UTF8COde; UTF8Code.bas
Startup="Frm_Main"
HelpFile=""
ExeName32="MCServer_Protocol.exe"
Command32=""
Name="MCServer_Protocol"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

3
MCServer_Protocol.vbw Normal file
View File

@ -0,0 +1,3 @@
MC_TCP = -217, 180, 1279, 685,
Frm_Main = 0, 0, 1496, 615, Z, 22, 22, 644, 715, C
UTF8COde = 0, 0, 0, 0, C

112
MC_TCP.bas Normal file
View File

@ -0,0 +1,112 @@
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

87
UTF8Code.bas Normal file
View File

@ -0,0 +1,87 @@
Attribute VB_Name = "UTF8COde"
Option Explicit
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Function UTF8_Encode(ByVal strUnicode As String) As Byte()
'UTF-8 编码
Dim TLen As Long
Dim lngBufferSize As Long
Dim lngResult As Long
Dim bytUtf8() As Byte
TLen = Len(strUnicode)
If TLen = 0 Then Exit Function
lngBufferSize = TLen * 3 + 1
ReDim bytUtf8(lngBufferSize - 1)
lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), TLen, bytUtf8(0), lngBufferSize, vbNullString, 0)
If lngResult <> 0 Then
lngResult = lngResult - 1
ReDim Preserve bytUtf8(lngResult)
End If
UTF8_Encode = bytUtf8
End Function
Public Function UTF8_Decode(ByRef bUTF8() As Byte) As String
'UTF-8 解码
Dim lRet As Long
Dim lLen As Long
Dim lBufferSize As Long
Dim sBuffer As String
Dim bBuffer() As Byte
lLen = UBound(bUTF8) + 1
If lLen = 0 Then Exit Function
lBufferSize = lLen * 2
sBuffer = String$(lBufferSize, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(bUTF8(0)), lLen, StrPtr(sBuffer), lBufferSize)
If lRet <> 0 Then
sBuffer = Left(sBuffer, lRet)
End If
UTF8_Decode = sBuffer
End Function
Public Function CreateStringFromByte(ByRef byteArray() As Byte, ByVal ByteLength As Long) As String
'字节数组中的数据连接成字符串
Dim StringData As String
'** 分配字符串空间
StringData = Space(ByteLength)
'** 复制字符数组地址内容到字符串地址
MoveMemory ByVal StringData, ByVal VarPtr(byteArray(0)), ByteLength
'** 返回字符串
CreateStringFromByte = StringData
End Function
Public Function SaveStringToByteArry(ByRef strString As String) As Byte()
'把字符串存入字节数组
Dim BytArray() As Byte, lngStrLen As Long
'** 获取字符串的长度(字节)
lngStrLen = LenB(StrConv(strString, vbFromUnicode))
'** 分配数组空间
ReDim BytArray(lngStrLen - 1)
'** 将字符串地址中的内容拷贝到数组
MoveMemory ByVal VarPtr(BytArray(0)), ByVal strString, lngStrLen
SaveStringToByteArry = BytArray
End Function