Coding the Winsock control....

B

Brad Pears

I have some sample code on connecting to a mail server using the winsock
control to send an email automatically from an Access 2000 project...

However, I am not getting a connect request back from the mail server at
all...There must be a missing step somewhere...

Does someone have some sample code they could send my way that will allow
the client computer to connect to an SMTP server over port 25 and send an
email?

The code I have seems to work but the .Connect request to the email server
just sits there and never comes back. It seems as a connection is never
established.

Here is the sample code....

(Form declaration code)

Option Compare Database
Dim winsock1 As Winsock

(command button code)

Private Sub cmdSendMail_Click()
Call SMTPSend("mydomain.com", "192.168.2.15", "bradp", "friggin", "This is
the Subject", "This is the body")

End Sub

' Routine to send email

Sub SMTPSend(strMyDomain As String, _
strEmailServer As String, _
strEmailAddressWithoutDomain As String, _
strWhoToSayThisIsFrom As String, _
strSubject As String, _
strMessageBody As String)
Set winsock1 = Me!axWinsockServer.Object
winsock1.Protocol = sckTCPProtocol
winsock1.RemoteHost = strEmailServer
winsock1.RemotePort = 25
winsock1.Connect

' Wait for connection
WaitForIt

Select Case Left$(strWSin, 3)
Case "220"
' connected ok, send HELLO
winsock1.SendData "HELO " & _
strMyDomain & _
vbCrLf
WaitForIt
winsock1.SendData "MAIL FROM: " & _
strWhoToSayThisIsFrom & _
vbCrLf
WaitForIt
winsock1.SendData "RCPT TO: " & _
strWhoToSayThisIsFrom & _
vbCrLf
WaitForIt
winsock1.SendData "DATA" & vbCrLf & _
"DATE:" & _
Format$(Now(), "mm/dd/yyyy hh:mm:ss") & _
"FROM: " & _
strWhoToSayThisIsFrom & vbCrLf & _
"TO:" & _
Format$(Now(), "mm/dd/yyyy hh:mm:ss") & _
"DATE:" & _
Format$(Now(), "mm/dd/yyyy hh:mm:ss") & _
"SUBJECT: " & _
strSubject & _
vbCrLf & _
strMessageBody & _
vbCrLf & _
"." & vbCrLf
' note: . & vbcrlf terminates the "send"
WaitForIt
' parse and validate the return from the sever
End Select
' tell the server you're done:
winsock1.SendData "QUIT" & vbCrLf
' and that's it!
winsock1.Close
End Sub


Private Sub WaitForIt()
WaitingforData = True
While WaitingforData = True
DoEvents
Wend
End Sub

' This should run when a connection has been established - but it never
does....

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim Temp As String
Temp = String(bytesTotal, " ")
winsock1.GetData Temp, vbString
Do
If Right$(Temp, 1) = vbLf Then
Temp = Left$(Temp, Len(Temp) - 1)
End If
Loop While Right$(Temp, 1) = vbLf
strWSin = Temp
WaitingforData = False
End Sub


Any help with this would be greatly appreciated!!!

Thanks,

Brad
 
R

Ron Weiner

Brad

If your clients are Win2K or later you might want to consider sending mail
Via Microsoft CDO. Here is some sample code to get you started.


Public Sub testCDO()
' Purpose Send an Email with or without an attachment without using
Outlook or other MAPI client
' Uses Late Binding - Does not need a reference to the Microsoft
CDO For Windows library
' But the system CdoSys registered. CDOSys comes standard on
Windows 2K and higher
' This code will likely fail on a Win 98 box

Const cdoSendUsingPort = 2
Const cdoBasic = 1
Dim objCDOConfig As Object, objCDOMessage As Object
Dim strSch As String

strSch = "http://Schemas.microsoft.com/cdo/configuration/"
Set objCDOConfig = CreateObject("CDO.Configuration")
With objCDOConfig.Fields
.Item(strSch & "sendusing") = cdoSendUsingPort
.Item(strSch & "smtpserver") = "SomeSecureMailServer.SomeDomain.COM"
'Use only when SMTP server requires Authentication - Otherwise Rem
out
.Item(strSch & "SMTPAuthenticate") = cdoBasic
.Item(strSch & "SendUserName") = "(e-mail address removed)"
.Item(strSch & "SendPassword") = "YourPassword"
.Update
End With

Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
.From = "Your Nice Name"
.Sender = "(e-mail address removed)"
.To = "(e-mail address removed)"
.Subject = "Sample CDO Message"
'.TextBody = "This is a test for CDO.message"
.HTMLBody = "This is a test for CDO.message. This is not Bold But
<B>This is!</B>"
'.AddAttachment "c:\Inv83595.pdf"
'.MDNRequested = True
.Send
End With
Set objCDOMessage = Nothing
Set objCDOConfig = Nothing
End Sub

I have found that this code to be reliable in my customers environment.
Since it uses late binding there are no references to worry about, BUT you
need to add error handler for cases where CDO is not available (Win 98), and
when the mail server is not available, or authentication fails, or ...
Well you get the idea.

Ron W
 
B

Brad Pears

Great, I'll give that a shot... Except, we do have some Win98 clients as
well...

CDO will not work for those clients?
 
A

Alex Ivanov

Are you sure your firewall is open on port 25?
Try to telnet to your mail server on this port and see if you have a reply.
A simple session may be like the following:

telnet mymail.myserver.com 25
220 mymail.myserver.com ESMTP
helo (e-mail address removed)
250 mymail.myserver.com
rcpt from: (e-mail address removed)
250 ok
mail to: (e-mail address removed)
250 ok
data
354 go ahead
that's all
..
250 ok 1100230717 qp 33434
quit
221 mymail.myserver.com
 
B

Brad Pears

The firewall is allowing port 25 through because that's the port our
Exchange server listens on...

In fact our Watchguard has a service specific to SMTP configured that allows
data on port 25.

Thanks,

Brad
 
A

Alex Ivanov

This is a barebone code with no authentication and no encryption. Some mail
servers may accept similar requests other not.
My home ISP's mail server silently ignores the email sent this way though it
seems that send succeeds. Our company's Exchange server is happy to work
with it if the mail is sent to internal recipients. Anyway, you can try.

Private Sub Form_Load()
With Winsock1
.RemoteHost = "mail.test.net"
.RemotePort = 25
.Protocol = sckTCPProtocol
.Connect
End With
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim buf As String
Dim retcode As Integer
Static c250 As Integer
Dim numOfRecipients
numOfRecipients = 1
buf = Space(Winsock1.BytesReceived)
Winsock1.GetData buf, vbString
Debug.Print buf
retcode = Val(buf)
Select Case retcode
Case 220
Winsock1.SendData "helo nothing.com" & vbCrLf
c250 = 0
Case 250
If c250 < numOfRecipients Then
Winsock1.SendData "mail to: (e-mail address removed)" & vbCrLf
c250 = c250 + 1
ElseIf c250 = numOfRecipients Then
Winsock1.SendData "rcpt from: (e-mail address removed)" & vbCrLf
c250 = c250 + 1
ElseIf c250 = numOfRecipients + 1 Then
Winsock1.SendData "data" & vbCrLf
c250 = c250 + 1
Else
Winsock1.SendData "quit" & vbCrLf
End If
Case 354
Winsock1.SendData "Your data goes here." & vbCrLf & "." & vbCrLf
Case 221
Winsock1.Close
MsgBox "Mail Sent"
End Select
End Sub
 
A

Alex Ivanov

I accidentally swithced "from" and "to" this caused rejection from my isp.
This is the corrected code that works.
If you need to send the mail to external clients, you will need either to
add an authentication code or set the RemoteHost property to their mail
servers before sending (unless you have an 'open proxy' allowing mail
forwarding).

HTH

Option Explicit

Private Sub Form_Load()
With Winsock1
.RemoteHost = "test.net"
.RemotePort = 25
.Protocol = sckTCPProtocol
.Connect
End With
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim buf As String
Dim retcode As Integer
Static c250 As Integer
Dim numOfRecipients
numOfRecipients = 1
buf = Space(Winsock1.BytesReceived)
Winsock1.GetData buf, vbString
Debug.Print buf
retcode = Val(Left(buf, 3))
Select Case retcode
Case 220
Winsock1.SendData "helo nothing.com" & vbCrLf
c250 = 0
Case 250
If c250 = 0 Then
Winsock1.SendData "mail from: test@test" & vbCrLf
c250 = c250 + 1
ElseIf c250 < numOfRecipients + 1 Then
Winsock1.SendData "rcpt to: (e-mail address removed)" & vbCrLf
c250 = c250 + 1
ElseIf c250 = numOfRecipients + 1 Then
Winsock1.SendData "data" & vbCrLf
c250 = c250 + 1
Else
Winsock1.SendData "quit" & vbCrLf
End If
Case 354
Winsock1.SendData "Subject: My Subject" & vbCrLf _
& "From: Me" & vbCrLf & vbCrLf _
& "Your data goes here." & vbCrLf & "." & vbCrLf
Case 221
Winsock1.Close
MsgBox "Mail Sent"
End Select
End Sub
 
B

Brad Pears

So to test this, do I just add the Microsoft Winsock control to my form and
rename the winsock control to "winsock1"?? When I add the control it's
named something completely different... Should I be worried about that?

Not sure how to test this...

Thanks,

Brad
 
B

Brad Pears

So to test this, do I just add the ActiveX Microsoft Winsock version 6
control to my form and
rename the winsock control to "winsock1"?? When I add the control it's
named something completely different... (ActiveXctl1)

Should I be worried about that?

Not sure how to test this...

Thanks,

Brad
 
A

Alex Ivanov

Yes, that basically all. Yo will need to set RemoteHost property to your
mail server address and make sure the "rcpt to:" line contains a valid email
address recognized by that server otherwise you may need to implement an
authentication protocol.
 
B

Brad Pears

I am able to communicate with my mail server on port 25. However, how do you
end the DATA command???

In the Telnet session after I type in "Data test", I get a response back
saying...
354 Start mail input; end with <CRLF>.<CRLF>


After I type in the body of the message, I cannot end that line. I've tried
typing in exactly what it says and various other things but none seem to
work.

We are using an Exchange 2000 server.

Any ideas??

Thanks,

Brad

My FTP client is saying to end with
 
S

stefan hoffmann

hi Brad,

Brad said:
354 Start mail input; end with <CRLF>.<CRLF>
After I type in the body of the message, I cannot end that line. I've tried
typing in exactly what it says and various other things but none seem to
work.
Click to expand...
= Chr(13) & Chr(10) & "." Chr(13) & Chr(10)

mfG
--> stefan <--
 
B

Brad Pears

I am having a heck of a time with this - implementing it into my project...
I was able to get it to work standalone by having all the code on the same
screen where I inserted the winsock control... But I cannot seem to get it
to work properly when the code to send the mail is in a procedure in a
module...

Here's the scoop...

On one of my forms, I added the Winsock control and renamed it to Winsock1.

However, it's not actually on this form where I have placed the code to send
the email. Instead - I placed the code inside a procedure that exists in a
module. When the user clicks a command button on this form, it runs the
on-click event which in turn calls a "SendMail" procedure to do the job.

So, in my module, in the declarations section, I have declared ...

public winsock1 as winsock.

Then I have my called procedure as follows...

Public Sub SendMail()

With Winsock1
.RemoteHost = "true3"
.RemotePort = 25
.Protocol = sckTCPProtocol
.Connect
End With

End Sub

Then in this same module I have placed the other code to actually send the
email (shown below...)

The problem is that when the procedure is called to connect to my mail
server I get the following error everytime ...

"Object variable or with block variable not set" and when I click the Debug
button, the code that is highlited is the .remotehost = "true3" line.

What am I missing? Is my winsock control not being defined properly
somewhere?

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim buf As String
Dim retcode As Integer
'Dim strMailTO As String
'Dim strMailSubject As String
'Dim strBody As String
Static c250 As Integer
Dim numOfRecipients
numOfRecipients = 1
buf = Space(Winsock2.BytesReceived)
Winsock2.GetData buf, vbString
Debug.Print buf
retcode = Val(Left(buf, 3))
Select Case retcode
Case 220
Winsock2.SendData "helo truenorthloghomes.com" & vbCrLf
c250 = 0
Case 250
If c250 = 0 Then
' winsock1.SendData getMailFrom(CurrentUser()) & vbCrLf
c250 = c250 + 1
ElseIf c250 < numOfRecipients + 1 Then
' winsock1.SendData "rcpt to: craigd" & vbCrLf
c250 = c250 + 1
ElseIf c250 = numOfRecipients + 1 Then
Winsock1.SendData "data" & vbCrLf
c250 = c250 + 1
Else
Winsock1.SendData "quit" & vbCrLf
End If
Case 354
Winsock1.SendData "Subject: " & strSubject & vbCrLf _
& "From: " & getMailFromFullName(CurrentUser()) & vbCrLf & vbCrLf _
& strBody & vbCrLf & "." & vbCrLf
Case 221
Winsock1.Close
MsgBox "Mail message successfully sent to " & strTo
End Select

End Sub
 
A

Alex Dybenko

Brad,
in order to use Winsock control without form - you have to create new
instance, but this is posible in VB only, because you have to add license.
this is not possible in Access. so in access you have to insert in a form in
order to have it instance created. form can be hidden, if you dont want to
show it
HTH
 
B

Brad Pears

I was able to get this working but I have found that I will sometimes get an
error...

Runtime Error: 40006
"Wrong protocol or connection state for the requested transaction or
request"

on the "Winsock1.GetData buf, vbString" line in the winsock1_DataArrival
event.

If I try to send a couple of emails back to back. Each time an email is
sent, there is code that closes the connection - but it appears that maybe
it is not being closed properly??

Have you seen this before and do you have any ideas on how to proceed?
Obviously this will not work in it's current state.

Thanks,

Brad
 
B

Brad Pears

I was able to get this working but I have found that I will sometimes get an
error...

Runtime Error: 40006
"Wrong protocol or connection state for the requested transaction or
request"

on the "Winsock1.GetData buf, vbString" line in the winsock1_DataArrival
event.

If I try to send a couple of emails back to back. Each time an email is
sent, there is code that closes the connection - but it appears that maybe
it is not being closed properly??

Have you seen this before and do you have any ideas on how to proceed?
Obviously this will not work in it's current state.


Thanks,

Brad
 
A

Alex Ivanov

Perhaps what you're experience is due to the race of signals. You may try to
add a static boolean variable to the procedure and set it to true when your
mailer starts and false when it finishes. Then check this var upon entering
the code and if previous send command is still running raise an error or do
something else to prevent the race condition. And, yes, clear the c250
variable in case 221 - it is static also.

HTH
 
B

Brad Pears

What exactly do you mean by a race of signals?

Also what exactly does declaring a variable of static enable vs declaring it
as public?
 
A

Alex Ivanov

Winsock operates asynchronously, that meens if you have a code similar to
this

sendmail "somebody", "something"
sendmail "somebody else", "something else"

at the time you are calling the sendmail second time, the first sendmail
request is still in process. To workaround of this problem you can make your
sendmail function synchronous, that does not return until the mail is sent.
In the example I used the form_load event to send the mail but let us create
a dedicated function to do that:

Private running as boolean ' at module scope
Private anError as boolean

Private Function SendMailad(sendTo as string, message as string) as boolean
running=true
With Winsock1
.RemoteHost = "mail.test.net"
.RemotePort = 25
.Protocol = sckTCPProtocol
.Connect
End With
while running
'wait until running=false
doevents
'add also a time cheking code here to prevent an infinite loop
wend
if not anError then sendmail=true else sendmail=false
End Function

'excerpt from DataArrival
'...
Case 221
Winsock1.Close
MsgBox "Mail Sent"
c250=0 'reset the counter
running=false
Case Else ' unexpected here, treating like error
Winsock1.Close
running=false
c250=0
anError=true
End Select

The reason c250 is static is that it needs to retain its value between
function calls.
You might move it outside of DataArrival which would have the same effect,
but then it would be accessible to other procedures within the same module,
which would not make sense.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Winsock control 1
new to VBA...Winsock DataArrival event not getting fired. 1
Can't hear vb6 winsock connect request in C# listener 3
VB.NET Winsock Multithreading question. 1
creating different emails dependant upon a control value 5
Outlook Cannot access more than the Outlook VBA 250 Mail Items 1
Saving outlook attachment to a different file 0
SMTP: Bad Sequence of Commands 1

Top