catchx.ctl

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

                    DIp = buffer(16) & "." & buffer(17) & "." & buffer(18) & "." & buffer(19)
                    Sport = buffer(Tmp_Int) * 256& + buffer(Tmp_Int + 1)
                    Dport = buffer(Tmp_Int + 2) * 256& + buffer(Tmp_Int + 3)
                    RaiseEvent Recev(DataBuff, DataLen, buffer(9), SIp, DIp, Sport, Dport)
                End If
            Case IPproto_ICMP
                Tmp_Int = (buffer(0) Mod 16) * 4        'IPHeader长度
                DataStart = Tmp_Int + 8   'IPHeader长＋ICMPHeader长
                DataLen = buffer(2) * 256& + buffer(3) - DataStart      '数据长度
                ReDim DataBuff(DataLen)
                If DataLen > 0 Then
                    CopyMemory DataBuff(0), buffer(DataStart - 1), DataLen
                    SIp = buffer(12) & "." & buffer(13) & "." & buffer(14) & "." & buffer(15)
                    DIp = buffer(16) & "." & buffer(17) & "." & buffer(18) & "." & buffer(19)
                    Sport = 0
                    Dport = 0
                    RaiseEvent Recev(DataBuff, DataLen, buffer(9), SIp, DIp, Sport, Dport)
                End If
            Case Else
                Tmp_Int = (buffer(0) Mod 16) * 4        'IPHeader长度
                DataStart = Tmp_Int   'IPHeader长，随后即作为数据
                DataLen = buffer(2) * 256& + buffer(3) - DataStart      '数据长度
                ReDim DataBuff(DataLen)
                If DataLen > 0 Then
                    CopyMemory DataBuff(0), buffer(DataStart - 1), DataLen
                    SIp = buffer(12) & "." & buffer(13) & "." & buffer(14) & "." & buffer(15)
                    DIp = buffer(16) & "." & buffer(17) & "." & buffer(18) & "." & buffer(19)
                    Sport = 0
                    Dport = 0
                    RaiseEvent Recev(DataBuff, DataLen, buffer(9), SIp, DIp, Sport, Dport)
                End If
            End Select
        End If
    
    End If

End Sub

'控件实例第二次及以后重新创建时，读保存的属性值
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Mode = PropBag.ReadProperty("Mode", 0)
    CatchIP = PropBag.ReadProperty("CatchIP", "")
    UserControl.AutoRedraw = True
    UserControl.Print "抓包"    '显示“抓包”二字，用于标识控件的显示
End Sub

'控件实例在销毁之前执行
Private Sub UserControl_Terminate()
    '如果在销毁之前，处于击活状态，则终止
    If vBegin Then vBegin = False
End Sub

'当改变控件实例大小时发生
Private Sub UserControl_Resize()
    '不允许改变控件大小，设置成固定大小
    UserControl.Height = 375
    UserControl.Width = 375
End Sub


'用户读属性Mode，Mode=0 激发RecevAll事件（获得完整数据包），Mode=1 激发Recev事件（获得实际数据包）
Public Property Get Mode() As Integer
    Mode = vMode
End Property

'用户写Mode属性，Mode=0 激发RecevAll事件（获得完整数据包），Mode=1 激发Recev事件（获得实际数据包）
Public Property Let Mode(ModeValue As Integer)
    If vMode < 3 Then
        vMode = ModeValue
    End If
End Property

'用户读属性Begin，开始或停止抓包，当BeginValue=True则开始，=False则停止
Public Property Get Begin() As Boolean
    Begin = vBegin
End Property

'用户写Begin属性，开始或停止抓包，当BeginValue=True则开始，=False则停止
Public Property Let Begin(BeginValue As Boolean)
    If BeginValue <> vBegin Then
        If BeginValue Then
            vBegin = True
            Connecting ip(hostname), UserControl.hWnd
        Else
            vBegin = False
        End If
    End If
End Property

'用户读属性CatchIP，指定要捕捉的IP地址，若为空字符串则捕捉本网卡上可截获的所有数据包（即本网段数据包）
Public Property Get CatchIP() As String
    CatchIP = vCatchIP
End Property

'用户写CatchIP属性，指定要捕捉的IP地址，若为空字符串则捕捉本网卡上可截获的所有数据包（即本网段数据包）
Public Property Let CatchIP(CatchIPValue As String)
    vCatchIP = Trim(CatchIPValue)
    CopyMemory vCatchIP_Byte(0), inet_addr(vCatchIP), 4     '为提高处理速度，同时将字符串IP转换成4字节IP
