PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

einfache SendMail

https://www.purebasic.fr/german/viewtopic.php?t=22503

Seite 1 von 2

einfache SendMail

Verfasst: 16.05.2010 14:39
von Christian+
So hier mal eine Procedur für Mails die ich mal angefangen und nie fertig gemacht habe mal schauen eventuell habe ich ja mal doch noch Zeit weiter zu machen doch derzeit wird das leider nichts.
Vielleicht kann es ja mal jemand brauchen wenn er sich so was schreiben will.
Ich wollte den Code eigentlich noch mit Kommentaren ausstatten und ausbauen damit auch anhänge verschickt werden können und je nach Fehler entsprechende werte zurückgegeben werden ...

Code: Alles auswählen

EnableExplicit

InitNetwork()

Procedure.s MailDate()
  Protected date$
  date$ = FormatDate("%dd %mm %yyyy %hh:%ii:%ss", Date()-3600)+" +0100"
  date$ = Left(date$, 3)+StringField("Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec",Month(Date()),"|") +" "+Right(date$, 20)
  date$ = StringField("Sun|Mon|Tue|Wed|Thu|Fri|Sat",DayOfWeek(Date())+1,"|") +", "+date$
  ProcedureReturn date$
EndProcedure

Procedure.s ReceiveNetworkString(verbindung.i)
  Protected len.l, *DatenBuffer = AllocateMemory(2000)
  len = ReceiveNetworkData(verbindung, *DatenBuffer, 2000)
  ProcedureReturn PeekS(*DatenBuffer, len)
EndProcedure

