VB.net进阶:VB.net下的Sniffer

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

原来的C#代码在这里:
http://www.techblog.idv.tw/Blog/zion/archive/2004/09/14/148.aspx

改写后的代码分成两部分:Receiver,用来侦听;PacketInfo,对数据包进行简单的解析。
数据包的内容是通过Receiver的DataReceived事件返回来的。
每个函数都不长,容易看懂,注释我就……咳咳。




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

Public Class Receiver

    Dim buffer As Byte()
    Dim mvarBufferLength As Integer = 4096
    Dim sck As Socket
    Dim thrReceive As Thread
    Dim mvarStopOne As Boolean = False

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

    Sub New()
        ReDim buffer(mvarBufferLength)

        sck = New Socket(AddressFamily.InterNetwork, SocketType.Raw, ProtocolType.IP)
        sck.Blocking = False
        sck.Bind(New IPEndPoint(Dns.GetHostByName(Dns.GetHostName).AddressList(0), 0))

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

    Public Property BufferLength() As Integer
        Get
            Return mvarBufferLength
        End Get
        Set(ByVal Value As Integer)
            If Not thrReceive Is Nothing Then
                If thrReceive.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 StopEveryOnePackage() As Boolean    '指定是否接受一个数据包后就退出。用于测试。
        Get
            Return mvarStopOne
        End Get
        Set(ByVal Value As Boolean)
            mvarStopOne = Value
        End Set
    End Property

    Public Sub StartReceive()
        StopReceive()
        thrReceive = New Thread(AddressOf subReceive)
        thrReceive.Start()
    End Sub

    Public Sub StopReceive()
        Try
            thrReceive.Abort()
        Catch ex As Exception
        End Try
    End Sub

    Private Sub subReceive()
        Dim i As Integer, ar As IAsyncResult
        Dim b As Byte()
        While True
            ar = sck.BeginReceive(buffer, 0, buffer.Length, SocketFlags.None, Nothing, Me)
            i = sck.EndReceive(ar)
            ReDim b(i)
            Array.Copy(buffer, 0, b, 0, i)
            RaiseEvent DataReceived(b, i)
            Thread.CurrentThread.Sleep(10)
            If Me.StopEveryOnePackage Then Exit While
        End While
    End Sub

    Private Function SetSockoption() As Boolean
        Try
            sck.SetSocketOption(SocketOptionLevel.IP, SocketOptionName.HeaderIncluded, 1)
            Dim IN_() As Byte = {1, 0, 0, 0}
            Dim OUT_(4) As Byte
            Dim SIO_RCVALL As Long = &H98000001
            sck.IOControl(SIO_RCVALL, IN_, OUT_)
            If (BitConverter.ToInt32(OUT_, 0) <> 0) Then Return False
        Catch ex As SocketException
            Return False
        End Try
        Return True
    End Function
End Class



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




Imports System.Net

Public Class PacketInfo
    Dim data As Byte()

    Sub New(ByVal PacketData As Byte())
        data = PacketData
    End Sub

    Public ReadOnly 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 Sender() As IPEndPoint
        Get
            If Me.Protocal = Sockets.ProtocolType.Unknown Then Return Nothing
            Return GetSenderIPEndPoint()
        End Get
    End Property

    Public ReadOnly Property Receiver() As IPEndPoint
        Get
            If Me.Protocal = Sockets.ProtocolType.Unknown Then Return Nothing
            Return GetreceiverIPEndPoint()
        End Get
    End Property

    Public ReadOnly Property PacketData() As Byte()
        Get
            If Me.Protocal = Sockets.ProtocolType.Unknown Then Return Nothing
            Return GetData()
        End Get
    End Property

 

    Private Function GetProtocal() As Integer
        Return data(9)
    End Function

    Private Function GetSenderIPEndPoint() As IPEndPoint
        Return New IPEndPoint(GetSenderAddress, GetSenderPort)
    End Function

    Private Function GetreceiverIPEndPoint() As IPEndPoint
        Return New IPEndPoint(GetReceiverAddress, getReceiverPort)
    End Function

    Private Function GetSenderAddress() As IPAddress
        Return GetAddress(12)
    End Function

    Private Function GetSenderPort() As Integer
        Return GetPort(20)
    End Function

    Private Function GetReceiverAddress() As IPAddress
        Return GetAddress(16)
    End Function

    Private Function getReceiverPort() As Integer
        Return GetPort(21)
    End Function

    Private 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(ByVal StartIndex As Integer) As Integer
        Return data(StartIndex) * 256 + data(StartIndex + 1)
    End Function

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

        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
    End Function

End Class

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