网络封包程序，可以截获流经网卡的所有数据包

效果图如下：

附源码：

1、frmSniffer

Public   Class frmSniffer Class frmSniffer

变量定义#Region "变量定义"

    Dim WithEvents Sniffer As Receiver

#End Region

构造函数#Region "构造函数"
    Public Sub New()Sub New()

        ' 此调用是 Windows 窗体设计器所必需的。
        InitializeComponent()

        ' 在 InitializeComponent() 调用之后添加任何初始化。

    End Sub
#End Region

主菜单事件#Region "主菜单事件"

    Private Sub 退出CToolStripMenuItem_Click()Sub 退出CToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 退出CToolStripMenuItem.Click
        Me.Close()
    End Sub

    Private Sub 开始捕获数据SToolStripMenuItem_Click()Sub 开始捕获数据SToolStripMenuItem_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles 开始捕获数据SToolStripMenuItem.Click
        Try
            If Sniffer Is Nothing Then
                Sniffer = New Receiver
                Sniffer.StartReceive()
                Sniffer.ContinueReceive = True
            End If

            开始捕获数据SToolStripMenuItem.Enabled = False
            停止捕获数据BToolStripMenuItem.Enabled = True
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical, "Error")
        End Try
    End Sub

    Private Sub 停止捕获数据BToolStripMenuItem_Click()Sub 停止捕获数据BToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 停止捕获数据BToolStripMenuItem.Click
        If Sniffer IsNot Nothing Then
            Sniffer.ContinueReceive = False
            Sniffer = Nothing
        End If

        开始捕获数据SToolStripMenuItem.Enabled = True
        停止捕获数据BToolStripMenuItem.Enabled = True
    End Sub

    Private Sub 状态栏ToolStripMenuItem_Click()Sub 状态栏ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 状态栏ToolStripMenuItem.Click
        状态栏ToolStripMenuItem.Checked = Not 状态栏ToolStripMenuItem.Checked
        StatusStrip.Visible = 状态栏ToolStripMenuItem.Checked
    End Sub

    Private Sub 数据ToolStripMenuItem_Click()Sub 数据ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 数据ToolStripMenuItem.Click
        数据ToolStripMenuItem.Checked = Not 数据ToolStripMenuItem.Checked
        TreeViewPackData.Visible = 数据ToolStripMenuItem.Checked
    End Sub

    Private Sub 数据包详细信息ToolStripMenuItem_Click()Sub 数据包详细信息ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 数据包详细信息ToolStripMenuItem.Click
        数据包详细信息ToolStripMenuItem.Checked = Not 数据包详细信息ToolStripMenuItem.Checked
        TreeViewPackInfo.Visible = 数据包详细信息ToolStripMenuItem.Checked
    End Sub

    Private Sub 关于AToolStripMenuItem_Click()Sub 关于AToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 关于AToolStripMenuItem.Click
        Dim frm As New frmAbout
        frm.ShowDialog()
    End Sub

    Private Sub 新文件NToolStripMenuItem_Click()Sub 新文件NToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 新文件NToolStripMenuItem.Click
        TreeViewIpInfo.Nodes(0).Nodes.Clear()
        TreeViewPackData.Nodes.Clear()
        TreeViewPackInfo.Nodes.Clear()
    End Sub

    Private Sub 打开文件OToolStripMenuItem_Click()Sub 打开文件OToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 打开文件OToolStripMenuItem.Click
        Dim cd As New System.Windows.Forms.OpenFileDialog

        With cd
            .FileName = ""
            .Title = "打开Sniffer文件"
            .Filter = "Sniffer文件(*.wzm)|*.wzm"
            .ShowDialog()
        End With
        If cd.FileName <> "" Then Call LoadNodes(TreeViewIpInfo, cd.FileName)
    End Sub

    Private Sub 保存SToolStripMenuItem_Click()Sub 保存SToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 保存SToolStripMenuItem.Click
        Call TreeViewFunction.CreateList(TreeViewIpInfo.Nodes(0), fPath)
    End Sub

    Private Sub 另存为ToolStripMenuItem_Click()Sub 另存为ToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 另存为ToolStripMenuItem.Click
        Dim cd As New System.Windows.Forms.SaveFileDialog

        With cd
            .FileName = ""
            .Title = "保存Sniffer数据"
            .Filter = "Sniffer文件(*.wzm)|*.wzm"
            .ShowDialog()
        End With

        If cd.FileName <> "" Then Call TreeViewFunction.CreateList(TreeViewIpInfo.Nodes(0), cd.FileName)
    End Sub

    Private Sub 网管MToolStripMenuItem_Click()Sub 网管MToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 网管MToolStripMenuItem.Click
        Dim frm As New frmNetManager
        frm.Show()
    End Sub

#End Region

