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 = ""
SendSmtpEmail( cMailServer ;
, cFrom ;
, cTo ;
, cSubject ;
, cMessage ;
, cAttachments )
Return .T.
FUNCTION SendSmtpEmail
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
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 = ''
endfor
endif
GiveFeedBack( loFB, "Connecting to Server: "+strServ )
Sock=create('mswinsock.winsock')
llRet = .F.
lnServPort = 25
lcServ = strServ
do case
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.
if sock.State <> 7
GiveFeedBack( loFB, "Waiting to connect..." )
inkey(0.1)
if seconds() - lnTime > TIME_OUT
GiveFeedBack( loFB, "Connect Timed Out")
EXIT
endif
LOOP
endif
GiveFeedBack( loFB, "Connected." )
if not ReadWrite(sock,"HELO " + alltrim(strServ), 220)
GiveFeedBack( loFB, "Failed HELO" )
EXIT
endif
If Not ReadWrite(sock,"MAIL FROM: " + alltrim(strFrom), 250)
GiveFeedBack( loFB, "Failed MAIL" )
EXIT
endif
lnCnt = aLines(laTo, ChrTran(strTo,' ,;',chr(13)))
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
endif
endif
endfor
If Not ReadWrite(sock,"DATA", 250)
GiveFeedBack( loFB, "Failed DATA" )
EXIT
endif
lcOutStr = "DATE: " + GetSMTPDateTime() +crlf;
+ "FROM: " + alltrim(strFrom) + CrLf ;
+ "TO: " + alltrim(strTo) + CrLf ;
+ "SUBJECT: " + alltrim(strSubj) ;
+ crlf ;
+ crlf ;
+ lcMsg
lcOutStr = StrTran(lcOutStr, crlf+'.'+crlf, crlf+'. '+crlf)
lcOutStr = lcOutStr + crlf + "."
If Not ReadWrite(sock,lcOutStr, 354 )
GiveFeedBack( loFB, "Failed DATA (Cont'd)" )
EXIT
ENDIF
If Not ReadWrite(sock,"QUIT", 250)
GiveFeedBack( loFB, "Failed QUIT" )
EXIT
endif
GiveFeedBack( loFB, "Email Sent!" )
llRet = .T.
EXIT
ENDDO
Junk = repl(chr(0),1000)
if sock.state = 7
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.
endif
else
? cMsg
endif
ENDFUNC
FUNCTION GetSMTPDateTime
LOCAL lcRet, ltDT, lnBias
ltDT = DateTime()
if 'UTIL' $ set('PROC')
lnBias = GetTimeZone('BIAS')
else
lnBias = -5
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
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
oSock.SendData( cMsgOut + CrLf )
Else
RETURN .F.
Endif
RETURN .T.
FUNCTION GetTimeZone( pcFunc )
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 )
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
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
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 )
LOCAL strFileName, strFileData, i, j, lEncodedLines, ;
strTempLine, lFileSize, strResult, strChunk
strFileName = JustFName(strFilePath)
if type('pcFileData')='C'
strFileData = pcFileData
else
strFileData = FileToStr(strFilePath)
endif
strResult = "begin 664 " + strFileName + chr(10)
lFileSize = Len(strFileData)
lEncodedLines = int(lFileSize / 45) + 1
For i = 1 To lEncodedLines
strTempLine = ""
If i = lEncodedLines Then
strChunk = strFileData
StrFileData = ''
else
strChunk = LEFT( strFileData, 45 )
StrFileData = SubStr( strFileData, 46 )
endif
strTempLine = Chr(Len(strChunk) + 32)
If i = lEncodedLines And (Len(strChunk) % 3<>0) Then
strChunk = strChunk + Space( 3 -(Len(strChunk) % 3) )
endif
For j = 1 To Len(strChunk) Step 3
ln1 = Asc(SubStr(strChunk, j, 1))
ln2 = Asc(SubStr(strChunk, j + 1, 1))
ln3 = Asc(SubStr(strChunk, j + 2, 1))
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
strResult = strResult + strTempLine + chr(10)
EndFor
strResult = strResult + "*" + chr(10) + "end" + chr(10)
return strResult
Function UUDecode(strUUCodeData)
LOCAL lnLines, laLines[1], lcOut, lnI, lnJ
LOCAL strDataLine, intSymbols, strTemp
If Left(strUUCodeData, 6) = "begin "
strUUCodeData = SubStr(strUUCodeData, AT(chr(10),strUUCodeData) + 1)
EndIf
If Right(strUUCodeData, 5) = "end" + chr(13)+chr(10)
strUUCodeData = Left(strUUCodeData, Len(strUUCodeData) - 10)
endif
strTemp = ""
lnLines = alines(laLines, strUUCodeData)
For lnI = 1 to lnLines
strDataLine = laLines[lnI]
intSymbols = Asc(Left(strDataLine, 1))
strDataLine = SubStr(strDataLine, 2, intSymbols)
For lnJ = 1 To Len(strDataLine) Step 4
strTemp = strTemp + Chr( (Asc(SubStr(strDataLine, lnJ, 1)) - 32) * 4 ;
+(Asc(SubStr(strDataLine, lnJ+1, 1)) - 32) / 16 )
strTemp = strTemp + Chr( (Asc(SubStr(strDataLine, lnJ+1, 1)) % 16) * 16 ;
+(Asc(SubStr(strDataLine, lnJ+2, 1)) - 32) / 4 )
strTemp = strTemp + Chr( (Asc(SubStr(strDataLine, lnJ+2, 1)) % 4) * 64 ;
+ Asc(SubStr(strDataLine, lnJ+3, 1)) - 32)
ENDFOR
lcOut = lcOut + strTemp
strTemp = ""
ENDFOR
RETURN lcOut
ENDFUNC
censored.