I am using Winsock as a control to send email messages via VB. Since I want to try to create a stand alone function to be included where needed, I created a class with the Winsock.ocx being referenced
When I used winsock as a control I used the event DataArival to sit there and wait for a response back from the server I was connecting to and save it to a response variable.
Then I used another sub to wait for 60 secs and if nothing showed up in the response variable or was not the right response an error was generated.
The problem is, I don't know how to create a DataArrival event for an object that was created in another sub. Is there a way to do this?
My only work around, that I see, would be to include and pole mobjWinsock.GetData every second for 60 seconds after every SendData and then see if I got a valid response.
This makes for a lot of extra confusing and coding.
Can somebody help me through this?
Thanks
Code:Private WithEvents mobjWinsock As MSWinsockLib.Winsock
Private mvarToAddr As String 'local copy
Private mvarToName As String 'local copy
Private mvarFromAddr As String 'local copy
Private mvarFromName As String 'local copy
Private mvarSubject As String 'local copy
Private mvarBody As String 'local copy
Private mvarSMTPServer As String 'local copy
Private mvarResponse As String 'local copy
Public Property Let ToAddr(ByVal vData As String)
mvarToAddr = vData
End Property
Public Property Let ToName(ByVal vData As String)
mvarToName = vData
End Property
Public Property Let FromAddr(ByVal vData As String)
mvarFromAddr = vData
End Property
Public Property Let FromName(ByVal vData As String)
mvarFromName = vData
End Property
Public Property Let Subject(ByVal vData As String)
mvarSubject = vData
End Property
Public Property Let Body(ByVal vData As String)
mvarBody = vData
End Property
Public Property Let SMTPServer(ByVal vData As String)
mvarSMTPServer = vData
End Property
Public Function Send() As Boolean
Dim CurrentDate As String
Set mobjWinsock = New MSWinsockLib.Winsock
'Set the Winsock control's local port to 0, because otherwise
'you may not be able to send more than one e-mail message
'every time the program runs
mobjWinsock.LocalPort = 0
'Start composing the required data strings, but first check
'if the Winsock socket is closed
If mobjWinsock.State = sckClosed Then
CurrentDate = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & _
Format(Time, "hh:mm:ss")
'Set the Winsock protocol
mobjWinsock.Protocol = sckTCPProtocol
'Set the remote host name (of SMTP server)
mobjWinsock.RemoteHost = mvarSMTPServer
'Set the SMTP Port to the default port 25
mobjWinsock.RemotePort = 25
'Start the connection
mobjWinsock.Connect
mobjWinsock.GetData mvarResponse
'Wait for response from the remote host
WaitForResponse ("220")
'Send your computer name or company name
mobjWinsock.SendData ("HELO DCTMUtl.wm.dupont.com" & vbCrLf)
'Wait for response from the remote host
WaitForResponse ("250")
mobjWinsock.SendData (mvarFromAddr)
WaitForResponse ("250")
mobjWinsock.SendData (mvarToAddr)
WaitForResponse ("250")
'Tell the SMTP server that you want to send data now
mobjWinsock.SendData ("data" & vbCrLf)
'Wait for response from the remote host
WaitForResponse ("354")
'Send the data
mobjWinsock.SendData ("From: " & Chr(32) & mvarFromName & vbCrLf & _
"Date: " & Chr(32) & CurrentDate & vbCrLf & _
"DCTM Util Send Mail Uility" & _
"To: " & Chr(32) & mvarToName & vbCrLf & _
"Subject: " & Chr(32) & mvarSubject & vbCrLf & vbCrLf)
mobjWinsock.SendData (mvarBody & vbCrLf)
mobjWinsock.SendData ("." & vbCrLf)
'Wait for response from the remote host
WaitForResponse ("250")
'Send quitting acknowledgment
mobjWinsock.SendData ("quit" & vbCrLf)
'Wait for response from the remote host
WaitForResponse ("221")
'Close the connection
mobjWinsock.Close
Send = True
Else
'Report Error
MsgBox (Str(mobjWinsock.State))
Send = False
End If
End Function
Private Sub WaitForResponse(ResponseCode As String)
Dim Start As Single
Dim TimeToWait As Single
Start = Timer
'Start a loop checking for response from SMTP host
While Len(mvarResponse) = 0
TimeToWait = Timer - Start
DoEvents
'If TimeToWait expires, report timeout error
If TimeToWait > 50 Then
MsgBox "SMTP timeout error, no response received", 64, App.Title
Exit Sub
End If
Wend
While Left(mvarResponse, 3) <> ResponseCode
DoEvents
If TimeToWait > 50 Then
'Report error if incorrect code is received
MsgBox "SMTP error, improper response code received!" & Chr(10) & _
"Correct code is: " & ResponseCode & ", Code received: " & _
mvarResponse, 64, App.Title
Exit Sub
End If
Wend
'Set response to nothing
mvarResponse = ""
End Sub
Private Sub mobjWinsock_DataArrival(ByVal bytesTotal As Long)
'Check for response from the remote host
mobjWinsock.GetData mvarResponse
End Sub