窗体事件#Region "窗体事件"

    Private Sub frmSniffer_Load()Sub frmSniffer_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        TreeViewIpInfo.Nodes.Add("No Tcp/Ip Packets")
    End Sub

    Private Sub FrmSniffer_Closing()Sub FrmSniffer_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles Me.Closing
        If MsgBox("确定要退出Sniffer吗?", MsgBoxStyle.Question Or MsgBoxStyle.OkCancel, "Info") = MsgBoxResult.Cancel Then
            e.Cancel = True
        Else
            If Sniffer IsNot Nothing Then
                Sniffer.ContinueReceive = False
                Sniffer.StopReceive()
                Sniffer = Nothing
            End If
        End If
    End Sub

#End Region

捕获信息触发的事件#Region "捕获信息触发的事件"

    Private Delegate Sub RunMySub()Sub RunMySub(ByVal Packet() As Byte)

    Private Sub RefreshTreeViewIpInfo()Sub RefreshTreeViewIpInfo(ByVal PacketDataReceived() As Byte)
        Dim tt As New PacketInfo(PacketDataReceived)
        Dim SourceIpEndPoint As System.Net.IPEndPoint = tt.Source, DestIpEndPoint As System.Net.IPEndPoint = tt.Destionation
        Dim FindIp As Boolean = False

        Try
            For Each FindIpNode As System.Windows.Forms.TreeNode In TreeViewIpInfo.Nodes(0).Nodes
                If FindIpNode.Text = SourceIpEndPoint.Address.ToString Or FindIpNode.Text = DestIpEndPoint.Address.ToString Then
                    FindIpNode = FindIpNode.Nodes.Add(SourceIpEndPoint.ToString.PadRight(25, " ") + "-->" + DestIpEndPoint.ToString.PadLeft(25, " ") + tt.ProtocalName.PadLeft(10, " ") + Now.ToString.PadLeft(20, " "))
                    FindIpNode.Tag = PacketDataReceived
                    FindIp = True
                    Exit For
                End If
            Next

            If Not FindIp Then
                Dim FindIpNode As System.Windows.Forms.TreeNode = TreeViewIpInfo.Nodes(0).Nodes.Add(SourceIpEndPoint.Address.ToString)
                FindIpNode = FindIpNode.Nodes.Add(SourceIpEndPoint.ToString.PadRight(25, " ") + "-->" + DestIpEndPoint.ToString.PadLeft(25, " ") + tt.ProtocalName.PadLeft(10, " ") + Now.ToString.PadLeft(20, " "))
                FindIpNode.Tag = PacketDataReceived
            End If
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical, "Add new or modify an exists node")
        End Try

        '释放资源
        tt = Nothing : SourceIpEndPoint = Nothing : DestIpEndPoint = Nothing
    End Sub

    Private Sub Sniffer_DataReceived()Sub Sniffer_DataReceived(ByVal data() As Byte, ByVal Length As Integer) Handles Sniffer.DataReceived
        Me.Invoke(New RunMySub(AddressOf RefreshTreeViewIpInfo), data)
    End Sub

#End Region

TreeViewIpInfo事件#Region "TreeViewIpInfo事件"

    Private Sub TreeViewIpInfo_AfterSelect()Sub TreeViewIpInfo_AfterSelect(ByVal sender As Object, ByVal e As System.Windows.Forms.TreeViewEventArgs) Handles TreeViewIpInfo.AfterSelect
        Dim Data() As Byte = CType(e.Node.Tag, Byte())

        TreeViewPackData.Nodes.Clear()
        TreeViewPackInfo.Nodes.Clear()

        If Data IsNot Nothing Then
            Call RefreshTreeViewPackData(Data)
            Call RefreshTreeViewPackInfo(Data)
        End If
    End Sub

#End Region

显示某个数据包#Region "显示某个数据包"

Data#Region "Data"
    Private Sub RefreshTreeViewPackData()Sub RefreshTreeViewPackData(ByVal Data() As Byte)
        Dim strData As String = "", strChr As String = ""
        Dim NewPackData As PackData
        Dim ArrayData As New ArrayList

        For i As Integer = 0 To Data.GetLength(0) - 1
            strData += Hex(Data(i)).PadLeft(2, "0") + Space(1)
            Dim str As String = Chr(CInt(Data(i))).ToString

            strChr += IIf(str <> "", str, ".")

            If (i + 1) Mod 16 = 0 Then
                With NewPackData
                    .strRow = ArrayData.Count.ToString.PadLeft(4, "0") + ":"
                    .strData = strData
                    .strChr = strChr
                End With
                ArrayData.Add(NewPackData)

                strData = "" : strChr = ""
            End If
        Next

        If strData.Trim <> "" Then
            With NewPackData
                .strRow = ArrayData.Count.ToString.PadLeft(4, "0") + ":"
                .strData = strData.PadRight(16 * 3, " ")
                .strChr = strChr
            End With
            ArrayData.Add(NewPackData)
        End If

        For i As Integer = 0 To ArrayData.Count - 1
            NewPackData = CType(ArrayData(i), PackData)
            TreeViewPackData.Nodes.Add(NewPackData.strRow + NewPackData.strData + Space(2) + NewPackData.strChr)
        Next

        '释放资源
        ArrayData.Clear() : ArrayData = Nothing : NewPackData = Nothing : strData = "" : strChr = ""
    End Sub
