?
Solved

Using system.net.sockets in vb 2005 vs winsock in vb6

Posted on 2007-10-08
4
Medium Priority
?
1,214 Views
Last Modified: 2012-05-05
I am familiar with how to use winsock in vb6 to create a network app.  I'm trying to find a way to take the current vb6 app and create a windows service using system.net.sockets.  How do you create a service (for the server side) that accepts incoming client connections using system.net.sockets?
0
Comment
Question by:smcintire001
  • 4
4 Comments
 
LVL 17

Expert Comment

by:inthedark
ID: 20039247
Are you using TCP or UDP? If you are using UDP sockets are ok but you can also listen for a oonnection like the VB winsock control and then accept a connection. The nice thing about .net is that you can process the new connection on a new thread but this can impact performace if you are going to have losts of clients.
0
 
LVL 17

Expert Comment

by:inthedark
ID: 20039337
There are a few samples using TCPListener I modified one of the MS examples.

I will post the code for a control form frmSMTPLIsten and a client class clsClient.vb

It works as follows:

frmSMTPListen creates a thread controllor which creates a listener object clsClient which will die until a connection is made. As soon as the connection is made clsClient will handle the new connection. The controller is also released and creates a new listener object ready for the next connection.

This is part of what you need to know, the next part being how to deploy as a service.

-------------------------------frmSMTPListen.vb

Imports System.Threading
Imports System.Net
Imports System.Net.Sockets

Public Delegate Sub StatusInvoker(ByVal t As String)

Public Class frmSMTPListen

    Inherits System.Windows.Forms.Form

    Private mobjThread As Thread
    Private mobjListener As TcpListener
    Private mcolClients As New Hashtable
    Private mbStarted As Boolean

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub
    Friend WithEvents lstStatus As System.Windows.Forms.ListBox

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.Container

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.lstStatus = New System.Windows.Forms.ListBox
        Me.SuspendLayout()
        '
        'lstStatus
        '
        Me.lstStatus.Dock = System.Windows.Forms.DockStyle.Fill
        Me.lstStatus.Location = New System.Drawing.Point(0, 0)
        Me.lstStatus.Name = "lstStatus"
        Me.lstStatus.Size = New System.Drawing.Size(292, 264)
        Me.lstStatus.TabIndex = 0
        '
        'frmSMTPListen
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(292, 273)
        Me.Controls.Add(Me.lstStatus)
        Me.Name = "frmSMTPListen"
        Me.Text = "Socket Server"
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        If gbInteractive Then
            StartService()
        End If
    End Sub
    Public Sub StartService()
        Static bDone As Boolean
        If bDone Then Exit Sub
        bDone = True

        mobjThread = New Thread(AddressOf DoListen)
        mbStarted = False
        mobjThread.Start()
        ' Give the new thread time to start
        Do Until mbStarted
            Thread.Sleep(50)
        Loop
        UpdateStatus("Listener started")
    End Sub
    Private Sub DoListen()
        mbStarted = True ' tell caller that this thread is now active
        Try
            Dim EP As System.Net.IPEndPoint
            EP = New System.Net.IPEndPoint(IPAddress.Parse("192.168.0.10"), 4950)

            mobjListener = New TcpListener(EP)

            mobjListener.Start()
            ' the thread will wait until a new connection arrives
            Do
                'Dim x As New Client(mobjListener.AcceptSocket)
                Dim x As New aClient(mobjListener) '.AcceptTcpClient, xTCPClient))

                AddHandler x.Connected, AddressOf OnConnected
                AddHandler x.Disconnected, AddressOf OnDisconnected
                'AddHandler x.CharsReceived, AddressOf OnCharsReceived
                'AddHandler x.LineReceived, AddressOf OnLineReceived
                mcolClients.Add(x.ID, x)
                Dim params() As Object = {"New connection"}
                Me.Invoke(New StatusInvoker(AddressOf Me.UpdateStatus), params)
                x.StartConnection()
            Loop Until False
        Catch ex As Exception
            '     MsgBox(ex.Message)
        End Try
    End Sub

    Private Sub OnConnected(ByVal sender As aClient)
        UpdateStatus("Connected")
    End Sub

    Private Sub OnDisconnected(ByVal sender As aClient)
        UpdateStatus("Disconnected")

        mcolClients.Remove(sender.ID)
    End Sub




    Private Sub UpdateStatus(ByVal t As String)
        lstStatus.Items.Add(t)
        lstStatus.SetSelected(lstStatus.Items.Count - 1, True)
    End Sub

    Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        mobjListener.Stop()
    End Sub


