Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to send email using SMTP and no third party OCX?

Internet

How to send email using SMTP and no third party OCX?

by  wgcs  Posted    (Edited  )
( For the latest version of this code, see: http://fox.wikis.com/wc.dll?Wiki~SendSmtpEmail )

So you want to send an email, eh? And you don't want to require your users to have Outlook, Outlook Express, Eudora, CDO, or any other MAPI email client installed or registered? And you don't want to pay for it... and you don't want to have to distribute any third party OCX controls? AND, you want to send Attachments? AND, you want to use HTML?

Well, you've found the right example, because, purely in VFP, with the Microsoft WinSock OCX (MsWinSck.OCX) control, you can do just this!

Use this program (sendmail.prg) in this way:
Code: 
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)

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" <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
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....
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top