#End Region

DataDetailInfo#Region "DataDetailInfo"
    Private Sub RefreshTreeViewPackInfo()Sub RefreshTreeViewPackInfo(ByVal Data() As Byte)
        Dim tt As New PacketInfo(Data)
        Dim NewIpHeader As IpHeader = tt.GetIpHeader
        Dim TreeNodeItem As System.Windows.Forms.TreeNode

        With TreeViewPackInfo
            TreeNodeItem = .Nodes.Add("帧头")
            With TreeNodeItem.Nodes
                .Add("目的Mac地址：" + getRemoteMAC(NewIpHeader.DestinationAddress.ToString))
                .Add("源Mac地址：" + getRemoteMAC(NewIpHeader.SourceAddress.ToString))
            End With

            TreeNodeItem = .Nodes.Add("IP头")
            With TreeNodeItem.Nodes
                .Add("版本：" + NewIpHeader.Version)
                .Add("IP头的长度：20")
                .Add("服务类型：" + NewIpHeader.TypeOfService)
                .Add("数据包长度：" + NewIpHeader.TotalLength)
                .Add("标识段：" + NewIpHeader.Identification)
                .Add("标志段：" + NewIpHeader.Flags)
                .Add("数据偏移：" + NewIpHeader.FragmentedOffset)
                .Add("生存时间：" + NewIpHeader.TotalLength)
                .Add("传输协议：" + NewIpHeader.Protocol)
                .Add("IP头校验和：" + NewIpHeader.HeaderCheckSum)
                .Add("源IP地址：" + NewIpHeader.SourceAddress.ToString)
                .Add("目的IP地址：" + NewIpHeader.DestinationAddress.ToString)
            End With
        End With

        Select Case tt.Protocal
            Case Net.Sockets.ProtocolType.Udp
                Dim NewUdpHeader As UdpHeader = tt.GetUdpHeader

                With TreeViewPackInfo
                    TreeNodeItem = .Nodes.Add("UDP头")
                    With TreeNodeItem.Nodes
                        .Add("源端口号：" + NewUdpHeader.SourcePort)
                        .Add("目的端口号：" + NewUdpHeader.DestinationPort)
                        .Add("长度：" + NewUdpHeader.DatagramLength)
                        .Add("校验和：" + NewUdpHeader.CheckSum)
                    End With
                End With

                NewUdpHeader = Nothing
            Case Net.Sockets.ProtocolType.Tcp
                Dim NewTcpHeader As TcpHeader = tt.GetTcpHeader

                With TreeViewPackInfo
                    TreeNodeItem = .Nodes.Add("TCP头")
                    With TreeNodeItem.Nodes
                        .Add("未分析")
                    End With
                End With

                NewTcpHeader = Nothing
        End Select

        TreeViewPackInfo.ExpandAll()

        '释放资源
        tt = Nothing : NewIpHeader = Nothing : TreeNodeItem = Nothing
    End Sub
#End Region

#End Region


End Class

2、frmNetManager

Public   Class frmNetManager Class frmNetManager

变量定义#Region "变量定义"
    Private lstViewMenu As System.Windows.Forms.ContextMenuStrip
    Private thThread As System.Threading.Thread
    Private Delegate Sub RunMySub()Sub RunMySub(ByVal Computers As ArrayList)
#End Region

窗体事件#Region "窗体事件"
    Private Sub frmNetManager_Load()Sub frmNetManager_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        ListViewComputers.Items.Add("正在刷新列表…")

        thThread = New System.Threading.Thread(AddressOf GetComputer)
        thThread.Name = "获取计算机列表"
        thThread.Start()
    End Sub

    Private Sub frmNetManager_Closing()Sub frmNetManager_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles Me.Closing
        If thThread IsNot Nothing Then
            thThread.Abort()
            thThread = Nothing
        End If

        If lstViewMenu IsNot Nothing Then lstViewMenu = Nothing

    End Sub
#End Region

获取网上邻居列表#Region "获取网上邻居列表"
    Private Sub GetComputer()Sub GetComputer()
        ListViewComputers.Invoke(New RunMySub(AddressOf AddComputer), FunSub.GetComputerList)
    End Sub

    Private Sub AddComputer()Sub AddComputer(ByVal Computers As ArrayList)
        ListViewComputers.Items.Clear()

        For i As Integer = 0 To Computers.Count - 1
            Dim item() As String = CType(Computers(i), String())

            Dim CurrItem As System.Windows.Forms.ListViewItem = ListViewComputers.Items.Add(item(1), 0)
            CurrItem.SubItems.Add(item(2))
            CurrItem.SubItems.Add(item(0))
        Next
    End Sub
