PureBoard

Code: Alles auswählen

Set objMessage = CreateObject("CDO.Message") 
objMessage.Subject = "Example CDO Message" 
objMessage.From = "me@my.com" 
objMessage.To = "test@paulsadowski.com"
objMessage.HTMLBody = "<h1>This is some sample message html.</h1>" 
'objMessage.CreateMHTMLBody "Body"
'objMessage.CreateMHTMLBody "file://c|/temp/test.htm"
objMessage.Bcc = "you@your.com"
objMessage.Cc = "you2@your.com"
objMessage.Send

Code: Alles auswählen

;- _____________________________________________________________________________
;- |                                                                           |
;- |                              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

Enumeration 
  #eHlo 
  #RequestAuthentication 
  #Username 
  #Password 
  #MailFrom 
  #RcptTo 
  #Data 
  #Quit 
  #Complete 
EndEnumeration

ProcedureDLL SendEMailInit()
  Global NewList Attachments.s() 
  Global SendEMailConnectionID.l 
EndProcedure

ProcedureDLL AddAttachment(File.s)
  AddElement(Attachments()) 
  Attachments() =  file
EndProcedure
  
ProcedureDLL NoAttachment()
  ClearList(Attachments())
EndProcedure

Procedure.s GetMIMEType(Extension.s) 
  Extension = "." + Extension 
  hKey.l = 0 
  KeyValue.s = Space(255) 
  DataSize.l = 255 
  If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, Extension, 0, #KEY_READ, @hKey) 
    KeyValue = "application/octet-stream" 
  Else 
    If RegQueryValueEx_(hKey, "Content Type", 0, 0, @KeyValue, @DataSize) 
      KeyValue = "application/octet-stream" 
    Else 
      KeyValue = Left(KeyValue, DataSize-1) 
    EndIf 
    RegCloseKey_(hKey) 
  EndIf 
  ProcedureReturn KeyValue 
EndProcedure 

Procedure.s Base64Encode(strText.s) 
  ;DefType.s Result 
  *B64EncodeBufferA = AllocateMemory(Len(strText)+1) 
  *B64EncodeBufferB = AllocateMemory((Len(strText)*3)+1) 
  PokeS(*B64EncodeBufferA, strText) 
  Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText)*3) 
  Result.s = PeekS(*B64EncodeBufferB) 
  FreeMemory(*B64EncodeBufferA) 
  FreeMemory(*B64EncodeBufferB) 
  ProcedureReturn Result 
EndProcedure

Procedure Send(msg.s) 
  msg+#CRLF$ 
  SendNetworkData(SendEMailConnectionID, @msg, Len(msg)) 
EndProcedure 

Procedure SendFiles() 
  ResetList(Attachments()) 
  While(NextElement(Attachments())) 
    file.s=Attachments() 
    Send("") 
    If ReadFile(0,file.s) 
      InputBufferLength.l = Lof(0) 
      OutputBufferLength.l = InputBufferLength * 1.4 
      *memin=AllocateMemory(InputBufferLength) 
      If *memin 
        *memout=AllocateMemory(OutputBufferLength) 
        If *memout 
          Boundry.s = "--MyBoundary" 
          Send(Boundry) 
          Send("Content-Type: "+GetMIMEType(GetExtensionPart(file.s)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34)) 
          Send("Content-Transfer-Encoding: base64") 
          Send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34)) 
          Send("") 
          ReadData(0,*memin,InputBufferLength) 
          Base64Encoder(*memin,60,*memout,OutputBufferLength) 
          Send(PeekS(*memout,60)) ; this must be done because For i=0 To OutputBufferLength/60 doesn´t work 
          Base64Encoder(*memin,InputBufferLength,*memout,OutputBufferLength)                
          For i=1 To OutputBufferLength/60 
            temp.s=Trim(PeekS(*memout+i*60,60)) 
            If Len(temp)>0 
              Send(temp) 
            EndIf 
          Next 
        EndIf 
      EndIf 
      FreeMemory(-1) 
      CloseFile(0) 
    EndIf 
  Wend 
  ProcedureReturn 
EndProcedure 

