* strServ: The SMTP server to use. Can be in the following formats:
* xxx.xxx.xxx.xxx "xxx.xxx.xxx.xxx:port" "xxx.xxx.xxx.xxx port"
* ServerName "servername:port" "servername port"
* strFrom: The email address to provide as the "FROM" address
* can use "name" <add@svr.com> format
* strTo: The email address to send the email to.
* can use "name" <add@svr.com> format
* strSubj: Subject for the email
* strMsg: The Message to include as the body of the email.
* Start the message with <HTML> or <X-HTML>
* if you want it sent as HTML.
* oFB_Attachments: Comma separated list of files to attach
* (full path to each file)
* (for backward compatibility, the Feedback object
* can be passed as this parameter)
* All Attachments+message can be at most 16MB
* right now, because of VFP string size limit.
* oFeedBack: An object with a method "FeedBack" that
* expects one string property.
* If not provided, the feedback messages will
* be output to the console through "?".
* Pass .NULL. (or an object without "Feedback"
* method) to turn off all feedback.
PROCEDURE SendMail
* Updated: April 1, 2004: Fixed RCPT TO handling to properly
* bracket the email address.
LPARAMETERS strServ, strFrom, strTo, strSubj, strMsg, oFB_cAttachments, oFeedBack
#DEFINE crlf chr(13)+chr(10)
#DEFINE TIME_OUT 5
LOCAL Sock, llRet, lnI, laTO[1], lnCnt, lcServ, lnServPort
LOCAL lnTime, lcOutStr, Junk, lcAttachments, loFB, laAtch[1], lnAtchCnt
LOCAL laFiles[1]
lcMsg = strMsg
lcAttachments = oFB_cAttachments
loFB = oFeedback
if TYPE('oFB_cAttachments')='O'
loFB = oFB_cAttachments
lcAttachments = ''
endif
* Load Attachments
if TYPE('lcAttachments')='C' and not empty(lcAttachments)
lnAtchCnt = ALINES( laAtch, StrTran(lcAttachments,',',chr(13)) )
lcMsg = lcMsg + crlf + crlf
for lnI = 1 to lnAtchCnt
if ADIR(laFiles,laAtch[lnI])=0
GiveFeedBack( loFB, "ERROR: Attachment Not Found:"+laAtch[lnI] )
RETURN .F.
endif
lcAtch = FileToStr( laAtch[lnI] )
if empty(lcAtch)
GiveFeedBack( loFB, "ERROR: Attachment Empty/Could not be Read:"+laAtch[lnI] )
RETURN .F.
endif
GiveFeedBack( loFB, "Encoding file: "+laAtch[lnI] )
lcAtch = UUEncode( laAtch[lnI], lcAtch )
lcMsg = lcMsg + lcAtch
lcAtch = '' && free memory
endfor
endif
GiveFeedBack( loFB, "Connecting to Server: "+strServ )
Sock=create('mswinsock.winsock')
llRet = .F.
lnServPort = 25
lcServ = strServ
do case && Find Port
case ':' $ lcServ
lnAt = at(':',lcServ)
lcServ = left( lcServ, lnAt-1 )
lnServPort = val( Substr(lcServ, lnAt+1) )
if lnServPort<=0
lnServPort = 25
endif
case ' ' $ lcServ
lnAt = at(' ',lcServ)
lcServ = left( lcServ, lnAt-1 )
lnServPort = val( Substr(lcServ, lnAt+1) )
if lnServPort<=0
lnServPort = 25
endif
endcase
sock.Connect(strServ,lnServPort)
lnTime = seconds()
DO WHILE .T. && Control Loop
if sock.State <> 7 && Connected
GiveFeedBack( loFB, "Waiting to connect..." )
inkey(0.1)
if seconds() - lnTime > TIME_OUT
GiveFeedBack( loFB, "Connect Timed Out")
EXIT && Leave Control Loop
endif
LOOP && Wait to connect
endif
GiveFeedBack( loFB, "Connected." )
if not ReadWrite(sock,"HELO " + alltrim(strServ), 220)
GiveFeedBack( loFB, "Failed HELO" )
EXIT && Leave Control Loop
endif
If Not ReadWrite(sock,"MAIL FROM: " + alltrim(strFrom), 250)
GiveFeedBack( loFB, "Failed MAIL" )
EXIT
endif
lnCnt = aLines(laTo, ChrTran(strTo,' ,;',chr(13)))
* once for each email address
for lnI = 1 to lnCnt
if not empty(laTo[lnI])
lcTo = iif( '<' $ laTo[lnI], laTo[lnI], '<' + alltrim(laTo[lnI]) + '>' )
If Not ReadWrite(sock,"RCPT TO: " + lcTo, 250)
GiveFeedBack( loFB, "RCPT Failed" )
EXIT && Leave Control Loop
endif
endif
endfor
If Not ReadWrite(sock,"DATA", 250)
GiveFeedBack( loFB, "Failed DATA" )
EXIT && Leave Control Loop
endif
* tran(day(date()))+' '+tran(month(date()))+' '+tran(year(date()));
* + ' ' +tran(hour(datetime()))+':'+tran(minute(datetime()))+':'+tran(sec(datetime())) +crlf
lcHdrs = "DATE: " + GetSMTPDateTime() + crlf;
+ "FROM: " + alltrim(strFrom) + CrLf ;
+ "TO: " + alltrim(strTo) + CrLf ;
+ "SUBJECT: " + alltrim(strSubj) + crlf ;
+ "MIME-Version: 1.0 "
if InList(upper(lcMsg),'<HTML>','<X-HTML>')
lcHdrs = lcHdrs + crlf + "Content-Type: text/html"
endif
lcOutStr = lcHdrs + crlf + crlf + lcMsg
* remove any inadvertant end-of-data marks:
lcOutStr = StrTran(lcOutStr, crlf+'.'+crlf, crlf+'. '+crlf)
* Place end of data mark on end:
lcOutStr = lcOutStr + crlf + "."
If Not ReadWrite(sock,lcOutStr, 354 )
GiveFeedBack( loFB, "Failed DATA (Cont'd)" )
EXIT && Leave Control Loop
ENDIF
If Not ReadWrite(sock,"QUIT", 250)
GiveFeedBack( loFB, "Failed QUIT" )
EXIT && Leave Control Loop
endif
GiveFeedBack( loFB, "Email Sent!" )
llRet = .T.
EXIT && Leave Control Loop
ENDDO
* Do cleanup code.
Junk = repl(chr(0),1000)
if sock.state = 7 && Connected
sock.GetData(@Junk)
endif
sock.close
sock = .null.
RETURN llRet