#End Region

ListViewComputers菜单事件#Region "ListViewComputers菜单事件"

初始化右键菜单#Region "初始化右键菜单"
    Private Sub ListViewComputers_MouseDown()Sub ListViewComputers_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles ListViewComputers.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Right Then
            If lstViewMenu Is Nothing Then
                lstViewMenu = New System.Windows.Forms.ContextMenuStrip

                With lstViewMenu
                    .Items.Add("缩略图(&H)", Nothing, AddressOf SeeStyle)
                    .Items.Add("平铺(&S)", Nothing, AddressOf SeeStyle)
                    .Items.Add("图标(&N)", Nothing, AddressOf SeeStyle)
                    .Items.Add("列表(&L)", Nothing, AddressOf SeeStyle)
                    .Items.Add("详细信息(&D)", Nothing, AddressOf SeeStyle)
                    .Items.Add("-")
                    .Items.Add("刷新(&R)", Nothing, AddressOf SeeStyle)
                    .Items.Add("属性(&P)", Nothing, AddressOf SeeStyle)
                End With
            End If
            ListViewComputers.ContextMenuStrip = lstViewMenu
        End If
    End Sub
#End Region

右键菜单事件#Region "右键菜单事件"
    Private Sub SeeStyle()Sub SeeStyle(ByVal sender As System.Object, ByVal e As System.EventArgs)
        If lstViewMenu IsNot Nothing Then
            Dim itemMenu As System.Windows.Forms.ToolStripMenuItem = CType(sender, System.Windows.Forms.ToolStripMenuItem)
            Select Case itemMenu.Text
                Case "缩略图(&H)"
                    ListViewComputers.View = Windows.Forms.View.LargeIcon
                    For Each MenuItem As Object In lstViewMenu.Items
                        If MenuItem.GetType.Name = "ToolStripMenuItem" Then MenuItem.Checked = False
                    Next
                    itemMenu.Checked = True
                Case "平铺(&S)"
                    ListViewComputers.TileSize = New System.Drawing.Size(200, 50)
                    ListViewComputers.View = Windows.Forms.View.Tile
                    For Each MenuItem As Object In lstViewMenu.Items
                        If MenuItem.GetType.Name = "ToolStripMenuItem" Then MenuItem.Checked = False
                    Next
                    itemMenu.Checked = True
                Case "图标(&N)"
                    ListViewComputers.View = Windows.Forms.View.SmallIcon
                    For Each MenuItem As Object In lstViewMenu.Items
                        If MenuItem.GetType.Name = "ToolStripMenuItem" Then MenuItem.Checked = False
                    Next
                    itemMenu.Checked = True
                Case "列表(&L)"
                    ListViewComputers.View = Windows.Forms.View.List
                    For Each MenuItem As Object In lstViewMenu.Items
                        If MenuItem.GetType.Name = "ToolStripMenuItem" Then MenuItem.Checked = False
                    Next
                    itemMenu.Checked = True
                Case "详细信息(&D)"
                    ListViewComputers.View = Windows.Forms.View.Details
                    For Each MenuItem As Object In lstViewMenu.Items
                        If MenuItem.GetType.Name = "ToolStripMenuItem" Then MenuItem.Checked = False
                    Next
                    itemMenu.Checked = True
                Case "刷新(&R)"
                    ListViewComputers.Items.Clear()
                    ListViewComputers.Items.Add("正在刷新列表…")

                    thThread = New System.Threading.Thread(AddressOf GetComputer)
                    thThread.Name = "获取计算机列表"
                    thThread.Start()
                Case "属性(&P)"
                    If ListViewComputers.SelectedItems.Count <> 0 Then
                        Dim strIP As String = ListViewComputers.SelectedItems(0).SubItems(1).Text
                        MsgBox("IP=" + strIP + vbCrLf + FunSub.GetMac(strIP))
                        'MsgBox(getRemoteMAC("192.168.1.117", strIP))
                    Else
                        MsgBox("请选择要查看属性的项。", MsgBoxStyle.Exclamation, "Warn")
                    End If
            End Select

            '释放资源
            itemMenu = Nothing
        End If
    End Sub
#End Region

#End Region

End Class

3、ClsPacketInfo

Imports  System.Net
Imports  System.Net.Sockets
Imports  System.Threading


分析数据包 #Region "分析数据包"

