Try the following, I've increased the amount of feedback written to the screen. I do not get the error relating to the recipient (RCPT TO:) and the angle brackets that you refer to in your other post. I can only go as far as specifying the RCPT TO: when I get a message about 'Relaying not allowed', I cannot test the routine fully because of the firewall between me and the outside world.
Clear
cMailServer = "EWEE.PAULCON.STATE.GA.US"
cFrom = "Wes_Holden@paulcon.state.ga.us"
cTo = "Marc_Jones@paulcon.state.ga.us"
cSubject = "This is a test"
cMessage = "If you can read this the test worked."
cAttachments = ""
SendSmtpEmail( cMailServer ;
, cFrom ;
, cTo ;
, cSubject ;
, cMessage ;
, cAttachments )
FUNCTION SendSmtpEmail( strServ, strFrom, strTo, strSubj, strMsg, oFB_cAttachments, oFeedBack )
#DEFINE crlf chr(13)+chr(10)
#DEFINE TIME_OUT 15
LOCAL oSocket, 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 )
oSocket = 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
oSocket.Connect( strServ,lnServPort )
lnTime = seconds()
GiveFeedBack( loFB, "Waiting to connect..." )
DO WHILE .T.
GiveFeedBack( loFB, "." )
if oSocket.State <> 7
inkey(0.1)
if seconds() - lnTime > TIME_OUT ;
OR LastKey() == 32 Then
GiveFeedBack( loFB, "Connect Timed Out")
EXIT
endif
LOOP
endif
GiveFeedBack( loFB, "Connected." )
GiveFeedBack( loFB, "Sending HELO" )
if not ReadWrite( oSocket, "HELO " + AllTrim( strServ ), 220 )
GiveFeedBack( loFB, "Failed HELO" )
EXIT
endif
GiveFeedBack( loFB, "Sending MAIL FROM:" )
If Not ReadWrite( oSocket, "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]) + '>' )
GiveFeedBack( loFB, "Sending RCPT TO: " + alltrim(laTo[lnI] ))
If Not ReadWrite( oSocket, "RCPT TO: " + alltrim(laTo[lnI]), 250 )
GiveFeedBack( loFB, "RCPT Failed" )
EXIT
endif
endif
endfor
If Not ReadWrite( oSocket, "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(oSocket,lcOutStr, 354 )
GiveFeedBack( loFB, "Failed DATA (Cont'd)" )
EXIT
ENDIF
If Not ReadWrite(oSocket,"QUIT", 250)
GiveFeedBack( loFB, "Failed QUIT" )
EXIT
endif
GiveFeedBack( loFB, "Email Sent!" )
llRet = .T.
EXIT
ENDDO
Junk = repl(chr(0),1000)
if oSocket.state = 7
oSocket.GetData(@Junk)
endif
oSocket.close
oSocket = .null.
RETURN llRet
EndFunc
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
If len( cMsg ) == 1 Then
?? cMsg
Else
? cMsg
Endif
endif
Return .T.
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( oSocket, cMsgOut, iExpectedCode )
LOCAL cMsgIn, iCode, lnTime
lnTime = Seconds()
do while oSocket.BytesReceived = 0
inkey(0.2)
if seconds() - lnTime > TIME_OUT
return .F.
endif
enddo
cMsgIn = Replicate( Chr(0), 1000 )
oSocket.GetData( @cMsgIn )
cMsgIn = StrTran( cMsgIn, Chr(0), "" )
If Not Empty( cMsgIn ) Then
? cMsgIn
Endif
iCode = Val(Left(cMsgIn, 3))
If iCode = iExpectedCode
oSocket.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
EndFunc
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.