SMTP: Simple Mail Testing Program

Posted: 2002-06-01
By: ArchiveBot
Viewed: 59

Filed Under:

VB6 Code Cache

No attachments for this post

Allows sending of e-mail (SMTP) directly from a VB app using Winsock, WITH OUT having to buy an expensive add on componet

Original Author: Brian Anderson

Inputs

Requires: Server Address (Name or IP), Senders & Recipeient's Names, Sender & Recipient E-Mail address, Body of message

Assumptions

Very straight forward. Makes sending mail from a VB program EASY!

Returns

Nothing really, does give status on sending operation

Side Effects

NONE!

API Declarations

None

Code

Dim Response As String, Reply As Integer, DateNow As String
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
Dim Start As Single, Tmr As Single
Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
  
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") & "" & " -0600"
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) + ToNametxt + vbCrLf ' Who it going to
Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
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 ' 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 ' Start connection

WaitFor ("220")

StatusTxt.Caption = "Connecting...."
StatusTxt.Refresh

Winsock1.SendData ("HELO yourdomain.com" + vbCrLf)
WaitFor ("250")
StatusTxt.Caption = "Connected"
StatusTxt.Refresh
Winsock1.SendData (first)
StatusTxt.Caption = "Sending Message"
StatusTxt.Refresh
WaitFor ("250")
Winsock1.SendData (Second)
WaitFor ("250")
Winsock1.SendData ("data" + vbCrLf)

WaitFor ("354")
Winsock1.SendData (Eighth + vbCrLf)
Winsock1.SendData (Seventh + vbCrLf)
Winsock1.SendData ("." + vbCrLf)
WaitFor ("250")
Winsock1.SendData ("quit" + vbCrLf)

StatusTxt.Caption = "Disconnecting"
StatusTxt.Refresh
WaitFor ("221")
Winsock1.Close
Else
MsgBox (Str(Winsock1.State))
End If

End Sub
Sub WaitFor(ResponseCode As String)
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 Tmr > 50 Then ' Time in seconds to wait
   MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
   Exit Sub
  End If
Wend
While Left(Response, 3) <> ResponseCode
  DoEvents
  If 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()
SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
'MsgBox ("Mail Sent")
StatusTxt.Caption = "Mail Sent"
StatusTxt.Refresh
Beep

Close
End Sub
Private Sub Command2_Click()

End

End Sub
Private Sub Form_Load()
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub


Comments on this post

No comments have been added for this post.

You must be logged in to make a comment.