VB 从零开始编外挂(八)

类别:.NET开发 点击:0 评论:0 推荐:

--------------------------------------------------------------------------------------------------------------------------------------------------------
做外挂的人都知道,目前有两种办法制作网络游戏外挂。一种是封包式另外一种是内存式!下面就给大家制作一个抓包器,来研究一下,网络游戏的数据!

--------------------------------------------------------------------------------------------------------------------------------------------------------

Private Sub Form_Load()
CountID = 0
ExitID = False
ListView1.ColumnHeaders.Add 1, , "源 IP", 1500
ListView1.ColumnHeaders.Add 2, , "源端口", 1500
ListView1.ColumnHeaders.Add 3, , "目标 IP", 1500
ListView1.ColumnHeaders.Add 4, , "目标端口", 1500
ListView1.ColumnHeaders.Add 5, , "协议", 1500
ListView1.ColumnHeaders.Add 6, , "时间", 1500
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call WCleanup(s)
Unload Me
End Sub

Private Sub ListView1_Click()
Dim coun As Long
Dim sar As String, sar3 As String
Dim sar1 As String, sar2 As String

RichTextBox1.Text = ""                      '清除 RichTextBox1
Dim buffer() As Byte
buffer = str

If ListView1.SelectedItem Is Nothing Then   '如果 ListView1 控件没有数值则提示错误
    Exit Sub
End If


'将 buffer 的值(即通过 Recibir 接收的数据包)转换为一定格式并在 RichTextBox1 控件下显示出来
For i = 0 To resarray(ListView1.SelectedItem.Index)
    coun = coun + 1
    If Len(Hex(buffer(i))) = 1 Then
        sar = "0" & Hex(buffer(i))
    Else
        sar = Hex(buffer(i))
    End If
    
    sar3 = sar3 & sar
    
    If Asc(Chr("&h" & Hex(buffer(i)))) < 32 Then
        sar1 = "."
    Else
        sar1 = Chr("&h" & Hex(buffer(i)))
    End If
    
    sar2 = sar2 & sar1
    RichTextBox1.Text = RichTextBox1.Text & sar & " "
    
    If coun = 15 Then
        RichTextBox1.Text = RichTextBox1.Text & " |" & sar2 & vbCrLf:
        coun = 0
        sar2 = ""
        sar3 = ""
    End If
Next i

If coun < 15 Then
    r = 44 - (coun * 3) + 1
    es = String(r, Chr(32))
    RichTextBox1.Text = RichTextBox1.Text & es & " |" & sar2
End If
End Sub

Private Sub M_Clear_Click()
ListView1.ListItems.Clear
RichTextBox1.Text = ""
End Sub

'程序开始捕捉
Private Sub M_Start_Click()
ListView1.ListItems.Clear
RichTextBox1.Text = ""
Connecting ip(hostname), MsgHwnd            '开始截取封包
End Sub


Private Sub M_Stop_Click()
ExitID = True                               '停止截取封包
End Sub

Private Sub MsgHwnd_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
CountID = CountID + 1
Recibir s, 1
If ExitID = True Then
    Call WCleanup(s)
    ExitID = False
    MsgBox "退出", vbOKOnly, "数据封包截取"
End If
End Sub

模块:

Option Explicit

'WSAstartup 用来判断 Windows 所支持的 Winsock 版本,也就是初始化 Winsock DLL,其中第一个参数为你所想需要的Winsock版本!低字节为主版本,高字节为副版本!由于目前Winsock有两个版本:1.1和2.2,因此该参数可以是0x101或0x202;第二个参数是一个WSADATA结构,用于接收函数的返回信息!WSAStartup函数调用成功会返回0,否则返回非0值!
'WSACleanup 用来关闭 Winsock,与 WSAstartup 一起使用,即 WSAstartup 也可以看为启动 Winsock
'gethostbyname 用来返回一个关于主机信息的结构的指针
Public Declare Function WSAstartup Lib "wsock32.dll" Alias "WSAStartup" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSAdata) As Long
Public Declare Function WsACleanup Lib "wsock32.dll" Alias "WSACleanup" () As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
Public Declare Function gethostname Lib "wsock32.dll" (ByVal name As String, ByVal namelen As Long) As Long
Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As Long
Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Public Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Any, ByVal cbInBuffer As Long, lpvOutBuffer As Any, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare Function bind Lib "wsock32.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer


Public Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 255
    szSystemStatus As String * 128
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type


'sock 地址结构
Public Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Public Type HOSTENT
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

    
    
'ip 头结构
Public Type ipheader
    lenver As Byte
    tos As Byte
    len As Integer
    ident As Integer
    flags As Integer
    ttl As Byte
    proto As Byte
    checksum As Integer
    sourceIP As Long
    destIP As Long
End Type


'TCP 头结构
Public Type tcp_hdr
    th_sport As Integer
    th_dport As Integer
    th_seq As Long
    th_ack As Long
    th_lenres As Byte
    th_flag As Byte
    th_win As Integer
    th_sum As Integer
    th_urp As Integer
End Type


'UDP 头结构
Public Type udp_hdr
    th_sport As Integer
    th_dport As Integer
    th_len As Integer
    th_sum As Integer
End Type


'ICMP 头结构
Public Type icmp_hdr
    th_type As Byte
    th_code As Byte
    th_sum As Integer
    th_id As Integer
    th_seq As Integer
    th_time As Long
End Type

'常量
Public Const PF_INET = 2
Public Const SOCK_RAW = 3
Public Const AF_INET = 2
Public Const FD_READ = &H1
Public Const SIO_RCVALL = &H98000001
Public Const EM_REPLACESEL = &HC2

Public host As HOSTENT
Public s As Long
Public sock As sockaddr

Public Header As ipheader
Public tcpHead As tcp_hdr
Public udpHead As udp_hdr
Public icmpHead As icmp_hdr


Public resarray() As Long, str As String
Public i As Long, CountID As Long               'i 为临时变量,循环语句用,CountID 用来计算一共有多少个数据包
Public protocol As String
Public buffer() As Byte                         '存放数据包
Public res As Long                              '返回值,临时变量
Public ExitID As Boolean                        '退出标识


'开始
Public Sub Wstartup()
Dim Data As WSAdata
Call WSAstartup(&H202, Data)                        '初始化 Winsock 为 2.2
End Sub

'结束
Public Sub WCleanup(s As Long)
Call WsACleanup                                     '关闭 Winsock
closesocket s
End Sub

'获得当前主机的 IP
Public Function ip(ByRef address As String) As String
Dim pip As Long
Dim uip As Long
Dim s As Long
Dim ss As String
Dim cul As Long

CopyMemory host, ByVal gethostbyname(address), Len(host)            '将 gethostbyname 获得的值放到 host
CopyMemory pip, ByVal host.h_addr_list, 4                           '将 host.h_addr_list 的值放到 pip
CopyMemory uip, ByVal pip, 4                                        '将 pip 的值放到 uip
s = inet_ntoa(uip)                                                  '将 uip 转换为标准的 IPV4 格式
ss = Space(lstrlen(s))                                              '去掉空格
cul = lstrcpy(ss, s)
ip = ss                                                             '获得 IPV4 格式的地址并将其放如 ip
End Function

'获得当前机器的主机名
Public Function hostname() As String
Dim r As Long
Dim s As String
Dim host As String

Wstartup
host = String(255, 0)
r = gethostname(host, 255)                                          '获得当前主机的主机名

If r = 0 Then
    hostname = Left(host, InStr(1, host, vbNullChar) - 1)
End If

End Function

'连接 IP
Public Sub Connecting(ByRef ip As String, pic As PictureBox)
Dim res As Long, buf As Long, bufb As Long
buf = 1

Wstartup                                                            '初始化 Winsock

s = socket(AF_INET, SOCK_RAW, 0)                                    '创建套接字,s 是socket功能返回的文件描述符
If s < 1 Then
    Call WCleanup(s)
    Exit Sub                                                         '如果创建失败则退出
End If

sock.sin_family = AF_INET                                            'socket类型
sock.sin_addr = inet_addr(ip)                                        '所用的IP地址
res = bind(s, sock, Len(sock))                                       '绑定端口

If res <> 0 Then
    Call WCleanup(s)
    Exit Sub                                                         '如果绑定失败则退出
End If