End Class

--------------------------------------------clsClient.vb

Imports System.Net.Sockets
Imports System.Text


'HELO <SP> <domain> <CRLF>
'MAIL <SP> FROM:<reverse-path> <CRLF>
'RCPT <SP> TO:<forward-path> <CRLF>
'DATA <CRLF>
'RSET <CRLF>
'SEND <SP> FROM:<reverse-path> <CRLF>
'SOML <SP> FROM:<reverse-path> <CRLF>
'SAML <SP> FROM:<reverse-path> <CRLF>
'VRFY <SP> <string> <CRLF>
'EXPN <SP> <string> <CRLF>
'HELP [<SP> <string>] <CRLF>
'NOOP <CRLF>
'QUIT <CRLF>
'TURN <CRLF>


'S: MAIL FROM:<Smith@Alpha.ARPA>
'R: 250 OK

'S: RCPT TO:<Jones@Beta.ARPA>
'R: 250 OK

'S: RCPT TO:<Green@Beta.ARPA>
'R: 550 No such user here

'S: RCPT TO:<Brown@Beta.ARPA>
'R: 250 OK

'S: DATA
'R: 354 Start mail input; end with <CRLF>.<CRLF>
'S: Blah blah blah...
'S: ...etc. etc. etc.
'S: <CRLF>.<CRLF>
'R: 250 OK


' ********************************************************
' SMTP Reply codes outlined in RFC 821
' ********************************************************
' 211 - System status/help reply
' 214 - Help message
' 220 - <domain> Service ready
' 221 - <domain> Service closing channel
' 250 - OK: action completed
' 251 - User not local, will forward to <domain>
' 354 - OK: Start mail input, end with <CrLf>.<CrLf>
' 421 - <domain> Service not available, closing channel
' 450 - Mailbox busy, action not taken
' 451 - Requested action aborted: error in processing
' 452 - Requested action not taken: insufficient system storage
' 500 - Syntax error, command unrecognized
' 501 - Syntax error in parameters or arguments
' 502 - Command not implimented
' was
' 503 - Bad sequence of commands
' now
' 503 - Send helo
' 504 - Command parameter not implimented
' 550 - Mailbox unavailable, action not taken
' 553 - Requested action not taken: mailbox name not allowed / invalid
' 551 - User not local, please try <forward-path>
' 552 - Requested action not taken: exceeds storage allocation
' 554 - Transaction failed

' ********************************************************
' ESMTP AUTHentication extensions outlined in RFC 2554
' ********************************************************
' 235 - Authentication successful
' 334 - Server challenge / ready response
' 432 - A password transition is needed
' 454 - Temporary authentication failure
' 530 - Authentication required
' 534 - Authentication mechanism is too weak
' 535 - Server rejected authentication
' 538 - Encryption required for requested authentication mechanism

