frmtest.frm

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

VERSION 5.00
Object = "{B442745D-6B4C-4304-9405-312454F5086C}#1.0#0"; "CatchX.ocx"
Begin VB.Form FrmTest 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "抓包2000"
   ClientHeight    =   6795
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   9825
   Icon            =   "FrmTest.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   453
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   655
   StartUpPosition =   3  '窗口缺省
   Begin 抓包2000.CatchX CatchX1 
      Left            =   9000
      Top             =   600
      _ExtentX        =   661
      _ExtentY        =   661
   End
   Begin VB.OptionButton Option4 
      Caption         =   "汉字"
      Height          =   375
      Left            =   7080
      TabIndex        =   27
      Top             =   5340
      Width           =   975
   End
   Begin VB.OptionButton Option3 
      Caption         =   "ASC码"
      Height          =   315
      Left            =   7080
      TabIndex        =   26
      Top             =   4920
      Value           =   -1  'True
      Width           =   975
   End
   Begin VB.Frame Frame1 
      Caption         =   "抓包条件"
      Height          =   3555
      Left            =   7020
      TabIndex        =   11
      Top             =   1080
      Width           =   2775
      Begin VB.OptionButton Option1 
         Caption         =   "仅有效数据"
         Height          =   195
         Left            =   60
         TabIndex        =   19
         Top             =   360
         Value           =   -1  'True
         Width           =   1275
      End
      Begin VB.OptionButton Option2 
         Caption         =   "完整包数据"
         Height          =   195
         Left            =   1380
         TabIndex        =   18
         Top             =   360
         Width           =   1335
      End
      Begin VB.TextBox TxtLIP 
         Alignment       =   1  'Right Justify
         Height          =   315
         Left            =   1200
         TabIndex        =   17
         Top             =   720
         Width           =   1455
      End
      Begin VB.TextBox TxtRIP 
         Alignment       =   1  'Right Justify
         Height          =   315
         Left            =   1200
         TabIndex        =   16
         Top             =   1140
         Width           =   1455
      End
      Begin VB.TextBox TxtLPort 
         Alignment       =   1  'Right Justify
         Height          =   315
         Left            =   1560
         TabIndex        =   15
         Top             =   1620
         Width           =   1095
      End
      Begin VB.TextBox TxtRPort 
         Alignment       =   1  'Right Justify
         Height          =   315
         Left            =   1560
         TabIndex        =   14
         Top             =   2040
         Width           =   1095
      End
      Begin VB.TextBox TxtDLPort 
         Alignment       =   1  'Right Justify
         Height          =   330
         Left            =   1560
         TabIndex        =   13
         Top             =   2460
         Width           =   1095
      End
      Begin VB.TextBox TxtDRPort 
         Alignment       =   1  'Right Justify
         Height          =   315
         Left            =   1560
         TabIndex        =   12
         Top             =   2880
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "指定本地IP："
         Height          =   255
         Left            =   120
         TabIndex        =   25
         Top             =   780
         Width           =   1095
      End
      Begin VB.Label Label3 
         Caption         =   "指定远程IP："
         Height          =   255
         Left            =   120
         TabIndex        =   24
         Top             =   1200
         Width           =   1155
      End
      Begin VB.Label Label4 
         Caption         =   "指定本地端口："
         Height          =   255
         Left            =   120
         TabIndex        =   23
         Top             =   1680
         Width           =   1275
      End
      Begin VB.Label Label5 
         Caption         =   "指定远程端口："
         Height          =   255
         Left            =   120
         TabIndex        =   22
         Top             =   2100
         Width           =   1335
      End
      Begin VB.Label Label6 
         Caption         =   "屏蔽本地端口："
         Height          =   195
         Left            =   120
         TabIndex        =   21
         Top             =   2520
         Width           =   1335
      End
      Begin VB.Label Label7 
         Caption         =   "屏蔽远程端口："
         Height          =   255
         Left            =   120
         TabIndex        =   20
         Top             =   2940
         Width           =   1335
      End
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   3795
      LargeChange     =   19
      Left            =   6720
      Max             =   20
      Min             =   20
      TabIndex        =   8
      Top             =   2820
      Value           =   20
      Width           =   255
   End
   Begin VB.TextBox Text2 
      Height          =   3795
      Left            =   5100
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   7
      Top             =   2820
      Width           =   1635
   End
   Begin VB.ListBox List1 
      Height          =   2580
      Left            =   60
      MultiSelect     =   2  'Extended
      TabIndex        =   4
      Top             =   60
      Width           =   6915
   End
   Begin VB.TextBox Text1 
      Height          =   3795
      Left            =   600
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   3
      Top             =   2820
      Width           =   4455
   End
   Begin VB.CommandButton Command2 
      Caption         =   "停止"
      Enabled         =   0   'False
      Height          =   375
      Left            =   8340
      TabIndex        =   2
      Top             =   6120
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开始"
      Height          =   375
      Left            =   7200
      TabIndex        =   1
      Top             =   6120
      Width           =   1035
   End
   Begin VB.TextBox Text0 
      Height          =   3795
      Left            =   60
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   2820
      Width           =   495
   End
   Begin VB.Label LblByte 
      Alignment       =   1  'Right Justify
      Caption         =   "0"
      Height          =   195
      Left            =   7980
      TabIndex        =   29
      Top             =   780
      Width           =   735
   End
   Begin VB.Label Label8 
      Caption         =   "字节数："
      Height          =   195
      Left            =   7200
      TabIndex        =   28
      Top             =   780
      Width           =   795
   End
   Begin VB.Label LblEdt 
      Alignment       =   2  'Center
      Caption         =   "编辑"
      Height          =   255
      Left            =   8100
      TabIndex        =   10
      Top             =   60
      Width           =   855
   End
   Begin VB.Line Line1 
      X1              =   468
      X2              =   656
      Y1              =   24
      Y2              =   24
   End
   Begin VB.Label LblFile 
      Alignment       =   2  'Center
      Caption         =   "文件"
      BeginProperty Font 
         Name            =   "新宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   7140
      TabIndex        =   9
      Top             =   60
      Width           =   855
   End
   Begin VB.Label LblRecNum 
      Alignment       =   1  'Right Justify
      Caption         =   "0"
      Height          =   195
      Left            =   7980
      TabIndex        =   6
      Top             =   540
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "抓包数："
      Height          =   195
      Left            =   7200
      TabIndex        =   5
      Top             =   540
      Width           =   735
   End
   Begin VB.Menu MnuFile 
      Caption         =   "文件"
      Visible         =   0   'False
      Begin VB.Menu MnuOpen 
         Caption         =   "打开文件"
      End
      Begin VB.Menu MnuSave 
         Caption         =   "保存数据"
      End
      Begin VB.Menu bar 
         Caption         =   "-"
      End
      Begin VB.Menu MnuExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu MnuEdit 
      Caption         =   "编辑"
      Visible         =   0   'False
      Begin VB.Menu MnuCopy 
         Caption         =   "复制"
      End
      Begin VB.Menu MnuAll 
         Caption         =   "全选"
      End
   End
