Code:
//**************************************
//
// Name: Async Socket
// Description:A Socket which trys to wo
// rk like the good old VB6-Winsock
// By: Christopher K.
//
// Assumes:Winsock alike Socketclass
//
//This code is copyrighted and has // limited warranties.Please see http://
// www.Planet-Source-Code.com/vb/scripts/Sh
// owCode.asp?txtCodeId=6111&lngWId=10 //for details. //**************************************
//
Imports System.Net
Namespace CK
Public Class WinSocket
Implements IDisposable
#Region "( Variables )"
Private mySocket As Sockets.Socket
Private myStream As IO.Stream
Private myTimer As Threading.Timer
Private recBuffer(32676) As Byte
Private lActivity As DateTime
Private myTimeOut As Double = 60
Private toRaiseTimeOut As Boolean = False
Private isConnected As Boolean = True
Private disposedValue As Boolean = False' To detect redundant calls
#End Region
#Region "( Events )"
Public Event onConnect(ByVal isSSL As Boolean)
Public Event onDisconnect()
Public Event onAccept(ByVal Client As Sockets.Socket)
Public Event onDataArrival(ByVal Data As String, ByVal ByteString As Byte())
Public Event onSentComplete()
Public Event onSecure()
Public Event onTimeout()
#End Region
#Region "( Properties )"
Public ReadOnly Property LocalEndPoint() As IPEndPoint
Get
Return DirectCast(mySocket.LocalEndPoint, IPEndPoint)
End Get
End Property
Public ReadOnly Property RemoteEndPoint() As IPEndPoint
Get
Return DirectCast(mySocket.RemoteEndPoint, IPEndPoint)
End Get
End Property
Public Property Timeout() As Double
Get
Return myTimeOut
End Get
Set(ByVal value As Double)
myTimeOut = value
End Set
End Property
Public Property RaiseTimeout() As Boolean
Get
Return toRaiseTimeOut
End Get
Set(ByVal value As Boolean)
toRaiseTimeOut = value
End Set
End Property
#End Region
#Region "( Private )"
Public Sub New()
mySocket = New Sockets.Socket(Sockets.AddressFamily.InterNetwork, Sockets.SocketType.Stream, Sockets.ProtocolType.Tcp)
lActivity = DateTime.Now
End Sub
Public Sub New(ByVal oldSocket As Sockets.Socket)
mySocket = oldSocket
lActivity = DateTime.Now
myTimer = New Threading.Timer(New Threading.TimerCallback(AddressOf CBTimer), Nothing, 1000, 1000)
Dim NS As New Sockets.NetworkStream(mySocket)
myStream = DirectCast(NS, IO.Stream)
myStream.BeginRead(recBuffer, 0, 32676, New AsyncCallback(AddressOf CBDataArrival), Nothing)
End Sub
Protected Overrides Sub Finalize()
myStream.Close()
myStream.Dispose()
mySocket.Close()
mySocket = Nothing
myTimer.Dispose()
myTimer = Nothing
MyBase.Finalize()
End Sub
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not Me.disposedValue Then
If disposing Then
Try
myStream.Dispose()
Catch
Finally
myStream = Nothing
End Try
Try
mySocket.Close()
Catch
Finally
mySocket = Nothing
End Try
Try
myTimer.Dispose()
Catch
Finally
myTimer = Nothing
End Try
End If
' TODO: free shared unmanaged resources
End If
Me.disposedValue = True
End Sub
#End Region
#Region "( Public )"
Public Sub Listen(ByVal LocalHost As String, ByVal Port As Integer)
Dim IPEP As New IPEndPoint(IPAddress.Any, Port)
Dim IPA As IPAddress = IPAddress.Any
If IPAddress.TryParse(LocalHost, IPA) Then
IPEP.Address = IPA
Else
IPEP.Address = Dns.GetHostEntry(LocalHost).AddressList(0)
End If
Listen(IPEP)
End Sub
Public Sub Listen(ByVal LocalIP As IPAddress, ByVal Port As Integer)
Dim IPEP As New IPEndPoint(LocalIP, port)
Listen(IPEP)
End Sub
Public Sub Listen(ByVal Port As Integer)
Dim IPEP As New IPEndPoint(IPAddress.Any, Port)
Listen(IPEP)
End Sub
Public Sub Listen(ByVal LocalEndpoint As IPEndPoint)
mySocket.Bind(LocalEndpoint)
mySocket.Listen(CInt(Sockets.SocketOptionName.MaxConnections))
mySocket.BeginAccept(New AsyncCallback(AddressOf CBAccept), Nothing)
End Sub
Public Sub Connect(ByVal RemoteHost As String, ByVal Port As Integer)
mySocket.BeginConnect(RemoteHost, Port, New AsyncCallback(AddressOf CBConnect), Nothing)
End Sub
Public Sub Connect(ByVal RemoteEndpoint As IPEndPoint)
mySocket.BeginConnect(RemoteEndpoint, New AsyncCallback(AddressOf CBConnect), Nothing)
End Sub
Public Sub Connect(ByVal RemoteAddress As IPAddress, ByVal Port As Integer)
mySocket.BeginConnect(RemoteAddress, Port, New AsyncCallback(AddressOf CBConnect), Nothing)
End Sub
Public Sub Connect(ByVal RemoteAddresses As IPAddress(), ByVal Port As Integer)
mySocket.BeginConnect(RemoteAddresses, Port, New AsyncCallback(AddressOf CBConnect), Nothing)
End Sub
Public Sub Disconnect()
lActivity = DateTime.Now
mySocket.Shutdown(Sockets.SocketShutdown.Both)
mySocket.Disconnect(True)
RaiseEvent onDisconnect()
End Sub
Public Sub Send(ByVal Data As Byte())
lActivity = DateTime.Now
myStream.BeginWrite(Data, 0, Data.Length, New AsyncCallback(AddressOf CBSentData), Nothing)
End Sub
Public Sub Send(ByVal Data As String)
lActivity = DateTime.Now
Send(System.Text.Encoding.ASCII.GetBytes(Data))
End Sub
Public Sub SSLServer(ByVal Certificate As System.Security.Cryptography.X509Certificates.X509Certificate, _
ByVal ClientCertificateRequired As Boolean, ByVal Protocol As System.Security.Authentication.SslProtocols, ByVal CheckRevocation As Boolean)
lActivity = DateTime.Now
Dim SSLS As New Net.Security.SslStream(myStream)
SSLS.BeginAuthenticateAsServer(Certificate, ClientCertificateRequired, Protocol, CheckRevocation, New AsyncCallback(AddressOf CBSSLS), Nothing)
End Sub
Public Sub SSLConnect(ByVal Host As String, ByVal Certificate As System.Security.Cryptography.X509Certificates.X509CertificateCollection, _
ByVal ClientCertificateRequired As Boolean, ByVal Protocol As System.Security.Authentication.SslProtocols, ByVal CheckRevocation As Boolean)
lActivity = DateTime.Now
Dim SSLS As New Net.Security.SslStream(myStream)
SSLS.BeginAuthenticateAsClient(Host, Certificate, Protocol, CheckRevocation, New AsyncCallback(AddressOf CBSSLC), Nothing)
End Sub
#End Region
#Region "( Callback )"
Private Sub CBDataArrival(ByVal ar As IAsyncResult)
lActivity = DateTime.Now
Try
Dim sck_Data As String
Dim BytesRead As Integer = myStream.EndRead(ar)
If BytesRead > 0 Then
sck_Data = System.Text.Encoding.ASCII.GetString(recBuffer, 0, BytesRead)
RaiseEvent onDataArrival(sck_Data, recBuffer)
End If
myStream.BeginRead(recBuffer, 0, recBuffer.Length, New AsyncCallback(AddressOf CBDataArrival), Nothing)
Catch e As Exception
RaiseEvent onDisconnect()
End Try
End Sub
Private Sub CBSentData(ByVal ar As IAsyncResult)
lActivity = DateTime.Now
myStream.EndWrite(ar)
RaiseEvent onSentComplete()
End Sub
Private Sub CBAccept(ByVal ar As IAsyncResult)
RaiseEvent onAccept(mySocket.EndAccept(ar))
mySocket.BeginAccept(New AsyncCallback(AddressOf CBAccept), Nothing)
End Sub
Private Sub CBConnect(ByVal ar As IAsyncResult)
lActivity = DateTime.Now
myTimer = New Threading.Timer(New Threading.TimerCallback(AddressOf CBTimer), Nothing, 1000, 1000)
mySocket.EndConnect(ar)
RaiseEvent onConnect(False)
isConnected = True
Dim ns As New Sockets.NetworkStream(mySocket)
myStream = DirectCast(ns, IO.Stream)
myStream.BeginRead(recBuffer, 0, recBuffer.Length, New AsyncCallback(AddressOf CBDataArrival), Nothing)
End Sub
Private Sub CBSSLS(ByVal ar As IAsyncResult)
lActivity = DateTime.Now
Dim SSLS As Net.Security.SslStream = DirectCast(ar.AsyncState, Net.Security.SslStream)
SSLS.EndAuthenticateAsServer(ar)
RaiseEvent onSecure()
myStream = DirectCast(SSLS, IO.Stream)
myStream.BeginRead(recBuffer, 0, recBuffer.Length, New AsyncCallback(AddressOf CBDataArrival), Nothing)
End Sub
Private Sub CBSSLC(ByVal ar As IAsyncResult)
lActivity = DateTime.Now
Dim SSLS As Net.Security.SslStream = DirectCast(ar.AsyncState, Net.Security.SslStream)
SSLS.EndAuthenticateAsClient(ar)
RaiseEvent onConnect(True)
isconnected = True
myStream = DirectCast(SSLS, IO.Stream)
myStream.BeginRead(recBuffer, 0, recBuffer.Length, New AsyncCallback(AddressOf CBDataArrival), Nothing)
End Sub
Private Sub CBTimer(ByVal state As Object)
If lActivity.AddSeconds(myTimeOut) <= DateTime.Now Then
If toRaiseTimeOut Then RaiseEvent onTimeout()
ElseIf Not mySocket.Connected AndAlso isConnected Then
RaiseEvent onDisconnect()
isConnected = False
End If
End Sub
#End Region
#Region " IDisposable Support "
' This code added by Visual Basic to correctly implement the disposable pattern.
Public Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in Dispose(ByVal disposing As Boolean) above.
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace
Reply With Quote