Wiki Home

Send Smtp Email


Namespace: WIN_COM_API
The first versions are left here for reference but please skip down to the last version on this page...

Latest version of the code

it has a LOT of fixes in place, works with multi recipients, multiple attachments,
html, text or multipart messages, and has been tested to work with a large range of email clients (yahoo, gmail, outlook, opera, hotmail and others) if you try the earlier versions on this page
you will have issues, getting emails to work under many situations. - Ken. (thanks to the author of the original code for getting this started)

Here's a simple-to-use way to send email without a dependency on any 3rd party OCX, DLL or Application (no Outlook Required!). All you need is to know a usable SMTP server's name or address. Anyone have a simple way to read the SMTP address from Outlook? (to provide the user with a default, and to minimize user error in entering the SMTP address...)
  • Sample using the MSWINSCK.OCX (and attachments)
  • Sample using WS2_32.DLL WinSock directly
  • VfpSmtp http://www.zone.ee/dhpon/vfpsmtp/vfpsmtp.dfx (<-- I'd be wary of a link with no description!)

    FUNCTION SendSmtpEmail

    * 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
    * strTo:   The email address to send the email to.
    * strSubj: Subject for the email
    * strMsg:  The Message to include as the body of the email.
    * 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.
    *
    * 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')
    ** OR
    *  Sock=create('vfpWinSock')
    ** to use the winsock emulator class below (wayyyy below!) to avoid
    **   the licensing issues stemming from OCX's, and to avoid having to
    **   register MSWINSCK.OCX on the customers' machines.
    
    llRet = .F.
    
    
    
    lnServPort = 25
    lcServ     = strServ
    do case && Find Port
      case ':' $ lcServ
        lnAt = at(':',lcServ)
        lnServPort = val( Substr(lcServ, lnAt+1) )
        lcServ = left( lcServ, lnAt-1 ) && moved below "lnServPort =...."
        if lnServPort<=0
          lnServPort = 25
        endif
      case ' ' $ lcServ
        lnAt = at(' ',lcServ)
        lnServPort = val( Substr(lcServ, lnAt+1) )
        lcServ = left( lcServ, lnAt-1 ) && moved below "lnServPort =...."
        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
    
      lcOutStr = "DATE: " + GetSMTPDateTime() +crlf;
               + "FROM: " + alltrim(strFrom) + CrLf ;
               + "TO: " + alltrim(strTo) + CrLf ;
               + "SUBJECT: " + alltrim(strSubj) ;
               + 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
    
      * Simon Cropper: If using vfpWinSock and you are sending emails with large attachements you should
      * delay the following QUIT command until the email has has a chance to 'get out the building', otherwise
      * the program enters the IF...ENDIF construct and exits the DO...ENDDO without the llRet being set to TRUE.
      * Outcome: Email sent but program records an error => user keeps trying to send email = upset customer!
    
      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
    *--------------------------------------------------
    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.
    FUNCTION GetTimeZone( pcFunc )
    * Purpose: Return the Time Zone bias or description
    *   Input: pcFunc = "BIAS" or Missing... return the bias in Minutes
    *                     ( GMT = LocalTime + Bias )
    *          pcFunc = "NAME" ... Return the time zone name.
    *  Author: William GC Steinford
    ***********************************************************
    
    *!*	typedef struct _TIME_ZONE_INFORMATION {
    *!*	    LONG       Bias;                    2:  1-  2
    *!*	    WCHAR      StandardName[ 32 ];     64:  3- 66
    *!*	    SYSTEMTIME StandardDate;           16: 67- 82
    *!*	    LONG       StandardBias;            2: 83- 84
    *!*	    WCHAR      DaylightName[ 32 ];     64: 85-148
    *!*	    SYSTEMTIME DaylightDate;           16:149-164
    *!*	    LONG       DaylightBias;            2:165-166
    *!*	} TIME_ZONE_INFORMATION, *PTIME_ZONE_INFORMATION;
    *!*	typedef struct _SYSTEMTIME {
    *!*	    WORD wYear;
    *!*	    WORD wMonth;
    *!*	    WORD wDayOfWeek;
    *!*	    WORD wDay;
    *!*	    WORD wHour;
    *!*	    WORD wMinute;
    *!*	    WORD wSecond;
    *!*	    WORD wMilliseconds;
    *!*	} SYSTEMTIME, *PSYSTEMTIME;
    LOCAL lcTZInfo, lcDesc
    lcTZInfo = num2dword(0);
               +repl(chr(0),64)+repl(num2Word(0),8)+num2dword(0);
               +repl(chr(0),64)+repl(num2Word(0),8)+num2dword(0)
    DECLARE INTEGER GetTimeZoneInformation IN kernel32.dll;
        STRING @ lpTimeZoneInformation
    #DEFINE TIME_ZONE_ID_INVALID  0xFFFFFFFF
    #DEFINE TIME_ZONE_ID_UNKNOWN  0
    #DEFINE TIME_ZONE_ID_STANDARD 1
    #DEFINE TIME_ZONE_ID_DAYLIGHT 2
    lcRes = GetTimeZoneInformation( @lcTZInfo )
    lnBias = Buf2DWord( lcTZInfo )
    lcDesc = "Unknown"
    do case
      case lcRes=TIME_ZONE_ID_STANDARD
        lcDesc = substr( lcTZInfo, 3, 64 )
        lcDesc = StrConv( lcDesc, 6 ) && 6=Unicode(wide)->DoubleByte
        lcDesc = strTran( lcDesc, chr(0), '' )
      case lcRes=TIME_ZONE_ID_DAYLIGHT
        lcDesc = substr( lcTZInfo, 3, 64 )
        lcDesc = StrConv( lcDesc, 6 )
        lcDesc = strTran( lcDesc, chr(0), '' )
    endcase
    if varType(pcFunc)='C' and pcFunc='NAME'
      RETURN lcDesc
    endif
    
    RETURN lnBias
    ENDFUNC
    * * *
    * dword is compatible with LONG
    FUNCTION num2Long( lnValue )
    
      RETURN num2Dword(lnValue)
    ENDFUNC
    FUNCTION num2dword (lnValue)
    #DEFINE m0       256
    #DEFINE m1     65536
    #DEFINE m2  16777216
      LOCAL b0, b1, b2, b3
      b3 = Int(lnValue/m2)
      b2 = Int((lnValue - b3*m2)/m1)
      b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
      b0 = Mod(lnValue, m0)
      RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
    ENDFUNC
    * * *
    * word is compatible with Integer
    FUNCTION num2word (lnValue)
      RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
    ENDFUNC
    * * *
    FUNCTION buf2word (lcBuffer)
      RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
             Asc(SUBSTR(lcBuffer, 2,1)) * 256
    ENDFUNC
    * * *
    FUNCTION  buf2Long (lcBuffer)
      RETURN buf2Dword(lcBuffer)
    ENDFUNC
    FUNCTION  buf2dword(lcBuffer)
    RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
           Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
           Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
           Asc(SUBSTR(lcBuffer, 4,1)) * 16777216
    ENDFUNC
    **************************************************************************************
    Function UUEncode( strFilePath, pcFileData )
    * Converted by wgcs From VB code at 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
    
    Function UUDecode(strUUCodeData)
    * Converted by wgcs From VB code at 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
    

    Contributors: wgcs
    I suggest changing to GetData(@cMsgIn) and GetData(@Junk) .
    Anatoliy Mogylevets

    Thanks, Anatoliy, I'm sure that will make it more reliable... I believe that my code required SET UDFPARMS TO Reference, and the explicit passing by reference removes that restriction. - wgcs
    I used the Send Smtp Email function to send email. It works fine when I send a message without attachement. However, when I try to attach a very small text file to the message, it given an error message on line oSock.GetData.(@cMsgIn). The error message says -- "OLE IDispatch exception code 0 from Winsock. Wrong protocol or connection State for the requested transaction or request."
    I am using VFP8 on Windows XP.
    Any suggestion? Thanks.
    - rktaxali


    I suggest changing the commented lines to ASSERTs. That way the developer can run with them on for debugging, and the user can run with them off. A very good application of the infrequently used command. Ray Kirk

    I have a couple of issues with these routines. First, when using the routines above, I get a 'Class definition MSWINSOCK.WINSOCK is not found.' error when running on certain machines. It runs fine on other machines. Second, for both I get an 'Unable to relay for [email protected]' error when trying to send e-mail to someone not in my company address book. Is there a way to log on to a SMTPServer in order to fix this issue? Many thanks. -- BarryNewton
    The file MSWINSCK.OCX must be registered (and licensed for development, I just recently learned) on the machine that this code is running on. Regarding relaying, the FROM Address must be in the domain of the Smtp Server you're talking to, otherwise the smtp server will think you're trying to 'relay'... send mail from this server while not a customer/account holder on this server. - ?wgcs
    To avoid the development Licensing issue of the MSWINSCK.OCX control, you can change the CREATEOBJECT("MSWINSOCK.WINSOCK") call to CREATEOBJECT("vfpWinsock") and include this class defintion (this code is not thoroughly tested):

    . The following sounds like the preferred approach, since it avoids licensing issues etc. However, I'm getting a do nesting too deep where the protected function rd is referencing itself in the call THIS.cIn = THIS.cIn+THIS.Rd(). I could really use a fix for this one ASAP. -- Mike Yearwood.

    It seems that line didn't belong there... its functionality happens on the following three lines. Fixed below -- ?wgcs

    The 'WSAWait For Multiple EventsOffsite link to http://www.news2news.com/vfp/?function=592