Public Class PacketInfoClass PacketInfo
    Dim data As Byte()

    '构造函数
    Sub New()Sub New(ByVal mPacketData As Byte())
        data = mPacketData
    End Sub

    '报文协议
    Public ReadOnly Property Protocal()Property Protocal() As System.Net.Sockets.ProtocolType
        Get
            Select Case GetProtocal()
                Case 17
                    Return Net.Sockets.ProtocolType.Udp
                Case 6
                    Return Net.Sockets.ProtocolType.Tcp
                Case 1
                    Return Net.Sockets.ProtocolType.Icmp
                Case Else
                    Return Net.Sockets.ProtocolType.Unknown
            End Select
        End Get
    End Property

    '报文协议名
    Public ReadOnly Property ProtocalName()Property ProtocalName() As String
        Get
            Select Case GetProtocal()
                Case Net.Sockets.ProtocolType.Icmp : Return "Icmp"
                Case Net.Sockets.ProtocolType.IP : Return "Ip"
                Case Net.Sockets.ProtocolType.Raw : Return "Raw"
                Case Net.Sockets.ProtocolType.Tcp : Return "Tcp"
                Case Net.Sockets.ProtocolType.Udp : Return "Udp"
                Case Net.Sockets.ProtocolType.Unknown : Return "Unknown"
                Case Else : Return "未判断的协议"
            End Select
        End Get
    End Property

    '发送方的ip及port
    Public ReadOnly Property Source()Property Source() As IPEndPoint
        Get
            If Me.Protocal = Sockets.ProtocolType.Unknown Then Return Nothing
            Return New IPEndPoint(GetAddress(12), GetPort(20))
        End Get
    End Property

    '接收方的ip及port
    Public ReadOnly Property Destionation()Property Destionation() As IPEndPoint
        Get
            If Me.Protocal = Sockets.ProtocolType.Unknown Then Return Nothing
            Return New IPEndPoint(GetAddress(16), GetPort(22))
        End Get
    End Property

    '监听到的报文
    Public ReadOnly Property PacketData()Property PacketData() As Byte()
        Get
            If Me.Protocal = Sockets.ProtocolType.Unknown Then Return Nothing
            Return GetData()
        End Get
    End Property

    '从报文中分离出使用的协议
    Private Function GetProtocal()Function GetProtocal() As Integer
        Return data(9)
    End Function


    '格式化ip地址
    Private Function GetAddress()Function GetAddress(ByVal StartIndex As Integer) As IPAddress
        Dim b(3) As Byte

        Array.Copy(data, StartIndex, b, 0, 4)
        Return IPAddress.Parse(String.Format("{0}.{1}.{2}.{3}", b(0), b(1), b(2), b(3)))
    End Function

    Private Function GetPort()Function GetPort(ByVal StartIndex As Integer) As Integer
        '端口号占用两个字节，第一个字节左移八位再组合第二个字节
        Return data(StartIndex) * 256 + data(StartIndex + 1)
    End Function

    Private Function GetCheckSum()Function GetCheckSum(ByVal StartIndex As Integer) As Integer
        Return data(StartIndex) * 256 + data(StartIndex + 1)
    End Function

    Private Function GetData()Function GetData() As Byte()
        Dim b As Byte()
        Dim HeaderLength As Integer

        Try
            Select Case Me.Protocal
                Case Sockets.ProtocolType.Tcp
                    HeaderLength = 40
                Case Sockets.ProtocolType.Udp
                    HeaderLength = 28
            End Select

            ReDim b(data.Length - HeaderLength)
            Array.Copy(data, HeaderLength, b, 0, data.Length - HeaderLength)

            Return b
        Catch ex As Exception
            Throw New Exception(ex.Message)
        End Try
    End Function

    'IP头部
    Public Function GetIpHeader()Function GetIpHeader() As IpHeader
        Dim NewIpHeader As New IpHeader

        With NewIpHeader
            .Version = Left(Hex(data(0)), 1)                                            '版本号
            .IpHeaderLen = 20                                                           'IP头长度
            .TypeOfService = data(1).ToString                                           '服务类型
            .TotalLength = (data(2) * 256 + data(3)).ToString + Space(1) + "bytes"      '数据包长度
            .Identification = (data(4) * 256 + data(5)).ToString + Space(1) + "bytes"   '标识段
            .Flags = data(6).ToString                                                   '标志段
            .FragmentedOffset = data(7).ToString + Space(1) + "bytes"                   '数据偏移
            .TimeToLive = data(8).ToString                                              '生存时间
            .Protocol = ProtocalName                                                    '协议
            .HeaderCheckSum = (data(10) * 256 + data(11)).ToString                      '头校验和
            .SourceAddress = GetAddress(12)                                             '源地址
            .DestinationAddress = GetAddress(16)                                        '目的地址
        End With

        Return NewIpHeader
    End Function

    'UDP头部
    Public Function GetUdpHeader()Function GetUdpHeader() As UdpHeader
        Dim NewUdpHeader As New UdpHeader

        With NewUdpHeader
            .SourcePort = GetPort(20).ToString              '源端口号
            .DestinationPort = GetPort(22).ToString         '目的端口号
            .DatagramLength = GetCheckSum(24).ToString      '长度
            .CheckSum = GetCheckSum(26).ToString            '校验和
        End With

        Return NewUdpHeader
    End Function

    'TCP头部
    Public Function GetTcpHeader()Function GetTcpHeader() As TcpHeader
        Dim NewTcpHeader As New TcpHeader

        With NewTcpHeader

        End With

        Return NewTcpHeader
    End Function
