改写后的代码分成两部分：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.Unkno