Public Class aClient
    Public Event Connected(ByVal sender As aClient)
    Public Event Disconnected(ByVal sender As aClient)
    Public Event Status(ByVal sender As aClient, ByVal message As String)


    Private mgID As Guid = Guid.NewGuid
    Private marData(1024) As Byte
    Private mobjText As New StringBuilder
    Private msBuffer As String

    Private mbCommandMode As Boolean
    Private msMailFrom As String
    Private msMailTo As String

    Private ClientID As Integer
    Private msDomain As String
    ' only one of the following is used at any time
    Private mobjClient As TcpClient
    Private mobjSocket As Socket
    Private mstobox As String
    ' initialize with a raw socket
    Public Sub New(ByVal s As Socket)
        mbCommandMode = True
        mobjSocket = s
        RaiseEvent Connected(Me)
        mobjSocket.BeginReceive(marData, 0, 1024, SocketFlags.None, AddressOf DoReceive, Nothing)
    End Sub

    ' initialize with a TcpClient object
    Public Sub New(ByVal Li As TcpListener)

        ' the next statement will die until a connection is made

        mobjClient = Li.AcceptTcpClient

        Try
            mbCommandMode = True

            SyncLock "CLIENTCOUNT"
                ClientCount = ClientCount + 1
            End SyncLock
            ClientID = ClientCount
            RaiseEvent Connected(Me)

            mobjClient.GetStream.BeginRead(marData, 0, 1024, AddressOf DoStreamReceive, Nothing)
        Catch ex As Exception
            HE("1050", ex)
        End Try
    End Sub


    Public Sub StartConnection()
        Send("220 " + Globals.Domain + " Service ready")
    End Sub

    Public ReadOnly Property ID() As String
        Get
            Return mgID.ToString
        End Get
    End Property

    Private Sub DoStreamReceive(ByVal ar As IAsyncResult)
        Dim intCount As Integer

        Try
            SyncLock mobjClient.GetStream
                intCount = mobjClient.GetStream.EndRead(ar)
            End SyncLock
            If intCount < 1 Then
                RaiseEvent Disconnected(Me)
                Exit Sub
            End If
            Dim sNew As String
            sNew = ByteToString(marData, 0, intCount)
            LogAction(ClientID, "R", sNew)
            msBuffer = msBuffer + sNew

            SyncLock mobjClient.GetStream
                mobjClient.GetStream.BeginRead(marData, 0, 1024, AddressOf DoStreamReceive, Nothing)
            End SyncLock
            CheckBuffer()
        Catch ex As Exception

            RaiseEvent Disconnected(Me)
        End Try
    End Sub

    Private Sub DoReceive(ByVal ar As IAsyncResult)
        Dim intCount As Integer

        Try
            intCount = mobjSocket.EndReceive(ar)
            If intCount < 1 Then
                RaiseEvent Disconnected(Me)
                Exit Sub
            End If
            Dim sNew As String
            sNew = ByteToString(marData, 0, intCount)
            LogAction(ClientID, "R", sNew)
            msBuffer = msBuffer + sNew
            mobjSocket.BeginReceive(marData, 0, 1024, SocketFlags.None, AddressOf DoReceive, Nothing)
            CheckBuffer()
        Catch ex As Exception
            HE("1070", ex)

            RaiseEvent Disconnected(Me)
        End Try
    End Sub

    Private Function ByteToString(ByVal Bytes() As Byte) As String
        Dim objSB As New System.Text.StringBuilder(UBound(Bytes) + 1)
        Dim intIndex As Integer

        With objSB
            For intIndex = 0 To UBound(Bytes)
                .Append(ChrW(Bytes(intIndex)))
            Next
            Return .ToString
        End With
    End Function

    Private Function ByteToString(ByVal Bytes() As Byte, ByVal offset As Integer, ByVal count As Integer) As String
        Dim objSB As New System.Text.StringBuilder(count)
        Dim intIndex As Integer

        With objSB
            For intIndex = offset To offset + count - 1
                .Append(ChrW(Bytes(intIndex)))
            Next
            Return .ToString
        End With
    End Function

    Private Sub CheckBuffer()

        Dim intIndex As Integer
        Dim sData As String
       
        If mbCommandMode Then
            If Right(msBuffer, 2) = vbCrLf Then
                ProcessCommand(Left(msBuffer, Len(msBuffer) - 2))
                msBuffer = ""
            End If
        Else
            If Right(msBuffer, 3) = "." + vbCrLf Then
                ProcessData(Left(msBuffer, Len(msBuffer) - 3))
                msBuffer = ""
            End If
        End If
    End Sub
    Private Sub ProcessData(ByRef psData As String)
        Dim lfn As Integer
        Dim FileNum As Integer
        Dim sNumeric As String
        Dim sData As String
        '        Private msMailFrom As String
        '        Private msMailTo As String
        '        Private msDomain As String

        sData = msDomain + vbCrLf + msMailFrom + vbCrLf + msMailTo + vbCrLf + psData

        SyncLock "SAVEFILE"
            Try
                lfn = FreeFile()
                FileOpen(lfn, QueueCounter, OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.Shared)
                sNumeric = Space(10)
                FileGet(lfn, sNumeric, 1)
                FileNum = CLng(sNumeric)
                FileNum = FileNum + 1
                sNumeric = FileNum.ToString
                FilePut(lfn, sNumeric, 1)
                FileClose(lfn)
            Catch ex As Exception

                HE("1080", ex)

                FileNum = -1
            End Try
        End SyncLock
        If FileNum >= 0 Then
            Dim sFile As String
            sFile = Globals.QueueFolder + FileNum.ToString + ".txt"
            lfn = FreeFile()
            FileOpen(lfn, sFile, OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.Shared)
            FilePut(lfn, sData, 1)
            FileClose(lfn)
            sFile = Globals.QueueFolder + mstobox + "\" + FileNum.ToString + ".eml"
            lfn = FreeFile()
            FileOpen(lfn, sFile, OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.Shared)
            FilePut(lfn, psData, 1)
            FileClose(lfn)
        End If
        ' LogAction(ClientID, "R", psData + "." + vbCrLf)
        Send("250 OK")
        mbCommandMode = True

    End Sub

    Private Sub ProcessCommand(ByRef psCommand As String)

        Dim sCmd(4) As String
        Dim sCommand As String
        Dim bActionDone As Boolean
        sCommand = UCase(psCommand)
        sCmd(0) = "HELO"
        sCmd(1) = "QUIT"
        sCmd(2) = "MAIL FROM:"
        sCmd(3) = "RCPT TO:"
        sCmd(4) = "DATA"
        Dim lc As Short
        For lc = 0 To UBound(sCmd)
            If Left(sCommand, Len(sCmd(lc))) = sCmd(lc) Then
                Select Case lc
                    Case Is = 0 '  Helo
                        msDomain = GF.LeftPart(GF.RightPart(psCommand, "<"), ">")
                        If Len(msDomain) = 0 Then
                            msDomain = GF.RightPart(psCommand, "HELO")
                        End If
                        Send("250 OK")
                    Case Is = 1 '  Quit
                        Send("221 " + Globals.Domain + " Closing")
                        SyncLock mobjClient.GetStream
                            Try
                                Dim w As New IO.StreamWriter(mobjClient.GetStream)
                                w.Write("")
                                w.Flush()
                            Catch ex As Exception

                                HE("1090", ex)

                            End Try
                        End SyncLock
                        Try
                            mobjClient.Close()
                        Catch ex As Exception
                            HE("1100", ex)


                        End Try

                        RaiseEvent Disconnected(Me)
                    Case Is = 2 '  Mail From
                        msMailFrom = GF.LeftPart(GF.RightPart(psCommand, "<"), ">")
                        If Len(msMailFrom) = 0 Then
                            msMailFrom = GF.RightPart(psCommand, "MAIL FROM:")
                        End If
                        Send("250 OK")
                    Case Is = 3 '  RCPT To
                        Dim msTo As String
                        msTo = GF.LeftPart(GF.RightPart(psCommand, "<"), ">")
                        If Len(msTo) = 0 Then
                            msTo = GF.RightPart(psCommand, "RCPT TO:")
                        End If
                        Dim ok
                        ok = CheckRecipientOK(msTo)
                        If ok Then
                            If Len(msMailTo) > 0 Then
                                msMailTo = msMailTo + ";"
                            End If
                            msMailTo = msMailTo + msTo
                            Send("250 OK")
                        Else
                            Send("550 No such user here")
                        End If
                    Case Is = 4 '  DATA
                        If Len(msDomain) = 0 Or Len(msMailTo) = 0 Or Len(msMailFrom) = 0 Then
                            Send("503 - Bad sequence of commands")
                        Else
                            Send("354 Start mail input; end with <CRLF>.<CRLF>")
                            mbCommandMode = False
                        End If
                End Select
                bActionDone = True
                Exit For
            End If
        Next
        If Not bActionDone Then
            Send("502 - Command not implimented")
        End If
    End Sub

    Public Sub Send(ByVal Data As String)
        Try
            LogAction(ClientID, "S", Data + vbCrLf)
            If IsNothing(mobjClient) Then
                Dim arData(Len(Data) - 1) As Byte
                Dim intIndex As Integer

                For intIndex = 1 To Len(Data)
                    arData(intIndex - 1) = Asc(Mid(Data, intIndex, 1))
                Next

                mobjSocket.BeginSend(arData, 0, Len(Data), SocketFlags.None, Nothing, Nothing)
            Else
                SyncLock mobjClient.GetStream
                    Try
                        Dim w As New IO.StreamWriter(mobjClient.GetStream)
                        w.Write(Data + vbCrLf)
                        w.Flush()
                    Catch ex As Exception
                        HE("1120", ex)

                    End Try
                End SyncLock
            End If

        Catch ex As Exception
            HE("1130", ex)
        End Try
    End Sub

    Public Sub Send(ByVal Data() As Byte, ByVal offset As Integer, ByVal count As Integer)
        Try
            If IsNothing(mobjClient) Then
                mobjSocket.BeginSend(Data, offset, count, SocketFlags.None, Nothing, Nothing)
            Else
                SyncLock mobjClient.GetStream
                    mobjClient.GetStream.BeginWrite(Data, offset, count, Nothing, Nothing)
                End SyncLock
            End If
        Catch ex As Exception
            HE("1110", ex)
        End Try
    End Sub
    Private Function CheckRecipientOK(ByVal psTo As String) As Boolean

        Dim sSQL As String
        Dim sMailBox As String
        Dim sDomain As String
        Dim CN As New ADODB.Connection
        Dim RS As New ADODB.Recordset

        Dim sFile As String = "c:\my documents\smtp\smtp.mdb"
        Try
            CN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                             + "Data Source=" + sFile + ";" _
                                                  + "Persist Security Info=False;"
            CN.Open()
        Catch ex As Exception
            ' accept the address anyway
            HE("1030", ex)
            CheckRecipientOK = True
            Exit Function
        End Try
        Try
            sMailBox = GF.LeftPart(psTo, "@")
            If Len(mstobox) = 0 Then
                mstobox = sMailBox
            End If
            sDomain = GF.RightPart(psTo, "@")
            sSQL = "SELECT [smtp Mailboxes].[MB Mailbox], [smtp Mailboxes].[MB Domain]" _
            + " FROM [smtp Mailboxes]" _
            + " WHERE (([MB Mailbox]='" + sMailBox + "')" _
            + " AND (([MB Domain]='" + sDomain + "') Or ([MB Domain] ='*')));"
            RS.Open(sSQL, CN, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockReadOnly)
            If Not RS.EOF Then
                CheckRecipientOK = True
            Else
                CheckRecipientOK = False
            End If
            RS.Close()
            CN.Close()
        Catch ex As Exception
            ' accept the address anyway
            HE("1040", ex)

            CheckRecipientOK = False
        End Try
    End Function