End Class

#End Region

4、ClsReceive

Imports  System.Net
Imports  System.Net.Sockets
Imports  System.Threading

网卡设置混杂模式，监听数据包 #Region "网卡设置混杂模式，监听数据包"

Public Class ReceiverClass Receiver
    '定义变量
    Dim buffer As Byte()
    Dim mVarBufferLength As Integer = 1024 * 4
    Dim sck As Socket
    Dim threadListening As Thread
    Dim mContinueListening As Boolean = True

    Public Event DataReceived(ByVal data As Byte(), ByVal Length As Integer)


    '构造函数
    Sub New()Sub New()
        ReDim buffer(mVarBufferLength)

        '建立原始套结字
        sck = New Socket(AddressFamily.InterNetwork, SocketType.Raw, ProtocolType.IP)
        sck.Blocking = False '是否处于阻塞模式
        sck.Bind(New IPEndPoint(Dns.GetHostEntry(Dns.GetHostName).AddressList(0), 0))

        If Not SetSockoption() Then Throw New Exception("Error! Unable to setup socket options")
    End Sub

    '设置网卡工作在混合模式，以便可以截获所有流经网卡的数据包
    Private Function SetSockoption()Function SetSockoption() As Boolean
        Try
            sck.SetSocketOption(SocketOptionLevel.IP, SocketOptionName.HeaderIncluded, 1)
            Dim DataIN() As Byte = {1, 0, 0, 0}
            Dim DataOUT(4) As Byte
            Dim SIO_RCVALL As Integer = &H98000001

            sck.IOControl(SIO_RCVALL, DataIN, DataOUT)
            If (BitConverter.ToInt32(DataOUT, 0) <> 0) Then Return False Else Return True
        Catch ex As SocketException
            MsgBox(ex.Message, MsgBoxStyle.Critical, "设置网卡工作模式")
            Return False
        End Try
    End Function

    '获取或设置缓冲区大小
    Public Property BufferLength()Property BufferLength() As Integer
        Get
            Return mVarBufferLength
        End Get

        Set(ByVal Value As Integer)
            If threadListening IsNot Nothing Then
                If threadListening.ThreadState = ThreadState.Running Then Throw New Exception("Receiving thread is running. Call StopReceive() first.")
            End If
            ReDim buffer(Value)
            mVarBufferLength = Value
        End Set
    End Property

    '停止或继续接收数据包
    Public Property ContinueReceive()Property ContinueReceive() As Boolean
        Get
            Return mContinueListening
        End Get
        Set(ByVal Value As Boolean)
            mContinueListening = Value
        End Set
    End Property

    '启动线程，开始接收数据包
    Public Sub StartReceive()Sub StartReceive()
        StopReceive()
        threadListening = New Thread(AddressOf subReceive)
        threadListening.Start()
    End Sub

    '停止线程
    Public Sub StopReceive()Sub StopReceive()
        Try
            threadListening.Abort()
        Catch ex As Exception
        End Try
    End Sub

    '接收数据包
    Private Sub subReceive()Sub subReceive()
        Dim i As Integer, ar As IAsyncResult
        Dim b As Byte()

        While ContinueReceive
            ar = sck.BeginReceive(buffer, 0, buffer.Length, SocketFlags.None, Nothing, Me)
            i = sck.EndReceive(ar)

            ReDim b(i - 1)
            Array.Copy(buffer, 0, b, 0, i)
            RaiseEvent DataReceived(b, i)

            System.Threading.Thread.Sleep(10)
        End While
    End Sub

    '发送数据包
    Public Sub SendOut()Sub SendOut(ByVal Data() As Byte)

    End Sub

End Class

#End Region

5、FunSub

Imports  System
Imports  System.Net
Imports  System.Windows.Forms

Public   Module FunSub Module FunSub

