modparsedata.bas

使用vb寫出完美網頁遊戲外掛的原始碼分享

Attribute VB_Name = "ModParseData"
Option Explicit
Public Chan_List() As Channel_Info, send80 As Boolean
Public tmppacket() As String
Public Sub print_packet(packet As String, Text As String)
    Dim tstr As String
    Dim X As Integer
    tmppacket(UBound(tmppacket)) = packet
    ReDim Preserve tmppacket(UBound(tmppacket) + 1)
    tstr = ""
    For X = 1 To IIf(Len(packet) >= 8, 8, Len(packet))
       If Asc(Mid(packet, X, 1)) < 16 Then tstr = tstr + "0"
       tstr = tstr + Hex(Asc(Mid(packet, X, 1))) + " "
       'If x Mod 19 = 0 Then tstr = tstr & vbCrLf
    Next
        tstr = Left(tstr, Len(tstr) - 1)
        frmDebug.lstpacket.AddItem "[" & Time & "]" & Text & " " & tstr
        'DoColor frmDebug.rtbDebug, Chr(3) & "14[" & Chr(3) & "15" & Time & Chr(3) & "4 " & Text & Chr(3) & "14] " & tstr
End Sub


Public Sub PrintP(Head As String, packet As String)
    Dim tstr As String
    Dim X As Integer
    tstr = ""
    For X = 1 To Len(packet)
       If Asc(Mid(packet, X, 1)) < 16 Then tstr = tstr + "0"
       tstr = tstr + Hex(Asc(Mid(packet, X, 1))) + " "
       If X Mod 19 = 0 Then tstr = tstr & vbCrLf
    Next
       tstr = Left(tstr, Len(tstr) - 1)
       Open App.Path & "\log\" & ChrtoHex(Head) & ".txt" For Append As #1
       Print #1, " == " & ChrtoHex(Head) & "                  " & Len(packet) & " Bytes == "
       Print #1, tstr
       Close 1
End Sub


Public Sub ParseData()
Dim ChopNumber As Long
Dim tmpData As String
Dim NoJump As Boolean
  'On Error GoTo runtime5

restart:
If Len(RecvData) < 2 Then Exit Sub
ChopNumber = MakePort(Mid(RecvData, 3, 2))
tmpData = Mid(RecvData, 5, ChopNumber)
If (Len(tmpData) < ChopNumber And (Mid(RecvData, 1, 2) = (Chr(&HAA) & Chr(&H55)))) Then Exit Sub
Select Case Mid(RecvData, 1, 2)
Case Chr(&H1) & Chr(&H80)
    Pack_0180 tmpData
Case Chr(&H17) & Chr(&H80) 'list server
    Pack_1780 tmpData
Case Chr(&H64) & Chr(&H80)
    Pack_6480 tmpData
Case Chr(&HAA) & Chr(&H55)
    tmpData = Mid(RecvData, 5, ChopNumber)
    packet tmpData
Case Chr(&H32) & Chr(&H80) '32 80 04 00 18 00 03 00
    Pack_3280 tmpData
Case Else
    MsgBox "UnKnown Packet: " & MakePort(Mid(RecvData, 1, 2)) & " (Chr(" & UCase(Hex(MakePort(Mid(RecvData, 1, 1)))) & ") " & "Chr(" & UCase(Hex(MakePort(Mid(RecvData, 2, 1)))) & "))"
End Select
If (Mid(RecvData, 1, 2) = (Chr(&HAA) & Chr(&H55))) Then
    RecvData = Right(RecvData, Len(RecvData) - ChopNumber - 6)
Else
    RecvData = ""
End If
Exit Sub
runtime5:
RecvData = ""
End Sub

Public Sub packet(sData As String)
Select Case MakePort(Mid(sData, 3, 2))
    Case &H80
        If (Not send80) Then SendPacket Chr(&H72) & Chr(&H0) & Chr(&H5) & Chr(&H0) & Chr(&H1) & Chr(&H0) & _
      Chr(Char) & Chr(&H0) & Chr(&H61) & Chr(&H0), 1: send80 = True
        
    Case &H2
        frmChar.lstChar.Clear
        send80 = False
        SendPacket Chr(&H8) & Chr(&H0) & Chr(&H10) & Chr(&H0) & Chr(&H0) & Chr(&H0), 1
        ReDim LoginChar(0)
    Case &H11 '靡屡朽驼麓笛桥肖