res = WSAIoctl(s, SIO_RCVALL, buf, Len(buf), 0, 0, bufb, ByVal 0, ByVal 0)          '改变Socket IO模式,将其改为混乱模式,即接受与自己无关的数据,则 SIO_RCVALL

If res <> 0 Then
    Call WCleanup(s)
    Exit Sub
End If

res = WSAAsyncSelect(s, pic.hWnd, &H202, ByVal FD_READ)              '设置套接字处于阻塞方式或者非阻塞方式,消息发送的窗口是 pic,即 Form1.Picture1

If res <> 0 Then
    Call WCleanup(s)
    Exit Sub
End If

End Sub

'接收信息
Public Sub Recibir(s As Long, ByVal RecFormat As Long)
If RecFormat = FD_READ Then
    ReDim buffer(2000)                                              '重定义缓冲区大小为 2000
    Do
    res = recv(s, buffer(0), 2000, 0&)                              '接收信息
        If res > 0 Then
        
            ReDim Preserve resarray(CountID)                        '改变数组大小,并保留以前的数据
            str = buffer()
            resarray(CountID) = res
            
            CopyMemory Header, buffer(0), Len(Header)               '将 buffer 里面的数据复制到 Header 结构里面
            
            '根据IP头结构的标识来获得是什么类型的数据包,并将 IP 从头结构中分离出来
            If Header.proto = 1 Then
                protocol = "ICMP"
                proticmp inversaip(Hex(Header.destIP)), inversaip(Hex(Header.sourceIP))
            End If
            If Header.proto = 6 Then
                protocol = "TCP"
                protcp inversaip(Hex(Header.destIP)), inversaip(Hex(Header.sourceIP))
            End If
            If Header.proto = 17 Then
                protocol = "UDP"
                proudp inversaip(Hex(Header.destIP)), inversaip(Hex(Header.sourceIP))
            End If
        End If
    Loop Until res <> 2000
End If
End Sub

'将 16 进制转换为 IP 地址
Public Function inversaip(ByRef lng As String) As String
Dim ips As String

Select Case Len(lng)
    Case 1
        lng = "0000000" & lng
    Case 2
        lng = "000000" & lng
    Case 3
        lng = "00000" & lng
    Case 4
        lng = "0000" & lng
    Case 5
        lng = "000" & lng
    Case 6
        lng = "00" & lng
    Case 7
        lng = "0" & lng
End Select
For i = 1 To Len(lng) Step 2
    ips = ips & Val("&h" & Mid(lng, Len(lng) - i, 2)) & "."
Next i

inversaip = Mid(ips, 1, Len(ips) - 1)
End Function


Public Function proticmp(saa As String, soc As String) As String
Dim ListTemp As Variant
Set ListTemp = Form1.ListView1.ListItems.Add(, , soc)
ListTemp.SubItems(2) = saa
ListTemp.SubItems(4) = protocol
ListTemp.SubItems(5) = Time

CopyMemory icmpHead, buffer(0 + 20), Len(icmpHead)

End Function

Public Sub protcp(saa As String, soc As String)
Dim ListTemp As Variant
CopyMemory tcpHead, buffer(0 + 20), Len(tcpHead)

Set ListTemp = Form1.ListView1.ListItems.Add(, , soc)
ListTemp.SubItems(1) = ntohs(tcpHead.th_sport)
ListTemp.SubItems(2) = saa
ListTemp.SubItems(3) = ntohs(tcpHead.th_dport)
ListTemp.SubItems(4) = protocol
ListTemp.SubItems(5) = Time
End Sub

Public Sub proudp(saa As String, soc As String)
Dim ListTemp As Variant
CopyMemory udpHead, buffer(0 + 20), Len(udpHead)


Set ListTemp = Form1.ListView1.ListItems.Add(, , soc)
ListTemp.SubItems(1) = ntohs(udpHead.th_sport)
ListTemp.SubItems(2) = saa
ListTemp.SubItems(3) = ntohs(udpHead.th_dport)
ListTemp.SubItems(4) = protocol
ListTemp.SubItems(5) = Time
End Sub

--------------------------------------------------------------------------------------------------------------------------------------------------------
彩色的太费时间了,所以就直接贴了!呵呵!

