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

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.

inthedark

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

inthedark

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?