Tweet
modified from send email found in forums. Sorry, I do not recall the original author. Modified to allow the priority to be set in the email:
Code:
#IF 00 ' Usage
W_Email_Result = Email_Send($S_Email_Host , _ ' Mailhost URL
S_FTERequestor_Email , _ ' Sender email address
S_FTERecipient_Email , _ ' Receiver email address "[email protected]"
S_UrgencyPrefix + "FTE TUL Request..." , _ ' Message header
S_Email_Message , _ ' Message text ($Cr separated)
"" , _ ' Attachment files ($Cr separated)
n_Email_Priority ) ' email priority
#ENDIF
DECLARE FUNCTION Email_Send(BYVAL S_Host AS STRING , _ ' Mailhost URL
BYVAL S_Fr AS STRING , _ ' Sender email address
BYVAL S_To AS STRING , _ ' Receiver email address
BYVAL S_Subject AS STRING , _ ' Message header
BYVAL S_Message AS STRING , _ ' Message text ($Cr separated)
BYVAL S_Attachments AS STRING , _ ' Attachment files ($Cr separated)
BYVAL n_Priority AS LONG ) AS LONG ' email priority, 03 normal, 01 HOT
DECLARE FUNCTION Email_Date AS STRING
DECLARE FUNCTION Email_MimeEncode(BYVAL S_FileData AS STRING) AS STRING
FUNCTION Email_Date AS STRING
' Retrieve the current time and date in E-mail header format
LOCAL szFormat AS ASCIIZ * 40, szTemp AS ASCIIZ * 40, sResult AS STRING
LOCAL t AS SYSTEMTIME, sUCTOffset AS STRING, tzi AS TIME_ZONE_INFORMATION
GetLocalTime t
szFormat = "ddd',' dd MMM yyyy"
GetDateFormat %LOCALE_USER_DEFAULT, 0, t, szFormat, szTemp, SIZEOF(szTemp)
sResult = szTemp
szFormat = "HH':'mm':'ss"
GetTimeFormat %LOCALE_USER_DEFAULT, 0, t, szFormat, szTemp, SIZEOF(szTemp)
SELECT CASE GetTimeZoneInformation(tzi)
CASE %TIME_ZONE_ID_DAYLIGHT
sUCTOffset = IIF$((tzi.bias + tzi.DaylightBias) <= 0, "+", "-") _
+ FORMAT$(ABS(tzi.bias + tzi.DaylightBias) \ 60, "00") _
+ FORMAT$(ABS(tzi.bias + tzi.DaylightBias) MOD 60, "00")
CASE %TIME_ZONE_ID_STANDARD
sUCTOffset = IIF$((tzi.bias + tzi.StandardBias) <= 0, "+", "-") _
+ FORMAT$(ABS(tzi.bias + tzi.StandardBias) \ 60, "00") _
+ FORMAT$(ABS(tzi.bias + tzi.StandardBias) MOD 60, "00")
CASE ELSE
sUCTOffset = "-0000"
END SELECT
FUNCTION = sResult + " " + szTemp + " " + sUCTOffset
END FUNCTION
FUNCTION Email_MimeEncode(BYVAL S_FileData AS STRING) AS STRING
LOCAL lBlock, lcBlocks, lByte1, lByte2, lByte3, lIndex1, lIndex2, lIndex3, lIndex4 AS LONG
LOCAL pInput, pOutput , pTable AS BYTE PTR
LOCAL sBase64, sResult, Pad AS STRING
sBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ' Base64 table
Pad = STRING$(2 - (LEN(S_FileData) - 1) MOD 3, "=") ' Calculate padding on Base64 stream
lcBlocks = (LEN(S_FileData) + 2) \ 3 ' Round up the length of the input
IF lcBlocks * 3 > LEN(S_FileData) THEN ' data to a multiple of three
S_FileData = LSET$(S_FileData, lcBlocks * 3 USING $NUL)
END IF
sResult = SPACE$(lcBlocks * 4) ' Allocate space for output string
pInput = STRPTR(S_FileData) ' Set up pointers so we can treat
pOutput = STRPTR(sResult) ' the data as byte streams
pTable = STRPTR(sBase64)
FOR lBlock = 1 TO lcBlocks ' Loop through the input buffer
lByte1 = @pInput : INCR pInput ' Get the next three binary data-
lByte2 = @pInput : INCR pInput ' bytes to process
lByte3 = @pInput : INCR pInput
lIndex1 = lByte1 \ 4 ' Translate 3 databytes to 4 Base64
lIndex2 = (lByte1 AND 3) * 16 + lByte2 \ 16 ' table indices
lIndex3 = (lByte2 AND 15) * 4 + lByte3 \ 64
lIndex4 = lByte3 AND 63
@pOutput = @pTable[lIndex1] : INCR pOutput ' Use Base64 table to encode the
@pOutput = @pTable[lIndex2] : INCR pOutput ' output string
@pOutput = @pTable[lIndex3] : INCR pOutput
@pOutput = @pTable[lIndex4] : INCR pOutput
NEXT lBlock
RSET ABS sResult = Pad ' Merge in the padding bytes
FUNCTION = sResult
END FUNCTION
FUNCTION Email_Send(BYVAL S_Host AS STRING , _ ' Mailhost URL
BYVAL S_Fr AS STRING , _ ' Sender email address
BYVAL S_To AS STRING , _ ' Receiver email address
BYVAL S_Subject AS STRING , _ ' Message header
BYVAL S_Message AS STRING , _ ' Message text ($Cr separated)
BYVAL S_Attachments AS STRING , _ ' Attachment files ($Cr separated)
BYVAL n_Priority AS LONG ) AS LONG ' email priority, 03 normal, 01 HOT
LOCAL lLine AS LONG , nTCP AS LONG , sAttachment AS STRING, hFile AS DWORD
LOCAL sLocalHost AS STRING , sResponse AS STRING , sBoundary AS STRING
LOCAL Cnt AS LONG , sPart AS STRING , sCut AS STRING, sFile AS STRING
sBoundary = "Boundary." + REMOVE$(GUIDTXT$(GUID$), ANY "{-}") ' Make a unique filedata boundarymarker
nTCP = FREEFILE ' Connect to E-mailserver (mailhost)
TCP OPEN "smtp" AT S_Host AS nTCP : IF ERR THEN EXIT FUNCTION
TCP LINE nTCP, sResponse
IF LEFT$(sResponse, 3) <> "220" THEN EXIT FUNCTION
HOST NAME TO sLocalHost ' Get the local host name
TCP PRINT nTCP, "HELO " + sLocalHost ' Greet the mailhost
TCP LINE nTCP, sResponse
IF LEFT$(sResponse, 3) <> "250" THEN EXIT FUNCTION
TCP PRINT nTCP, "MAIL FROM:<" + S_Fr + ">" ' Tell the mailhost who we are
TCP LINE nTCP, sResponse
IF LEFT$(sResponse, 3) <> "250" THEN EXIT FUNCTION
sPart = S_To
FOR Cnt = 0 TO TALLY (S_To, ",")
SCut = EXTRACT$(sPart, ",")
TCP PRINT nTCP, "RCPT TO:<" + sCut + ">" ' Tell mailhost who message is for
TCP LINE nTCP, sResponse
IF LEFT$(sResponse, 3) <> "250" THEN EXIT FUNCTION
sPart = REMAIN$(sPart, ",")
NEXT sPart
TCP PRINT nTCP, "DATA" ' Send the message
TCP LINE nTCP, sResponse
IF LEFT$(sResponse, 3) <> "354" THEN EXIT FUNCTION
TCP PRINT nTCP, "Date: " + Email_Date ' The E-mail header
TCP PRINT nTCP, "From: " + S_Fr
TCP PRINT nTCP, "To: " + S_To
TCP PRINT nTCP, "Subject: " + S_Subject
TCP PRINT nTCP, "X-Mailer: Arcovox MIME/Base64 E-mailer 1.0"
TCP PRINT nTCP, "MIME-Version: 1.0"
' http://www.powerbasic.com/support/pbforums/showthread.php?t=39781
' You set the priority as header fields in the email (same as Date:, Content-Type: etc). There are a few possibilities depending on the email client. For example Outlook seems to send:
' X-Priority: 1 (Highest)
' X-MSMail-Priority: High
' Importance: High
' X-Priority has a scale of 1 (Highest) to 5 (Low) with 3 (Normal). You only need the number, but adding the brackets and text shouldn't affect how the header is read by the client.
TCP PRINT nTCP, "X-Priority: " + STR$(n_Priority)
'TCP PRINT nTCP, "X-Priority: 1 (Highest)"
TCP PRINT nTCP, "Content-Type: multipart/mixed; boundary=" + $DQ + sBoundary + $DQ
TCP PRINT nTCP, ""
TCP PRINT nTCP, "--" + sBoundary
' Create a Plain-text section
TCP PRINT nTCP, "Content-Type: text/plain; charset=" + $DQ + "us-ascii" + $DQ
TCP PRINT nTCP, "Content-Transfer-Encoding: 7bit"
TCP PRINT nTCP, ""
' Create a main E-mail body section
sPart = S_Message
FOR Cnt = 0 TO TALLY(sPart, $CR)
sCut = EXTRACT$(sPart, $CR)
TCP PRINT nTCP, sCut
sPart = REMAIN$(sPart, $CR)
NEXT Cnt
IF NOT S_Attachments = "" THEN
' Create the attachment body section
sPart = S_Attachments
FOR Cnt = 0 TO TALLY(S_Attachments, $CR)
sCut = EXTRACT$(sPart, $CR)
sPart = REMAIN$(sPart, $CR)
DIR$ CLOSE
IF DIR$(sCut) <> "" THEN
OPEN sCut FOR BINARY ACCESS READ LOCK SHARED AS #hFile 'Read the target file
GET$ #hFile, LOF(hFile), sAttachment '
CLOSE #hFile '
IF LEN (sAttachment) > 0 THEN
sAttachment = Email_MimeEncode(sAttachment) 'Encode filedata in Base64 for MIME
sFile = sCut
WHILE INSTR(sFile, ANY "\:")
sFile = RIGHT$(sFile, LEN(sFile) -1)
WEND
TCP PRINT nTCP, "--" + sBoundary
TCP PRINT nTCP, "Content-Type: application/octet-stream; name=" + $DQ + sFile + $DQ
TCP PRINT nTCP, "Content-Transfer-Encoding: base64"
TCP PRINT nTCP, ""
' Write the encoded data in lines of 76 characters. Add an equality character if the last line is less than 76 bytes long
FOR lLine = 1 TO LEN(sAttachment) STEP 76
IF LEN(sAttachment) - lLine >= 76 THEN
TCP PRINT nTCP, MID$(sAttachment, lLine, 76)
ELSE
TCP PRINT nTCP, MID$(sAttachment, lLine) + "="
END IF
NEXT lLine
END IF
END IF
NEXT Cnt
TCP PRINT nTCP, "--" + sBoundary + "--" 'Send the terminating boundary marker
END IF
TCP PRINT nTCP, "." 'Now finish E-mail off; we're done sending the message
TCP LINE nTCP, sResponse
IF LEFT$(sResponse, 3) <> "250" THEN EXIT FUNCTION
TCP PRINT nTCP, "QUIT" 'Say goodbye
TCP LINE nTCP, sResponse
IF LEFT$(sResponse, 3) <> "221" THEN EXIT FUNCTION
TCP CLOSE nTCP
FUNCTION = -1
END FUNCTION
Comment