' call never seems to get its FD_READ event and always waits the entire timeout period before returning. Any Ideas on why this is or how to correct it?
    Doug Thomson

    DEFINE CLASS vfpWinSock As Session
    
      * This class was written by William GC Steinford
      *   based on code posted by AnatoliyMogylevets on fox.wikis.com
      * This class is designed to mimic the features of the MSWINSCK.WinSock activeX control
      *   which are used by SendSmtpEmail
    
      * Public Interface Properties:
      *   N - State
      *   N - BytesReceived (read only)
      *   C - Host          (read only)
      *   C - IP            (read only)
      *   N - Port          (read only)
      *   C - cIn           (read/write)
      *
      * Public Interface Methods:
      *   L - Connect( cServer, nServerPort )
      *   L - Close()
      *   L - SendData( cData )
      *   L - GetData( @cDataOut )
    
      * State property Values
      *   0 Default. Closed
      *   1 Open
      *   2 Listening
      *   3 Connection pending
      *   4 Resolving host
      *   5 Host resolved
      *   6 Connecting
      *   7 Connected
      *   8 Peer is closing the connection
      *   9 Error
      State         = 0
      BytesReceived = 0
    
      host     = ""
      IP       = ""
      Port     = 80
      hSocket  = 0
      cIn      = ''
    
      WaitForRead = 0
    
      * Performance Adjustable Constants:
      #DEFINE READ_SIZE                16384
      #DEFINE READ_FROM_SERVER_TIMEOUT 200
    
      * API Constants:
      #DEFINE SMTP_PORT 25
      #DEFINE HTTP_PORT 80
      #DEFINE AF_INET 2
      #DEFINE SOCK_STREAM 1
      #DEFINE IPPROTO_TCP 6
      #DEFINE SOCKET_ERROR -1
      #DEFINE FD_READ 1
      #DEFINE HOSTENT_SIZE 16
    
      FUNCTION Connect( tcServer, tnServerPort )
        LOCAL cBuffer, cPort, cHost, lResult
    
        THIS.IP = THIS.GetIP(tcServer)
        IF EMPTY(THIS.IP)
          RETURN .F.
        ENDIF
        THIS.Host = tcServer
    
        THIS.Port = tnServerPort
    
        THIS.hSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
        IF THIS.hSocket = SOCKET_ERROR
            RETURN .F.
        ENDIF
    
        THIS.State = 6
        cPort = THIS.num2word(htons(THIS.Port))
        nHost = inet_addr(THIS.IP)
        cHost = THIS.num2dword(nHost)
        cBuffer = THIS.num2word(AF_INET) + cPort + cHost + Repli(Chr(0),8)
        lResult = (ws_connect(THIS.hSocket, @cBuffer, Len(cBuffer))=0)
        IF lResult
          THIS.State = 7
        ELSE
          THIS.State = 0
        ENDIF
      RETURN lResult
    
      FUNCTION Close
        if THIS.hSocket<>SOCKET_ERROR
          = closesocket(THIS.hSocket)
        endif
        THIS.hSocket = SOCKET_ERROR
        THIS.State = 0
      ENDFUNC
    
      FUNCTION SendData( cData )
        LOCAL cBuffer, nResult
        cBuffer = cData
        nResult = send(THIS.hSocket, @cBuffer, Len(cBuffer), 0)
        IF nResult = SOCKET_ERROR
            RETURN .F.
        ENDIF
        RETURN .T.
      ENDFUNC
    
      FUNCTION GetData( tcOutData )
        * NOTE: tcOutData MUST be passed by reference, ie: Sock.GetData( @Outstr )
        tcOutData = THIS.cIn
        THIS.cIn = ''
      ENDFUNC
    
      * Private methods follow:
    
      FUNCTION BytesReceived_Access
        THIS.Rd()
        RETURN LEN(THIS.cIn)
      ENDFUNC
    
      PROTECTED FUNCTION Rd
        LOCAL hEventRead, nWait, cRead, cRecv, nRecv, nFlags, lcRead
        DO WHILE .T.
            * creating event, linking it to the socket and wait
            hEventRead = WSACreateEvent()
            = WSAEventSelect(THIS.hSocket, hEventRead, FD_READ)
    
            * 1000 milliseconds can be not enough
            THIS.WaitForRead = WSAWaitForMultipleEvents(1, @hEventRead, 0, READ_FROM_SERVER_TIMEOUT, 0)
            = WSACloseEvent(hEventRead)
    
            IF THIS.WaitForRead <> 0 && error or timeout
                EXIT
            ENDIF
    
            * reading data from connected socket
    *This didn't belong here:
    *        THIS.cIn = THIS.cIn+THIS.Rd()
    
            cRecv = Repli(Chr(0), READ_SIZE)
            nFlags = 0
            nRecv = recv(THIS.hSocket, @cRecv, READ_SIZE, nFlags)
    
    
            IF nRecv>0
              THIS.cIn = THIS.cIn + LEFT(cRecv, nRecv))
            ENDIF
        ENDDO
      ENDFUNC
    
      PROCEDURE Init()
        DECLARE INTEGER gethostbyname IN ws2_32 STRING host
        DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
        DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
        DECLARE INTEGER closesocket IN ws2_32 INTEGER s
        DECLARE INTEGER WSACreateEvent IN ws2_32
        DECLARE INTEGER WSACloseEvent IN ws2_32 INTEGER hEvent
        DECLARE GetSystemTime IN kernel32 STRING @lpSystemTime
        DECLARE INTEGER inet_addr IN ws2_32 STRING cp
        DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
        DECLARE INTEGER WSAStartup IN ws2_32 INTEGER wVerRq, STRING lpWSAData
        DECLARE INTEGER WSACleanup IN ws2_32
    
        DECLARE INTEGER connect IN ws2_32 AS ws_connect ;
            INTEGER s, STRING @sname, INTEGER namelen
    
        DECLARE INTEGER send IN ws2_32;
            INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
    
        DECLARE INTEGER recv IN ws2_32;
            INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags
    
        DECLARE INTEGER WSAEventSelect IN ws2_32;
            INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents
    
        DECLARE INTEGER WSAWaitForMultipleEvents IN ws2_32;
            INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
            INTEGER dwTimeout, INTEGER fAlertable
    
        DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
    
            STRING @Dest, INTEGER Src, INTEGER nLength
    
    
        IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
          * unable to initialize Winsock on this computer
          RETURN .F.
        ENDIF
        RETURN .T.
      ENDPROC
    
      PROCEDURE Destroy
    
        = WSACleanup()
      ENDPROC
    
      PROTECTED FUNCTION GetIP( pcHost )
          LOCAL nStruct, nSize, cBuffer, nAddr, cIP
          nStruct = gethostbyname(pcHost)
          IF nStruct = 0
              RETURN ""
          ENDIF
          cBuffer = Repli(Chr(0), HOSTENT_SIZE)
          cIP = Repli(Chr(0), 4)
          = CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
          = CopyMemory(@cIP, THIS.buf2dword(SUBS(cBuffer,13,4)),4)
          = CopyMemory(@cIP, THIS.buf2dword(cIP),4)
      RETURN inet_ntoa(THIS.buf2dword(cIP))
      ENDFUNC
    
      FUNCTION buf2dword(lcBuffer)
        RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
            BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
            BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
            BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
      ENDFUNC
    
      FUNCTION num2dword(lnValue)
        *#DEFINE m0 256      2^8
        *#DEFINE m1 65536    2^16
        *#DEFINE m2 16777216 2^24
          IF lnValue < 0
              lnValue = 0x100000000 + lnValue
          ENDIF
          LOCAL b0, b1, b2, b3
          b3 = Int(lnValue/2^24)
          b2 = Int((lnValue - b3*2^24)/2^16)
          b1 = Int((lnValue - b3*2^24 - b2*2^16)/2^8)
          b0 = Mod(lnValue, 2^8)
        RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
      ENDFUNC
    
      FUNCTION num2word(lnValue)
        RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
      ENDFUNC
    ENDDEFINE
    

    Alternatively, don't use the above code "as is". Instead, put it into a form (making a form method for each procedure), and creating one OCX Control Container (called "Sock") on the form for the MSWINSOCK.WINSOCK control, and remove the logic for creating the Sock variable. Change all the references to "Sock" to use "THISFORM.Sock" instead. This is how the WinSock is really designed to be used (embedded in a form at run time), though the only difference, functionally, is M$'s licensing.... - wgcs
    WS2_32.DLL: sending email messages (SMTP, port 25) Provide valid SMTP server name, and email address for both sender and recipient to initialize the object.

    Certainly you should know your SMTP server name, otherwise there is no reason for you in using this program code :)

    Unfortunately you can enter any sender address. This approach somehow hides your identity (except the actual IP address). By any means I do not encourage you to cheat your recipients. Myself, I really hate spammers and unsolicited messages.

    This class can be easily modified for sending messages to multiple recipients.

    The message body is just a plain text. Some program code should be added to support multipart messages with attachments.

    #DEFINE CrLf  Chr(13)+Chr(10)
    LOCAL cServer, cSender, cRecipient, obj
    cServer = "smtp.smtpserver.com"
    cSender = "[email protected]"
    cRecipient = "[email protected]"

    obj = Create Object("Tsmtp", cServer, cSender, cRecipient)
    IF VARTYPE(obj) <> "O"
    = MessageB("Unable to initiaze Tsmtp object. " + Chr(13) +;
    "Check Host, Sender, and Recipient parameters. ", 48, " Error")
    ELSE
    WITH obj
    .subject = "Testing Winsock SMTP functionality"
    .body = "Test message:" + CrLf + CrLf +;
    "Windows Sockets (Winsock) provides a general-purpose networking " +;
    "application programming interface (API) based on the socket interface " +;
    "from the University of California at Berkeley. " + CrLf + CrLf +;
    "Winsock is designed to run efficiently on Windows OSs while maintaining " +;
    "compatibility with the Berkeley Software Distribution (BSD) standard, " +;
    "known as Berkeley Sockets."
    .SendMail()
    ENDWITH
    IF USED("csLog")
    SELECT csLog
    GO TOP
    BROW NORMAL NOWAIT
    ENDIF
    ENDIF
    • end of main
    DEFINE CLASS Tsmtp As Custom
    #DEFINE SMTP_PORT 25 && default SMTP port
    #DEFINE AF_INET 2
    #DEFINE SOCK_STREAM 1
    #DEFINE IPPROTO_TCP 6
    #DEFINE SOCKET_ERROR -1
    #DEFINE FD_READ 1
    host=""
    IP=""
    sender=""
    recipient=""
    subject=""
    body=""
    hSocket=0

    PROCEDURE Init(cServer, cSender, cRecipient)
    DO decl
    IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
    * unable to initialize Winsock on this computer
    RETURN .F.
    ENDIF

    THIS.host = cServer
    THIS.sender = cSender
    THIS.recipient = cRecipient

    IF Not THIS.InitCheck()
    = WSACleanup()
    RETURN .F.
    ENDIF

    FUNCTION InitCheck
    IF EMPTY(THIS.host) Or EMPTY(THIS.recipient);
    Or EMPTY(THIS.sender)
    * invalid Host or sender/recipient email address
    RETURN .F.
    ENDIF
    THIS.IP = THIS.GetIP()
    IF EMPTY(THIS.IP)
    * can not resolve Host name to IP address
    RETURN .F.
    ENDIF
    RETURN .T.

    PROCEDURE Destroy
    = WSACleanup()

    PROTECTED FUNCTION IsMailValid && just a minimal check
    RETURN Not (EMPTY(THIS.sender) Or EMPTY(THIS.recipient);
    Or EMPTY(THIS.subject+THIS.body))

    PROTECTED FUNCTION GetIP
    #DEFINE HOSTENT_SIZE 16
    LOCAL nStruct, nSize, cBuffer, nAddr, cIP
    nStruct = gethostbyname(THIS.host)
    IF nStruct = 0
    RETURN ""
    ENDIF
    cBuffer = Repli(Chr(0), HOSTENT_SIZE)
    cIP = Repli(Chr(0), 4)
    = CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
    = CopyMemory(@cIP, buf2dword(SUBS(cBuffer,13,4)),4)
    = CopyMemory(@cIP, buf2dword(cIP),4)
    RETURN inet_ntoa(buf2dword(cIP))

    PROTECTED FUNCTION ConnectTo
    LOCAL cBuffer, cPort, cHost, lResult
    cPort = num2word(htons(SMTP_PORT))
    nHost = inet_addr(THIS.IP)
    cHost = num2dword(nHost)
    cBuffer = num2word(AF_INET) + cPort + cHost + Repli(Chr(0),8)
    lResult = (ws_connect(THIS.hSocket, @cBuffer, Len(cBuffer))=0)
    RETURN lResult

    FUNCTION SendMail
    IF Not THIS.IsMailValid()
    RETURN .F.
    ENDIF
    THIS.hSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
    IF THIS.hSocket = SOCKET_ERROR
    RETURN .F.
    ENDIF

    LOCAL lResult
    IF THIS.ConnectTo()
    ** Most servers expect the server name after HELO:
    ** THIS.snd("HELO", .T.)
    THIS.snd("HELO "+THIS.host, .T.)
    THIS.snd("MAIL FROM:<" + THIS.sender + ">", .T.)
    THIS.snd("RCPT TO:<" + THIS.recipient + ">", .T.)
    THIS.snd("DATA", .T.)
    THIS.snd("From: " + THIS.sender)
    THIS.snd("To: " + THIS.recipient)
    THIS.snd("Subject: " + THIS.subject)
    THIS.snd("")
    THIS.snd(THIS.body)
    THIS.snd(".", .T.)
    THIS.snd("QUIT", .T.)
    lResult = .T.
    ELSE
    = MessageB("Unable to connect to [" + THIS.host +;
    "] on port " + LTRIM(STR(SMTP_PORT)) + ". ",;
    48, " Connection error")
    lResult = .F.
    ENDIF
    = closesocket(THIS.hSocket)
    RETURN lResult
    ENDFUNC

    PROTECTED FUNCTION snd(cData, lResponse)
    THIS.writelog(1, cData)
    LOCAL cBuffer, nResult, cResponse
    cBuffer = cData + CrLf
    nResult = send(THIS.hSocket, @cBuffer, Len(cBuffer), 0)

    IF nResult = SOCKET_ERROR
    RETURN .F.
    ENDIF
    IF Not lResponse
    RETURN .T.
    ENDIF

    LOCAL hEventRead, nWait, cRead
    DO WHILE .T.
    * creating event, linking it to the socket and wait
    hEventRead = WSACreate EventOffsite link to http://www.news2news.com/vfp/?function=593
