inspired by a coding question from dige,
I found it a good idea to extend the code of this thread.
I added the possibility to send also HTML e-mails.
SendMail.pbi:
Code: Select all
;- _____________________________________________________________________________
;- | |
;- | SendEmail (New) |
;- | _______________ |
;- | |
;- |___________________________________________________________________________|
;{ SendEmail (New) (Start)
; Author : clipper
; PureBasic 3.93
; Changed to Purebasic 4.61 x86 from Falko
; Sending Mail with SMTP-AUTH + add multiple attachments
; Don´t fill the Username if you don't want authentification
; changed by ts-soft:
; + variabledeclaration (for EnableExplicit)
; + Prefix SendMail_ for Functions and global Vars, __SendMail_ for private Functions
; + compatibility to linux
; + option to set the port in SendMail_SendEmail()
; + Unicode-Support
; ^ fixed many bugs
; + added Structure for SendMail_SendEMail() Parameter
; + added Callback for AttachedFile
; + added Protocol option
; + added timeout
; + cancel on more errors, thx to IdeasVacuum
; + mime-support for MacOS
; + supports multiple recipients
; changed by infratec:
; + added html support
;}
EnableExplicit
Enumeration
#eHlo
#RequestAuthentication
#Username
#Password
#MailFrom
#RcptTo
#Data
#Quit
#Complete
EndEnumeration
Structure SendMail_Parameter
Name.s
Sender.s
Recipient.s
UserName.s
Password.s
SMTPServer.s
Subject.s
Message.s
MessageHtml.s
Port.w
ProgressAttachedFile.i
EnableProtocol.b
EndStructure
Prototype SendMail_Callback(percent.i)
Global NewList SendMail_Attachments.s()
Global SendMail_ConnectionID
Procedure SendMail_AddAttachment(File.s)
AddElement(SendMail_Attachments())
SendMail_Attachments() = File
EndProcedure
Procedure SendMail_NoAttachment()
ClearList(SendMail_Attachments())
EndProcedure
Procedure.s __SendMail_GetMimeType(pExt.s)
; Cross-Platform
; Windows code originally by Kale
; Linux code by Straker
;
; returns as default "application/octet-stream" if Mime Type is not found.
Protected lRetVal.s, lMimeFile.s, lContinue
Protected hKey, lKeyValue.s, lDataSize.l, lLoop
Protected lLof.q, *lMemoryID, lBytesRead, lFileContents.s
Protected lPos1, lPos2, lMimeLen, lMyChar.s, lDefault.s
Protected MimeFile
Protected Dim lExt.s(7)
lContinue = 1
lDefault = "application/octet-stream"
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_MacOS
Select LCase(pExt)
Case "pdf" : lRetVal = "application/pdf"
Case "ai", "eps", "ps" : lRetVal = "application/postscript"
Case "rtf" : lRetVal = "application/rtf"
Case "tar" : lRetVal = "application/x-tar"
Case "zip" : lRetVal = "application/zip"
Case "au", "snd" : lRetVal = "audio/basic"
Case "aif", "aiff", "aifc" : lRetVal = "audio/x-aiff"
Case "wav" : lRetVal = "audio/x-wav"
Case "gif" : lRetVal = "image/gif"
Case "jpg", "jpeg", "jpe" : lRetVal = "image/jpeg"
Case "png" : lRetVal = "image/png"
Case "tiff", "tif" : lRetVal = "image/tiff"
Case "zip" : lRetVal = "multipart/x-zip"
Case "gz", "gzip" : lRetVal = "multipart/x-gzip"
Case "htm", "html" : lRetVal = "text/html"
Case "txt", "g", "h", "c", "cc", "hh", "m", "f90" : lRetVal = "text/plain"
Case "mpeg", "mpg", "mpe" : lRetVal = "video/mpeg"
Case "qt", "mov" : lRetVal = "video/quicktime"
Case "avi" : lRetVal = "video/msvideo "
Case "movie" : lRetVal = "video/x-sgi-movie"
Default
lRetVal = lDefault
EndSelect
CompilerCase #PB_OS_Windows
pExt = ("." + pExt)
lKeyValue = Space(255)
lDataSize = 255
If (RegOpenKeyEx_(#HKEY_CLASSES_ROOT, pExt, 0, #KEY_READ, @hKey))
lKeyValue = lDefault
Else
If RegQueryValueEx_(hKey, "Content Type", 0, 0, @lKeyValue, @lDataSize)
lKeyValue = lDefault
Else
lKeyValue = Left(lKeyValue, (lDataSize - 1))
EndIf
RegCloseKey_(hKey)
EndIf
lRetVal = lKeyValue
CompilerCase #PB_OS_Linux
pExt = LCase(pExt)
lRetVal = lDefault
lMimeFile = "/etc/mime.types"
MimeFile = ReadFile(#PB_Any, lMimeFile)
If MimeFile
lLof = Lof(MimeFile)
*lMemoryID = AllocateMemory(lLof)
If (*lMemoryID)
lBytesRead = ReadData(MimeFile, *lMemoryID, lLof)
lFileContents = PeekS(*lMemoryID, lLof, #PB_UTF8)
Else
lContinue = 0
EndIf
CloseFile(MimeFile)
Else
lContinue = 0
EndIf
If (lContinue = 1)
; find the extension in the /etc/mime.types file
lExt.s(0) = (Space(1) + pExt + Space(1))
lExt.s(1) = (Chr(9) + pExt + Chr(10))
lExt.s(2) = (Chr(9) + pExt + Space(1))
lExt.s(3) = (Chr(9) + pExt + Chr(9))
lExt.s(4) = (Chr(9) + pExt)
lExt.s(5) = (Space(1) + pExt + Chr(10))
lExt.s(6) = (Space(1) + pExt + Chr(9))
lExt.s(7) = (Space(1) + pExt)
lContinue = 0
For lLoop = 0 To 7 Step 1
lPos1 = FindString(lFileContents, lExt.s(lLoop), 1)
If (lPos1 > 0)
lContinue = 1
Break
EndIf
Next
EndIf
If (lContinue = 1)
; found the line - parse the mime type...
For lLoop = 1 To 80 Step 1
If (Mid(lFileContents, (lPos1 - lLoop), 1) = Chr(10))
lPos2 = (lPos1 - lLoop + 1)
Break
EndIf
Next
EndIf
If (lPos2 > 0)
For lLoop = 1 To 80 Step 1
lMyChar = Mid(lFileContents, (lPos2 + lLoop), 1)
If ((lMyChar = Chr(9)) Or (lMyChar = " "))
lMimeLen = lLoop
Break
EndIf
Next
EndIf
If (lMimeLen > 0)
lRetVal = Trim(Mid(lFileContents, lPos2, lMimeLen))
If (Left(lRetVal, 1) = "#")
lRetVal = lDefault
EndIf
EndIf
FreeMemory(*lMemoryID)
CompilerEndSelect
ProcedureReturn lRetVal
EndProcedure
Procedure.s __SendMail_Base64Encode(strText.s)
Protected Result.s
Protected *B64EncodeBufferA = AllocateMemory(Len(strText) + 1)
Protected *B64EncodeBufferB = AllocateMemory((Len(strText) * 3) + 1)
PokeS(*B64EncodeBufferA, strText, -1, #PB_Ascii)
Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText) * 3)
Result = PeekS(*B64EncodeBufferB, -1, #PB_Ascii)
FreeMemory(*B64EncodeBufferA)
FreeMemory(*B64EncodeBufferB)
ProcedureReturn Result
EndProcedure
Procedure __SendMail_Send(msg.s)
Protected *mem, length
msg + #CRLF$
length = StringByteLength(msg, #PB_UTF8)
*mem = AllocateMemory(length + 1)
If *mem
PokeS(*mem, msg, -1, #PB_UTF8)
SendNetworkData(SendMail_ConnectionID, *mem, length)
FreeMemory(*mem)
EndIf
EndProcedure
Procedure __SendMail_SendFiles(ProgressCB.SendMail_Callback = 0)
Protected file.s, FF, InputBufferLength.i, OutputBufferLength.i
Protected *memin, *memout, Boundry.s, temp.s, i
ResetList(SendMail_Attachments())
While(NextElement(SendMail_Attachments()))
file = SendMail_Attachments()
__SendMail_Send("")
FF = ReadFile(#PB_Any, file)
InputBufferLength = Lof(FF)
OutputBufferLength = InputBufferLength * 1.4
*memin = AllocateMemory(InputBufferLength)
If *memin
*memout = AllocateMemory(OutputBufferLength)
If *memout
Boundry = "--MyMixedBoundary"
__SendMail_Send(Boundry)
__SendMail_Send("Content-Type: " + __SendMail_GetMIMEType(GetExtensionPart(file)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34))
__SendMail_Send("Content-Transfer-Encoding: base64")
__SendMail_Send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34))
__SendMail_Send("")
ReadData(FF, *memin, InputBufferLength)
Base64Encoder(*memin, 60, *memout, OutputBufferLength)
__SendMail_Send(PeekS(*memout, 60, #PB_Ascii)) ; this must be done because For i=0 To OutputBufferLength/60 doesn't work
If ProgressCB
ProgressCB(60 / (OutputBufferLength / 100))
EndIf
Base64Encoder(*memin, InputBufferLength, *memout, OutputBufferLength)
For i = 1 To OutputBufferLength / 60
temp = Trim(PeekS(*memout + i * 60, 60, #PB_Ascii))
If Len(temp) > 0
__SendMail_Send(temp)
If ProgressCB
ProgressCB((60 * i) / (OutputBufferLength / 100))
EndIf
EndIf
Next
FreeMemory(*memout)
EndIf
FreeMemory(*memin)
EndIf
CloseFile(FF)
Wend
ProcedureReturn
EndProcedure
Procedure.s __SendMail_SendEmail(*para.SendMail_Parameter, TimeOut.l, Number = 0)
Protected loop250, ReceivedData.s, ct, cmdID.s, cmdText.s
Protected State, quit, ProtocolTxt.s, Time.l = ElapsedMilliseconds()
If *para\Port = 0 : *para\Port = 25 : EndIf
SendMail_ConnectionID = OpenNetworkConnection(*para\SMTPServer, *para\Port)
With *para
If SendMail_ConnectionID
Repeat
If NetworkClientEvent(SendMail_ConnectionID)
ReceivedData = Space(9999)
ct = ReceiveNetworkData(SendMail_ConnectionID, @ReceivedData, 9999)
ReceivedData = PeekS(@ReceivedData, -1, #PB_Ascii)
If ct
cmdID = Left(ReceivedData, 3)
cmdText = Mid(ReceivedData, 5, ct - 6)
If \EnableProtocol = #True
ProtocolTxt + "[" + FormatDate("%hh:%ii:%ss", Date()) + "] " + cmdText + #CRLF$
EndIf
Select cmdID
Case "220"
If Len(\Username) > 0
__SendMail_Send("Ehlo " + Hostname())
State = #eHlo
Else
__SendMail_Send("HELO " + Hostname())
State = #MailFrom
EndIf
Case "221"
__SendMail_Send("[connection closed]")
State = #Complete
quit = 1
Case "235"
__SendMail_Send("MAIL FROM: <" + \Sender + ">")
State = #RcptTo
Case "334"
If State=#RequestAuthentication
__SendMail_Send(__SendMail_Base64Encode(\UserName))
State = #Username
EndIf
If State = #Username
__SendMail_Send(__SendMail_Base64Encode(\Password))
state = #Password
EndIf
Case "250"
Select state
Case #eHlo
__SendMail_Send("AUTH LOGIN")
state = #RequestAuthentication
Case #MailFrom
__SendMail_Send("MAIL FROM: <" + \Sender + ">")
state = #RcptTo
Case #RcptTo
__SendMail_Send("RCPT TO: <" + StringField(\Recipient, Number + 1, ";") + ">")
state = #Data
Case #Data
__SendMail_Send("DATA")
state = #Quit
Case #Quit
__SendMail_Send("QUIT")
EndSelect
Case "251"
__SendMail_Send("DATA")
state = #Data
Case "354"
__SendMail_Send("X-Mailer: eSMTP 1.0")
__SendMail_Send("To: " + \Recipient)
__SendMail_Send("From: " + \Name + " <" + \Sender + ">")
__SendMail_Send("Reply-To: " + \Sender)
__SendMail_Send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()))
__SendMail_Send("Subject: " + \Subject)
__SendMail_Send("MIME-Version: 1.0")
__SendMail_Send("Content-Type: multipart/mixed; boundary=" + #DQUOTE$ + "MyMixedBoundary" + #DQUOTE$)
__SendMail_Send("")
__SendMail_Send("--MyMixedBoundary")
If \MessageHtml
__SendMail_Send("Content-Type: multipart/alternative; boundary=" + #DQUOTE$ + "MyAlternativeBoundary" + #DQUOTE$)
__SendMail_Send("")
__SendMail_Send("--MyAlternativeBoundary")
EndIf
__SendMail_Send("Content-Type: text/plain; charset=utf-8")
__SendMail_Send("Content-Transfer-Encoding: 8bit")
__SendMail_Send("")
__SendMail_Send(\Message)
If \MessageHtml
__SendMail_Send("--MyAlternativeBoundary")
__SendMail_Send("Content-Type: text/html; charset=utf-8")
__SendMail_Send("Content-Transfer-Encoding: 8bit")
__SendMail_Send("")
__SendMail_Send(\MessageHtml)
__SendMail_Send("--MyAlternativeBoundary--")
EndIf
__SendMail_SendFiles(\ProgressAttachedFile)
__SendMail_Send("--MyMixedBoundary--")
__SendMail_Send(".")
Case "421", "450", "451", "452", "454", "500", "501", "502", "503", "535","550", "551", "552", "553", "554"
ProtocolTxt + cmdID + " " + cmdText + #CRLF$
quit = 1
EndSelect
EndIf
EndIf
Until quit = 1 Or ElapsedMilliseconds() > (Time + TimeOut)
CloseNetworkConnection(SendMail_ConnectionID)
EndIf
EndWith
ProcedureReturn ProtocolTxt
EndProcedure
Procedure.s SendMail_SendEmail(*para.SendMail_Parameter, TimeOut.l = 15000)
Protected Result.s
Protected I, Count = CountString(*para\Recipient, ";")
For I = 0 To Count
Result + StringField(*para\Recipient, I + 1, ";") + ":" + #CRLF$
Result + __SendMail_SendEmail(*para, TimeOut.l, I)
Next
ProcedureReturn Result
EndProcedure
Code: Select all
IncludeFile "SendMail.pbi"
InitNetwork()
Define mpara.SendMail_Parameter
With mpara
\Name = "" ; Hier ist egal was steht.
\Sender = "you@your_host.org" ; E-Mail des Senders
\Recipient = "to@somewhere.net" ; E-Mail des Empfängers
\UserName = "" ; Username
\Password = "" ; hier dein Kennwort
\SMTPServer = "your.smtp_server.net"
\Subject = "Test" ; Hier Betreffzeile
\Message = "Testtext" ; Hier der Text im Body
\MessageHtml = "<html><body><h1>TestHTMLText</h1></body></html>"
\Port = 25
\EnableProtocol = #True
EndWith
;SendMail_AddAttachment("c:\tmp\a_picture.png")
Define.s ProtocolTxt.s = SendMail_SendEmail(mpara)
If ProtocolTxt
OpenWindow(0, #PB_Ignore, #PB_Ignore, 640, 480, "SendMail - Protocol")
EditorGadget(0, 5, 5, 630, 470, #PB_Editor_ReadOnly)
SetGadgetText(0, ProtocolTxt)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf