Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As _
      System.EventArgs) Handles MyBase.Load
        startserver(12345)
    End Sub
 
    Sub startserver(ByVal lport As Integer)
        Dim SOCK As New System.Net.Sockets.Socket( _
          Net.Sockets.AddressFamily.InterNetwork, _
          Net.Sockets.SocketType.Stream, Net.Sockets.ProtocolType.Tcp)
        Dim localEP As New Net.IPEndPoint(0, lport)
        SOCK.Bind(localEP)
        SOCK.Listen(10)
        SOCK.BeginAccept(AddressOf incomingconnectioncallback, SOCK)
    End Sub
 
    Sub incomingconnectioncallback(ByVal ar As IAsyncResult)
        Dim SOCK As Net.Sockets.Socket = CType(ar.AsyncState, _
          Net.Sockets.Socket)
        Dim thisuser As New user(SOCK.EndAccept(ar))
        SOCK.BeginAccept(AddressOf incomingconnectioncallback, SOCK)
    End Sub
 
    Class user
        Structure data
            Dim sock As Net.Sockets.Socket
            Dim readbuf() As Byte
            Const readbufsize% = 255
        End Structure
 
        Sub New(ByVal sock As Net.Sockets.Socket)
            Dim d As New Data
            d.sock = sock
            ReDim d.readbuf(d.readbufsize)
            sock.BeginReceive(d.readbuf, 0, d.readbufsize, _
              Net.Sockets.SocketFlags.None, AddressOf readcallback, d)
        End Sub
 
        Sub readcallback(ByVal ar As IAsyncResult)
            Dim d As Data = CType(ar.AsyncState, Data)
            If d.sock.Connected Then
                Try
                    SyncLock Threading.Thread.CurrentThread
                        Dim bRead% = d.sock.EndReceive(ar)
                        Dim cmd$ = System.Text.Encoding.Default.GetString( _
                          d.readbuf, 0, bRead - 2) ' - 2 weil ich immer noch 
                        ' crlf mitsende
                        ReDim d.readbuf(d.readbufsize)
                        d.sock.BeginReceive(d.readbuf, 0, d.readbufsize, _
                          Net.Sockets.SocketFlags.None, AddressOf readcallback, _
                          d)
                    End SyncLock
                Catch ex As Exception
                    d.sock.Close()
                    d.sock = Nothing
                    Threading.Thread.CurrentThread.Abort()
                End Try
            End If
        End Sub
 
        Sub cmd(ByVal cmd As String, ByVal sock As Net.Sockets.Socket)
            Select Case cmd
                Case cmd.StartsWith("OS")
                    send(sock, Environment.OSVersion.ToString)
                    '...
                    '...
                    '...
                Case Else
                    send(sock, "Unrecognized Command")
            End Select
        End Sub
 
        Sub send(ByVal sock As Net.Sockets.Socket, ByVal s As String)
            Dim b() As Byte = System.Text.Encoding.Default.GetBytes(s & _
              ControlChars.CrLf)
            sock.Send(b, 0, b.Length, Net.Sockets.SocketFlags.None)
        End Sub
    End Class