1
0
mirror of https://e.coding.net/circlecloud/MCServer_Protocol.git synced 2024-11-22 14:58:49 +00:00
MCServer_Protocol/Frm_Main.frm
j502647092 a2a721b14b 增加协议号的修改...
Signed-off-by: j502647092 <jtb1@163.com>
2015-08-04 16:48:31 +08:00

616 lines
17 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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.TextBox protocolver
Height = 300
Left = 6075
TabIndex = 43
Text = "47"
Top = 60
Width = 315
End
Begin VB.CheckBox autosend
Caption = "自动发送"
Height = 195
Left = 4950
TabIndex = 42
Top = 30
Width = 1125
End
Begin VB.CheckBox heart
Caption = "心跳包"
Height = 195
Left = 4950
TabIndex = 41
Top = 240
Width = 1125
End
Begin VB.ListBox List1
Height = 2220
Left = 105
TabIndex = 1
Top = 1455
Width = 8625
End
Begin VB.TextBox datachr
Height = 300
Left = 105
TabIndex = 40
Top = 1110
Width = 8640
End
Begin VB.TextBox resenddelay
Height = 270
Left = 7590
TabIndex = 39
Text = "100"
Top = 7710
Width = 435
End
Begin VB.CheckBox resendc
Caption = "开始发送"
Height = 225
Left = 7605
TabIndex = 38
Top = 7425
Width = 1035
End
Begin VB.TextBox resenddata
Height = 930
Left = 105
MultiLine = -1 'True
TabIndex = 37
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 = 36
Top = 6525
Width = 1515
End
Begin VB.TextBox Text1
Height = 300
Index = 5
Left = 1620
TabIndex = 35
Top = 6525
Width = 5850
End
Begin VB.TextBox rconpassword
Height = 300
Left = 105
TabIndex = 34
Top = 6225
Width = 1515
End
Begin VB.TextBox Text1
Height = 300
Index = 3
Left = 1620
TabIndex = 33
Top = 6225
Width = 5850
End
Begin VB.CommandButton Command1
Caption = "数据发送"
Height = 345
Index = 6
Left = 7500
TabIndex = 32
Top = 6930
Width = 1245
End
Begin VB.TextBox Text1
Height = 300
Index = 6
Left = 105
TabIndex = 31
Top = 6945
Width = 7365
End
Begin VB.CommandButton Command1
Caption = "RCON命令"
Height = 345
Index = 5
Left = 7500
TabIndex = 30
Top = 6525
Width = 1245
End
Begin VB.CheckBox getdatac
Caption = "接受数据"
Height = 195
Left = 3840
TabIndex = 29
Top = 240
Width = 1125
End
Begin VB.CheckBox checkwsk
Caption = "自动检测"
Height = 195
Left = 3840
TabIndex = 28
Top = 30
Width = 1125
End
Begin VB.ComboBox port
Height = 300
Left = 2940
TabIndex = 27
Text = "25565"
Top = 60
Width = 840
End
Begin VB.ComboBox addr
Height = 300
Left = 585
TabIndex = 26
Text = "127.0.0.1"
Top = 60
Width = 1815
End
Begin VB.TextBox chrinfo
Height = 300
Left = 105
TabIndex = 25
Top = 795
Width = 8640
End
Begin VB.TextBox finfo
Height = 300
Left = 105
TabIndex = 24
Top = 480
Width = 8640
End
Begin VB.TextBox commandT
Height = 300
Left = 105
TabIndex = 23
Top = 5535
Width = 7365
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.Text & ":" & port.Text, EncodeIP, "00-" + hhex(protocolver.Text), "01")
logindata = Encode(addr.Text & ":" & port.Text, EncodeIP, "00-" + hhex(protocolver.Text), "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