--------------------------------------------------------------------------------------------------------------------------------------------------------
点击给我留言

--------------------------------------------------------------------------------------------------------------------------------------------------------

Private Sub Form_Load()
CountID = 0
ExitID = False
ListView1.ColumnHeaders.Add 1, , "源 IP", 1500
ListView1.ColumnHeaders.Add 2, , "源端口", 1500
ListView1.ColumnHeaders.Add 3, , "目标 IP", 1500
ListView1.ColumnHeaders.Add 4, , "目标端口", 1500
ListView1.ColumnHeaders.Add 5, , "协议", 1500
ListView1.ColumnHeaders.Add 6, , "时间", 1500
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call WCleanup(s)
Unload Me
End Sub

Private Sub ListView1_Click()
Dim coun As Long
Dim sar As String, sar3 As String
Dim sar1 As String, sar2 As String

RichTextBox1.Text = ""                      '清除 RichTextBox1
Dim buffer() As Byte
buffer = str

If ListView1.SelectedItem Is Nothing Then   '如果 ListView1 控件没有数值则提示错误
    Exit Sub
End If


'将 buffer 的值(即通过 Recibir 接收的数据包)转换为一定格式并在 RichTextBox1 控件下显示出来
For i = 0 To resarray(ListView1.SelectedItem.Index)
    coun = coun + 1
    If Len(Hex(buffer(i))) = 1 Then
        sar = "0" & Hex(buffer(i))
    Else
        sar = Hex(buffer(i))
    End If
    
    sar3 = sar3 & sar
    
    If Asc(Chr("&h" & Hex(buffer(i)))) < 32 Then
        sar1 = "."
    Else
        sar1 = Chr("&h" & Hex(buffer(i)))
    End If
    
    sar2 = sar2 & sar1
    RichTextBox1.Text = RichTextBox1.Text & sar & " "
    
    If coun = 15 Then
        RichTextBox1.Text = RichTextBox1.Text & " |" & sar2 & vbCrLf:
        coun = 0
        sar2 = ""
        sar3 = ""
    End If
Next i

If coun < 15 Then
    r = 44 - (coun * 3) + 1
    es = String(r, Chr(32))
    RichTextBox1.Text = RichTextBox1.Text & es & " |" & sar2
End If
End Sub

Private Sub M_Clear_Click()
ListView1.ListItems.Clear
RichTextBox1.Text = ""
End Sub

'程序开始捕捉
Private Sub M_Start_Click()
ListView1.ListItems.Clear
RichTextBox1.Text = ""
Connecting ip(hostname), MsgHwnd            '开始截取封包
End Sub


Private Sub M_Stop_Click()
ExitID = True                               '停止截取封包
End Sub

Private Sub MsgHwnd_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
CountID = CountID + 1
Recibir s, 1
If ExitID = True Then
    Call WCleanup(s)
    ExitID = False
    MsgBox "退出", vbOKOnly, "数据封包截取"
End If
End Sub

模块:

Option Explicit

'WSAstartup 用来判断 Windows 所支持的 Winsock 版本,也就是初始化 Winsock DLL,其中第一个参数为你所想需要的Winsock版本!低字节为主版本,高字节为副版本!由于目前Winsock有两个版本:1.1和2.2,因此该参数可以是0x101或0x202;第二个参数是一个WSADATA结构,用于接收函数的返回信息!WSAStartup函数调用成功会返回0,否则返回非0值!
'WSACleanup 用来关闭 Winsock,与 WSAstartup 一起使用,即 WSAstartup 也可以看为启动 Winsock
'gethostbyname 用来返回一个关于主机信息的结构的指针
Public Declare Function WSAstartup Lib "wsock32.dll" Alias "WSAStartup" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSAdata) As Long
Public Declare Function WsACleanup Lib "wsock32.dll" Alias "WSACleanup" () As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
Public Declare Function gethostname Lib "wsock32.dll" (ByVal name As String, ByVal namelen As Long) As Long
Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As Long
Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Public Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Any, ByVal cbInBuffer As Long, lpvOutBuffer As Any, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare Function bind Lib "wsock32.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer


Public Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 255
    szSystemStatus As String * 128
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type


