原来的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