定义数据包分析格式#Region "定义数据包分析格式"
    '数据包显示用
    Public Structure PackDataStructure PackData
        Dim strRow As String
        Dim strData As String
        Dim strChr As String
    End Structure

    'IP头部分
    Public Structure IpHeaderStructure IpHeader
        Dim Version As String               '版本号（半个字节）
        Dim IpHeaderLen As String           'IP头长度（半个字节）
        Dim TypeOfService As String         '服务类型（1个字节）
        Dim TotalLength As String           '数据包长度（2个字节）
        Dim Identification As String        '标识段（2个字节）
        Dim Flags As String                 '标志段（1个字节）
        Dim FragmentedOffset As String      '碎片偏移（1个字节）
        Dim TimeToLive As String            '生存时间（1个字节）
        Dim Protocol As String              '传输协议（1个字节）
        Dim HeaderCheckSum As String        '头校验和（2个字节）
        Dim SourceAddress As IPAddress      '源地址（4个字节）
        Dim DestinationAddress As IPAddress '目标地址（4个字节）

        Dim Options() As Byte               '选项（不定）
        Dim Padding() As Byte               '填充
    End Structure

    'UDP头部分
    Public Structure UdpHeaderStructure UdpHeader
        Dim SourcePort As String            '源端口号（2个字节）
        Dim DestinationPort As String       '目的端口号（2个字节）
        Dim DatagramLength As String        '长度（2个字节）
        Dim CheckSum As String              '校验和（2个字节）
    End Structure

    'TCP头部分
    Public Structure TcpHeaderStructure TcpHeader
        Dim SourcePort As String            '源端口号（2个字节）
        Dim DestinationPort As String       '目的端口号（2个字节）
        Dim SequenceNumber As String        '序号（4个字节）
        Dim AcknowledgementNumber As String '确认序号（4个字节）
        Dim DataOffset As String            '首部长度（4位）
        Dim Reserved As String              '保留（6位）
        Dim URG As Boolean                  'URG（1位）
        Dim ACK As Boolean                  'ACK（1位）
        Dim PSH As Boolean                  'PSH（1位）
        Dim RST As Boolean                  'RST（1位）
        Dim SYN As Boolean                  'SYN（1位）
        Dim FIN As Boolean                  'FIN（1位）
        Dim Window As String                '窗口大小（2个字节）
        Dim CheckSum As String              '校验和（2个字节）
        Dim UrgentPointer As String         '指针（2个字节）

        Dim Options() As Byte               '选项（不定）
        Dim Data() As Byte                  '数据
    End Structure
#End Region

递归查询节点#Region "递归查询节点"
    Public Function ScanNode()Function ScanNode(ByVal RootNode As TreeNode, ByVal CompareInfo As String, ByVal TV As TreeView) As TreeNode
        If RootNode.Text = CompareInfo Then
            Return RootNode
        Else
            If RootNode.Nodes.Count <= 0 Then Return Nothing

            For Each thisNode As TreeNode In RootNode.Nodes
                If thisNode.Text = CompareInfo Then Return thisNode
                Return ScanNode(thisNode, CompareInfo, TV)
            Next
        End If
    End Function
#End Region

根据IP地址获得计算机Mac地址#Region "根据IP地址获得计算机Mac地址"

使用Windows nbtstat 命令#Region "使用Windows nbtstat 命令"
    Public Function GetMac()Function GetMac(ByVal IP As String) As String
        Dim strMac As String = String.Empty

        Try
            Dim str As String = String.Empty
            Dim info As ProcessStartInfo = New ProcessStartInfo()
            Dim mProcess As Process = New Process()

            With info
                .FileName = "nbtstat"
                .RedirectStandardInput = False
                .RedirectStandardOutput = True
                .Arguments = "-A " + IP
                .UseShellExecute = False
                .WindowStyle = ProcessWindowStyle.Hidden
            End With

            mProcess = Process.Start(info)

            Dim num As Integer = -1

            While (num <= -1)
                num = str.Trim().ToLower().IndexOf("mac address", 0)
                If (num > -1) Then Exit While

                str = mProcess.StandardOutput.ReadLine()
                mProcess.WaitForExit()
                strMac = str.Trim()
            End While
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical, "Error")
        End Try

        Return strMac
    End Function

#End Region

使用SendARP获得计算机Mac地址#Region "使用SendARP获得计算机Mac地址"
    Private Declare Ansi Function SendARP()Function SendARP Lib "Iphlpapi.dll" (ByVal dest As Int32, ByVal host As Int32, ByRef mac As Int64, ByRef length As Int32) As Int32
    Private Declare Ansi Function inet_addr()Function inet_addr Lib "Ws2_32.dll" (ByVal IP As String) As Int32

    Public Function getRemoteMAC()Function getRemoteMAC(ByVal RemoteIp As String) As String
        Dim dest As Int32 = inet_addr(RemoteIp)
        Dim StrMac As String = ""

        Try
            Dim macinfo As Int64 = New Int64
            Dim len As Int32 = 6
            Dim res As Integer = SendARP(dest, 0, macinfo, len)
            StrMac = Convert.ToString(macinfo, 16)
        Catch ex As Exception
            MsgBox("解析MAC地址出现错误！", MsgBoxStyle.Critical, "Error")
        End Try

        Return StrMac
    End Function
#End Region

#End Region