'sock 地址结构
Public Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Public Type HOSTENT
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type

    
    
'ip 头结构
Public Type ipheader
    lenver As Byte
    tos As Byte
    len As Integer
    ident As Integer
    flags As Integer
    ttl As Byte
    proto As Byte
    checksum As Integer
    sourceIP As Long
    destIP As Long
End Type


'TCP 头结构
Public Type tcp_hdr
    th_sport As Integer
    th_dport As Integer
    th_seq As Long
    th_ack As Long
    th_lenres As Byte
    th_flag As Byte
    th_win As Integer
    th_sum As Integer
    th_urp As Integer
End Type


'UDP 头结构
Public Type udp_hdr
    th_sport As Integer
    th_dport As Integer
    th_len As Integer
    th_sum As Integer
End Type


'ICMP 头结构
Public Type icmp_hdr
    th_type As Byte
    th_code As Byte
    th_sum As Integer
    th_id As Integer
    th_seq As Integer
    th_time As Long
End Type

'常量
Public Const PF_INET = 2
Public Const SOCK_RAW = 3
Public Const AF_INET = 2
Public Const FD_READ = &H1
Public Const SIO_RCVALL = &H98000001
Public Const EM_REPLACESEL = &HC2

Public host As HOSTENT
Public s As Long
Public sock As sockaddr

Public Header As ipheader
Public tcpHead As tcp_hdr
Public udpHead As udp_hdr
Public icmpHead As icmp_hdr


Public resarray() As Long, str As String
Public i As Long, CountID As Long               'i 为临时变量,循环语句用,CountID 用来计算一共有多少个数据包
Public protocol As String
Public buffer() As Byte                         '存放数据包
Public res As Long                              '返回值,临时变量
Public ExitID As Boolean                        '退出标识


'开始
Public Sub Wstartup()
Dim Data As WSAdata
Call WSAstartup(&H202, Data)                        '初始化 Winsock 为 2.2
End Sub

'结束
Public Sub WCleanup(s As Long)
Call WsACleanup                                     '关闭 Winsock
closesocket s
End Sub

'获得当前主机的 IP
Public Function ip(ByRef address As String) As String
Dim pip As Long
Dim uip As Long
Dim s As Long
Dim ss As String
Dim cul As Long

CopyMemory host, ByVal gethostbyname(address), Len(host)            '将 gethostbyname 获得的值放到 host
CopyMemory pip, ByVal host.h_addr_list, 4                           '将 host.h_addr_list 的值放到 pip
CopyMemory uip, ByVal pip, 4                                        '将 pip 的值放到 uip
s = inet_ntoa(uip)                                                  '将 uip 转换为标准的 IPV4 格式
ss = Space(lstrlen(s))                                              '去掉空格
cul = lstrcpy(ss, s)
ip = ss                                                             '获得 IPV4 格式的地址并将其放如 ip
End Function

'获得当前机器的主机名
Public Function hostname() As String
Dim r As Long
Dim s As String
Dim host As String

Wstartup
host = String(255, 0)
r = gethostname(host, 255)                                          '获得当前主机的主机名

If r = 0 Then
    hostname = Left(host, InStr(1, host, vbNullChar) - 1)
End If

End Function

'连接 IP
Public Sub Connecting(ByRef ip As String, pic As PictureBox)
Dim res As Long, buf As Long, bufb As Long
buf = 1

Wstartup                                                            '初始化 Winsock

s = socket(AF_INET, SOCK_RAW, 0)                                    '创建套接字,s 是socket功能返回的文件描述符
If s < 1 Then
    Call WCleanup(s)
    Exit Sub                                                         '如果创建失败则退出
End If

sock.sin_family = AF_INET                                            'socket类型
sock.sin_addr = inet_addr(ip)                                        '所用的IP地址
res = bind(s, sock, Len(sock))                                       '绑定端口

If res <> 0 Then
    Call WCleanup(s)
    Exit Sub                                                         '如果绑定失败则退出
End If

res = WSAIoctl(s, SIO_RCVALL, buf, Len(buf), 0, 0, bufb, ByVal 0, ByVal 0)          '改变Socket IO模式,将其改为混乱模式,即接受与自己无关的数据,则 SIO_RCVALL

