module1.bas

Visual Basic实现抓取IP包数据包的控件及实例源代码.

Attribute VB_Name = "Module1"
'本控件由杭州元帅于2005年12月完成，版本1.0。用于制作IP协议抓包程序，亦可用于制作游戏外挂类软件
'这是一个抓包（Sniffer）控件，可以捕捉流经本网段上的所有IP协议数据
'可根据模式0（属性Mode＝0）获得完整包数据（包括IP头＋TCP/UDP/ICMP头＋实际数据）
'或模式1（属性Mode＝1）获得网络包中的实际数据（不包括IP头、TCP/UDP/ICMP头）
'属性CatchIP为指定要捕捉的IP地址，若为空字符串则捕捉本网卡上可截获的所有数据包（即流经本网段所有数据包）
'只读属性LocalIP为本机IP地址，利用该属性赋给CatchIP，实现仅捕捉本机IP数据
'属性Begin为Boolean类型，当设为True时开始抓包，当设为False则停止抓包
'方法GetIPHeader用于从指定的完整包数据中提取IP头部数据
'方法GetTCPHeader用于从指定的完整包数据中提取TCP头部数据
'方法GetUDPHeader用于从指定的完整包数据中提取UDP头部数据
'方法GetICMPHeader用于从指定的完整包数据中提取ICMP头部数据
'方法GetData用于从指定的完整数据包中获得实际数据
'方法GetDataLen用于从指定的完整数据包中获得实际数据长度
'方法GetIpStr用于转换长整数型IP地址为字符串IP地址
'方法DataCopy用于复制字节数组指定位置开始的指定个数数据
Option Explicit

Private Declare Function WSAstartup Lib "wsock32.dll" Alias "WSAStartup" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSAdata) As Long
Private 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)
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal addr As Long) As Long
Private Declare Function gethostname Lib "wsock32.dll" (ByVal name As String, ByVal namelen As Long) As Long
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As Long
Private 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
Private Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Private 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
Private Declare Function bind Lib "wsock32.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
Private Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer


Private 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
Private Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type
Private 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



Private Const PF_INET = 2
Private Const SOCK_RAW = 3
Private Const AF_INET = 2
Public Const FD_READ = &H1
Private Const SIO_RCVALL = &H98000001
Private Const EM_REPLACESEL = &HC2
Private Const WM_LBUTTONUP = &H202
Public Const PACKMAX = 8192

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

Public buffer(PACKMAX) As Byte


Public Sub Wstartup()
    Dim Data As WSAdata
    Call WSAstartup(&H202, Data)
End Sub

Public Sub WCleanup(s As Long)
    Call WsACleanup
    closesocket s
End Sub



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)
    CopyMemory pip, ByVal host.h_addr_list, 4
    CopyMemory uip, ByVal pip, 4
    s = inet_ntoa(uip)
    ss = Space(lstrlen(s))
    cul = lstrcpy(ss, s)
    ip = ss
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 Function


Public Sub Connecting(ByRef ip As String, UseWnd As Long)
Dim res As Long, buf As Long, bufb As Long
    buf = 1
    Wstartup
    s = socket(AF_INET, SOCK_RAW, 0)
    If s < 1 Then WCleanup s: Exit Sub
    sock.sin_family = AF_INET
    sock.sin_addr = inet_addr(ip)
    res = bind(s, sock, Len(sock))
    If res <> 0 Then WCleanup s: Exit Sub
    res = WSAIoctl(s, SIO_RCVALL, buf, Len(buf), 0, 0, bufb, ByVal 0, ByVal 0)
    If res <> 0 Then WCleanup s: Exit Sub
    res = WSAAsyncSelect(s, UseWnd, WM_LBUTTONUP, ByVal FD_READ)
    If res <> 0 Then WCleanup s: Exit Sub
End Sub