Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
FUNCTION SendSmtpEmail
LPARAMETERS strServ, strFrom, strTo, strSubj, strMsg
* 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.
#DEFINE crlf chr(13)+chr(10)
#DEFINE TIME_OUT 5
LOCAL Sock, llRet, lnI, laTO[1], lnCnt, lcServ, lnServPort
LOCAL lnTime, lcOutStr, Junk
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
DO WHILE .T. && Control Loop
sock.Connect(strServ,lnServPort)
lnTime = seconds()
do while sock.State <> 7
?"Waiting to connect..."
inkey(0.1)
if seconds() - lnTime > TIME_OUT
* ?"Timed Out"
EXIT && Leave Control Loop
endif
enddo
* ?"Connected."
if not ReadWrite(sock,"HELO " + strServ, 220)
* ?"Failed 1"
EXIT && Leave Control Loop
endif
If Not ReadWrite(sock,"MAIL FROM: " + strFrom, 250)
* ?"Failed"
EXIT
endif
lnCnt = aLines(laTo, ChrTran(strTo,' ,;',chr(13)))
* once for each email address
for lnI = 1 to lnCnt
If Not ReadWrite(sock,"RCPT TO: " + laTo[lnI], 250)
* ?"Failed"
EXIT && Leave Control Loop
endif
endfor
If Not ReadWrite(sock,"DATA", 250)
* ?"Failed"
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: " + TTOC( DateTime() ) +crlf;
+ "FROM: " + strFrom + CrLf ;
+ "TO: " + strTo + CrLf ;
+ "SUBJECT: " + strSubj ;
+ crlf ;
+ crlf ;
+ strMsg
* 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 )
* ?"Failed"
EXIT && Leave Control Loop
ENDIF
If Not ReadWrite(sock,"QUIT", 250)
* ?"Failed"
EXIT && Leave Control Loop
endif
llRet = .T.
EXIT && Leave Control Loop
ENDDO
* Do cleanup code.
Junk = repl(chr(0),1000)
sock.GetData(@Junk)
sock.close
sock = .null.
RETURN llRet
*--------------------------------------------------
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)
iCode = Val(Left(cMsgIn, 3))
If iCode = iExpectedCode
oSock.SendData( cMsgOut + CrLf )
Else
* ?"Failed; Code="+cMsgin
* ?"Code="+tran(iCode)
RETURN .F.
Endif
RETURN .T.
Function UUDecode(strUUCodeData)
* From VB code at [URL unfurl="true"]http://www.vbip.com/winsock/winsock_uucode_04.asp[/URL]
LOCAL lnLines, laLines[1], lcOut, lnI, lnJ
LOCAL strDataLine, intSymbols, strTemp
*Remove first marker
If Left(strUUCodeData, 6) = "begin "
strUUCodeData = Mid(strUUCodeData, _
InStr(1, strUUCodeData, vbLf) + 1)
EndIf
*Remove marker of the attachment's end
If Right(strUUCodeData, 5) = "end" + chr(13)+chr(10)
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 = Mid(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
Function UUEncode( strFilePath )
LOCAL strFileName, strFileData, i, j, lEncodedLines, ;
strTempLine, lFileSize, strResult, strChunk
*Get file name
strFileName = JustFName(strFilePath)
strFileData = FileToStr(strFilePath)
*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
*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
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