johnmemor
asked on
Send Mail by Using winsock.dll
How do I use VB and winsock.dll to send an email ?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Just load the form, you don't have to show it.
Then use the SendEmail routine.
--------------------------
Public AppName As String
Public ResponseString As String
Public Sub SendEmail(MailServerName As String, SenderName As String, SenderEmailAddress As String, RecipientName As String, RecipientEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
MailServerName = Trim(MailServerName)
SenderName = Trim(SenderName)
SenderEmailAddress = Trim(SenderEmailAddress)
RecipientName = Trim(RecipientName)
RecipientEmailAddress = Trim(RecipientEmailAddress
EmailSubject = Trim(EmailSubject)
EmailBodyOfMessage = Trim(EmailBodyOfMessage)
Dim Data1 As String, Data2 As String
Dim Data3 As String, Data4 As String
Dim Data5 As String, Data6 As String
Dim Data7 As String, Data8 As String
Dim CurrentDate As String
Dim TimeDifference As String
'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
'form_frmemail.Winsock1.Lo
'Start composing the required data strings, but first check
'if the Winsock socket is closed
If Winsock1.State = sckClosed Then
'Compose the current date and time string
TimeDifference = " -200"
CurrentDate = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & TimeDifference
'Set the program name used to send this e-mail message (you can
'put your program name here)
AppName = "X-Mailer: " + "My Mail Program V1.0" + Chr(13) + Chr(10)
'Set the e-mail address of the sender
Data1 = "mail from:" + Chr(32) + SenderEmailAddress + Chr(13) + Chr(10)
'Set the e-mail address of the recipient
Data2 = "rcpt to:" + Chr(32) + RecipientEmailAddress + Chr(13) + Chr(10)
'Set the date string
Data3 = "Date:" + Chr(32) + CurrentDate + Chr(13) + Chr(10)
'Set the name of the sender
Data4 = "From:" + Chr(32) + SenderName + Chr(13) + Chr(10)
'Set the name of the recipient
Data5 = "To:" + Chr(32) + RecipientName + Chr(13) + Chr(10)
'Set the subject of the E-Mail message
Data6 = "Subject:" + Chr(32) + EmailSubject + Chr(13) + Chr(10)
'Set the E-mail message body string
Data7 = EmailBodyOfMessage + Chr(13) + Chr(10)
'Combine the whole string for proper SMTP syntax
Data8 = Data4 + Data3 + AppName + Data5 + Data6
'Set the Winsock protocol
Winsock1.Protocol = sckTCPProtocol
'Set the remote host name (of SMTP server)
Winsock1.RemoteHost = MailServerName
'Set the SMTP Port to the default port 25
Winsock1.RemotePort = 25
'Start the connection
Winsock1.Connect
'Wait for ResponseString from the remote host
WaitForResponseString ("220")
'Report status
'StatusLabel.Caption = "Connecting...."
'StatusLabel.Refresh
'Send your computer name or company name
Winsock1.SendData ("HELO mycomputername" + Chr(13) + Chr(10))
'Wait for ResponseString from the remote host
WaitForResponseString ("250")
'Update status
'StatusLabel.Caption = "Connected"
'StatusLabel.Refresh
'Send the first string
Winsock1.SendData (Data1)
'Update status
'StatusLabel.Caption = "Sending Message"
'StatusLabel.Refresh
'Wait for ResponseString from the remote host
WaitForResponseString ("250")
'Send the second string
Winsock1.SendData (Data2)
'Wait for ResponseString from the remote host
WaitForResponseString ("250")
'Tell the SMTP server that you want to send data now
Winsock1.SendData ("data" + Chr(13) + Chr(10))
'Wait for ResponseString from the remote host
WaitForResponseString ("354")
'Send the data
Winsock1.SendData (Data8 + Chr(13) + Chr(10))
Winsock1.SendData (Data7 + Chr(13) + Chr(10))
Winsock1.SendData ("." + Chr(13) + Chr(10))
'Wait for ResponseString from the remote host
WaitForResponseString ("250")
'Send quitting acknowledgment
Winsock1.SendData ("quit" + Chr(13) + Chr(10))
'Update status
'StatusLabel.Caption = "Disconnecting"
'StatusLabel.Refresh
'Wait for ResponseString from the remote host
WaitForResponseString ("221")
'Close the connection
Winsock1.Close
Else
'Report error
MsgBox (Str(Winsock1.State))
End If
End Sub
Public Sub WaitForResponseString(Resp
Dim Startt As Single
Dim TimeToWait As Single
Startt = Timer
'Start a loop checking for ResponseString from SMTP host
While Len(ResponseString) = 0
TimeToWait = Timer - Startt
DoEvents
'If TimeToWait expires, report timeout error
If TimeToWait > 50 Then
'MsgBox "SMTP timeout error, no ResponseString received", 64, App.Title
MsgBox "SMTP timeout error, no ResponseString received", 64, AppName
Exit Sub
End If
Wend
While Left(ResponseString, 3) <> ResponseStringCode
DoEvents
If TimeToWait > 50 Then
'Report error if incorrect code is received
MsgBox "SMTP error, improper ResponseString code received!" + Chr(10) + "Correct code is: " + ResponseStringCode + ", Code received: " + ResponseString, 64, AppName
Exit Sub
End If
Wend
'Set ResponseString to nothing
ResponseString = ""
End Sub
Public Sub Winsock1_DataArrival(ByVal
'Check for ResponseString from the remote host
Winsock1.GetData ResponseString
End Sub