获得同网段内的计算机列表#Region "获得同网段内的计算机列表"
    Public Function GetComputerList()Function GetComputerList() As ArrayList
        Dim List As New ArrayList

        Dim Root As System.DirectoryServices.DirectoryEntry = New System.DirectoryServices.DirectoryEntry("WinNT:")
        Dim Domains As System.DirectoryServices.DirectoryEntries = Root.Children

        Domains.SchemaFilter.Add("domain")

        For Each Domain As System.DirectoryServices.DirectoryEntry In Domains
            Dim Computers As System.DirectoryServices.DirectoryEntries = Domain.Children
            Computers.SchemaFilter.Add("computer")

            For Each Computer As System.DirectoryServices.DirectoryEntry In Computers
                Dim arr(2) As String
                Dim iphe As System.Net.IPHostEntry = Nothing

                Try
                    iphe = Dns.GetHostEntry(Computer.Name)
                Catch ex As Exception
                End Try

                arr(0) = Domain.Name : arr(1) = Computer.Name

                If iphe IsNot Nothing AndAlso iphe.AddressList.Length > 0 Then
                    For i As Integer = 0 To iphe.AddressList.Length - 1
                        arr(2) += iphe.AddressList(i).ToString + ","
                    Next

                    arr(2) = arr(2).ToString().Remove(arr(2).ToString().Length - 1, 1)
                Else
                    arr(2) = ""
                End If

                List.Add(arr)
            Next
        Next

        '释放资源
        Root = Nothing : Domains = Nothing

        '返回
        Return List
    End Function

    '遍历法
    Public Function ScanComputers()Function ScanComputers(ByVal ipPrefix As String, ByVal StartIP As Integer, ByVal EndIp As Integer) As ArrayList
        Dim List As New ArrayList

        For i As Integer = StartIP To EndIp
            Dim ScanIP As String = ipPrefix + "." + i.ToString

            Try
                Dim myScanHost As System.Net.IPHostEntry = Nothing
                myScanHost = Dns.GetHostEntry(System.Net.IPAddress.Parse(ScanIP))

                If myScanHost IsNot Nothing Then
                    Dim arr(2) As String
                    arr(1) = myScanHost.HostName
                    arr(2) = ScanIP
                    List.Add(arr)
                End If
            Catch ex As Exception
            End Try
        Next

        Return List
    End Function

#End Region


End Module

6、TreeViewFunction

Imports  System.Runtime.Serialization.Formatters.Binary
Imports  System.IO
Imports  System.Windows.Forms

Module TreeViewFunction Module TreeViewFunction
    <Serializable()> Structure sNodeStructure sNode
        Dim node As String
        Dim level As Integer
        Dim tag() As Byte
    End Structure

    Dim GlobeNodes As New ArrayList

    Public fPath As String = Application.StartupPath + "Sniffer.wzm"

    Private Sub SaveNodes()Sub SaveNodes(ByVal fName As String)
        Dim formatter As BinaryFormatter
        Dim saveFile As System.IO.FileStream

        saveFile = File.Create(fName)
        formatter = New BinaryFormatter
        formatter.Serialize(saveFile, GlobeNodes)
        saveFile.Close()
    End Sub

    Public Sub CreateList()Sub CreateList(ByVal node As TreeNode, ByVal fName As String)
        Static level As Integer
        Dim thisNode As TreeNode, myNode As New sNode

        With myNode
            .level = level
            .node = node.Text
            .tag = node.Tag
        End With

        GlobeNodes.Add(myNode)

        If node.Nodes.Count > 0 Then
            level = level + 1
            For Each thisNode In node.Nodes
                CreateList(thisNode, fName)
            Next
            level = level - 1
        End If

        Call SaveNodes(fName)
    End Sub

    Public Sub LoadNodes()Sub LoadNodes(ByVal TV As TreeView, ByVal fname As String)
        Dim formatter As BinaryFormatter = New BinaryFormatter
        Dim openFile As System.IO.FileStream = File.Open(fname, System.IO.FileMode.Open)

        GlobeNodes.Clear()
        GlobeNodes = CType(formatter.Deserialize(openFile), ArrayList)
        openFile.Close()

        ShowNodes(TV)
    End Sub

    Sub ShowNodes()Sub ShowNodes(ByRef TV As TreeView)
        Dim mObject As sNode
        Dim currNode As TreeNode = Nothing
        Dim level As Integer = 0

        TV.Nodes.Clear()

        For i As Integer = 0 To GlobeNodes.Count - 1
            mObject = CType(GlobeNodes(i), sNode)

            If mObject.level = level Then
                If currNode Is Nothing Then
                    currNode = TV.Nodes.Add(mObject.node.ToString)
                    currNode.Tag = mObject.tag
                Else
                    currNode = currNode.Parent.Nodes.Add(mObject.node.ToString)
                    currNode.Tag = mObject.tag
                End If
            Else
                If mObject.level > level Then
                    currNode = currNode.Nodes.Add(mObject.node.ToString)
                    currNode.Tag = mObject.tag
                    level = mObject.level
                Else
                    While mObject.level <= level
                        currNode = currNode.Parent
                        level = level - 1
                    End While
                    currNode = currNode.Nodes.Add(mObject.node.ToString)
                    currNode.Tag = mObject.tag
                    level = level + 1
                End If
            End If
        Next
        '释放资源
        GlobeNodes.Clear() : currNode = Nothing : mObject = Nothing
    End Sub

End Module

7、Sniffer Setup 安装程序下载，现在不知何故上传不了，有时间再弄吧。