()
    = WSAEvent SelectOffsite link to http://www.news2news.com/vfp/?function=595
(THIS.hSocket, hEventRead, FD_READ)

    * 1000 milliseconds can be not enough
    nWait = WSAWait For Multiple EventsOffsite link to http://www.news2news.com/vfp/?function=592
(1, @hEventRead,;
    0, 1000, 0)
    = WSAClose EventOffsite link to http://www.news2news.com/vfp/?function=594
(hEventRead)

    IF nWait <> 0 && error or timeout
    EXIT
    ENDIF

    * reading data from connected socket


    cRead = THIS.rd()
    IF Not EMPTY(cRead)
    THIS.writelog(0, cRead)
    ENDIF
    ENDDO
    RETURN .T.

    PROTECTED FUNCTION rd
    #DEFINE READ_SIZE 16384
    LOCAL cRecv, nRecv, nFlags
    cRecv = Repli(Chr(0), READ_SIZE)
    nFlags = 0
    nRecv = recv(THIS.hSocket, @cRecv, READ_SIZE, nFlags)
    RETURN Iif(nRecv<=0, "", LEFT(cRecv, nRecv))

    PROTECTED PROCEDURE writelog(nMode, cMsg)
    IF Not USED("csLog")
    CREATE CURSOR csLog(dir I, msg C(250))
    ENDIF
    ? cMsg
    cMsg = CrLf + cMsg + CrLf


    LOCAL nIndex, nPos0, nPos1
    nIndex = 1
    DO WHILE .T.
    nPos0 = AT(CrLf, cMsg, nIndex)
    nPos1 = AT(CrLf, cMsg, nIndex+1)
    IF nPos1 = 0
    EXIT
    ENDIF
    cLog = SUBSTR(cMsg, nPos0, nPos1-nPos0)
    cLog = STRTRAN(STRTRAN(cLog, Chr(13),""),Chr(10),"")
    IF Not EMPTY(cLog)
    INSERT INTO csLog VALUES (m.nMode, m.cLog)
    ENDIF
    nIndex = nIndex + 1
    ENDDO
    ENDDEFINE

    PROCEDURE decl
    DECLARE INTEGER gethostbyname IN ws2_32 STRING host
    DECLARE STRING inet_ntoa IN ws2_32 INTEGER in_addr
    DECLARE INTEGER socket IN ws2_32 INTEGER af, INTEGER tp, INTEGER pt
    DECLARE INTEGER closesocket IN ws2_32 INTEGER s
    DECLARE INTEGER WSACreate EventOffsite link to http://www.news2news.com/vfp/?function=593
IN ws2_32
    DECLARE INTEGER WSAClose EventOffsite link to http://www.news2news.com/vfp/?function=594
IN ws2_32 INTEGER hEvent
    DECLARE Get System TimeOffsite link to http://www.news2news.com/vfp/?function=95
IN kernel32 STRING @lpSystemTime
    DECLARE INTEGER inet_addr IN ws2_32 STRING cp
    DECLARE INTEGER htons IN ws2_32 INTEGER hostshort
    DECLARE INTEGER WSAStartup IN ws2_32 INTEGER wVerRq, STRING lpWSAData
    DECLARE INTEGER WSACleanup IN ws2_32

    DECLARE INTEGER connect IN ws2_32 AS ws_connect ;
    INTEGER s, STRING @sname, INTEGER namelen

    DECLARE INTEGER send IN ws2_32;
    INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags

    DECLARE INTEGER recv IN ws2_32;
    INTEGER s, STRING @buf, INTEGER buflen, INTEGER flags

    DECLARE INTEGER WSAEvent SelectOffsite link to http://www.news2news.com/vfp/?function=595
IN ws2_32;
    INTEGER s, INTEGER hEventObject, INTEGER lNetworkEvents

    DECLARE INTEGER WSAWait For Multiple EventsOffsite link to http://www.news2news.com/vfp/?function=592
IN ws2_32;
    INTEGER cEvents, INTEGER @lphEvents, INTEGER fWaitAll,;
    INTEGER dwTimeout, INTEGER fAlertable

    DECLARE RtlMoveMemory IN kernel32 As Copy MemoryOffsite link to http://www.news2news.com/vfp/?function=87