End Property

'用户只读属性LocalIP，本机IP地址
Public Property Get LocalIP() As String
    LocalIP = ip(hostname)
End Property

'方法GetIpHeader,从完整数据包中获得IP协议头
'输入参数：PackBuff     完整数据包数据
'输出参数：IPHeader     IP协议头数据
Public Sub GetIPHeader(IpHeader As Ip_Header, PackBuff() As Byte)
    CopyMemory IpHeader, PackBuff(0), Len(IpHeader)
End Sub

'方法GetTCPHeader,从完整数据包中获得TCP协议头
'输入参数：PackBuff     完整数据包数据
'输出参数：TCPHeader    TCP协议头数据
Public Sub GetTCPHeader(TCPHeader As Tcp_Header, PackBuff() As Byte)
    CopyMemory TCPHeader, PackBuff((PackBuff(0) Mod 16) * 4), Len(TCPHeader)
End Sub

'方法GetUDPHeader,从完整数据包中获得UDP协议头
'输入参数：PackBuff     完整数据包数据
'输出参数：UDPHeader    UDP协议头数据
Public Sub GetUDPHeader(UDPHeader As Udp_Header, PackBuff() As Byte)
    CopyMemory UDPHeader, PackBuff((PackBuff(0) Mod 16) * 4), Len(UDPHeader)
End Sub

'方法GetICMPHeader,从完整数据包中获得Icmp协议头
'输入参数：PackBuff     完整数据包数据
'输出参数：ICMPHeader   Icmp协议头数据
Public Sub GetICMPHeader(ICMPHeader As Icmp_Header, PackBuff() As Byte)
    CopyMemory ICMPHeader, PackBuff((PackBuff(0) Mod 16) * 4), Len(ICMPHeader)
End Sub

'方法GetData，从完整数据包中获得实际数据
'输入参数：PackBuff     完整数据包数据
'输出参数：DataBuff()数据包中的实际数据、DataLen为实际数据长度
Public Sub GetData(DataBuff() As Byte, PackBuff() As Byte, DataLen As Long)
    Tmp_Int = (PackBuff(0) Mod 16) * 4        'IPHeader长度
    Select Case PackBuff(9)
    Case IPproto_TCP
        DataStart = Tmp_Int + (PackBuff(Tmp_Int + 12) \ 16) * 4   'IPHeader长＋TCPHeader长
    Case IPproto_UDP
        DataStart = Tmp_Int + 8     'IPHeader长＋UDPHeader长
    Case IPproto_ICMP
        DataStart = Tmp_Int + 8    'IPHeader长＋ICMPHeader长
    Case Else
        DataStart = Tmp_Int         'IPHeader长，随后即作为数据
    End Select
    DataLen = PackBuff(2) * 256& + PackBuff(3) - DataStart      '数据长度
    If DataLen > 0 Then
        CopyMemory DataBuff(0), PackBuff(DataStart), DataLen
    End If
End Sub

'方法GetDataLen，从完整数据包中获得实际数据长度
'输入参数：PackBuff     完整数据包数据
'输出参数：GetDataLen      为实际数据长度
Public Function GetDataLen(PackBuff() As Byte) As Long
    Tmp_Int = (PackBuff(0) Mod 16) * 4        'IPHeader长度
    Select Case PackBuff(9)     '根据协议类型字节
    Case IPproto_TCP
        DataStart = Tmp_Int + (PackBuff(Tmp_Int + 12) \ 16) * 4   'IPHeader长＋TCPHeader长
    Case IPproto_UDP
        DataStart = Tmp_Int + 8     'IPHeader长＋UDPHeader长
    Case IPproto_ICMP
        DataStart = Tmp_Int + 8    'IPHeader长＋ICMPHeader长
    Case Else
        DataStart = Tmp_Int         'IPHeader长，随后即作为数据
    End Select
    GetDataLen = PackBuff(2) * 256& + PackBuff(3) - DataStart      '数据长度
End Function

'方法DataCopy，复制字节数据
Public Sub DataCopy(DData As Byte, SData As Byte, DataLen As Long)
    CopyMemory DData, SData, DataLen
End Sub

'方法GetIpStr，转换长整数型IP地址为字符串IP地址
Public Function GetIpStr(Lng_Ip As Long) As String
Dim Lng2B(3) As Byte
    CopyMemory Lng2B(0), Lng_Ip, 4
    GetIpStr = Lng2B(0) & "." & Lng2B(1) & "." & Lng2B(2) & "." & Lng2B(3)
End Function