Procedure SMTP_SendMail(server$, von_name$, von_adresse$, von_password$, an_name$, an_adresse$, subject$, mailtext$)
  Protected status.l, buffer$
  Protected verbindung.i = OpenNetworkConnection(server$, 587, #PB_Network_TCP)
  If verbindung
    If Left(ReceiveNetworkString(verbindung), 3) = "220"
      SendNetworkString(verbindung, "AUTH LOGIN"+#CRLF$)
      If Left(ReceiveNetworkString(verbindung), 3) = "334"
        buffer$ = Space(StringByteLength(von_adresse$)*1.35+64) 
        Base64Encoder(@von_adresse$, StringByteLength(von_adresse$), @buffer$, StringByteLength(von_adresse$)*1.35+64)
        SendNetworkString(verbindung, buffer$+#CRLF$)
        If Left(ReceiveNetworkString(verbindung), 3) = "334"
          buffer$ = Space(StringByteLength(von_password$)*1.35+64) 
          Base64Encoder(@von_password$, StringByteLength(von_password$), @buffer$, StringByteLength(von_password$)*1.35+64)
          SendNetworkString(verbindung, buffer$+#CRLF$)
          If Left(ReceiveNetworkString(verbindung), 3) = "235"
            SendNetworkString(verbindung, "HELO SendMail"+#CRLF$)
            If Left(ReceiveNetworkString(verbindung), 3) = "250"
              SendNetworkString(verbindung, "MAIL FROM: " + von_adresse$+#CRLF$)
              If Left(ReceiveNetworkString(verbindung), 3) = "250"
                SendNetworkString(verbindung, "RCPT TO: "+an_adresse$+#CRLF$)
                If Left(ReceiveNetworkString(verbindung), 3) = "250"
                  SendNetworkString(verbindung, "DATA"+#CRLF$)
                  If Left(ReceiveNetworkString(verbindung), 3) = "354"
                    SendNetworkString(verbindung, "Date: " + MailDate()+#CRLF$)
                    SendNetworkString(verbindung, "From: " + von_name$ + " <" + von_adresse$ + ">"+#CRLF$)
                    SendNetworkString(verbindung, "To: " + an_name$ + " <" + an_adresse$ + ">"+#CRLF$)
                    SendNetworkString(verbindung, "Subject: " + subject$+#CRLF$)
                    SendNetworkString(verbindung, ""+#CRLF$)
                    SendNetworkString(verbindung, mailtext$+#CRLF$)
                    SendNetworkString(verbindung, "."+#CRLF$)
                    If Left(ReceiveNetworkString(verbindung), 3) = "250"
                      SendNetworkString(verbindung, "QUIT"+#CRLF$)
                      If Left(ReceiveNetworkString(verbindung), 3) = "221"
                        status = 1
                      EndIf
                    EndIf
                  EndIf
                EndIf
              EndIf
            EndIf
          EndIf
        EndIf
      EndIf
    EndIf
    CloseNetworkConnection(verbindung)
  EndIf
  ProcedureReturn status
EndProcedure

Re: einfache SendMail

Verfasst: 17.05.2010 11:36
von andi256
Hi ... in der Datums-Procedure zählst du die Tage komisch :-)

Sonntag Montag Mittwoch ....

Code: Alles auswählen

Procedure.s MailDate()
 Protected date$
 date$ = StringField("Sun|Mon|Tue|Wed|Thu|Fri|Sat",DayOfWeek(Date())+1,"|") +" "
 date$ + FormatDate("%dd",Date()) +" "
 date$ + StringField("Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec",Month(Date()),"|") +" "
 date$ + FormatDate("%yyyy %hh:%ii:%ss",Date())
 ProcedureReturn date$
EndProcedure
Debug MailDate()
Andi256

Re: einfache SendMail

Verfasst: 17.05.2010 12:24
von Christian+
@andi256
Da habe ich nicht wohl aufgepasst war nicht die aktuellste Version danke für den Hinweis. Habe es korrigiert in dem ich die Select mit deinen StringField Vorschlag ersetzt habe.

Re: einfache SendMail

Verfasst: 17.05.2010 13:17
von rolaf

Code: Alles auswählen

"X-Mailer: Chess-Mail"
Ist der jetzt nur für Schach-Spieler? :wink:

Re: einfache SendMail

Verfasst: 17.05.2010 13:44
von Christian+
Ok schon entfernt. Eigentlich wollte ich ja nur meinen Code hier reinstellen damit falls jemand mal so was macht bzw. braucht schon was dazu findet aber wenn jetzt sogar Vorschläge kommen mach ich glaube doch mal daran weiter scheint ja einige zu interessieren oder sucht ihr nur Fehler.

Re: einfache SendMail

Verfasst: 17.05.2010 21:32
von NoUser
Also ich denke mal dass sicher einige (inkl. mir) Interesse hätten. Aber ich denke auch dass es dann etwas mehr sein sollte als dass was die internen Mail-Funktionen von PB schon können.
Soll sicher kein nieder machen sein. Ich z.B. fände es nat. super wenn Deine SendMail-Funktion auch mit Servern die eine Authentifizierung benötigen zurecht kommen würde.
Wäre etwas was ich bisher so noch nicht in reinem PB-Code gesehen habe. :mrgreen:

lg Martin

Re: einfache SendMail

Verfasst: 18.05.2010 13:39
von Christian+
marroh hat geschrieben:Ich z.B. fände es nat. super wenn Deine SendMail-Funktion auch mit Servern die eine Authentifizierung benötigen zurecht kommen würde.
Also meine SendMail Funktion arbeitet doch schon mit Authentifizierung aber klar ausbauen muss ich das noch.

Re: einfache SendMail

Verfasst: 18.05.2010 17:09
von Christian+
Ich habe mal weiter gemacht aber so ganz toll ist es immer noch nicht. Ich werde wohl noch weiter daran arbeiten müssen doch damit man einen Fortschritt sieht hier mal der Code. Vielleicht hat ja noch einer ein paar Tipps oder findet Fehler.

Code: Alles auswählen

EnableExplicit

InitNetwork()

Global SMTP_LastAnswer$

Declare.s SMTP_CreateNameAdressString(name$, adress$)

Declare.s SMTP_MailDate()
Declare.s SMTP_GetAdressPart(string$)
Declare.s SMTP_ReceiveNetworkString(verbindung.i)
Declare SMTP_SendNetworkStringBase64(id.i, string$)

Declare.i SMTP_OpenConnection(smtp_server$, from_adress$, from_password$, port=25)
Declare SMTP_SendMail(id.i, from_adress$, subject$, mailbody$, to_adress$, to_cc_adress$="", to_bcc_adress$="")
Declare SMTP_CloseConnection(id.i)

Structure SMTP_Attachment
  Dateiname$
  MimeTyp$
EndStructure

Declare SMTP_SendFiles(id.i, List attachments.SMTP_Attachment())
Declare SMTP_SendMailAndAttachment(id.i, from_adress$, subject$, mailbody$, to_adress$, List attachments.SMTP_Attachment() ,to_cc_adress$="", to_bcc_adress$="")

Procedure.s SMTP_CreateNameAdressString(name$, adress$)
  ProcedureReturn name$+" <"+adress$+">"
EndProcedure

Procedure.s SMTP_MailDate()
  Protected date$
  date$ = StringField("Sun|Mon|Tue|Wed|Thu|Fri|Sat", DayOfWeek(Date())+1, "|") +", "
  date$ + FormatDate("%dd", Date())+" "
  date$ + StringField("Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec", Month(Date()), "|")+" "
  date$ + FormatDate("%yyyy %hh:%ii:%ss", Date())+" +0200"
  ProcedureReturn date$
EndProcedure

Procedure.s SMTP_GetAdressPart(string$)
  Protected adress$, pos.l, i.l
  Repeat
    pos = FindString(string$, "<", i) 
    i = FindString(string$, ">", pos)
    If pos > 0
      adress$ = adress$+Mid(string$, pos, i-pos+1)
    EndIf
  Until pos = 0
  ProcedureReturn adress$
EndProcedure

Procedure.s SMTP_ReceiveNetworkString(verbindung.i)
  Protected len.l, *DatenBuffer = AllocateMemory(2048)
  len = ReceiveNetworkData(verbindung, *DatenBuffer, 2048)
  ProcedureReturn PeekS(*DatenBuffer, len)
EndProcedure

Procedure SMTP_SendNetworkStringBase64(id.i, string$)
  Protected buffer$ = Space(StringByteLength(string$)*1.35+64)
  Base64Encoder(@string$, StringByteLength(string$), @buffer$, StringByteLength(string$)*1.35+64)
  SendNetworkString(id, buffer$+#CRLF$)
EndProcedure

Procedure.i SMTP_OpenConnection(smtp_server$, from_adress$, from_password$, port=25)
  Protected id.i
  id = OpenNetworkConnection(smtp_server$, port, #PB_Network_TCP)
  If id
    SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
    If Left(SMTP_LastAnswer$, 3) = "220"
      SendNetworkString(id, "AUTH LOGIN"+#CRLF$)
      SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
      If Left(SMTP_LastAnswer$, 3) = "334"
        SMTP_SendNetworkStringBase64(id, from_adress$)
        SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
        If Left(SMTP_LastAnswer$, 3) = "334"
          SMTP_SendNetworkStringBase64(id, from_password$)
          SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
          If Left(SMTP_LastAnswer$, 3) = "235"
            SendNetworkString(id, "EHLO SendMail"+#CRLF$)
            SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
            If Left(SMTP_LastAnswer$, 3) = "250"
              ProcedureReturn id
            EndIf
          EndIf
        EndIf
      EndIf
    EndIf
    CloseNetworkConnection(id)
  Else
    SMTP_LastAnswer$ = "OpenNetworkConnection = 0"
  EndIf
  Debug SMTP_LastAnswer$
EndProcedure

Procedure SMTP_SendMail(id.i, from_adress$, subject$, mailbody$, to_adress$, to_cc_adress$="", to_bcc_adress$="")
  Protected pos1.l, pos2.l, adress$
  SendNetworkString(id, "MAIL FROM: "+SMTP_GetAdressPart(from_adress$)+#CRLF$)
  SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
  If Left(SMTP_LastAnswer$, 3) = "250"
    adress$ = SMTP_GetAdressPart(to_adress$)
    pos1 = FindString(adress$, "<", 1)
    Repeat
      pos2 = FindString(adress$, "<", pos1+1)
      If pos2 = 0
        pos2 = Len(adress$)+1
      EndIf
      SendNetworkString(id, "RCPT TO: "+Mid(adress$, pos1, pos2-pos1)+#CRLF$)
      SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
      pos1 = pos2
    Until pos1 = Len(adress$)+1
    If Left(SMTP_LastAnswer$, 3) = "250"
      SendNetworkString(id, "DATA"+#CRLF$)
      SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
      If Left(SMTP_LastAnswer$, 3) = "354"
        SendNetworkString(id, "Date: "+SMTP_MailDate()+#CRLF$)
        SendNetworkString(id, "From: "+from_adress$+#CRLF$)
        SendNetworkString(id, "To: "+to_adress$+#CRLF$)
        If to_cc_adress$ : SendNetworkString(id, "cc: "+to_cc_adress$+#CRLF$) : EndIf
        If to_bcc_adress$ : SendNetworkString(id, "Bcc: "+to_bcc_adress$+#CRLF$) : EndIf
        SendNetworkString(id, "Subject: "+subject$+#CRLF$)
        SendNetworkString(id, #CRLF$)
        SendNetworkString(id, mailbody$+#CRLF$)
        SendNetworkString(id, "."+#CRLF$)
        SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
        If Left(SMTP_LastAnswer$, 3) = "250"
          ProcedureReturn 1
        EndIf
      EndIf
    EndIf
  EndIf
  CloseNetworkConnection(id)
  Debug SMTP_LastAnswer$
EndProcedure

Procedure SMTP_CloseConnection(id.i)
  SendNetworkString(id, "QUIT"+#CRLF$)
  SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
  CloseNetworkConnection(id)
EndProcedure

Procedure SMTP_SendFiles(id.i, List attachments.SMTP_Attachment())
  Protected nr.i, InputBufferLength.l, OutputBufferLength.l, *InputBuffer, *OutputBuffer
  ResetList(attachments())
  While NextElement(attachments())
    nr = ReadFile(#PB_Any, attachments()\Dateiname$)
    If nr
      InputBufferLength = Lof(nr)
      OutputBufferLength = InputBufferLength*1.35+64
      *InputBuffer = AllocateMemory(InputBufferLength)
      If *InputBuffer
        *OutputBuffer = AllocateMemory(OutputBufferLength)
        If *OutputBuffer
          SendNetworkString(id, #CRLF$)
          SendNetworkString(id, "--myboundary"+#CRLF$)
          SendNetworkString(id, "Content-Type: "+attachments()\MimeTyp$+"; name="+Chr(34)+GetFilePart(attachments()\Dateiname$)+Chr(34)+#CRLF$)
          SendNetworkString(id, "Content-Transfer-Encoding: base64"+#CRLF$)
          SendNetworkString(id, #CRLF$)
          ReadData(nr, *InputBuffer, InputBufferLength)
          OutputBufferLength = Base64Encoder(*InputBuffer, InputBufferLength, *OutputBuffer, OutputBufferLength)
          SendNetworkData(id, *OutputBuffer, OutputBufferLength)
          FreeMemory(*OutputBuffer)
        EndIf
        FreeMemory(*InputBuffer)
      EndIf
      CloseFile(nr)
    EndIf
  Wend
EndProcedure

Procedure SMTP_SendMailAndAttachment(id.i, from_adress$, subject$, mailbody$, to_adress$, List attachments.SMTP_Attachment() ,to_cc_adress$="", to_bcc_adress$="")
  Protected pos1.l, pos2.l, adress$
  SendNetworkString(id, "MAIL FROM: "+SMTP_GetAdressPart(from_adress$)+#CRLF$)
  SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
  If Left(SMTP_LastAnswer$, 3) = "250"
    adress$ = SMTP_GetAdressPart(to_adress$)
    pos1 = FindString(adress$, "<", 1)
    Repeat
      pos2 = FindString(adress$, "<", pos1+1)
      If pos2 = 0
        pos2 = Len(adress$)+1
      EndIf
      SendNetworkString(id, "RCPT TO: "+Mid(adress$, pos1, pos2-pos1)+#CRLF$)
      SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
      pos1 = pos2
    Until pos1 = Len(adress$)+1
    If Left(SMTP_LastAnswer$, 3) = "250"
      SendNetworkString(id, "DATA"+#CRLF$)
      SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
      If Left(SMTP_LastAnswer$, 3) = "354"
        SendNetworkString(id, "Date: "+SMTP_MailDate()+#CRLF$)
        SendNetworkString(id, "From: "+from_adress$+#CRLF$)
        SendNetworkString(id, "To: "+to_adress$+#CRLF$)
        If to_cc_adress$ : SendNetworkString(id, "cc: "+to_cc_adress$+#CRLF$) : EndIf
        If to_bcc_adress$ : SendNetworkString(id, "Bcc: "+to_bcc_adress$+#CRLF$) : EndIf
        SendNetworkString(id, "Subject: "+subject$+#CRLF$)
        SendNetworkString(id, "MIME-Version: 1.0"+#CRLF$)
        SendNetworkString(id, "Content-Type: multipart/mixed; boundary="+Chr(34)+"myboundary"+Chr(34)+#CRLF$)
        SendNetworkString(id, #CRLF$)
        SendNetworkString(id, "--myboundary"+#CRLF$)
        SendNetworkString(id, "Content-Type: text/plain; charset=ascii"+#CRLF$)
        SendNetworkString(id, #CRLF$)   
        SendNetworkString(id, mailbody$+#CRLF$)
        SMTP_SendFiles(id, attachments())
        SendNetworkString(id, "--myboundary--"+#CRLF$)
        SendNetworkString(id, "."+#CRLF$)
        SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
        If Left(SMTP_LastAnswer$, 3) = "250"
          ProcedureReturn 1
        EndIf
      EndIf
    EndIf
  EndIf
  CloseNetworkConnection(id)
  Debug SMTP_LastAnswer$
EndProcedure

; ;Beispiel
; Define id.i, from_adress$, subject$, mailbody$, to_adress$
; 
; from_adress$ = SMTP_CreateNameAdressString("sender", "sendername@mail.de")
; to_adress$ = SMTP_CreateNameAdressString("empfänger", "zielname@mail.de")
; 
; subject$ = "Hallo Hallo"
; mailbody$ = "Dies ist eine Test E-Mail gesendet mit PB"+Chr(10)+";-)"
; 
; id = SMTP_OpenConnection("smtp.server.de", "sendername@mail.de", "senderpasswort")
; If id
;   If SMTP_SendMail(id, from_adress$, subject$, mailbody$, to_adress$)
;     Debug "E-Mail wurde gesendet!"
;   Else
;     Debug "Fehler! E-Mail wurde nicht gesendet!"
;   EndIf
;   SMTP_CloseConnection(id)
; EndIf

Re: einfache SendMail

Verfasst: 28.05.2010 12:46
von NoUser
Christian+ hat geschrieben:Also meine SendMail Funktion arbeitet doch schon mit Authentifizierung aber klar ausbauen muss ich das noch.
Sorry, ich meinte damit Authentifizierung welche auch eine sichere Verbindung (SSL) wie z.B. bei GMail (smtp 465 / pop3 995) unterstützt.

lg Martin

Re: einfache SendMail

Verfasst: 11.06.2010 19:38
von Christian+
So ich habe mal noch eine etwas andere Version erstellt um E-Mails zu verschicken da ich es selbst so etwas praktischer finde.
Nach einem weg SSL zu verwenden werde ich mal demnächst schauen aber ich denke das ist relativ schwer umzusetzen.

Code: Alles auswählen

;SMTP-SendMail
;11.06.2010
;von Christian+

EnableExplicit

InitNetwork()

Global SMTP_LastAnswer$

Structure SMTP_ATTACHMENT
  Dateiname$
  MimeTyp$
EndStructure

Structure SMTP_MAIL
  from_adress$
  date$
  sender_adress$
  to_adress$
  to_cc_adress$
  to_bcc_adress$
  subject$
  mailbody$
  attachment.l
  contenttype$
  List attachments.SMTP_ATTACHMENT()
EndStructure

; Erstellt aus Name und E-Mail Adresse einen String mit beiden Informationen
Declare.s SMTP_CreateNameAdressString(name$, adress$)

; Erstellt einen für E-Mails geeigneten String mit aktuellem Datum und Uhrzeit
Declare.s SMTP_MailDate()

; Öffnet eine Verbindung zu einem SMTP Server
Declare.i SMTP_OpenConnection(smtp_server$, from_adress$, from_password$, port=25)

; Beendet eine bestehende Verbindung zu einem SMTP Server
Declare SMTP_CloseConnection(id.i)

; Erstellt die E-Mail
Declare SMTP_CreateMail(*mail.SMTP_MAIL, from_adress$, subject$, mailbody$, to_adress$, to_cc_adress$="", to_bcc_adress$="", sender_adress$="", contenttype$="")

; Fügt eine Datei-Anlage zur Mail hinzu
Declare SMTP_AddAttachment(*mail.SMTP_MAIL, file$, mimetyp$="")

; Sendet die E-Mail
Declare SMTP_SendMail(id.i, *mail.SMTP_MAIL)

; Hilfsfunktionen
;{

Procedure.s GetMimeType(extension$)
  Protected mimetype$, string$, size.l, key.l
  mimetype$ = "application/octet-stream"
  If #PB_Compiler_OS = #PB_OS_Windows
    string$ = Space(255)
    size = 255
    If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, "." + extension$, 0, #KEY_READ, @key) = 0
      If RegQueryValueEx_(key, "Content Type", 0, 0, @string$, @size) = 0
        mimetype$ = Left(string$, size-1)
      EndIf
      RegCloseKey_(key)
    EndIf
  EndIf
  ProcedureReturn mimetype$
EndProcedure

Procedure.s SMTP_GetAdressPart(string$)
  Protected pos.l = FindString(string$, "<", 1)
  ProcedureReturn Mid(string$, pos, FindString(string$, ">", 1)-pos+1)
EndProcedure

Procedure.s SMTP_ReceiveNetworkString(id.i)
  Protected len.l, *DatenBuffer = AllocateMemory(2048)
  len = ReceiveNetworkData(id, *DatenBuffer, 2048)
  ProcedureReturn PeekS(*DatenBuffer, len)
EndProcedure

Procedure SMTP_SendNetworkStringBase64(id.i, string$)
  Protected buffer$ = Space(StringByteLength(string$)*1.35+64)
  Base64Encoder(@string$, StringByteLength(string$), @buffer$, StringByteLength(string$)*1.35+64)
  SendNetworkString(id, buffer$+#CRLF$)
EndProcedure

Procedure SMTP_SendFiles(id.i, List attachments.SMTP_ATTACHMENT())
  Protected nr.i, InputBufferLength.l, OutputBufferLength.l, *InputBuffer, *OutputBuffer
  ResetList(attachments())
  While NextElement(attachments())
    nr = ReadFile(#PB_Any, attachments()\Dateiname$)
    If nr
      InputBufferLength = Lof(nr)
      OutputBufferLength = InputBufferLength*1.35+64
      *InputBuffer = AllocateMemory(InputBufferLength)
      If *InputBuffer
        *OutputBuffer = AllocateMemory(OutputBufferLength)
        If *OutputBuffer
          SendNetworkString(id, #CRLF$)
          SendNetworkString(id, "--myboundary"+#CRLF$)
          SendNetworkString(id, "Content-Type: "+attachments()\MimeTyp$+"; name="+Chr(34)+GetFilePart(attachments()\Dateiname$)+Chr(34)+#CRLF$)
          SendNetworkString(id, "Content-Transfer-Encoding: base64"+#CRLF$)
          SendNetworkString(id, #CRLF$)
          ReadData(nr, *InputBuffer, InputBufferLength)
          OutputBufferLength = Base64Encoder(*InputBuffer, InputBufferLength, *OutputBuffer, OutputBufferLength)
          SendNetworkData(id, *OutputBuffer, OutputBufferLength)
          FreeMemory(*OutputBuffer)
        EndIf
        FreeMemory(*InputBuffer)
      EndIf
      CloseFile(nr)
    EndIf
  Wend
EndProcedure

;}

; Erstellt aus Name und E-Mail Adresse einen String mit beiden Informationen
Procedure.s SMTP_CreateNameAdressString(name$, adress$)
  ProcedureReturn name$+" <"+adress$+">"
EndProcedure

; Erstellt einen für E-Mails geeigneten String mit aktuellem Datum und Uhrzeit
Procedure.s SMTP_MailDate()
  Protected date$
  date$ = StringField("Sun|Mon|Tue|Wed|Thu|Fri|Sat", DayOfWeek(Date())+1, "|") +", "
  date$ + FormatDate("%dd", Date())+" "
  date$ + StringField("Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec", Month(Date()), "|")+" "
  date$ + FormatDate("%yyyy %hh:%ii:%ss", Date())+" +0200"
  ProcedureReturn date$
EndProcedure

; Öffnet eine Verbindung zu einem SMTP Server
Procedure.i SMTP_OpenConnection(smtp_server$, from_adress$, from_password$, port=25)
  Protected id.i
  id = OpenNetworkConnection(smtp_server$, port, #PB_Network_TCP)
  If id
    SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
    If Left(SMTP_LastAnswer$, 3) = "220"
      SendNetworkString(id, "AUTH LOGIN"+#CRLF$)
      SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
      If Left(SMTP_LastAnswer$, 3) = "334"
        SMTP_SendNetworkStringBase64(id, from_adress$)
        SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
        If Left(SMTP_LastAnswer$, 3) = "334"
          SMTP_SendNetworkStringBase64(id, from_password$)
          SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
          If Left(SMTP_LastAnswer$, 3) = "235"
            SendNetworkString(id, "EHLO SendMail"+#CRLF$)
            SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
            If Left(SMTP_LastAnswer$, 3) = "250"
              ProcedureReturn id
            EndIf
          EndIf
        EndIf
      EndIf
    EndIf
    CloseNetworkConnection(id)
  Else
    SMTP_LastAnswer$ = "OpenNetworkConnection = 0"
  EndIf
  Debug SMTP_LastAnswer$
EndProcedure

; Beendet eine bestehende Verbindung zu einem SMTP Server
Procedure SMTP_CloseConnection(id.i)
  SendNetworkString(id, "QUIT"+#CRLF$)
  SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
  CloseNetworkConnection(id)
EndProcedure

; Erstellt die E-Mail
Procedure SMTP_CreateMail(*mail.SMTP_MAIL, from_adress$, subject$, mailbody$, to_adress$, to_cc_adress$="", to_bcc_adress$="", sender_adress$="", contenttype$="")
  With *mail
  \from_adress$ = from_adress$
  \date$ = SMTP_MailDate()
  If sender_adress$ = "" : \sender_adress$ = from_adress$ : Else : \sender_adress$ = sender_adress$ : EndIf
  \to_adress$ = to_adress$
  \to_cc_adress$ = to_cc_adress$
  \to_bcc_adress$ = to_bcc_adress$
  \subject$ = subject$
  \mailbody$ = mailbody$
  \contenttype$ = contenttype$
  EndWith
EndProcedure

; Fügt eine Datei-Anlage zur Mail hinzu
Procedure SMTP_AddAttachment(*mail.SMTP_MAIL, file$, mimetyp$="")
  AddElement(*mail\attachments())
  *mail\attachments()\Dateiname$ = file$
  If mimetyp$
    *mail\attachments()\MimeTyp$ = mimetyp$
  Else
    *mail\attachments()\MimeTyp$ = GetMimeType(GetExtensionPart(file$))
  EndIf
  *mail\attachment = 1
EndProcedure

; Sendet die E-Mail
Procedure SMTP_SendMail(id.i, *mail.SMTP_MAIL)
  With *mail
  SendNetworkString(id, "MAIL FROM: "+SMTP_GetAdressPart(\from_adress$)+#CRLF$)
  SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
  If Left(SMTP_LastAnswer$, 3) = "250"
    Protected pos1.l, pos2.l, adress$
    adress$ = \to_adress$+\to_cc_adress$+\to_bcc_adress$
    Repeat
      pos1 = FindString(adress$, "<", pos2)
      pos2 = FindString(adress$, ">", pos1)
      If pos2 = 0 Or pos1 = 0
        Break
      EndIf
      SendNetworkString(id, "RCPT TO: "+Mid(adress$, pos1, pos2-pos1+1)+#CRLF$)
      SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
      If Left(SMTP_LastAnswer$, 3) <> "250"
        Debug SMTP_LastAnswer$
      EndIf
    ForEver
    If Left(SMTP_LastAnswer$, 3) = "250"
      SendNetworkString(id, "DATA"+#CRLF$)
      SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
      If Left(SMTP_LastAnswer$, 3) = "354"
        SendNetworkString(id, "Date: "+\date$+#CRLF$)
        SendNetworkString(id, "From: "+\sender_adress$+#CRLF$)
        SendNetworkString(id, "To: "+\to_adress$+#CRLF$)
        If \to_cc_adress$ : SendNetworkString(id, "cc: "+\to_cc_adress$+#CRLF$) : EndIf
        ;If \to_bcc_adress$ : SendNetworkString(id, "Bcc: "+\to_bcc_adress$+#CRLF$) : EndIf
        SendNetworkString(id, "Subject: "+\subject$+#CRLF$)
        If \attachment = 1
          SendNetworkString(id, "MIME-Version: 1.0"+#CRLF$)
          SendNetworkString(id, "Content-Type: multipart/mixed; boundary="+Chr(34)+"myboundary"+Chr(34)+#CRLF$)
          SendNetworkString(id, #CRLF$)
          SendNetworkString(id, "--myboundary"+#CRLF$)
          If \contenttype$
          SendNetworkString(id, "Content-Type: "+\contenttype$+#CRLF$)
          Else
            SendNetworkString(id, "Content-Type: text/plain"+#CRLF$)
          EndIf
        ElseIf \contenttype$
          SendNetworkString(id, "MIME-Version: 1.0"+#CRLF$)
          SendNetworkString(id, "Content-Type: "+\contenttype$+#CRLF$)
        EndIf
        SendNetworkString(id, #CRLF$)
        SendNetworkString(id, \mailbody$+#CRLF$)
        If \attachment = 1
          SMTP_SendFiles(id, \attachments())
          SendNetworkString(id, #CRLF$)
          SendNetworkString(id, "--myboundary--"+#CRLF$)
        EndIf
        SendNetworkString(id, "."+#CRLF$)
        SMTP_LastAnswer$ = SMTP_ReceiveNetworkString(id)
        If Left(SMTP_LastAnswer$, 3) = "250"
          ProcedureReturn 1
        EndIf
      EndIf
    EndIf
  EndIf
  CloseNetworkConnection(id)
  Debug SMTP_LastAnswer$
  EndWith
EndProcedure

; ;Beispiel
; Define id.i, mail.SMTP_MAIL
; 
; Define absender$ = SMTP_CreateNameAdressString("sender", "sendername@mail.de")
; Define empfaenger$ = SMTP_CreateNameAdressString("empfänger", "zielname@mail.de")
; 
; SMTP_CreateMail(@mail, absender$, "Guten Tag", "Dies ist eine Test E-Mail gesendet mit PB"+Chr(10)+";-)", empfaenger$)
; ;SMTP_AddAttachment(@mail, "C:\test1.txt", "text/plain"")
; ;SMTP_AddAttachment(@mail, "C:\test2.txt", "text/plain")
; 
; id = SMTP_OpenConnection("smtp.server.de", "sendername@mail.de", "senderpasswort")
; If id
;   If SMTP_SendMail(id, @mail)
;     Debug "E-Mail wurde gesendet!"
;   Else
;     Debug "Fehler! E-Mail wurde nicht gesendet!"
;   EndIf
;   SMTP_CloseConnection(id)
; EndIf
; 
; End
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de