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