sendto='rothltdoad@gmail.com' etopic='"invoice"' emsg='"Pleas pay the inclosed Invoice on or before"' eattach='"c:\clients\fox2\start.prg"' efdbk='fdbkmsg' fdbkmsg='test complete' lRes=SendMail( 'mail.quailcourt.biz','compex_ce@quailcourt.biz',sendto,etopic,emsg,eattach,efdbk) *lRes=SendMail( 'My.mail.server.com', 'myReturnAddress@MyServer.com', 'DestinationAddress@YourServer.com', 'My Message Subject', 'My Message Body, line 1'+chr(13)+chr(10)+'Line 2, etc...', 'C:\My\Attached\File.dbf,C:\My\Other\Attached\File.pdf',oMyFeedBackObject) ?'mail.quailcourt.biz'+" "+'compex_ce@quailcourt.biz'+" "+sendto +" "+etopic+" "+emsg+" "+eattach+" "+efdbk *The parameters are as follows: *CODE * 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" format * strTo: The email address to send the email to. * can use "name" format * strSubj: Subject for the email * strMsg: The Message to include as the body of the email. * Start the message with or * 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),'','') 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 CODE *-------------------------------------------------- Function GiveFeedback( oFB, cMsg ) if VarType(oFB)='O' or IsNull(oFB) if NOT IsNull(oFB) and PEMStatus(oFB,'Feedback',3)='Method' RETURN oFB.Feedback( cMsg ) else RETURN .T. && Hide Feedback endif else ?cMsg endif ENDFUNC *-------------------------------------------------- FUNCTION GetSMTPDateTime * Wed, 12 Mar 2003 07:54:56 -0500 LOCAL lcRet, ltDT, lnBias ltDT = DateTime() if 'UTIL' $ set('PROC') lnBias = GetTimeZone('BIAS') && In Util.prg else lnBias = -5 && EST endif lcBias = iif( lnBias<0, '+', '-' ) lnBias = abs(lnBias) lcBias = lcBias+PadL(Tran(lnBias/60),2,'0')+PadL(Tran(lnBias%60),2,'0') lcRet = LEFT( CDOW(ltDT), 3 )+', '+Str( Day(ltDt), 2 ) + ' ' + LEFT( CMONTH(ltDT), 3); +' '+TRAN( Year(ltDT) )+' '+PadL(Tran(hour(ltDT)),2,'0')+':'; +PadL(Tran(Minute(ltDT)),2,'0')+':'; +PadL(Tran(Sec(ltDT)),2,'0')+' '; +lcBias RETURN lcRet ENDFUNC *-------------------------------------------------- Function ReadWrite( oSock, cMsgOut, iExpectedCode ) LOCAL cMsgIn, iCode, lnTime lnTime = seconds() do while oSock.BytesReceived = 0 * ?"Waiting to Receive data..." inkey(0.2) if seconds() - lnTime > TIME_OUT * ?"Timed Out" return .F. endif enddo cMsgIn = repl(chr(0),1000) oSock.GetData(@cMsgIn) *?"expected:",iExpectedCode * *?"resp:",cMsgIn iCode = Val(Left(cMsgIn, 3)) *?"Got:",icode If iCode = iExpectedCode oSock.SendData( cMsgOut + CrLf ) Else * ?"Failed; Code="+cMsgin * ?"Code="+tran(iCode) RETURN .F. Endif RETURN .T. CODE ************************************************************************************** Function UUEncode( strFilePath, pcFileData ) * Converted by wgcs From VB code at http://www.vbip.com/winsock/winsock_uucode_02.asp * strFilePath: Specify the full path to the file to load and UU-encode. * pcFileData: an optional parameter. Specify this, and strFilePath is not loaded, * but just the filename from strFilePath is used for the encoding label. * LOCAL strFileName, strFileData, i, j, lEncodedLines, ; strTempLine, lFileSize, strResult, strChunk *Get file name strFileName = JustFName(strFilePath) if type('pcFileData')='C' strFileData = pcFileData else strFileData = FileToStr(strFilePath) endif *Insert first marker: "begin 664 ..." strResult = "begin 664 " + strFileName + chr(10) *Get file size lFileSize = Len(strFileData) lEncodedLines = int(lFileSize / 45) + 1 For i = 1 To lEncodedLines *Process file data by 45-bytes cnunks *reset line buffer strTempLine = "" If i = lEncodedLines Then *Last line of encoded data often is not *equal to 45 strChunk = strFileData StrFileData = '' else strChunk = LEFT( strFileData, 45 ) StrFileData = SubStr( strFileData, 46 ) endif * Thanks to "AllTheTimeInTheWorld" on Tek-Tips.com, it was recognized that * the length calculation should be after the correction of the last line * with the blankspace symbols: * *Add first symbol to encoded string that informs * *about quantity of symbols in encoded string. * *More often "M" symbol is used. * strTempLine = Chr(Len(strChunk) + 32) If i = lEncodedLines And (Len(strChunk) % 3<>0) Then *If the last line is processed and length of *source data is not a number divisible by 3, *add one or two blankspace symbols strChunk = strChunk + Space( 3 -(Len(strChunk) % 3) ) endif *Now that we know the final length of the last string, *Add first symbol to encoded string that informs *about quantity of symbols in encoded string. *More often "M" symbol is used. strTempLine = Chr(Len(strChunk) + 32) *!* For j = 1 To Len(strChunk) Step 3 *!* *Break each 3 (8-bits) bytes to 4 (6-bits) bytes *!* * *!* *1 byte *!* strTempLine = strTempLine + ; *!* Chr(Asc(SubStr(strChunk, j, 1)) / 4 + 32) *!* *2 byte *!* strTempLine = strTempLine + ; *!* Chr((Asc(SubStr(strChunk, j, 1)) % 4) * 16 ; *!* + Asc(SubStr(strChunk, j + 1, 1)) / 16 + 32) *!* *3 byte *!* strTempLine = strTempLine + ; *!* Chr((Asc(SubStr(strChunk, j + 1, 1)) % 16) * 4 ; *!* + Asc(SubStr(strChunk, j + 2, 1)) / 64 + 32) *!* *4 byte *!* strTempLine = strTempLine + ; *!* Chr(Asc(SubStr(strChunk, j + 2, 1)) % 64 + 32) *!* EndFor * Faster method: For j = 1 To Len(strChunk) Step 3 *Break each 3 (8-bits) bytes to 4 (6-bits) bytes ln1 = Asc(SubStr(strChunk, j, 1)) ln2 = Asc(SubStr(strChunk, j + 1, 1)) ln3 = Asc(SubStr(strChunk, j + 2, 1)) *1 byte strTempLine = strTempLine + Chr(ln1 / 4 + 32) ; + Chr((ln1 % 4) * 16 + ln2 / 16 + 32) ; + Chr((ln2 % 16) * 4 + ln3 / 64 + 32) ; + Chr(ln3 % 64 + 32) EndFor *add encoded line to result buffer strResult = strResult + strTempLine + chr(10) EndFor *add the end marker strResult = strResult + "*" + chr(10) + "end" + chr(10) *asign return value return strResult CODE Function UUDecode(strUUCodeData) * Converted by wgcs From VB code at http://www.vbip.com/winsock/winsock_uucode_04.asp LOCAL lnLines, laLines[1], lcOut, lnI, lnJ LOCAL strDataLine, intSymbols, strTemp *Remove first marker If Left(strUUCodeData, 6) = "begin " strUUCodeData = SubStr(strUUCodeData, AT(chr(10),strUUCodeData) + 1) EndIf *Remove marker of the attachment's end If Right(strUUCodeData, 5) = "end" + chr(13)+chr(10) * Remove last 10 characters: CR,LF,*,CR,LF,E,N,D,CR,LF strUUCodeData = Left(strUUCodeData, Len(strUUCodeData) - 10) endif strTemp = "" *Break decoded data to the strings *From now each member of the array vDataLines contains *one line of the encoded data lnLines = alines(laLines, strUUCodeData) For lnI = 1 to lnLines *Decode data line by line strDataLine = laLines[lnI] *Extract the number of characters in the string *We can figure it out by means of the first string character intSymbols = Asc(Left(strDataLine, 1)) *which we delete because of its uselessness strDataLine = SUBSTR(strDataLine, 2, intSymbols) *Decode the string by 4 bytes portion. *From each byte remove two oldest bits. *From remain 24 bits make 3 bytes For lnJ = 1 To Len(strDataLine) Step 4 *1 byte strTemp = strTemp + Chr( (Asc(SubStr(strDataLine, lnJ, 1)) - 32) * 4 ; +(Asc(SubStr(strDataLine, lnJ+1, 1)) - 32) / 16 ) *2 byte strTemp = strTemp + Chr( (Asc(SubStr(strDataLine, lnJ+1, 1)) % 16) * 16 ; +(Asc(SubStr(strDataLine, lnJ+2, 1)) - 32) / 4 ) *3 byte strTemp = strTemp + Chr( (Asc(SubStr(strDataLine, lnJ+2, 1)) % 4) * 64 ; + Asc(SubStr(strDataLine, lnJ+3, 1)) - 32) ENDFOR *Write decoded string to the file lcOut = lcOut + strTemp *Clear the buffer in order to receive the next *line of the encoded data strTemp = "" ENDFOR RETURN lcOut ENDFUNC ps: Someday I'll get around to integrating Antoliy Mogylevets code to remove the need for the MSWinSck.ocx control.... Back to Microsoft: FoxPro FAQ Index Back to Microsoft: FoxPro Forum Join | Advertise Copyright © 1998-2019 engineering.com, Inc. All rights reserved. Unauthorized reproduction or linking forbidden without expressed written permission. Registration on or use of this site constitutes acceptance of our Privacy Policy. Engineering.com