mirror of
https://e.coding.net/circlecloud/MCServer_Protocol.git
synced 2024-11-21 14:48:51 +00:00
首次提交...
Signed-off-by: j502647092 <jtb1@163.com>
This commit is contained in:
j502647092
commit
bfc0bdebf6
607
Frm_Main.frm
Normal file
607
Frm_Main.frm
Normal 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
33
MCServer_Protocol.vbp
Normal 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
3
MCServer_Protocol.vbw
Normal 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
112
MC_TCP.bas
Normal 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
87
UTF8Code.bas
Normal 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
|
||||
Loading…
Reference in New Issue
Block a user