;
    STRING @Dest, INTEGER Src, INTEGER nLength

    FUNCTION buf2dword(lcBuffer)
    RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)

    FUNCTION num2dword(lnValue)
    #DEFINE m0 256
    #DEFINE m1 65536
    #DEFINE m2 16777216
    IF lnValue < 0
    lnValue = 0x100000000 + lnValue
    ENDIF
    LOCAL b0, b1, b2, b3
    b3 = Int(lnValue/m2)
    b2 = Int((lnValue - b3*m2)/m1)
    b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
    b0 = Mod(lnValue, m0)
    RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)

    FUNCTION num2word(lnValue)
    RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))


    Original link: http://www.news2news.com/vfp/?function=-1&example=385
    Anatoliy Mogylevets
    My smtp server requires a password, can any help me? -- Cetin Yasar

    Is there no requirement for a password to connect to the smtp server? -- Mike Yearwood

    Nope. How do you think spam works? SMTP is a trusting protocol. Typically, a mail server might verify your IP address, but then you can tell it who you and who you are sending your mail as. -- ?tr

    I'm getting an error about authentication. SMTP may be trusting, but the admins aren't eh? -- Mike Yearwood.

    Sorta something like this? Sending the "AUTH LOGIN" command right after the "EHLO". The login and password are base-64 encoded (thus the STRCONV() call).
    * I'm not really familiar with the smtp code above, but I'll try
    * to make this work within its framework.
    
    * Note that you'll probably have to open connection to the SMTP server with 'EHLO'
    * not 'HELO' to enable the AUTH command (and other advanced -- eSMTP -- commands)
    PROCEDURE SendMessage
    	&& connect to server.
    	&& send 'EHLO' message
    	...
    	If ReadWrite('AUTH LOGIN',250)
    		if !ReadWrite(STRCONV(this.UserName,13),250) and !ReadWrite(STRCONV(this.Password,13),250)
    			WAIT WINDOW 'Username and Password are invalid.'
    		endif
    	else
    		wait window 'AUTH LOGIN not supported by smtp server.'
    	ENDIF
    	...
    	&& continue sending message
    ENDPROC
    

    Along with "AUTH LOGIN", there's "AUTH PLAIN" & "AUTH CRAM-MD5" & "AUTH DIGEST-MD5" which use different encryption schemes. I'd be interested to know how those actually worked.
    -- Tom Bellin
    Thanks! This'll be very useful! - wgcs

        ReadWrite(sock,"EHLO " + alltrim(strServ), 220)
        ReadWrite(sock,"AUTH LOGIN ",250)
        ReadWrite(sock,strconv(suser,13), 334)
        ReadWrite(sock,strconv(spass,13), 334)
    
    

    server reply code, only works with auth plain
    [email protected]
    ENDIF
    3. I have got an waring about bad message header from AMAVIS.

    Subject: N�idiskiri ise tehtus

    must become to

    Subject: =?windows-1257?Q?N=E4idiskiri_ise_tehtus?=

    Spaces must be replaced to undescores
    other special characters must be replaced to =hh codings.

    How to implement this encoding ?

    It seems that only subject is required to be encoded to avoid warnings.
    Message body can be left intact.
    -- Andrus Moor
    I don't have time to work on adding this now, but here's the RFC that describes how to accomplish this encoding: http://www.ietf.org/rfc/rfc1505.txt Maybe you can figure it out and post your method here. -- ?wgcs
    I looked closer at the rfc I cited above, and it doesn't seem to address the "subject" header encoding. You should be able to find it by looking through the SMTP-related rfc's listed here: http://www.systemwebmail.com/faq/6.1.aspx -- ?wgcs
    systemwebmail link does not have any information about subject header encoding.
    So it seems that subject header encoding is totally undocumented.
    This is the answer... The header fields in SMTP support the "Quoted-Printable" encoding described here: http://www.ietf.org/rfc/rfc2045.txt and here http://www.ietf.org/rfc/rfc1522.txt (this page helped me find them: http://www.aspemail.com/manual_06.html )
    Here's a quick-and-dirty Quoted Printable Encoder
    (ps: please use "new" markers: # N #, to make finding new changes easier) -- ?wgcs

    How can i send Attachments?
    PAC [email protected]

    The first routine above includes the ability to send attachments -- wgcs
    How can I mark an email as HTML so it show formatted insted of showing all ... tags
    PAC pac@cortiel.com

    Research MIME: Basically, include a header line that says:
    MIME-Version: 1.0
    Content-Type: text/html

    ..then stick to the MIME standard for defining the message bodies. -- wgcs
    The section:
    case ':' $ lcServ
    > lnAt = at(':',lcServ)
    > lcServ = left( lcServ, lnAt-1 )
    > lnServPort = val( Substr(lcServ, lnAt+1) )
    will never get the entered port numer as lcServ is already chopped
    > lcServ = left( lcServ, lnAt-1 )
    needs to be after the get port bit or I guess noone has used this on anything thats not port 25 or you would have noticed it always defaults. I'll let you edit it to however you want, thats all

    KenSands
    Good point... Fixed. - wgcs
    I am using the UUEncode method and when I use a linux server for attachments I get the following error message 451 http://cr.yp.to/docs/smtplf.html The Linux server doesn't like chr(10) on it's own. If I use chr(13) with it then it doesn't work at all. Could anyone tell me how to get round this problem.

    Kind regards

    David
    david@(remove)anagram-sys.co.uk
    Code which uses direct winsock call has the following issues:

    1. Slow perfomance caused by

    nWait = WSAWait For Multiple EventsOffsite link to http://www.news2news.com/vfp/?function=592
(1, @hEventRead, 0, 1000, 0)

    For unknown reason this line causes ALWAYS 1 second delay. Thus sending
    every e-mail takes always 6 seconds, not related to connection speed at all.

    2. Violation of SMTP timeouts can cause message loss.
    Code waits only 1 seconds for SMTP server response. Server may not respond during 1 second. According to http://www.faqs.org/rfcs/rfc2821.html timeouts must be a lot bigger.
    In this case this code terminates TCP connection and message may
    be not sent.

    3. It is not possible to attach pdf files to mails.
    http://foxsocks.sourceforge.net/ Contains some encoding ideas.

    Andrus Moor
    I used the program to send plain text is ok, but how can I send HTML format ? I tried to add the MIME version to the program as follows;

    lcOutStr = "DATE: " + GetSMTPDateTime() +crlf;
    + "FROM: " + alltrim(strFrom) + CrLf ;
    + "TO: " + alltrim(strTo) + CrLf ;
    + "SUBJECT: " + alltrim(strSubj) + CrLf;
    + "MIME-Version: 1.0" + CrLf;
    + "Content-Type: multipart/alternative;" + CrLf;
    + ' boundary = "Ipgo_140520060124"' + CrLf;
    + crlf ;
    + crlf ;
    + lcMsg

    and I also added the boundary header "--Ipgo_140520060124" and tailer "--Ipgo_140520060124--" to bound my message, but receiver cannot display the message in the mail box. What can I do ?

    Edward ( edwkong@gmail.com )

    Newest Version Feel free to edit this into a topmost example or whatever to keep it all tidy, I've done lots of testing on the code and through telnet sessions with ms-exchange and hmail I've discovered a range of issues with the code, from timing out to early to all the return codes being off by one!. Below is my modified version which includes login, html format emails, and attachments encoded as base64 (this needs a dll I tried base64 encoding in fox but it was very slow, so I made a dll in c) it's used in a production environment and now works very well (at least for me!).

    the base 64 encode dll I made for attachments can be downloaded from
    https://www.sendspace.com/file/htkff6
    or
    http://www.kensands.co.uk/random/Base64_Library.dll (if my home server is turned on)
    it just encodes the named input file to the named output file. feel free to use it.

    #Define crlf Chr(13)+Chr(10)
    #Define TIME_OUT 100
    #Define vfpCr   Chr(13)
    #Define vfpLf   Chr(10)
    #Define vfpCrLf vfpCr + vfpLf
    
    *********************************************************************************
    Function SendEmail ( strFrom, emailTo, strSubj, strMsg, strAttachments, replyto )
    
    If Type('strFrom') == 'C' And strFrom == "?"
    	Return "asSendEmail ( strFrom, emailTo, strSubj, strMsg, strAttachments, replyto )"
    Endif
    
    Local Sock, llRet, lnI, laTO[1], lnCnt, lcServ, lnServPort
    Local lnTime, lcOutStr, Junk, lcAttachments, loFB, laAtch[1], lnAtchCnt
    Local laFiles[1], username, pword
    Local cMsgIn, iCode
    
    Private exactstate && save the set exact state, this routine requires it to be on
    
    exactstate = Set('exact')
    Set Exact On
    
    Set Fullpath On
    
    If Type('strFrom') != 'C' Or strFrom == ""
    	strFrom = "[email protected]"
    Endif
    If Type('emailto') != 'C' Or emailTo == ""
    	emailTo = "[email protected]"
    Endif
    If Type('strsubj') != 'C' Or strSubj == ""
    	strSubj = "test email"
    Endif
    If Type('strmsg') != 'C' Or strMsg == ""
    	strMsg = "just a test"
    Endif
    If Type('strAttachments') != 'C'
    	strAttachments = ""
    Endif
    If Type('replyto') != 'C' Or replyto == ""
    	replyto = strFrom
    Endif
    
    username = ""
    pword = ""
    
    strserv = "MAILSERVER" && mail server name
    
    *** in our system two mailservers are used depending on user name ****
    *** the standard for login seems to be username and password encoded as base64
    *** try http://makcoder.sourceforge.net/demo/base64.php to do this
    
    	IF strfrom = "[email protected]"
    		strserv = "MAILSERVER"
    		username = "BASE64name="
    		pword = "BASE64password="
    	ENDIF
    
    	IF strfrom = "[email protected]"
    		strserv = "MAILSERVER2"
    		username = "BASE64name="
    		pword = "BASE64password="
    	ENDIF
    lcmsg = ""
    lcmsg = strMsg
    lcAttachments = strAttachments
    
    * Load Attachments
    If Type('lcAttachments')='C' And Alltrim(lcAttachments)!=""
    	lnAtchCnt = Alines( laAtch, Chrtran(lcAttachments,',;',Chr(13)+Chr(13)) )
    	lcmsg = lcmsg + crlf + crlf
    	For lnI = 1 To lnAtchCnt
    		If Adir(laFiles,laAtch[lnI])=0
    *      ? "attachment "+ laAtch[lnI] + " not found, email failed."
    			Inkey(1)
    			Set Exact &exactstate
    			Return .F.
    		Endif
    
    		lcAtch = dobase64Encode( laAtch[lnI] )
    
    		contenttype = "application/octet-stream"
    		If Upper(Justext(laAtch[lnI])) == "PDF"
    			contenttype = "application/pdf"
    		Endif
    		newemailsegment =  crlf + "--MyUniqueEmailBoundary1" + crlf ;
    			+ "Content-Type: " + contenttype + "; name=" + '"' + Justfname(laAtch[lnI]) + '"' + crlf ;
    			+ "Content-Transfer-Encoding: base64"  + crlf ;
    			+ 'Content-Disposition: attachment; filename="' + Justfname(laAtch[lnI]) + '"' + crlf + crlf
    
    		lcmsg = lcmsg + newemailsegment + lcAtch
    
    		lcAtch = '' && free memory
    	Endfor
    Endif
    
    Local inlineimg
    Local inlineimgpath
    * add any inline content
    inlinepos = At('src="cid:',lcmsg)
    If inlinepos > 0
    	inlineimg = Substr(lcmsg,inlinepos,100)
    	inlineimg = Left(inlineimg,At('"',inlineimg,2))
    	inlineimgpath = Substr(inlineimg,10,Len(inlineimg)-10)
    	lcAtch = dobase64Encode( Alltrim(inlineimgpath) )
    	contenttype = "application/octet-stream"
    	If Upper(Justext(inlineimgpath)) == "PNG"
    		contenttype = "image/png"
    	Endif
    	If Upper(Justext(inlineimgpath)) == "JPG"
    		contenttype = "image/jpeg"
    	Endif
    	If Upper(Justext(inlineimgpath)) == "GIF"
    		contenttype = "image/gif"
    	Endif
    	newemailsegment =  crlf + "--MyUniqueEmailBoundary1" + crlf ;
    		+ "Content-Type: " + contenttype + crlf ;
    		+ "Content-Transfer-Encoding: base64" + crlf ;
    		+ "Content-ID: inlineimg1" + crlf ;
    		+ "Content-Disposition: inline" + crlf + crlf
    
    	newinlineimg = Strtran(inlineimg,inlineimgpath,"inlineimg1")
    	lcmsg = Strtran(lcmsg,inlineimg,newinlineimg)
    	lcmsg = lcmsg + newemailsegment + lcAtch
    	lcAtch = '' && free memory
    Endif
    
    **STRTOFILE(lcMSG,"tempemail.txt")
    
    Do While Type("sock") != "O"
    	Sock=Create('mswinsock.winsock')
    Enddo
    Local cMsgIn
    
    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.RemoteHost = strServ
    Sock.RemotePort = lnServPort
    
    llRet = .F.
    emailattempts = 0
    
    Do While emailattempts < 20 && try up to 20 times
    
    	emailattempts = emailattempts + 1
    
    	Do While .T. && just a way of breaking out using exit on failed
    		lnTime = Seconds()
    
    		If Sock.State <> 7 && Connected
    			Sock.Connect
    			Do While Sock.State <> 7
    				Inkey(0.1)
    				If Seconds() - lnTime > TIME_OUT
    					Exit && Leave Control Loop
    				Endif
    			Enddo
    			Do While Sock.BytesReceived = 0
    				Inkey(0.2)
    				If Seconds() - lnTime > TIME_OUT
    					Exit
    				Endif
    			Enddo
    			cMsgIn = Repl(Chr(0),1000)
    			Sock.GetData(@cMsgIn)
    *    ? "connected"
    *    ? cMsgIn
    		Endif
    
    *? "ehlo"
    		If Not Readwrite(Sock,"EHLO ["+Alltrim(Sock.LocalIP)+"]", 250)
    			Exit && Leave Control Loop
    		Endif
    
    		If username != ""
    *? "authlogin"
    			If Not Readwrite(Sock,"AUTH LOGIN", 334)
    				Exit && Leave Control Loop
    			Endif
    
    
    
    *? "user"
    
    			If Not Readwrite(Sock,username, 334)
    				Exit && Leave Control Loop
    			Endif
    
    
    *? "pass"
    
    			If Not Readwrite(Sock,pword, 235)
    				? "FAILED TO AUTHENTICATE"
    				Exit && Leave Control Loop
    			Endif
    
    
    		Endif
    
    *? "mailfrom"
    
    		If Not Readwrite(Sock,"MAIL FROM: " + Alltrim(strFrom), 250)
    			Exit
    		Endif
    
    		lnCnt = Alines(laTO, Chrtran(emailTo,' ,;',Chr(13)+Chr(13)+Chr(13)))
    *  ? str(lncnt)
    * once for each email address
    		For lnI = 1 To lnCnt
    			If Not Empty(laTO[lnI])
    				lcTo = 'rcpt to: <'+Alltrim(laTO[lnI])+'>'
    *  		? lcTo
    				If Not  Readwrite(Sock,lcTo,250)
    					Exit && Leave Control Loop
    				Endif
    			Endif
    		Endfor
    
    *? "about to send data"
    		If Not Readwrite(Sock,"DATA", 354)
    			Exit && Leave Control Loop
    		Endif
    
    		lcOutStr = "DATE: " + GetSMTPDateTime() + crlf;
    			+ "FROM: " + Alltrim(replyto) + crlf ;
    			+ "TO: " + Alltrim(emailTo) + crlf ;
    			+ "SUBJECT: " + Alltrim(strSubj) + crlf  ;
    			+ "MIME-Version: 1.0" + crlf ;
    			+ 'Content-Type: multipart/mixed; boundary="MyUniqueEmailBoundary1"' +  crlf  +  crlf;
    			+ "--MyUniqueEmailBoundary1" + crlf
    		If "" $ Upper(lcmsg)
    			lcOutStr = lcOutStr + "Content-Type: text/html"  + crlf
    		Else
    			lcOutStr = lcOutStr + "Content-Type: text/plain"  + crlf
    		Endif
    		lcOutStr = lcOutStr + "Content-Transfer-Encoding: 8bit"  + crlf ;
    			+ crlf ;
    			+ lcmsg ;
    			+ crlf ;
    			+ "--MyUniqueEmailBoundary1--"
    
    * ? 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 + "."
    
    *? "transmit email"
    
    		If Not Readwrite(Sock,lcOutStr, 250)
    			Exit && Leave Control Loop
    		Endif
    
    		Sock.SendData( "QUIT" + crlf )
    
    		llRet = .T.
    
    		Exit
    
    	Enddo
    
    	If llRet == .T.
    		Exit && Leave Control Loop
    	Endif
    
    Enddo
    
    If llRet = .T.
    * Do cleanup code.
    	Junk = Repl(Chr(0),1000)
    	If Sock.State = 7 && Connected
    		Sock.GetData(@Junk)
    	Endif
    Endif
    Sock.Close
    Sock = .Null.
    
    Set Exact &exactstate
    Return llRet
    Endfunc
    
    
    *********************************************************************************
    Function GetTimeZone( pcFunc )
    * Purpose: Return the Time Zone bias or description
    * Input: pcFunc = "BIAS" or Missing... return the bias in Minutes
    * ( GMT = LocalTime + Bias )
    * pcFunc = "NAME" ... Return the time zone name.
    * Author: William GC Steinford
    *******************************
    lcTZInfo = num2dword(0);
    	+Repl(Chr(0),64)+Repl(num2Word(0),8)+num2dword(0);
    	+Repl(Chr(0),64)+Repl(num2Word(0),8)+num2dword(0)
    Declare Integer GetTimeZoneInformation In kernel32.Dll;
    	STRING @ lpTimeZoneInformation
    #Define TIME_ZONE_ID_STANDARD 1
    #Define TIME_ZONE_ID_DAYLIGHT 2
    lcRes = GetTimeZoneInformation( @lcTZInfo )
    lnBias = Buf2DWord( lcTZInfo )
    lcDesc = "Unknown"
    If lcRes > 0
    	Do Case
    	Case lcRes=TIME_ZONE_ID_STANDARD
    		lcDesc = Substr( lcTZInfo, 3, 64 )
    	Case lcRes=TIME_ZONE_ID_DAYLIGHT
    		lcDesc = Substr( lcTZInfo, 89, 64 )
    		lnBias = lnBias + Buf2DWord(Substr(lcTZInfo, 169, 4)) - 2 ^ 32
    	Endcase
    	lcDesc = Strconv( lcDesc, 6 ) && 6=Unicode(wide)->DoubleByte
    	lcDesc = Strtran( lcDesc, Chr(0), '' )
    Endif
    If Vartype(pcFunc)='C' And pcFunc='NAME'
    	Return lcDesc
    Endif
    Return lnBias
    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
    * * *
    * dword is compatible with LONG
    Function num2Long( lnValue )
    Return num2dword(lnValue)
    Endfunc
    Function num2dword (lnValue)
    #Define m0 256
    #Define m1 65536
    #Define m2 16777216
    Local b0, b1, b2, b3
    b3 = Int(lnValue/m2)
    b2 = Int((lnValue - b3*m2)/m1)
    b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
    b0 = Mod(lnValue, m0)
    Return Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
    Endfunc
    * * *
    * word is compatible with Integer
    Function num2Word (lnValue)
    Return Chr(Mod(m.lnValue,256)) + Chr(Int(m.lnValue/256))
    Endfunc
    * * *
    Function buf2word (lcBuffer)
    Return Asc(Substr(lcBuffer, 1,1)) + ;
    	Asc(Substr(lcBuffer, 2,1)) * 256
    Endfunc
    * * *
    Function buf2Long (lcBuffer)
    Return Buf2DWord(lcBuffer)
    Endfunc
    Function Buf2DWord(lcBuffer)
    Return Asc(Substr(lcBuffer, 1,1)) + ;
    	Asc(Substr(lcBuffer, 2,1)) * 256 +;
    	Asc(Substr(lcBuffer, 3,1)) * 65536 +;
    	Asc(Substr(lcBuffer, 4,1)) * 16777216
    Endfunc
    
    
    *********************************************************************************
    Function dobase64Encode(tcInFile)
    
    Declare String EncodeBase64 In Base64_Library.Dll String, String, Integer
    Local lcguid
    Local lcoutfile
    Local lcoutfname
    lcoutfile = ""
    lcguid = GetGUID()
    If !Empty(lcguid)
    	If !File("BASE64TEMP\base64temp"+Alltrim(lcguid)+".txt") && belt and braces
    		lcoutfname = "BASE64TEMP\base64temp"+Alltrim(lcguid)+".txt"
    		b64File = EncodeBase64(tcInFile,lcoutfname,76)
    		If b64File != ""
    			lcoutfile = Filetostr(lcoutfname)
    			Erase (lcoutfname)
    		Endif
    	Endif
    Endif
    
    Return lcoutfile
    
    
    *********************************************************************************
    Function GetGUID()
    Local lcBuffer, ;
    	lcReturnValue, ;
    	llNoClear, ;
    	lnFuncVal
    
    *-- Define local variables
    lcBuffer      = Replicate( Chr( 0 ), 256 )
    lcReturnValue = []
    llNoClear     = Iif( Pcount() > 0 And Vartype( tlNoClear ) = "L", ;
    	tlNoClear, ;
    	.F. ;
    	)
    lnFuncVal     = 0
    
    *-- Declare DLL functions
    Declare Integer CoCreateGuid ;
    	IN Ole32.Dll ;
    	STRING @pGuid
    Declare Integer StringFromGUID2 ;
    	IN Ole32.Dll ;
    	STRING rguid, String @lpsz, Integer cchMax
    
    *-- Initialize a buffer to hold the GUID value
    pGuid = Replicate( Chr( 0 ), 17 )
    
    *-- Call the CoCreateGuid function
    lnFuncVal = CoCreateGuid( @pGuid )
    
    *-- If the DLL function returned zero,
    *-- the function was successful,
    *-- so build a string of the GUID data
    If lnFuncVal = 0
    	= StringFromGUID2( pGuid, @lcBuffer, 128 )
    
    *-- Truncate the GUID string to the desired length
    	lcBuffer = Substr( lcBuffer, ;
    		1, ;
    		AT( Chr( 0 ) + Chr( 0 ), lcBuffer ) ;
    		)
    
    *-- Convert the string
    	lcReturnValue = Strconv( lcBuffer, 6 )
    
    Endif && lnFuncVal = 0
    
    *-- Unless the calling module chose not to,
    *-- clear the instantiated DLLs from memory
    If !llNoClear
    	Clear Dlls "StringFromGUID2"
    	Clear Dlls "CoCreateGuid"
    
    Endif && !tlNoClear
    *-- Clean up and return
    Return ( lcReturnValue )
    
    
    *********************************************************************************
    Function Readwrite(oSock, cMsgOut, iExpectedCode)
    
    Local cMsgIn, iCode, lnTime
    lnTime = Seconds()
    
    oSock.SendData( cMsgOut + crlf )
    
    Do While oSock.BytesReceived = 0
    	Inkey(0.2)
    	If Seconds() - lnTime > TIME_OUT
    		Return .F.
    	Endif
    Enddo
    
    cMsgIn = Repl(Chr(0),1000)
    oSock.GetData(@cMsgIn)
    iCode = Val(Left(cMsgIn, 3))
    If iCode == iExpectedCode
    	Return .T.
    ELSE
    && show the code that failed
    		? cmsgout && Mike - this is msgout to show the failed request, icode below is the returned error number
    		? iexpectedcode
    		? icode
    	Return .F.
    Endif
    Endfunc
    
    


    Hope this helps you all.

    Ken Sands. kensands@dsigroup.com


    There is a typo in your MIME Content-Type boundary setting: the dashes should not be there.

    
    
    lcoutstr = "DATE: " + getsmtpdatetime() + crlf;
    				+ "FROM: " + ALLTRIM(replyto) + crlf ;
    				+ "TO: " + ALLTRIM(emailto) + crlf ;
    				+ "SUBJECT: " + ALLTRIM(strsubj) + crlf ;
    				+ "MIME-Version: 1.0" + crlf ;
    				+ 'Content-Type: multipart/mixed; boundary="UniqueEmailBoundary1";' + crlf ;
    				+ "--UniqueEmailBoundary1" + crlf
    
    


    -Barry Dempsey

    ---

    Thanks Barry, it was one of those mistakes you introduce when trying to remove all the non generic bits that relate to your company (it used to be "mycompanynameboundary"). I'll sort it in the main code section.

    -Ken

    I've made another ammend there, the boundary line should not end with a semicolon, surprisingly it's been running for over a year now and we've only just had an email cause issues due to this, and it was connected with it getting processed trough a email scanner. anyway, thats now correct.

    - Ken

    I don't mean to be critical, but all this strikes me as needlessly complex. Why not just use something like CDO? Here's a link to a free zipped package of VFP CDO forms and classes that handles everything from simple plain text emails to HTML emails with attachments and embedded graphics.

    - Sam Thornton

    CDO also doesn't work half the time, gets messed around with security issues and does not suit a slim automated system. it's based on that computers outlook settings, so how do you send email via different email servers, or using different accounts? and what happens when outlook gets an automatic update restricting the cdo interface yet again? for those reasons CDO is not always a good solution. when setting up a system to send emails in a production environment this works a lot better, at least in my experience. My version also includes options of html, plaintext, or multipart, and attachments, I use all these options - Ken


    Category Code Samples

    - Simon Cropper

    Has anyone managed to get a version of this program to work without WinSock?

    I had the WinSock version working beautifully when following the instalation of a new AntiVirus Program (CA AntiVirus) and running SpyBot to get rid of some spyware, the program stopped working. Now I get the error "Class definition MSWINSOCK.WINSOCK is not found" mentioned above. One of these programs deregistered the WinSock and stuffed up the software. None of the program logs indicate what was done. I have removed all software but the error still happens.

    I tried using vfpWinSock but Send SMTPEmail still returns a FALSE value.

    OUTCOME of investigations...
    1. inserting vfpWinSock class after the Send SMTPEmail.prg DID ACTUALLY WORK. The program just returned a false value.
    2. working through the program with the debugger I found that the 'error' was due to the sock program not being able to quit while sending an encoded attachment. If you delay the program 20-30 seconds while the request is processed the quit command works.
    3. for some reason this behaviour is only apparent when using the vfpWinSock class - MSWinSck.ocx did accepted the command without generating an error.
    4. I have marked the relevant point to insert a delay in the above program.

    ---
    Problem on sending multi receipants and attachments

    I tried to use Sendsmtpemail, it works properly for single receipant and single attachment, but I want to send to multiple receipants with 2 or more attachement, it failed.
    What should I do ?

    thanks,
    Edward (edwkong@gmail.com)

    ---
    Send SMTPEmail has a parameter, oFB_Attachments, which allows multiple attachments. File names are separated by commas. See restrictions in comments at top of program. You can send multiple emails by creating a program that works through a table and calls Send SMTPEmail with the relevant parameters. Simon Cropper.

    ---
    I send emails to mutiple recipients with multiple attachments no problem, are you using my version of the code? the last one on this page? - ken.

    ---

    Hi Guys,

    I recently encountered a problem, which I could use some hints in solving. I send a newsletter to about 150 of my clients using Send SMTPEmail - mailout program scans table of clients, uses Send SMTPEmail to send an email with PDF attachement, waits 40 seconds for the file to be encoded and sent, then moves onto the next client. Occassionally people emailed me that the file was corrupted and asked for me to resent the attachement. The second attempt always worked. They don't change their program or anything they do, nor do I, it is just that the second attempt isn't corrupted or something.

    The last mailout resulted in about 10% of the 150 not working. Most complained that the file was coming as an mime-encoded inclusion and was not able to be displayed in the body of the text. I resend the file, either from my foxpro program or outlook, and they have no problem with getting the email or opening the attachment (PDF). It appears the second attempt has all the bits and flags inside the email in the right place. One person had Mail Marshall state that there could be a virus in the attachment. The file and attachement were clean.

    I have emailed 120 copies of the same email and attachement to myself with my virus scanner on/off, outlook on/off and IE7 on/off. Despite trying I can't reproduce the problem.

    Anyone got any ideas what might be happening here? It appears that the Send SMTPEmail does something that can be misinterpreted by different email programs.

    I intend to ask everyone who has had a problem a range of questions about their system to try and identify the problem but I am not sure what I should be asking. Any guidance here would be helpful as well.

    All the people that responded had Lotus Notes. It appears this program can do funny things with MIME-encoded data depending on the configuration, etc. What is confusing though is that if I send them emails from outlook they work. So as a work around I have flagged clients that report an error using the Send SMTPEmail program and save an email for them in Outlook using Office Automation. I can then go to Outlook and send the files manually. Not a big problem for a few people, but could be a pain for lots.

    Simon Cropper

    Simon, I was encountering a similar issue with email filter software causing issues at the point of scanning, I put something in to do with email boundries which fixed it, I'm not sure exactly what it was now though. is the problem occuring using the last version on this page that I put up? - Ken.

    17/01/2008 -- After a long delay I finally worked through this problem and seem to have resolved this issue. I tried to run the last program on this page without any success -- problems with Winsock Registration. I was therefore required to modify my existing hybrid program that uses vfpWinSock. I correctly presumed, as mentioned by you, the problem would be in either the encoding routine or in delimiting of the attachments. I therefore went through the SendEmail program and compared it line-by-line to Send SMTPEmail program and modified these sections appropriately. It worked.

    Simon Cropper

    There is always "RCPT Failed" error when I send to single receipant
    When I send a plain text email to single receiver, it always show "RCPT Failed", why ? please help !!
    Edward


    I was getting a "Error 501 5.0 ehlo requires domain address". Changing the line
    IF NOT readwrite(sock,"EHLO", 250)
    to
    IF NOT readwrite(sock,"EHLO localhost", 250)
    fixes the problem.


    fixed an attachment semi bug the code should have been CHRTRAN not STRTRAN to sepatrate multiple attachments - Ken


    Just as feedback for future users.

    Take care when using these programs as they use !="" alot. As I found out through trial an error while trying to clarify why my email program suddenly stopped working -- !="" is not treated the same with SET EXACT ON and OFF.

    For example, the IF b64file != "" command below is only positive if SET EXACT is ON; if OFF it is negative. I changed the command to IF NOT b64file == "" to get the correct result.

    FUNCTION dobase64encode(tcinfile)
    
    	DECLARE STRING EncodeBase64 IN Base64_Library.DLL STRING, STRING, INTEGER
    	lcoutfile = ""
    	b64file = encodebase64(tcinfile,"base64temp.txt",76)
    	IF b64file != ""
    		lcoutfile = FILETOSTR(b64file)
    	ENDIF
    	RETURN lcoutfile
    ENDFUNC
    
    


    Simon Cropper


    Here is a peculiar issue that occurs in both my modified Send SMTPEmail() that uses vfpWinSock and the SendEmail() program listed at the bottom of this page that uses WinSock.

    If you send an email message (no attachements) that is over 990 characters long something in the program cuts it up and inserts a carriage return followed by a space. I have tried to track down the culprit but it seems to be occurring in vfpWinSock and WinSock. My debugging indicates the message text is intact when handed to ReadWrite() to send.

    To see what I mean, try sending 1111111111222222222233333333334444444444...(reiterate so you have several thouusand characters) to yourself. Look at an email.

    Essentally what happens is that the initial segment is 990 characters followed by CHR(13)+" ", then 989 characters followed by CHR(13)+" ". The last 989 chunks are repeated over and over. No data seems to have gone missing, it is just that various words in my emails get spaces inserted in them. To date this has gone unnoticed in large text files but have become a problem in large HTML files due to hyperlinks and commands being broken into two parts.

    Attachments seem to get sent without any problems.

    Has anyone encountered this problem before? Anyone know what is going on?

    Cheers Simon Cropper (scropper_AT_botanicus-aust.com.au)

    27/02/2008 -- I have continued trying to debug this problem and found that it is not confined to SendEmail. Using the CDOEmail() functions from http://fox.wikis.com/wc.dll?Wiki~CdoEmail also generates the same problem. Files over 990 characters long are split into 990, then 989 sized, blocks separated by chr(13)+" ". It does not seem to matter whether the data is sent as HTML or TEXT. The fact that I get the problem whether I am using SendEmail()/CDOEmail() which uses Microsoft's WinSock or Send SMTPEmail() using vfpWinSock, I am pretty sure it is not the WinSock Library. The fact that I can send any sized email from Outlook without any problem also supports this. I am using Office2000 + XPPro SP2 + VFP9. Simon.

    28/02/2008 -- Ken was unable to reproduce the error on his system so it appears that the issue is centred around my computer or ISP. Ken suggested it might have something to do with email spam filtering or virus scanning. I have turned off everything I could to no avail. What I did discover was that the problem occurs in all the programs I could find - BLAT, SendEmail, Send SMTPEmail and CDOEmail. It does not occur in Outlook. All use WinSock. The other interesting fact was that the problem only appears if the length of a string of characters between carriage returns in the email goes over the 990, 989, etc limit. That is, the problem only appears if you create a continuous string over 990 charcaters long. My work around is to insert CHR(13) where ever I can in my emails. Bye and bye, spaces don't count.

    05/03/2008 -- I could not find util.prg (used in the code), so I reproduce how to get timezone from windows below. The good thing about putting this into your code is that it is one less dependency. Tony Wallace

    FUNCTION getbias()
    *| typedef struct _TIME_ZONE_INFORMATION {
    *| LONG Bias; 0 4
    *| WCHAR StandardName[ 32 ]; 4 64
    *| SYSTEMTIME StandardDate; 68 16
    *| LONG StandardBias; 84 4
    *| WCHAR DaylightName[ 32 ]; 88 64
    *| SYSTEMTIME DaylightDate; 152 16
    *| LONG DaylightBias; 168 4
    *| } TIME_ZONE_INFORMATION, *PTIME_ZONE_INFORMATION; total 172 bytes
    #DEFINE TIME_ZONE_SIZE 172
    DECLARE INTEGER Get Time Zone InformationOffsite link to http://www.news2news.com/vfp/?function=106
IN kernel32;
    STRING @lpTimeZoneInformation

    LOCAL cTimeZone, cTimeZone_, nId
    cTimeZone = Repli(Chr(0), TIME_ZONE_SIZE)

    nId = GetTimeZoneInformation(@cTimeZone)
    RETURN buf2dword(SUBSTR(cTimeZone, 1,4))

    ENDFUNC

    FUNCTION buf2dword(lcBuffer)
    RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
    BitLShift(Asc(SUBSTR(lcBuffer, 2,1)), 8) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
    BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)

    [2009.05.16 10:07:09 AM GMT] Could anyone highlight the final workable version for usage ?!

    I've only just notice the date thing myself, it was a few errors in the time code right from the original, I never looked into it because it didn't break the code it just put slightly incorrect send times into the emails.
    I've fixed that now, there is no reference to UTILS and the daylight saving time bias works. again I've fixed it in the last full code example shown above. - Ken

    I've also added guids to the temp filenames used in base64 encoding, this allows this code to be called multiple times without the tempfiles overlapping and sending the wrong attachments! code for the guid bit was taken from the wiki at http://fox.wikis.com/wc.dll?Wiki~GUIDGenerationCode
    - Ken

    [2010-11-16]I've successfully used this code to send emails with attachments, but am unable to get it to CC: someone. I've added a new parameter (emailCC) and relevant code to pass a CC: email address in to the function and altered the lcOutStr to read as follows:

    		lcOutStr = "DATE: " + GetSMTPDateTime() + crlf;
    			+ "FROM: " + Alltrim(replyto) + crlf ;
    			+ "TO: " + Alltrim(emailTo) + crlf ;
    			+ "CC: " + Alltrim(emailCC) + crlf ;
    			+ "SUBJECT: " + Alltrim(strSubj) + crlf  ;
    			+ "MIME-Version: 1.0" + crlf ;
    			+ 'Content-Type: multipart/mixed; boundary="MyUniqueEmailBoundary1"' +  crlf  +  crlf;
    			+ "--MyUniqueEmailBoundary1" + crlf
    


    The email will still reach the TO: recipient, but the CC: recipient receives nothing. Any ideas?
    regards, Ric.
    Hi Ric... I'm pretty sure that CC recipients are NOT handled by adding header entries like this. (Some mail programs, like SENDMAIL, might receive and parse the CC: header, than obey the request to send the mail to the specified recipient(s).) Instead, I believe CC recipients are specified in the initial SMTP conversation with the "RCPT TO:" commands. The .SendMail function could loop twice, issuing "RCPT TO:" each of the TO: addresses, then issue it once for each CC address that was specified separately. BCC recipients especially should be handled like this so that their addresses do not show up in any of the TO: or CC: recipients' email headers. -- ?wgcs

    Hi William, many thanks for response! You are spot on with that - I had misread the SMTP entry in Wikipedia and missed the bit about adding "RCPT TO:" for each CC: recipient. Adding the CC: Header just displayed the name in the actual email without actually sending it to them. I've now added this extra code to issue "RCPT TO:" for the CC address (placed after the code for "RCPT TO:" for the TO: recipients) and it all works now. Many thanks for your guidance. Ric.

    
    		lnCntcc = Alines(laCC, Chrtran(emailCC,' ,;',Chr(13)+Chr(13)+Chr(13)))
    *  ? str(lncntcc)
    * once for each CC email address
    		For lnI = 1 To lnCntcc
    			If Not Empty(laCC[lnI])
    				lcCC = 'rcpt to: <'+Alltrim(laCC[lnI])+'>'
    *  		? lcCC
    				If Not  Readwrite(Sock,lcCC,250)
    					Exit && Leave Control Loop
    				Endif
    			Endif
    		Endfor
    


    ---
    -Stelios---
    Just to mention that you have to make the directory BASE64TEMP and in the line
    lcoutfname = "C:\BASE64TEMP\base64temp"+Alltrim(lcguid)+".txt"
    lead it to corect path
    Also i have this error
    If iCode == iExpectedCode &? iCode <= iemax
    Error in line 495: Command contains unrecognized phrase/keyword.
    but I don't mind I just comment out the whole if
    Hi Stelios: I'm not sure what the exact intent of that code snippet was... but it is clear that a bug creeped in when it was posted. It should either be:
    If iCode == iExpectedCode && iCode <= iemax
    or
    If iCode == iExpectedCode AND iCode <= iemax
    The first just has a comment at the end of the line ("&& iCode <= iemax") and the second adds an odd restriction to when .T. can be returned (the odd restriction is that the iExpectedCode provided to the function must be less than or equal to iemax (apparently a calculated maximum valid error code...). The logic does not look correct to me, so I think that "iCode <= iemax" was just intended to be commented out at the end of the line. I fixed the code snippet to avoid this error. -- ?wgcs

    It was used when I was debugging the code for different smtp return codes, I think I had just the iCode <= iemax bit in place for a while to allow it to go through, as it seemed different servers were replying with different codes yet still working, however that was solved by tweaking what was sent through to be something compatible with at least all the servers I tested it with. - Ken

    In attempting to adapt this code for my needs, I found that it would be helpful for ReadWrite() to output whatever the server sends back when the command is successful. This lets me collect the list of advertised authentication methods so I can fork the code based on the server's requirements. So I modified ReadWrite() as follows:

    
    Function Readwrite(oSock, cMsgOut, iExpectedCode)
    
    Local cMsgIn, iCode, lnTime, llReturn
    
    llReturn = .F.
    lnTime = Seconds()
    
    oSock.SendData( cMsgOut + crlf )
    
    Do While oSock.BytesReceived = 0
    	Inkey(0.2)
    	If Seconds() - lnTime > TIME_OUT
    		Return .F.
    	Endif
    Enddo
    
    cMsgIn = Repl(Chr(0),1000)
    oSock.GetData(@cMsgIn)
    iCode = Val(Left(cMsgIn, 3))
    If iCode == iExpectedCode
    	*Return .T.
            llReturn = .T.
    ELSE
    	*Return .F.
            llReturn = .F.
    Endif
    
    
    ? cmsgout
    ? iexpectedcode
    ? icode
    RETURN llReturn
    Endfunc
    

    -- Ken Dibble

    < NEW > In the class definition for VFPWinSock (THANK YOU!! for this!), there is a bug in the Rd function:

    The line:

    THIS.cIN = THIS.cIn + LEFT (cRecv, nRecv))

    is either missing a left paren, or should lose the second right paren.
    -- Ken Dibble
  • ( Topic last updated: 2015.11.11 12:32:02 PM )