End
Attribute VB_Name = "FrmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
     "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
     
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Const MAXLEN = 16384
Const MAXALLLEN = 2097152
Dim a As Ip_Header, Prot As String
Dim RecNum As Long                  '存放记录号
Dim PackIndx(1, MAXALLLEN / 100) As Single   '存放包索引，PackIndx(0, X)为时间、PackIndx(1, X)为X+1包在PackD()中的偏移指针
Dim PackD(MAXALLLEN) As Byte
Dim TmpPack(MAXLEN) As Byte, TmpData(MAXLEN) As Byte
Dim LIP As Long, RIP As Long, LPort As Long, RPort As Long, DLPort As Long, DRPort As Long
Dim DataStr0 As String, DataStr1 As String, DataStr2 As String
Dim TmpSPort As Long, TmpDPort As Long
Dim TCPSeq(3) As Byte

Private Sub CatchX1_Recev(Data() As Byte, DataLen As Long, Proto As Byte, SIp As String, DIp As String, Sport As Long, Dport As Long)
    Select Case Proto
    Case ipproto_tcp
        Prot = "TCP"
    Case ipproto_udp
        Prot = "UDP"
    Case ipproto_icmp
        Prot = "ICMP"
    Case Else
        Prot = "OTHER"
    End Select
    List1.AddItem List1.ListCount & ")" & SIp & "(" & Sport & ")→" & DIp & "(" & Dport & ")  " & Prot & "  LEN=" & DataLen & vbCrLf
End Sub

Private Sub CatchX1_RecevAll(PackData() As Byte, PackLen As Long)
    If (CatchX1.GetDataLen(PackData) > 0) Or Option2.Value Then
        PackIndx(0, RecNum) = Timer
        
        TmpSPort = PackData(20) * 256& + PackData(21)
        TmpDPort = PackData(22) * 256& + PackData(23)
        CatchX1.GetIPHeader a, PackData
        If (LIP = 0 Or LIP = a.sourceIP) And (RIP = 0 Or RIP = a.destIP) Then
            If (LPort = 0 Or LPort = TmpSPort) And (RPort = 0 Or RPort = TmpDPort) Then
                If (DLPort = 0 Or DLPort <> TmpSPort) And (DRPort = 0 Or DRPort <> TmpDPort) Then
                    '数据包的源地址(SOURCE)符合过滤条件
                    If RecNum > 0 Then
                        PackIndx(0, RecNum) = Timer
                        PackIndx(1, RecNum) = PackIndx(1, RecNum - 1) + PackLen
                        CatchX1.DataCopy PackD(PackIndx(1, RecNum - 1)), PackData(0), PackLen
                    Else
                        PackIndx(0, RecNum) = Timer
                        PackIndx(1, RecNum) = PackLen
                        CatchX1.DataCopy PackD(0), PackData(0), PackLen
                    End If
                    '检查是否为重复收到的数据包
                    If PackData(9) = ipproto_tcp And PackData(24) = TCPSeq(0) And PackData(25) = TCPSeq(1) _