Tweet
I've made one Function from the mailfile example, to be used to send single E-mails, and also add one or multiple
attachment files. It works, but I'm not sure if the boundary locations are correct in all cases.
When a stand-alone mail is sent, only an opening boundary is sent; with attachment(s) both opening
and closing boundaries are sent. Also with multiple attachments, a boundary is sent between files...
Is this correct? (want to avoid troubles; I need it to send error loggings from an application, and
the last thing you want that the error-sending itself generates errors...
)
------------------
Regards,
Peter
[This message has been edited by Peter Lameijn (edited September 06, 2005).]
attachment files. It works, but I'm not sure if the boundary locations are correct in all cases.
When a stand-alone mail is sent, only an opening boundary is sent; with attachment(s) both opening
and closing boundaries are sent. Also with multiple attachments, a boundary is sent between files...
Is this correct? (want to avoid troubles; I need it to send error loggings from an application, and
the last thing you want that the error-sending itself generates errors...
)Code:
'================================================================================================== ' MailFile : Send E-mail with a file attachment using TCP statements '================================================================================================== #Compile Exe #Register All #Dim All %USEMACROS = 1 #Include "Win32API.INC" '-------------------------------------------------------------------------------------------------- ' Modify these equates to match your E-mail server and desired E-mail headers. '-------------------------------------------------------------------------------------------------- $mailhost = "smtp.mymailserver.nl" 'The name of your SMTP E-mailserver. $MailFrom = "[email protected]" $MailTo = "[email protected]" $Subject = "Arcovox E-mail, attachment demo" '-------------------------------------------------------------------------------------------------- ' Retrieve the current time and date in E-mail header format '-------------------------------------------------------------------------------------------------- Function MailDate () As String 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 '-------------------------------------------------------------------------------------------------- ' Encode binary file data using Base64 encoding for MIME. '-------------------------------------------------------------------------------------------------- Function MimeEncode (ByVal sFileData 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(sFileData) - 1) Mod 3, "=") 'Calculate padding on Base64 stream lcBlocks = (Len(sFileData) + 2) \ 3 'Round up the length of the input If lcBlocks * 3 > Len(sFileData) Then 'data to a multiple of three sFileData = LSet$(sFileData, lcBlocks * 3 Using $Nul) End If sResult = Space$(lcBlocks * 4) 'Allocate space for output string pInput = StrPtr(sFileData) '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 RSet Abs sResult = Pad 'Merge in the padding bytes Function = sResult End Function '================================================================================================== ' '-------------------------------------------------------------------------------------------------- Function Send_Email(ByVal sHost As String, _ 'Mailhost URL ByVal sFrom As String, _ 'Sender email address ByVal sTo As String, _ 'Receiver email address ByVal sSubject As String, _ 'Message header ByVal sMsgText As String, _ 'Message text ($Cr separated) ByVal sFiles As String) As Long 'Attachment files ($Cr separated) 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 sHost 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:<" + sFrom + ">" 'Tell the mailhost who we are Tcp Line nTCP, sResponse If Left$(sResponse, 3) <> "250" Then Exit Function sPart = sTo For Cnt = 0 To Tally (sTo, ",") 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 Tcp Print nTCP, "DATA" 'Send the message Tcp Line nTCP, sResponse If Left$(sResponse, 3) <> "354" Then Exit Function Tcp Print nTCP, "Date: " + MailDate 'The E-mail header Tcp Print nTCP, "From: " + sFrom Tcp Print nTCP, "To: " + sTo Tcp Print nTCP, "Subject: " + sSubject Tcp Print nTCP, "X-Mailer: Arcovox MIME/Base64 E-mailer 1.0" Tcp Print nTCP, "MIME-Version: 1.0" 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 = sMsgText For Cnt = 0 To Tally(sPart, $Cr) sCut = Extract$(sPart, $Cr) Tcp Print nTCP, sCut sPart = Remain$(sPart, $Cr) Next If (sFiles <> "") Then ' Create the attachment body section sPart = sFiles For Cnt = 0 To Tally(sFiles, $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 = 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 End If End If Next 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 '-------------------------------------------------------------------------------------------------- Function PbMain () As Long Local Result As Long Result = Send_Email($MailHost, $MailFrom, $MailTo, $Subject, _ "Line 1" & $Cr & "Line 2" & $Cr & $Cr & "Line 4", _ "\scratch\makewav2.bak" & $Cr & "mailfile.exe") MsgBox Str$(result) End Function
Regards,
Peter
[This message has been edited by Peter Lameijn (edited September 06, 2005).]
Comment