Still having problems sending Tsmtp e-mail .. if SMTP reports an address failure ..like send to and cc are the same address .. failure() does not seem to work and then subsequent e-mail in the same session seems to fail.
This only occurs when you send two e-mails within the same application session .. and the first one fails .. something is just not trapping the code or closing the socket ..
Really at a loss here if anyone can help.
Here is my code
oWndMdi:SetMsg( "Sending Project ADD noticication to "+cTO )
WSAStartup()
oOutMail := TSmtp():New( cIP := GetHostByName( cHOST ) )
oOutMail:bConnecting := { || oWndMdi:SetMsg( "Connecting to "+cHOST ) }
oOutMail:bConnected := { || oWndMdi:SetMsg( "Connected" ) }
oOutMail:bDone := { || oWndMdi:SetMsg( "Message sent successfully" ) }
oOutMail:bFailure := { || oOutMail:nStatus := 7 }
oOutMail:SendMail( cFROM,; // From
{ cTO },; //, cPMOEMAIL, cSPOEMAIL },; // To
cMESSAGE,; // Msg Text
cSUBJECT,;
{"C:\DBTMP\PROJINFO.BAT"},; // attachment
aCC, ; // cc
{ }, ; // bc
.F., ; // no return receipt
NIL ) // not html
Here is tsmtp class code from 8.11
- Code: Select all Expand view
// FiveWin Internet outgoing mail Class
// Modified by Luis Krause July 5, 2001; February 26, 2002; October 7, 2002; November 5, 2002;
// October 9, 2003; June 1, 2005, March 26, 2008
// with code from Alex Shaft, Byron Hopp, Andrew Ross (PipleLine Solutions),
// Frank Demont, Peter Kohler, Rafael Gaona, Joaquim Ferrer,
// Jos‚ Lal¡n, Ray Alich (IBTC), Ignacio Vizca¡no Tapia and others
// Special thanks to Jorge Mason for the fix to GetHostByAddress() that was GPFing on some servers
// Simple Authentication and Security Layer [SASL]
// This class only supports LOGIN type for authentication.
// TODO: Add PLAIN and MD5 methods.
// PLAIN is the same as LOGIN but it doesn't use base64, i.e.:
// AUTH LOGIN -> USER cMimeEnc( ::cUser )
// AUTH PLAIN -> USER ::cUser
// See rfc2554.txt for more details about ESMTP
// [jlalin]
#include "FiveWin.ch"
#ifndef __CLIPPER__
#xtranslate Memory(<n>) => // only needed with Clipper, not [x]Harbour
#endif
// different session status
#define ST_INIT 0
#define ST_CONNECTED 1
#define ST_RESET 2
#define ST_MAILFROM 3
#define ST_RCPTTO 4
#define ST_DATA 5
#define ST_SENT 6
#define ST_QUIT 7
#define ST_DONE 8
#define ST_ERROR 9
// Authentication states
#define ST_AUTH0 10 // IBTC
#define ST_AUTH 11 // [jlalin]
#define ST_USER 12 // [jlalin]
#define ST_PASS 13 // [jlalin]
// Last defined state
#define ST_LAST ST_PASS // [jlalin]
#define MSG_CAPTION "SMTP Services"
//----------------------------------------------------------------------------//
CLASS TSmtp
DATA oSocket AS OBJECT // socket used during the mail session
DATA cIPServer AS String // IP of the mail server
DATA cFrom AS String // Sender email address
DATA aTo AS ARRAY INIT NIL // Array of strings for each recipient email address
DATA aCC AS ARRAY INIT NIL
DATA aBCC AS ARRAY INIT NIL
DATA cReplyTo AS String // added by LKM Sep/28/2002
DATA lReceipt AS LOGICAL // added by LKM Sep/25/2002
DATA nStatus AS NUMERIC // Temporary session status
DATA nTo AS NUMERIC // Temporary recipient index into aTo recipients array
DATA nCC AS NUMERIC
DATA nBCC AS NUMERIC
DATA cMsg AS String // Msg Text to send
DATA cHTML AS String // Html Text to Send - added by RRG 29.05.2002
DATA cSubject AS String // msg subject
DATA dDate AS String // msg date
DATA cTime AS String // msg time
DATA nGMT AS NUMERIC // GMT deviation
DATA cPriority AS String // msg priority: normal, high, low
DATA aFiles AS ARRAY INIT NIL // Attached files
DATA bConnecting AS CODEBLOCK INIT NIL // Action to perform while trying to connect
DATA bConnected AS CODEBLOCK INIT NIL // Action to perform when already connected
DATA bDone AS CODEBLOCK INIT NIL // Action to perform when Msg has been already sent
DATA bFailure AS CODEBLOCK INIT NIL
DATA lTxtAsAttach AS LOGICAL // .T. to force Txt files as Attachments; .F. to force as Inline
DATA cReceived AS String INIT "" // added by AS
DATA acReply AS ARRAY INIT {} // added by AS
DATA cError AS String INIT "" // added by AS
DATA cMailer // Mailer Name added by Pipeline
DATA cClient // Mail Client Name added by Pipeline
DATA nDelay AS NUMERIC INIT 0 // added by LKM Sep/28/2002, based on RG's idea (see mods to TSocket class)
DATA cUser AS String INIT "" // [jlalin]
DATA cPassword AS String INIT "" // [jlalin]
// We can only log in one time per session
DATA lAuth AS LOGICAL // [jlalin]
DATA lDoAuth AS LOGICAL // IBTC
METHOD New( cIPServer, nPort, lAuth, cUser, cPassword ) CONSTRUCTOR
METHOD End() INLINE ; // added by LKM
If( ::oSocket # Nil, ::oSocket:End(), Nil )
METHOD OnRead( oSocket, nWSAError )
METHOD OnConnect( oSocket, nWSAError ) // added by LKM see TSocket class
METHOD SendMail( cFrom, aTo, cMsg, cSubject, aFiles, aCC, aBCC, lReceipt, cHTML ) // added CC, BCC and Return Receipt capability LKM; cHTML added by RRG
METHOD Priority()
METHOD Failure( oSocket, nWSAError, cReply ) HIDDEN // called from OnRead when failure occurs
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( cIPServer, nPort, lAuth, cUser, cPassword ) CLASS TSmtp
Default nPort := 25, ;
lAuth := .F., ; // IBTC
cUser := "", ; // [jlalin]
cPassword := "" // [jlalin]
If Empty( cIPServer ) // nil or ""
cIPServer := "0.0.0.0"
Endif
::lAuth := .F. // IBTC
::lDoAuth := lAuth // IBTC
::cUser := AllTrim( cUser ) // [jlalin]
::cPassword := AllTrim( cPassword ) // [jlalin]
::oSocket := TSocket():New( nPort )
::oSocket:bRead := {|o,n| ::OnRead( o, n ) }
::oSocket:bConnect := {|o,n| ::OnConnect( o, n ) } // lkm - see adjustment to TSocket class
// by lkm now you can provide either the IPAddress or the server name (friendly name)
::cIPServer := If( IsAlpha( cIPServer ), GetHostByName( AllTrim( cIPServer ) ), cIPServer )
::nStatus := ST_INIT
// predefined events actions
::bDone := {|| MsgInfo( ;
"Message successfully sent through " + ::cIPServer + CRLF + ;
GetHostByAddress( ::cIPServer ), MSG_CAPTION ) }
::bFailure := {|| ;
MsgStop( "Session did not complete successfully" + CRLF + CRLF + ::cError, MSG_CAPTION ) }
::lTxtAsAttach := .T. // force text files as attachments, not inline
Return Self
//----------------------------------------------------------------------------//
METHOD OnRead( oSocket, nWSAError ) CLASS TSmtp
Local cData
Local nI
Local nPos := 0, cReply, cExt, cAns
Local bReply := {|| AScan( ::acReply, {|cTxt| Left( cTxt, 3 ) == cAns } ) > 0 }
Local cTmpFile
If oSocket == Nil // random error with [x]Harbour
::Failure()
Return Nil // avoid r/t error
Endif
cData := oSocket:GetData()
// Buffer received data
::cReceived += cData
// Pull out full lines received
Do While ( nPos := At( CRLF, ::cReceived ) ) > 0
AAdd( ::acReply, Left( ::cReceived, nPos - 1 ) )
::cReceived := SubStr( ::cReceived, nPos + 2 )
Enddo
// Has closing line been received?
If ATail( ::acReply ) == Nil .or. ; // rare, but s**t happens
! SubStr( ATail( ::acReply ), 4, 1 ) == " "
If( ATail( ::acReply ) == Nil, ::acReply := {}, Nil )
Return Nil
Endif
cReply := Left( ATail( ::acReply ), 3 )
Do Case
Case ::nStatus == ST_INIT // Socket Connection being established
If cReply == "220" // SMTP Server Ready and waiting
oSocket:SendData( "HELO " + ::cClient + CRLF ) // ::cFrom has "@" which some servers don't like Andrew W. Ross <awr@jps.net>
If ! ::lDoAuth // IBTC
::nStatus := ST_CONNECTED
Endif
If ::bConnected != nil
Eval( ::bConnected )
Endif
If ::lDoAuth // IBTC
// [jlalin]
// If we pass User and Password we ask the server for authenticacion
// if cReply == "530"
If ! Empty( ::cUser ) .and. ! Empty( ::cPassword )
If ! ::lAuth // We are not authenticated yet
oSocket:SendData( "AUTH LOGIN" + CRLF )
::nStatus := ST_AUTH0
Endif
Endif
//endif
Endif
Else
::Failure( oSocket, nWSAError, cReply )
Endif
// IBTC
Case ::nStatus == ST_AUTH0
If SubStr( cData, 1, 3 ) == "250" .or. Eval( bReply, cAns := "334" )
::nStatus := ST_AUTH
Else
::nStatus := ST_QUIT
Endif
// [jlalin]
Case ::nStatus == ST_AUTH
If SubStr( cData, 1, 3 ) == "334"
// User and Pass must be encoded in base64
oSocket:SendData( cMimeEnc( ::cUser ) + CRLF )
::nStatus := ST_USER
Else
::nStatus := ST_QUIT
Endif
// [jlalin]
Case ::nStatus == ST_USER
If SubStr( cData, 1, 3 ) == "334"
oSocket:SendData( cMimeEnc( ::cPassword ) + CRLF )
::nStatus := ST_PASS
Else
::nStatus := ST_QUIT
Endif
// [jlalin]
Case ::nStatus == ST_PASS
If SubStr( cData, 1, 3 ) == "235" // // Allright. Server supports authentication
::nStatus := ST_CONNECTED
::lAuth := .T. // We are authenticate, proceed with connection.
oSocket:SendData( CRLF )
Else //if SubStr( cData, 1, 3 ) == "535" // Auth failure
::Failure( oSocket, nWSAError, cReply )
Endif
// case ::nStatus == ST_CONNECTED
// oSocket:SendData( "RSET" + CRLF )
// ::nStatus := ST_RESET
Case ::nStatus == ST_CONNECTED .or. ::nStatus == ST_RESET
If cReply == "250" // Server happy with our repsonse. Start mail send.
oSocket:SendData( StrTran( "MAIL FROM:<%>", "%", CleanEMail( ::cFrom ) ) + CRLF )
::nStatus := ST_MAILFROM
::nTo := 1 // First recipient index to send mail to
::nCC := 1
::nBCC := 1
Elseif Val( cReply ) > 400 .and. ::nStatus == ST_CONNECTED
::nStatus := ST_RESET
oSocket:SendData( "EHLO " + ::cClient + CRLF ) // don't use ::cFrom (see note above)
Else
::Failure( oSocket, nWSAError, cReply )
Endif
Case ::nStatus == ST_MAILFROM .or. ::nStatus == ST_RCPTTO
If cReply == "250" .or. cReply == "251" // Server happy with our repsonse
If ::nTo <= Len( ::aTo )
oSocket:SendData( StrTran( "RCPT TO:<%>", "%", CleanEMail( ::aTo[ ::nTo ] ) ) + ;
CRLF )
::nStatus := ST_RCPTTO
::nTo++
Elseif ::nCC <= Len( ::aCC )
oSocket:SendData( StrTran( "RCPT TO:<%>", "%", CleanEMail( ::aCC[ ::nCC ] ) ) + ;
CRLF )
::nStatus := ST_RCPTTO
::nCC++
Elseif ::nBCC <= Len( ::aBCC )
oSocket:SendData( StrTran( "RCPT TO:<%>", "%", CleanEMail( ::aBCC[ ::nBCC ] ) ) + ;
CRLF )
::nStatus := ST_RCPTTO
::nBCC++
Else
::nStatus := ST_DATA
oSocket:SendData( "DATA" + CRLF )
Endif
Else
::Failure( oSocket, nWSAError, cReply )
Endif
Case ::nStatus == ST_DATA
If cReply == "354" // Ready to accept data
Default ::cMsg := "", ::cSubject := "[no subject]", ::cHTML := "", ;
::dDate := Date(), ::cTime := Time(), ;
::nGMT := 0, ::cPriority := "Normal"
oSocket:SendData( "From: " + ::cFrom + CRLF + ;
If( ! Empty( ::cReplyTo ), ;
"Reply-To: " + CleanEMail( ::cReplyTo ) + CRLF, "" ) + ;
AToStr( ::aTo, "To: " ) + ;
AToStr( ::aCC, "CC: " ) + ;
/*AToStr( ::aBCC, "BCC: " ) +*/ ; // or it wouldn't be a blind carbon copy at all <g>
"Subject: " + ::cSubject + CRLF + ;
"Date: " + DTtoEDT( ::dDate, ::cTime, ::nGMT ) + CRLF + ;
"MIME-Version: 1.0" + CRLF + ;
If( ::lReceipt, ;
"Disposition-Notification-To: " + ::cFrom + CRLF, "" ) + ;
"X-MSMail-Priority: " + ::cPriority + CRLF + ;
"X-Priority: " + LTrim( Str( ::Priority() ) ) + CRLF + ;
"X-Mailer: " + ::cMailer + CRLF + ;
If( ! Empty( ::aFiles ) .or. ! Empty( ::cHTML ), ;
"Content-Type: multipart/mixed; " + ;
'boundary="NextPart"' + CRLF + CRLF + ;
"This is a multi-part message in MIME format." + CRLF + CRLF + ;
"--NextPart" + CRLF, "" ) + ;
If( ! Empty( ::cMsg ), ;
"Content-Type: text/plain; " + ;
'charset="iso-8859-1"' + CRLF + ;
"Content-Transfer-Encoding: 7bit" + CRLF + CRLF + ;
::cMsg + CRLF, "" ) )
If ! Empty( ::cHTML ) // RRG 29.05.2002 Send as HTML sytle email (Cambios para enviar correo como html)
oSocket:SendData( CRLF + "--NextPart" + CRLF + ;
"Content-Type: text/html; " + ;
'charset="iso-8859-1"' + CRLF + ;
"Content-Transfer-Encoding: quoted-printable" + CRLF + CRLF + ;
FormHtml( ::cHTML, ::cSubject, ::cMailer ) + CRLF )
Endif
For nI := 1 To Len( ::aFiles )
If File( ::aFiles[ nI ] )
cExt := Upper( cFileExt( ::aFiles[ nI ] ) )
If ( cExt == "TXT" .or. cExt == "LOG" .or. cExt == "HTM" ) .and. ! ::lTxtAsAttach
oSocket:SendData( CRLF + "--NextPart" + CRLF + ;
"Content-Type: " + DocType( cExt ) + ;
'name="' + ::aFiles[ nI ] + '"' + CRLF + ;
"Content-Transfer-Encoding: " + If( cExt == "HTM", "7bit", "quoted-printable" ) + CRLF + ;
"Content-Disposition: inline; " + ; // LKM was attachment
'filename="' + cFileNoPath( ::aFiles[ nI ] ) + '"' + CRLF + CRLF )
oSocket:SendFile( ::aFiles[ nI ],, ::nDelay )
Else
oSocket:SendData( CRLF + "--NextPart" + CRLF + ;
"Content-Type: " + DocType( cExt ) + ;
'name="' + ::aFiles[ nI ] + '"' + CRLF + ;
"Content-Transfer-Encoding: base64" + CRLF + ;
"Content-Disposition: attachment; " + ; // LKM was inline
'filename="' + cFileNoPath( ::aFiles[ nI ] ) + '"' + CRLF + CRLF )
cTmpFile := TmpFile() // ivt (based on his fix)
FMimeEnc( ::aFiles[ nI ], cTmpFile )
oSocket:SendFile( cTmpFile,, ::nDelay )
FErase( cTmpFile )
Endif
Endif
Next
oSocket:SendData( CRLF + ;
If( ! Empty( ::aFiles ), "--NextPart--" + CRLF + CRLF, "" ) + ;
CRLF + "." + CRLF ) // the dot signals the server the mail ends here (leave the CRLF before the dot!)
::nStatus := ST_SENT
// the following to avoid a huge delay (5 minutes or more if the server times out!)
If oSocket:nRetCode == -1 // most likely the attachment(s) choked the server; increment ::nDelay by one until it works
AAdd( ::acReply, "421 4.4.2 Timeout while waiting for command. Increase ::nDelay" )
::Failure( oSocket, 10060, "421" ) // i.e. WSAETIMEDOUT
Endif
Else
::Failure( oSocket, nWSAError, cReply )
Endif
Case ::nStatus == ST_SENT
If cReply == "250" .or. Eval( bReply, cAns := "250" ) // Server happy with our repsonse (sometimes ::acReply has two elements: "250" and "500", so we can safely asume everything is ok)
::nStatus := ST_QUIT // swapped with next line (Peter Kohler)
oSocket:SendData( "QUIT" + CRLF )
Else
::Failure( oSocket, nWSAError, cReply )
Endif
Case ::nStatus == ST_QUIT
If cReply == "221" .or. cReply == "500" .or. cReply == "502" .or. cReply == "550" // 500/550 is "unknown command" and doesn't really matter at this stage
::nStatus := ST_DONE
If ::bDone != nil
Eval( ::bDone )
Endif
::oSocket:End()
Else
::Failure( oSocket, nWSAError, cReply )
Endif
EndCase
::acReply := {}
Return Nil
//----------------------------------------------------------------------------//
METHOD OnConnect( oSocket, nWSAError )
Local cHost
If nWSAError # 0
cHost := GetHostByAddress( ::cIPServer )
AAdd( ::acReply, "Could not establish connection to " + If( Empty( cHost ), ::cIPServer, cHost ) )
::Failure( oSocket, nWSAError )
Endif
Return Nil
//----------------------------------------------------------------------------//
METHOD SendMail( cFrom, aTo, cMsg, cSubject, aFiles, aCC, aBCC, lReceipt, cHTML ) CLASS TSmtp
Default aTo := {}, aCC := {}, aBCC := {}, aFiles := {}, lReceipt := .F.
Default ::cClient := "smtp-client"
Default ::cMailer := "FiveWin Mailer"
::cFrom := AllTrim( cFrom )
::aTo := aTo
::cMsg := cMsg
::cSubject := cSubject
::aFiles := aFiles
::aCC := aCC
::aBCC := aBCC
::lReceipt := lReceipt
::cHTML := cHTML //RRG 29.05.2002 send HTML style email (envio de email tipo html)
If Empty( cFrom )
If( ::oSocket # Nil, ::oSocket:End(), Nil )
MsgStop( "No sender was specified" + CRLF + ;
"Message won't be sent", MSG_CAPTION )
Elseif Empty( aTo ) .and. Empty( aCC ) .and. Empty( aBCC )
If( ::oSocket # Nil, ::oSocket:End(), Nil )
MsgStop( "No recipients were specified" + CRLF + ;
"Message won't be sent", MSG_CAPTION )
Elseif ::cIPServer == "0.0.0.0" .or. Empty( GetHostByAddress( ::cIPServer ) )
If( ::oSocket # Nil, ::oSocket:End(), Nil )
MsgStop( "The IP address " + ::cIPServer + " could not be resolved" + CRLF + ;
"Make sure you're connected to the internet and" + CRLF + ;
"check the firewall settings if applicable", MSG_CAPTION )
Else
If ::bConnecting != nil
Eval( ::bConnecting )
Endif
::nStatus := ST_INIT
::acReply := {}
::cReceived := ""
* Memory(-1) // cleanup memory when sending one after another
If ::oSocket # Nil
::oSocket:Connect( ::cIPServer )
Else
::Failure()
Endif
Endif
Return Nil
//----------------------------------------------------------------------------//
METHOD Priority() CLASS TSmtp
Local nType
Do Case
Case Upper( ::cPriority ) == "HIGH"
nType := 1
Case Upper( ::cPriority ) == "LOW"
nType := 5
Otherwise
nType := 3
EndCase
Return nType
//----------------------------------------------------------------------------//
METHOD Failure( oSocket, nWSAError, cReply ) CLASS TSmtp
Local aStage := { "ST_INIT", ;
"ST_CONNECTED", ;
"ST_RESET", ;
"ST_MAILFROM", ;
"ST_RCPTTO", ;
"ST_DATA", ;
"ST_SENT", ;
"ST_QUIT", ;
"ST_DONE", ;
"ST_ERROR", ;
"ST_AUTH0", ;
"ST_AUTH", ;
"ST_USER", ;
"ST_PASS" }
Default oSocket := ::oSocket, nWSAError := WSAGetLastError(), cReply := ""
If ::nStatus >= ST_INIT .and. ::nStatus <= ST_LAST
::cError := "Stage: " + aStage[ ::nStatus + 1 ] + CRLF
Else
::cError := ""
Endif
::nStatus := ST_ERROR
::cError += "IP Address: " + ::cIPServer + CRLF + CRLF
AEval( ::acReply, {|cReply| ::cError += cReply + CRLF } )
If nWSAError # 0
::cError += "WSA Error Code: " + AllTrim( Str( nWSAError ) )
Endif
/*
If ::bFailure # Nil
Eval( ::bFailure )
Endif
If( oSocket # Nil, oSocket:End(), Nil )
*/
// Antonio suggested change here ...
If ::bFailure != nil
Eval( ::bFailure, oSocket, nWSAError, cReply )
Endif
oSocket:End()
Return Self
//----------------------------------------------------------------------------//
Static Function DTtoEDT( dDate, cTime, nGMT )
Local aWeek := { "Sun", "Mon", "Tue", "Wed", "Thu", "Fry", "Sat" }
Local aMonth := { "Jan", "Feb", "Mar", "Apr", "May", "Jun", ;
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }
Local cGMT
If nGMT != 0
cGMT := " " + If( nGMT > 0, "+" , "-" ) + StrZero( Abs( nGMT ), 2 ) + "00"
Else
cGMT := ""
Endif
Return aWeek[ Dow( dDate ) ] + ", " + LTrim( Str( Day( dDate ) ) ) + " " + ;
aMonth[ Month( dDate ) ] + " " + LTrim( Str( Year( dDate ) ) ) + " " + ;
cTime + cGMT
//----------------------------------------------------------------------------//
Static Function Today( nGMT )
Local dDate := Date(), cGMT
If nGMT != 0
cGMT := " " + If( nGMT > 0, "+" , "-" ) + StrZero( Abs( nGMT ), 2 ) + "00"
Else
cGMT := ""
Endif
Return SubStr( CDoW( dDate ), 1, 3 ) + ", " + ;
LTrim( Str( Day( dDate ), 2 ) ) + " " + ;
SubStr( CMonth( dDate ), 1, 3 ) + " " + ;
Str( Year( dDate ), 4 ) + " " + ;
Time() + cGMT
//----------------------------------------------------------------------------//
Static Function AToStr( aArray, cPrefix )
Local cStr := "", nI, nLen := Len( aArray )
Default cPrefix := ""
If nLen > 0
cStr := cPrefix
Endif
For nI := 1 To nLen
cStr += AllTrim( aArray[nI] ) + If( nI < nLen, ", ", "" )
Next
cStr += If( ! Empty( cStr ), CRLF, "" )
Return cStr
//----------------------------------------------------------------------------//
Static Function DocType( cExt )
Local cType
If cExt $ "EXE*COM*OBJ*LIB*DLL*VBX*OCX*HLP*CHM"
cType := "application/octet-stream; "
Elseif cExt $ "ZIP*ARC*ZOO*TAR"
cType := "application/x-zip-compressed; "
Elseif cExt $ "HTM*HTML*SHT*SHTML*MHT*MHTML"
cType := "text/html; "
Elseif cExt == "CSS"
cType := "text/css; "
Elseif cExt $ "XML*XSL"
cType := "text/xml; "
Elseif cExt $ "TXT*TEXT*LOG*BAT"
cType := "text/plain; "
Elseif cExt == "PDF"
cType := "application/pdf; "
Elseif cExt $ "BMP*DIB"
cType := "application/bmp; "
Elseif cExt == "GIF"
cType := "image/gif; "
Elseif cExt $ "JPG*JPE**JPEG*JFI*JFIF*PJP"
cType := "image/jpeg; "
Elseif cExt $ "XLS*XLT*XLA*XLB*XLC*XLL*XLM*XLW"
cType := "application/x-msexcel; "
Elseif cExt $ "PPT*PPS*POT*PWZ"
cType := "application/x-mspowerpoint; "
Elseif cExt $ "MPG*MPE*MPEG*M1S*M1A*MP2*MPM*MPA"
cType := "video/mpeg; "
Elseif cExt $ "PIC*PICT*PCT"
cType := "image/pict; "
Elseif cExt == "PNG"
cType := "image/png; "
Elseif cExt $ "MOV*QT*QTL*QTS*QTX*QTI*QTI*QTIF*QDA*QDAT*QPX*QTP"
cType := "video/quicktime; "
Elseif cExt $ "TIF*TIFF"
cType := "image/tiff; "
Elseif cExt $ "AVI*VFW"
cType := "video/avi; "
Elseif cExt $ "DOC*RTF*WBK*DOT*WIZ"
cType := "application/msword; "
Elseif cExt $ "RMI*MID*WAV*CDA*MIDI*MP2*MP3*WMA*MJF*MP1*VOC*IT*XM*S3M*STM*MOD*ULT*MTM*HMI*XMI*CMF*MUS*MIZ*HMZ*MSS*GMD*MIDS*HMP"
cType := "audio/mid; "
Else
cType := "application/x-unknown-content-type; "
Endif
Return cType
//----------------------------------------------------------------------------//
Static Function FormHtml( cHTML, cSubject, cMailer )
Local cOpen := "", cClose := ""
If At( "<html>", Lower( cHTML ) ) == 0
cOpen := ;
'<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"' + CRLF + ;
' "http://www.w3.org/TR/1999/REC-html401-19991224/loose.dtd">' + CRLF + ;
'<html>' + CRLF + ;
'<head>' + CRLF + ;
' <title>' + cSubject + '</title>' + CRLF + ;
' <meta http-equiv="Content-Type"' + CRLF + ;
' content="text/html; charset=iso-8859-1">' + CRLF + ;
' <meta name="generator"' + CRLF + ;
' content="' + cMailer + '">' + CRLF + ;
'</head>' + CRLF + ;
'<body>' + CRLF
cClose := ;
CRLF + ;
'</body>' + CRLF + ;
'</html>'
Endif
Return cOpen + cHTML + cClose
//----------------------------------------------------------------------------//
// IBTC: Convert "Your Name <your@email.com>" into "your@email.com"
Static Function CleanEMail( cEMail )
Local nLeft, nRight
If ( nLeft := At( "<", cEMail ) ) > 0
If ( nRight := At( ">", cEMail ) ) > 0
cEMail := SubStr( cEMail, nLeft + 1, nRight - nLeft - 1 )
Else
cEMail := SubStr( cEMail, nLeft + 1 )
Endif
Endif
Return AllTrim( cEMail )
//----------------------------------------------------------------------------//
Static Function TmpFile()
Local cTmpDir := GetEnv( "TEMP" ) + "\" // LK Mar/26/2008 added path to avoid file being created in _SET_DEFAULT directory
Local cTmpName := "__temp"
Do While File( cTmpName := cTmpDir + "__" + StrZero( nRandom( 99999 ), 5 ) + ".tmp" )
Enddo
FClose( FCreate( cTmpName ) )
Return cTmpName
//----------------------------------------------------------------------------//
- Code: Select all Expand view