ProcedureDLL SendEmail(Name.s,sender.s,recipient.s,Username.s,Password.s,smtpserver.s,subject.s,body.s) 
  If InitNetwork() 
    SendEMailConnectionID = OpenNetworkConnection(smtpserver, 25) 
    If SendEMailConnectionID 
      loop250.l=0 
      Repeat    
        If NetworkClientEvent(SendEMailConnectionID) 
          ReceivedData.s=Space(9999) 
          ct=ReceiveNetworkData(SendEMailConnectionID ,@ReceivedData,9999) 
          If ct 
            cmdID.s=Left(ReceivedData,3) 
            cmdText.s=Mid(ReceivedData,5,ct-6) 
            Select cmdID 
              Case "220" 
                If Len(Username)>0 
                  Send("Ehlo " + Hostname()) 
                  State=#eHlo 
                Else 
                  Send("HELO " + Hostname()) 
                  State=#MailFrom 
                EndIf    
              Case "221" 
                Send("[connection closed]") 
                State=#Complete 
                quit=1      
              Case "235" 
                Send("MAIL FROM: <" + sender + ">") 
                State=#RcptTo 
                
              Case "334" 
                If State=#RequestAuthentication 
                  Send(Base64Encode(Username)) 
                  State=#Username 
                EndIf 
                If State=#Username 
                  Send(Base64Encode(password)) 
                  state=#Password 
                EndIf 
                
              Case "250" 
                Select state 
                  Case #eHlo 
                    Send("AUTH LOGIN") 
                    state=#RequestAuthentication      
                  Case #MailFrom    
                    Send("MAIL FROM: <" + sender + ">") 
                    state=#RcptTo 
                  Case #RcptTo 
                    Send("RCPT TO: <" + recipient + ">") 
                    state=#Data 
                  Case #Data 
                    Send("DATA") 
                    state=#Quit 
                  Case #Quit 
                    Send("QUIT") 
                EndSelect 
                
              Case "251" 
                Send("DATA") 
                state=#Data 
              Case "354" 
                Send("X-Mailer: eSMTP 1.0") 
                Send("To: " + recipient) 
                Send("From: " + name + " <" + sender + ">") 
                Send("Reply-To: "+sender) 
                Send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) ) 
                Send("Subject: " + subject) 
                Send("MIME-Version: 1.0") 
                Send("Content-Type: multipart/mixed; boundary="+Chr(34)+"MyBoundary"+Chr(34)) 
                Send("") 
                Send("--MyBoundary") 
                Send("Content-Type: text/plain; charset=us-ascii") 
                Send("Content-Transfer-Encoding: 7bit") 
                Send("")                      
                Send(body.s) 
                SendFiles() 
                Send("--MyBoundary--") 
                Send(".") 
                
              Case "550" 
                
                quit=1      
            EndSelect 
          EndIf 
        EndIf 
        
      Until quit = 1 
      CloseNetworkConnection(SendEMailConnectionID) 
      
    EndIf 
  EndIf          
EndProcedure 

Name.s="Mein Name bei email.de"   ; Hier ist egal was steht.
sender.s="Mein@Mail.de" ;E-Mail des Senders
recipient.s="Empfaenger@SeineMail.de";E-Mail des Empfängers
Username.s="Benutzername" ; Username
Password.s="XXXXXXX" ; hier dein Kennwort
smtpserver.s="mail.SMTP.DE" ; Hier bei Evanzo mail. + E-Mailaccount
subject.s="Diese Mail wurde von mir geschickt" ; Hier Betreffzeile
body.s="Das ist eine Mail, die ich mal testweise an mich selber ueber PB schicke" ; Hier der Text im Body

SendEMailInit() 
SendEmail(Name,sender,recipient,Username,Password,smtpserver,subject,body) 

Code: Alles auswählen

IncludePath "[DeinPfadZu]\COMatePLUS\" ; Pfad anpassen!
XIncludeFile "comateplus.pbi" 

Define objMessage.COMateObject

objMessage = COMate_CreateObject("CDO.Message")

If objMessage
  
  objMessage\SetStringProperty("Subject='Example CDO Message'")
  objMessage\SetStringProperty("From='me@my.com'")
  objMessage\SetStringProperty("To='test@paulsadowski.com'")
  objMessage\SetStringProperty("HTMLBody='<h1>This is some sample message html.</h1>'")
  objMessage\SetStringProperty("Bcc='you@your.com'")
  objMessage\SetStringProperty("Cc='you2@your.com'")
  objMessage\Invoke("Send")
  
  objMessage\Release()
  
Else
  Debug "!objMessage"
EndIf