原来的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) &nb [1] [2] 下一页 [Delphi程序]Xray@NET,业余写的SNIFFER
|