UNKNOWN '************************************** 'Windows API/Global Declarations for :SM ' TP: Simple Mail Testing Program '************************************** None '************************************** ' Name: SMTP: Simple Mail Testing Progra ' m ' Description:Allows sending of e-mail ( ' SMTP) directly from a VB app using Winso ' ck, WITH OUT having to buy an expensive ' add on componet ' By: Brian Anderson ' ' ' Inputs:Requires: Server Address (Name ' or IP), Senders & Recipeient's Names, Se ' nder & Recipient E-Mail address, Body of ' message ' ' Returns:Nothing really, does give stat ' us on sending operation ' 'Assumes:Very straight forward. Makes se ' nding mail from a VB program EASY! ' 'Side Effects:NONE! 'This code is copyrighted and has limite ' d warranties. 'Please see http://www.Planet-Source-Cod ' e.com/xq/ASP/txtCodeId.841/lngWId.1/qx/v ' b/scripts/ShowCode.htm 'for details. '************************************** 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