If res <> 0 Then
    Call WCleanup(s)
    Exit Sub
End If

res = WSAAsyncSelect(s, pic.hWnd, &H202, ByVal FD_READ)              '设置套接字处于阻塞方式或者非阻塞方式,消息发送的窗口是 pic,即 Form1.Picture1

If res <> 0 Then
    Call WCleanup(s)
    Exit Sub
End If

End Sub

'接收信息
Public Sub Recibir(s As Long, ByVal RecFormat As Long)
If RecFormat = FD_READ Then
    ReDim buffer(2000)                                              '重定义缓冲区大小为 2000
    Do
    res = recv(s, buffer(0), 2000, 0&)                              '接收信息
        If res > 0 Then
        
            ReDim Preserve resarray(CountID)                        '改变数组大小,并保留以前的数据
            str = buffer()
            resarray(CountID) = res
            
            CopyMemory Header, buffer(0), Len(Header)               '将 buffer 里面的数据复制到 Header 结构里面
            
            '根据IP头结构的标识来获得是什么类型的数据包,并将 IP 从头结构中分离出来
            If Header.proto = 1 Then
                protocol = "ICMP"
                proticmp inversaip(Hex(Header.destIP)), inversaip(Hex(Header.sourceIP))
            End If
            If Header.proto = 6 Then
                protocol = "TCP"
                protcp inversaip(Hex(Header.destIP)), inversaip(Hex(Header.sourceIP))
            End If
            If Header.proto = 17 Then
                protocol = "UDP"
                proudp inversaip(Hex(Header.destIP)), inversaip(Hex(Header.sourceIP))
            End If
        End If
    Loop Until res <> 2000
End If
End Sub

'将 16 进制转换为 IP 地址
Public Function inversaip(ByRef lng As String) As String
Dim ips As String

Select Case Len(lng)
    Case 1
        lng = "0000000" & lng
    Case 2
        lng = "000000" & lng
    Case 3
        lng = "00000" & lng
    Case 4
        lng = "0000" & lng
    Case 5
        lng = "000" & lng
    Case 6
        lng = "00" & lng
    Case 7
        lng = "0" & lng
End Select
For i = 1 To Len(lng) Step 2
    ips = ips & Val("&h" & Mid(lng, Len(lng) - i, 2)) & "."
Next i

inversaip = Mid(ips, 1, Len(ips) - 1)
End Function


Public Function proticmp(saa As String, soc As String) As String
Dim ListTemp As Variant
Set ListTemp = Form1.ListView1.ListItems.Add(, , soc)
ListTemp.SubItems(2) = saa
ListTemp.SubItems(4) = protocol
ListTemp.SubItems(5) = Time

CopyMemory icmpHead, buffer(0 + 20), Len(icmpHead)

End Function

Public Sub protcp(saa As String, soc As String)
Dim ListTemp As Variant
CopyMemory tcpHead, buffer(0 + 20), Len(tcpHead)

Set ListTemp = Form1.ListView1.ListItems.Add(, , soc)
ListTemp.SubItems(1) = ntohs(tcpHead.th_sport)
ListTemp.SubItems(2) = saa
ListTemp.SubItems(3) = ntohs(tcpHead.th_dport)
ListTemp.SubItems(4) = protocol
ListTemp.SubItems(5) = Time
End Sub

Public Sub proudp(saa As String, soc As String)
Dim ListTemp As Variant
CopyMemory udpHead, buffer(0 + 20), Len(udpHead)


Set ListTemp = Form1.ListView1.ListItems.Add(, , soc)
ListTemp.SubItems(1) = ntohs(udpHead.th_sport)
ListTemp.SubItems(2) = saa
ListTemp.SubItems(3) = ntohs(udpHead.th_dport)
ListTemp.SubItems(4) = protocol
ListTemp.SubItems(5) = Time
End Sub

--------------------------------------------------------------------------------------------------------------------------------------------------------
彩色的太费时间了,所以就直接贴了!呵呵!

--------------------------------------------------------------------------------------------------------------------------------------------------------
点击给我留言

--------------------------------------------------------------------------------------------------------------------------------------------------------

本文地址:http://com.8s8s.com/it/it41400.htm