The rewritten code is divided into two parts: Receiver, which is used for listening, packetinfo, and simple parsing of the packet.
The contents of the packet are returned through the receiver DataReceived event.
Each function is not long, easy to read, note I just ... Cough.
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 are nothing Then
If thrreceive.threadstate = threadstate.running Then Throw New Exception ("Receiving thread is Running. Call Stopreceive ()
End If
ReDim Buffer (Value)
Mvarbufferlength = Value
End Set
End Property
The Public Property stopeveryonepackage () as Boolean "Specifies whether to accept a packet and then exit." For testing.
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
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
The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion;
products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the
content of the page makes you feel confusing, please write us an email, we will handle the problem
within 5 days after receiving your email.
If you find any instances of plagiarism from the community, please send an email to:
info-contact@alibabacloud.com
and provide relevant evidence. A staff member will contact you within 5 working days.
A Free Trial That Lets You Build Big!
Start building with 50+ products and up to 12 months usage for Elastic Compute Service