Imports System Imports System.Net Imports System.Net.Sockets Imports System.Text Imports System.Text.ASCIIEncoding Public Class Sockets Public lSocket As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) Public Event CloseSocket() Public Event ConnectSocket() 'connection successful Public Event FailedSocket() 'connection failed Public Event ConnectionRequestSocket(ByVal requestID As IPEndPoint) Public Event DataArrivalSocket(ByVal bytesTotal As Long, ByVal strData As String) Public Event SendCompleteSocket() Public Event Errors(ByVal Number As Integer, ByVal Description As String, ByVal Source As String) Public LocalHostName As String Public LocalIP As String Public LocalPort As Integer Public RemoteHost As String Public RemoteHostIP As String Public RemotePort As Integer Public iBuffer As Integer = 32767, sBuffer(32767) As Byte Private bUse As Boolean Public strName As String Public result As IAsyncResult Public lConnect As IAsyncResult Public bListen As Boolean Public bConnect As Boolean Public Sub New() Try 'set all the known settings LocalHostName = System.Net.Dns.GetHostName Dim iIP As IPHostEntry iIP = System.Net.Dns.GetHostByName(LocalHostName) Dim iIP2() As IPAddress = iIP.AddressList Dim iTemp As Integer, iTemp2 As Integer iTemp2 = iIP2.GetUpperBound(0) 'if they have more than one connection, which ip to set omg?, well lets just set the first one! LocalIP = iIP2(0).ToString LocalPort = 80 'for a default, so we dont get error later RemotePort = 80 Catch MsgBox("Error: Initialization error in New sub") End Try End Sub Public Sub Connect(Optional ByVal strHost As String = "", Optional ByVal iPort As Integer = 0) Try 'if they had previously set these settings If strHost = "" Then strHost = RemoteHost If iPort = 0 Then iPort = RemotePort 'attempt to connect Dim ipRemote As IPHostEntry ipRemote = Dns.Resolve(strHost) Dim ipRemotePoint As IPAddress ipRemotePoint = ipRemote.AddressList(0) bUse = True 'result = lSocket.BeginConnect(New IPEndPoint(ipRemotePoint, iPort), AddressOf Connected, lSocket) lConnect = lSocket.BeginConnect(New IPEndPoint(ipRemotePoint, iPort), AddressOf Connected, lSocket) Catch ex As Exception Call Close() RaiseEvent Errors(Err.Number, "Sub Connect" & vbCrLf & Err.Description, Err.Source) End Try End Sub Public Sub Listen() If bListen = True Then 'raise an event and exit sub Throw New ArgumentException("custom: Already listening") Exit Sub End If Try bListen = True lSocket.Bind(New IPEndPoint(Dns.GetHostByName(LocalHostName).AddressList(0).Any, LocalPort)) lSocket.Listen(5) 'this is here because of an invalid argument supplied error raised , because the bind failes result = lSocket.BeginAccept(AddressOf ConnectionRequest, lSocket) lSocket = result.AsyncState Catch 'if we are here then that means that for some odd reason the close did not do a good 'cleanup and the socket still has the original port bound RaiseEvent Errors(0, "Sub Connect" & vbCrLf & "This is bug #1 found, the socket will not release it's bind after a successful connection and close.", Err.Source) 'this only appears, if we listen 'they connect, we close connection, and we re-listen End Try End Sub Public Sub ConnectionRequest(ByVal ar As IAsyncResult) Try bListen = False bConnect = True 'we do not want to end the acception request 'a normal socket would still accept connectionrequests if we did not send a close to it, but for this beta 'version we are going to close it here, until we get the entire socket class working lSocket = lSocket.EndAccept(ar) RaiseEvent ConnectionRequestSocket(lSocket.RemoteEndPoint) Catch ex As Exception 'usually this happens on a CLOSE call after a LISTEN call without a remote connection! wierd!?! i know! 'dont raise an error 'the event wont be raised(ConnectionRequestSocket), because it errors at EndAccept Call Close() 'RaiseEvent Errors(Err.Number, "Sub ConnectionRequest" & vbCrLf & Err.Description, Err.Source) End Try End Sub 'Public Sub EndAccept(ByVal ar As IAsyncResult) ' lSocket = lSocket.EndAccept(ar) 'End Sub Public Sub Accept(ByVal requestID As IPEndPoint) Try lConnect = lSocket.BeginReceiveFrom(sBuffer, 0, iBuffer, SocketFlags.None, requestID, AddressOf DataArrival, lSocket) 'we connected here from a listen Dim iIP As IPEndPoint = lSocket.RemoteEndPoint() RemotePort = iIP.Port RemoteHostIP = iIP.Address.ToString 'RemoteHost = cannot find anything for remotehost Catch ex As Exception Call Close() RaiseEvent Errors(Err.Number, "Sub Accept" & vbCrLf & Err.Description, Err.Source) End Try End Sub Private Sub Connected(ByVal ar As IAsyncResult) 'this is for the client only Try 'TODO: find out if this is the proper way to deal with ar.IsCompleted 'in case its over the internet, give 7.5 seconds of waittime Dim iTemp As Byte For iTemp = 1 To 15 If ar.IsCompleted = False Then 'the connection has not completed Application.DoEvents() 'do any other events in the queue System.Threading.Thread.Sleep(500) 'only this thread, other threads will continue (app itself, other instances of this class) Else Exit For End If Next ''this is not required, only in a listen, because here we know where we are connecting to! ''we connected here from a connect 'Dim iIP As IPEndPoint = lSocket.RemoteEndPoint() 'RemotePort = iIP.Port 'RemoteHostIP = iIP.Address.ToString ''RemoteHost = cannot find anything for remotehost 'end the connect lSocket.EndConnect(ar) If lSocket.Connected = True Then RaiseEvent ConnectSocket() result = lSocket.BeginReceive(sBuffer, 0, iBuffer, 0, AddressOf DataArrival, lSocket) Else 'it failed to connect RaiseEvent FailedSocket() End If '''Try Catch ex As Exception 'normally we would raise the error event, but the app tries to complete lsocket.endconnect(ar) 'and errors there, so instead we are going to call the failed socket connect RaiseEvent FailedSocket() 'Call Close() 'RaiseEvent Errors(Err.Number, "Sub Connected" & vbCrLf & Err.Description, Err.Source) End Try End Sub Private Sub DataArrival(ByVal ar As IAsyncResult) Dim bytesRead As Integer Try 'lSocket = ar.AsyncState 'just added for testing, dont think it changes anything If lSocket.Connected = False Then 'this will only appear if we try closing the socket, and unloading the form 'but the other socket sends a blank message! Call Close2() Exit Sub End If 'If bUse = False Then ' lSocket.EndReceive(ar) ' Exit Sub 'exit if we are trying to finish this sub after we asked to close the socket 'End If 'stop accepting data bytesRead = lSocket.EndReceive(ar) If bytesRead = 0 Then 'a note for all developers, whenever any socket (including .net's or winsock's) disconnects 'from one side (ie. without one persons wireless dying or something, (they close the app) ) 'then the socket will automatically send a blank message 'using winsock, you cannot do a winsock.senddata "", (fyi you CAN however winsock.senddata chr(0)) 'but the bytestotal will be 1 and not 0... :-D 'when a winsock disconnects from this (ie. you click listen in this app, and connect with a vb6 app) 'it sends this blank message, same with if in this app you click listen, and in another instance connect 'here we are handling the situation: if they sent a 0 byte message (which means they disconnected) Try Dim iChr(0) As Byte 'the reason we try and send this, is because 'since microsoft is so dumb, their sockets suck put plainly 'we have to try and send a message to our good friend on the 'other side of this connection, and if he's there then 'nothing will happen, but if he is not there, then 'an error will be raised and the user is informed that 'the connection was broken 'now you may ask why four attempts? 'if you are not new to sockets, then you have seen other people's submissions 'with users complaining that it does not properly detect when a user disconnects 'now i have found that around four tries will most always get it to detect '(yes since ms is so dumb sometimes the first, second, and third try wont work) lSocket.Send(iChr) lSocket.Send(iChr) lSocket.Send(iChr) lSocket.Send(iChr) Catch ex As Exception Call Close2() 'this raises the close event too End Try ''UPDATE: wrote this long time ago, not sure if its still true or not { 'this works too, but im handling it inside of the err trap 'If lSocket.Connected = False Then 'that caused it to break 'Call Close() 'Exit Sub 'End If ''} Else 'get the data Dim strData As String = ASCII.GetChars(sBuffer) sBuffer.Clear(sBuffer, 0, iBuffer) RaiseEvent DataArrivalSocket(bytesRead, strData) 'accept more data now lConnect = lSocket.BeginReceive(sBuffer, 0, iBuffer, 0, AddressOf DataArrival, lSocket) End If Catch ex As Exception Call Close() RaiseEvent Errors(Err.Number, "Sub DataArrival" & vbCrLf & Err.Description, Err.Source) End Try End Sub Public Sub Close() 'UPDATE: Normally i would delete all ths junk i wrote like i did in all the other subs while experimenting 'but i wanted to show you the differnent approaches i have attempted at getting the lousy bind 'to, well, unbind!!! it keeps on getting that error in listen, where once we listen, someone connects, 'and we close the connection and try relistening, its already bound! omfg! Dim bRaise As Boolean 'bListen = False 'On Error Resume Next ' Try 'close the socket! 'lSocket.Close() 'bUse = False 'if the socket is currently reading information then stop now 'i need to endaccept here 'lSocket.EndReceive(async) If lSocket.Connected = True Then 'should we raise the disconnect call? 'i suppose so! bRaise = True 'we have to disconnect everything! 'lSocket() 'lSocket.EndReceiveFrom(lConnect, lSocket.RemoteEndPoint) 'lSocket.EndReceive(lConnect) End If 'Dim iIP As New IPHostEntry 'Dim iIP2 As IPAddress 'iIP = Dns.GetHostByName(LocalHostName) ''iIP2 = iIP.AddressList(0) ''iIP3.Address = iIP2 ''iIP3.Port = -1 'Dim iIP3 As New IPEndPoint(iIP.AddressList(0), 2223) 'lSocket.Bind(iIP3) 'lSocket.Bind(New IPEndPoint(Dns.GetHostByName(LocalHostName).AddressList(0), 2224)) If bListen Then 'If result.IsCompleted = False Then 'we have to bind to something else! 'UPDATE: i have left this commented out because at one point while programming it actually worked, 'but now it does not and instead hangs the application 'lSocket = lSocket.EndAccept(result) 'End If End If If bConnect Then 'If result.IsCompleted = False Then 'lSocket.EndConnect(result) 'End If End If bConnect = False bListen = False 'lSocket.EndConnect(result) 'lSocket.EndReceive(result) 'lSocket.EndSend(result) 'lSocket.EndSendTo(result) ''Application.DoEvents() Try lSocket.Shutdown(SocketShutdown.Both) Catch ' MsgBox("socket close, tried to use SHUTDOWN!") '' 'MsgBox("socket shutdown bad") End Try 'Try 'lSocket.Accept() 'Catch 'MsgBox("socket close, tried to use ACCEPT!") '' 'MsgBox("socket shutdown bad") 'End Try 'lSocket.Close() 'Try ' lSocket.Shutdown(SocketShutdown.Both) 'Catch ex As Exception ' MsgBox("close2: shutdown error!") 'End Try 'lSocket.Bind(New IPEndPoint(Dns.GetHostByName(LocalHostName).AddressList(0), 0)) lSocket.Close() lSocket.Close() lSocket = Nothing lSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) 'lSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) 'lSocket = Nothing 'RaiseEvent CloseSocket() 'Catch ex As Exception 'Call Close() 'RaiseEvent Errors(Err.Number, "Sub Close" & vbCrLf & Err.Description, Err.Source) 'End Try If bRaise = True Then RaiseEvent CloseSocket() End Sub Private Sub Close2() 'this will be the same as Close, only it WILL raise the close event 'the close event should only be raised if an open connection is closed 'this sub will only be called by functions inside this Call Close() RaiseEvent CloseSocket() End Sub Public Sub SendData(ByVal strData As String) Try sBuffer.Clear(sBuffer, 0, iBuffer) Array.Copy(ASCII.GetBytes(strData), sBuffer, Len(strData)) result = lSocket.BeginSend(sBuffer, 0, Len(strData), SocketFlags.None, AddressOf SendComplete, lSocket) 'the beginsend allows us to use the sendcomplete! which is more properly emulating winsock 'lSocket.Send(sBuffer, Len(strData), SocketFlags.None) Catch ex As Exception 'if theres an error here, then that means that we didnt detect there was a disconnection!! omfg! 'now since they are disconnected, we are going to raise close2 instead of close 'and we are NOT going to raise an error for this, because no one cares. lol Call Close2() 'Call Close() 'RaiseEvent Errors(Err.Number, "Sub SendData" & vbCrLf & Err.Description, Err.Source) End Try End Sub Private Sub SendComplete(ByVal ar As IAsyncResult) Try 'end the send lSocket.EndSend(ar) RaiseEvent SendCompleteSocket() Catch ex As Exception Call Close() RaiseEvent Errors(Err.Number, "Sub SendComplete" & vbCrLf & Err.Description, Err.Source) End Try End Sub End Class