End Class
0
 
LVL 17

Accepted Solution

by:
inthedark earned 1500 total points
ID: 20039399
With 2005 you can create a project  using the Windows Service template to see how you can interact with the windows.

I would resist the temptation do do what I did and make the sercie have a client inteface, this is not a good idea  becuase system resources will be used when only seldom needed.

In an ideal word your service needs three components:

1) The actual sercvice that does all you need it to do.

2) A control/status interface that connects to the service and sends commands or gets and displays status information. This means that the user interface, if you need one, is only loaded when the operator needs it hence releasing resources when not needed.

3) An optional SysTray exe that monitors if the service is running  and displays a "Go" or "Stop" icon. There are many examples of this type of app on the net.
Using a speperate icon EXE means that you can monitor and handle icons for multiple services without needing much extra code.  I created one that works form ini files and can monitor and control any service. The overhead is that the service monitor needs to poll every few seconds, instead of controlling directly from the service. The advantage is that even if the service is down your monitor app can know this and take action, like sending an email or an sms message.

I used the phrase "ideal word" other experts would almost certainly have other ideas on this subject as windows services are a very big subject.

Other ideas welcome.......but hope this is a start.
0
 
LVL 17

Expert Comment

by:inthedark
ID: 20107489
Just a small question.......why did you only award a B for the solution when you did not respond to my questions or ask for a more complete answer, of which I would have been happy to give?
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Although it can be difficult to imagine, someday your child will have a career of his or her own. He or she will likely start a family, buy a home and start having their own children. So, while being a kid is still extremely important, it’s also …
If you are a mobile app developer and especially develop hybrid mobile apps then these 4 mistakes you must avoid for hybrid app development to be the more genuine app developer.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question