Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Email Automation via SMTP Server
Message
 
 
To
28/07/2003 13:56:07
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
00813190
Message ID:
00814266
Views:
34
There are two different routines (that do pretty much the same thing):

The first uses System32\MsWinSck.Ocx and the COM object mswinsock.winsock defined in it, this is a wrapper for WinSock.DLL - and I've just noticed something unusual here: With most ProgID's (mswinsock.winsock) the first part corresponds to a file name. E.g. Word.Application corresponds to Word.Exe, Excel.WorkSheet corresponds to Excel.Exe and so on. mswinsock is not the same as MsWinSck!

The second uses functions in System32\WS2_32.DLL directly - arguably this offers greater flexibility at greater cost. Things get complicated here by the fact that most calls to system DLLS from VFP have to be done synchronously because VFP offers no native support for call-backs (and asynchronous processing).

The Wiki seems to like adding question marks. These will all need to be removed excepting "? cMsg".
Also oFB_cAttachments is not an object it is an comma delimited list of files to attach.
Paste the following code into a Prg file, and try running it, after altering the cMailServer, cFrom and cTo fields.
Set Step On

cMailServer = "mail.SomeDomain.com"
cFrom = "YourName@SomeDomain.com"
cTo = "Recipient@SomeOtherDomain.Com"
cSubject = "This is a test"
cMessage = "If you can read this the test worked."
cAttachments = ""		&& "d:\AttacheFile1.Txt,U:\SomePath\SomeFIle.Dat"

SendSmtpEmail( cMailServer ;
		, cFrom ;
		, cTo ;
		, cSubject ;
		, cMessage ;
		, cAttachments )
Return .T.

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.

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: " + alltrim(laTo[lnI]), 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
  
  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 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
    
    *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

*!* 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 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
censored.
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform