Sending Email code in VB6 got Error

**LucasYew** · 19-02-2009

Hi

I notice that my VB6 code get error “runtime error 40006 - Wrong protocol or connection state for the requested transaction or request which mean the exchange server is down” when running in windows 2000. There was no issue on windows server 2003 and windows xp. It is something wrong with my VB6 code syntax? Hope someone can help to diagnose the code below. I notice that exchange server is response slow when i send HELO code. It will run the code highlighted in red. Some more it only happen in Exchange server 2003. Last time we use Exchange 5.5 no issue. I think is probably something is wrong on the code or the VB6 component (.dll) need to upgrade.

VB6 - sendiong email code
Option Explicit

Const EmailLog = "c:\twinsock.log"

Public response As String, Reply As Integer, DateNow As String, tState As Integer
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String, Ninth As String, Tenth As String
Dim Start As Single, Tmr As Single

Sub emailNotification(statusCtrl As StatusBar, Winsock1 As Winsock, txtGroup As String, txtSubject As String, txtBody As String)
Dim tmp
Dim i As Integer
Dim txtMailSrvName As String, txtRcpt As String, txtRcptAdd As String, txtFrmName As String, txtFrmAdd As String

txtMailSrvName = "wsexvpmy01"
txtFrmName = "UOB Statement Auto Forward Mail"
txtFrmAdd = "[email protected]"

addEmailLog ("Send YH1")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan1", "[email protected]", txtSubject, txtBody

addEmailLog ("Send YH2")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan2", "[email protected]", txtSubject, txtBody

addEmailLog ("Send YH3")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan3", "[email protected]", txtSubject, txtBody

addEmailLog ("Send YH4")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan4", "[email protected]", txtSubject, txtBody

addEmailLog ("Send YH5")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan5", "[email protected]", txtSubject, txtBody

addEmailLog ("Send YH6")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan6", "[email protected]", txtSubject, txtBody

addEmailLog ("Send YH7")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan7", "[email protected]", txtSubject, txtBody

addEmailLog ("Send YH8")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan8", "[email protected]", txtSubject, txtBody

addEmailLog ("Send YH9")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan9", "[email protected]", txtSubject, txtBody

addEmailLog ("Send YH10")
SendEmail statusCtrl, Winsock1, txtMailSrvName, txtFrmName, txtFrmAdd, "yuenhan10", "[email protected]", txtSubject, txtBody

statusCtrl.SimpleText = "Mail Sent"
Beep
Winsock1.Close
addEmailLog ("Sent Complete")
MsgBox ("Sent Complete")
Exit Sub
End Sub

Sub SendEmail(statusCtrl As StatusBar, Winsock1 As Winsock, MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)

On Error GoTo ErrorHandler

Winsock1.LocalPort = 0 ' Must Set local port To 0 (Zero) or you can only send 1 e-mail per program start
If Winsock1.State = sckClosed Then ' Check To see if socet is closed
DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " +0800"
first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address
Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to
Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
Fifth = "To:" + Chr(32) + ToName + vbCrLf ' Who it going to
Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
Tenth = "Content-Type: text/html; charset=us-ascii" + vbCrLf ' define HTML type content
Tenth = Tenth & "Content-Transfer-Encoding: 7bit" + vbCrLf ' define content transfer encoding
Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
Eighth = Fourth + Third + Ninth + Fifth + Sixth + Tenth ' Combine For proper SMTP sending
Winsock1.Protocol = sckTCPProtocol ' Set protocol For sending
Winsock1.RemoteHost = MailServerName ' Set the server address
Winsock1.RemotePort = 25 ' Set the SMTP Port
Winsock1.Connect
statusCtrl.SimpleText = "Connecting...."
statusCtrl.Refresh

WaitFor ("220")

Winsock1.SendData ("HELO yourdomain.com" + vbCrLf)
addEmailLog ("helo send")
WaitFor ("250")
addEmailLog ("finish helo")

statusCtrl.SimpleText = "Connected"
statusCtrl.Refresh
Winsock1.SendData (first)
addEmailLog ("first")
statusCtrl.SimpleText = "Sending Message"
statusCtrl.Refresh
WaitFor ("250")
Winsock1.SendData (Second)
addEmailLog ("second")
WaitFor ("250")
Winsock1.SendData ("data" + vbCrLf)
addEmailLog ("data")
WaitFor ("354")
Winsock1.SendData (Eighth + vbCrLf)
Winsock1.SendData (Seventh + vbCrLf)
Winsock1.SendData ("." + vbCrLf)
WaitFor ("250")
Winsock1.SendData ("quit" + vbCrLf)

statusCtrl.SimpleText = "Disconnecting"
statusCtrl.Refresh
WaitFor ("221")
Winsock1.Close

Else
MsgBox (Str(Winsock1.State))
End If

Exit Sub

ErrorHandler:
Dim ErrNum, ErrDesc, Log1 As String, Log2 As String
ErrNum = Str(Err.Number)
ErrDesc = Err.Description
MsgBox ErrNum & "-" & ErrDesc
Err.Clear
Exit Sub

End Sub

Sub WaitFor(ResponseCode As String)
Dim MsgTitle

Start = Timer ' Time Event so won't Get stuck In Loop

While Len(response) = 0
Tmr = Start - Timer

DoEvents ' Let System keep checking For incoming response **IMPORTANT**

If Abs(Tmr) > 30 Then ' Time In seconds To wait
MsgBox "SMTP service error, timed out While waiting For response", 64, MsgTitle
Exit Sub
End If Wend

Start = Timer
While Left(response, 3) <> ResponseCode
Tmr = Start - Timer

DoEvents
If Abs(Tmr) > 50 Then
MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + response, 64, MsgTitle
Exit Sub
End If Wend
response = "" ' Sent response code To blank **IMPORTANT**
End Sub

Private Sub Command1_Click()
emailNotification Form1.stbmain, Winsock1, "supertest", "super email - " & Date & " - ", "WSEXVPMY01 testing"
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

On Error Resume Next
Winsock1.GetData response ' Check For incoming response *IMPORTANT*
addEmailLog ("Resume " & response)
End Sub

Private Sub addEmailLog(log As String)
Open EmailLog For Append As #2
Print #2, log
Close #2
End Sub

**switchblade327** · 19-02-2009

SYMPTOMS

Run-time error: 40006

"Wrong protocol or connection state for the requested transaction or request."

CAUSE

The code is trying to call the SendData method before the port has actually been connected. The Connect method in Visual Basic is asynchronous and is more like a request to connect to the Winsock port.

RESOLUTION

The code must wait until the Connect event is fired before attempting to call the SendData or GetData methods. The Connect event is a signal that the connect request has been accepted and the connection is established.

FOR MORE INFORMATION:

PRB: SendData Method Generates Error 40006

**LucasYew** · 19-02-2009

Hi switchblade327,

I search before this link and is not much help. The cause is actually what microsoft provided but it only happen to windows 2000 not issue in windows server 2003 and windows xp. That is the strange part.

I have no idea