PureBoard

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

Mail Funktionen (POP3, SMTP und Mailauswertung)

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

Seite 1 von 1

Mail Funktionen (POP3, SMTP und Mailauswertung)

Verfasst: 07.04.2006 16:27
von Dostej
Im Rahmen meines derzeitigen Spleens bin ich dabei, einen Mailaccount abzufragen, die Mails auszuwerten und evtl. wieder was zu verschicken.

Um das Ei (siehe Ostern) nicht nochmals neu zu erfinden, habe ich im Forum und in der Codebase tüchtig geklaut.
Mein Verdienst ist eigentlich nur die Auswertungsfunktion und evtl. das Zusammenstellen udn ein paar kleine Ergänzungen.

Naja, hier also etwas Code für das Abfragen und Abrufen von Mails

Code: Alles auswählen

; Einen Mailaccount abfragen und Mails abrufen
; 2006 by Dostej  PB 4.0

;{ inits
If Not InitNetwork() 
  Debug "Error - Can not init the network"
  End
EndIf
;}

;{ Basis
Procedure WaitNetworkClientEvent(ConnectionID_L.l, TimeOut_L.l) 
  For x = 1 To TimeOut_L 
    Event_L = NetworkClientEvent(ConnectionID_L) 
    If Event_L Or x = TimeOut_L
      Break 
    EndIf 
    Delay(1) 
  Next 
  ProcedureReturn Event_L 
EndProcedure 
Procedure.s ReceiveNetworkString(ConnectionID_L.l) 
  Back_S.s
  Buffer_S.s
  Ergebnis_L.l
  Repeat 
    Buffer_S = Space(3000) 
    Ergebnis_L = ReceiveNetworkData(ConnectionID_L, @Buffer_S, 3000) 
    Back_S + RTrim(Buffer_S) 
  Until Ergebnis_L < 3000 
  ProcedureReturn Back_S
EndProcedure 
;}

;{ Mail-Funktionen
Procedure.l ConnectPOP3(ServerName_S.s, UserName_S.s, Passwort_S.s) 
  ConnectionID_L.l
  ConnectionID_L = OpenNetworkConnection(ServerName_S, 110) 
  If ConnectionID_L 
    If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
      If Left(ReceiveNetworkString(ConnectionID_L), 3) = "+OK" 
        SendNetworkString(ConnectionID_L, "USER " + UserName_S + #CRLF$) 
        If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
          If Left(ReceiveNetworkString(ConnectionID_L), 3) = "+OK" 
            SendNetworkString(ConnectionID_L, "PASS " + Passwort_S + #CRLF$) 
            If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
              If Left(ReceiveNetworkString(ConnectionID_L), 3) = "+OK" 
                ProcedureReturn ConnectionID_L 
              Else 
                CloseNetworkConnection(ConnectionID_L) 
              EndIf 
            Else 
              CloseNetworkConnection(ConnectionID_L) 
            EndIf 
          Else 
            CloseNetworkConnection(ConnectionID_L) 
          EndIf 
        Else 
          CloseNetworkConnection(ConnectionID_L) 
        EndIf 
      Else 
        CloseNetworkConnection(ConnectionID_L) 
      EndIf 
    Else 
      CloseNetworkConnection(ConnectionID_L) 
    EndIf 
  EndIf 
EndProcedure 

Procedure CountMails(ConnectionID_L.l) 
  S.s
  Back_L.l
  SendNetworkString(ConnectionID_L, "STAT" + #CRLF$) 
  If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    S = ReceiveNetworkString(ConnectionID_L) 
    ; debug "Count Mails: " + S
    If Left(S, 3) = "+OK" 
      Back_L = Val(StringField(S, 2, " ")) 
    EndIf 
  EndIf 
  ProcedureReturn Back_L 
EndProcedure 

Procedure GetTotalMailsSize(ConnectionID_L.l) 
  Back_L.l
  S.s
  SendNetworkString(ConnectionID_L, "LIST" + #CRLF$) 
  If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    S = ReceiveNetworkString(ConnectionID_L)
    Debug "Mailsize: " + S
    If Left(S, 3) = "+OK" 
      Back_L = Val(StringField(StringField(S, 2, "("), 1, " ")) 
    EndIf 
  EndIf 
  ProcedureReturn Back_L 
EndProcedure 

Procedure.s GetMailList(ConnectionID_L.l) ; get the List of all Mails
  SendNetworkString(ConnectionID_L, "LIST" + #CRLF$) 
  If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    S.s = ReceiveNetworkString(ConnectionID_L)
  EndIf
  ; debug "---LIST--------"
  ; debug S
  
  ProcedureReturn S
EndProcedure

Procedure.s GetMailMsgList(ConnectionID_L.l, ID_L.l) ; get the List the specified Mails
  SendNetworkString(ConnectionID_L, "LIST " + Str(ID_L) + #CRLF$) 
  If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    S.s = ReceiveNetworkString(ConnectionID_L)
  EndIf
  ; debug "---LIST " + Str(ID_L) + " --------"
  ; debug S
  
  ProcedureReturn S
EndProcedure

Procedure.l GetMailSize(ConnectionID_L.l, Index_L) ; return the size of the specified mail
  Back_L.l
  SendNetworkString(ConnectionID_L, "LIST " + Str(Index_L) + #CRLF$) 
  If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    S.s = ReceiveNetworkString(ConnectionID_L) 
    ; debug "Mailsize (" + Str(Index_L) + "): " + S
    If Left(S, 3) = "+OK" 
      Back_L = Val(StringField(S, 3, " ")) 
    EndIf 
  EndIf 
  ProcedureReturn Back_L 
EndProcedure 

Procedure.s GetMail(ConnectionID_L.l, Index_L) ; returns the specified mail
  S.s
  SendNetworkString(ConnectionID_L, "RETR " + Str(Index_L) + #CRLF$) 
  While WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    S + ReceiveNetworkString(ConnectionID_L) 
  Wend
  ; debug "----MAIL-------"
  ; debug S
  If Left(S, 3) = "+OK" 
    ProcedureReturn S 
  EndIf 
EndProcedure 

Procedure DeleteMail(ConnectionID_L.l, Index_L) ; set the specified mail to delete - this will be done if "QUIT" is send
  SendNetworkString(ConnectionID_L, "DELE " + Str(Index_L) + #CRLF$) 
  If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    If Left(ReceiveNetworkString(ConnectionID_L), 3) = "+OK" 
      ProcedureReturn Index_L 
    EndIf 
  EndIf 
EndProcedure 

Procedure ResetMails(ConnectionID_L.l) ; Clear all "Delete" Flag from Mails
  SendNetworkString(ConnectionID_L, "RSET" + #CRLF$) 
  If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    If Left(ReceiveNetworkString(ConnectionID_L), 3) = "+OK" 
      ProcedureReturn 1 
    EndIf 
  EndIf 
EndProcedure 

Procedure ResetTimeOut(ConnectionID_L.l) ; Keeps the connection open
  SendNetworkString(ConnectionID_L, "NOOP" + #CRLF$) 
  If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    If Left(ReceiveNetworkString(ConnectionID_L), 3) = "+OK" 
      ProcedureReturn 1 
    EndIf 
  EndIf 
EndProcedure 

Procedure SaveAndQuitPOP3(ConnectionID_L.l) ; Close the connection and all Mails with the delete-Flag will be deleted
  SendNetworkString(ConnectionID_L, "QUIT" + #CRLF$) 
  If WaitNetworkClientEvent(ConnectionID_L, 1000) = 2 
    If Left(ReceiveNetworkString(ConnectionID_L), 3) = "+OK" 
      CloseNetworkConnection(ConnectionID_L) 
      ProcedureReturn 1 
    EndIf 
  EndIf
  CloseNetworkConnection(ConnectionID_L) 
EndProcedure 
;}


; Demo
S.s
ServerName_S.s = "pop.server.com"
UserName_S.s = "dein username"
Password_S.s = "dein passwort"
ConnectionID_L = ConnectPOP3(ServerName_S, UserName_S, Password_S) 
If ConnectionID_L
  ; Einen Mailaccount abfragen
  
  Anzahl_L.l = CountMails(ConnectionID_L)
  Debug "Global"
  Debug "CountMails: " + Str(Anzahl_L)
  Debug "GetList: " + GetMailList(ConnectionID_L)
  Debug "GetTotalMailsSize: " + Str(GetTotalMailsSize(ConnectionID_L))
  
  Debug " "
  Debug "now the details"
  For x = 1 To Anzahl_L ; get the List for every single mail
    Debug "GetList " + Str(x) + ": " + GetMailMsgList(ConnectionID_L, x)
    Debug "GetMailSize: " + Str(GetMailSize(ConnectionID_L, x))
    Debug " "
  Next
  Debug " "
  Debug "now the content of the Mails"
  For x = 0 To Anzahl_L-1 ; get the List for every single mail
    S = GetMail(ConnectionID_L, x)
    Debug "GetMail: " + S
    If CreateFile(1, "Mail" + Str(x) + ".txt")
      WriteData(1, @S, Len(S))
      CloseFile(1)
    EndIf
    Debug " "
  Next
  
  Debug " "
  Debug "now close the Mail-Account"
  Debug "ResetMails: " + Str(ResetMails(ConnectionID_L))
  Debug "ResetTimeOut: " + Str(ResetTimeOut(ConnectionID_L))
  Debug "SaveAndQuitPOP3: " + Str(SaveAndQuitPOP3(ConnectionID_L))
Else
  Debug "Error while connecting"
EndIf
So, dann hier der Code, um einfache Textmails, Mails im html-format und Mails mit Anhängen auszuwerten. Erkennt base64-Verschlüsselungen und decodiert auch

Code: Alles auswählen

Global ExePfad_GS.s = GetCurrentDirectory() + "\"
#FileTemp = 0
#FileSave = 1

; sonstiges
Procedure.s KorrigiereFileName(Pfad_S.s) ; ersetzt ungültige zeichen mit "_"
  *P.Byte = @Pfad_S
  For x = 0 To Len(Pfad_S)-1
    ; Debug Str(*P\b) + " - " + Chr(*P\b)
    If *P\b < 32 Or *P\b = 34 Or *P\b = 42 Or *P\b = 47 Or *P\b = 58 Or *P\b = 60 Or *P\b = 62 Or *P\b = 63 Or *P\b = 92 Or *P\b = 124
      *P\b = 95 ; _  ersetzen
    EndIf
    *P +1
  Next
  ProcedureReturn Pfad_S
EndProcedure

; Funktionseinheiten
Procedure.l Hole_Content_Typ(S.s) ; liest aus dem übergebenen String den Content-typ aus und gibt einen Zahlencode zurück
  Back_L.l
  Content_Type_S.s
  
  Content_Type_S = LTrim(StringField(S, 2, ":"))
  Debug "Content_Type_S: " + Content_Type_S
  
  ; hier können nun die verschiedenen Content-Arten abgefragt werden
  If LCase(Left(Content_Type_S, 10)) = "text/plain"
    Debug "einfaches Textfile"
    Back_L = 1
    
  ElseIf LCase(Left(Content_Type_S, 9)) = "text/html" ; Mail als hmtl
    Debug "HTML Mail"
    Back_L = 2
    
  ElseIf LCase(Left(Content_Type_S, 21)) = "multipart/alternative" ; mehrteilige Daten gemischt
    Debug "mehrteiliges Mail"
    Back_L = 3
    
  EndIf
  
  ProcedureReturn Back_L
EndProcedure
Procedure.l Hole_Content_Encoding(S.s) ; liest aus dem übergebenen String den Content-encoding typ aus und gibt einen Zahlencode zurück
  Back_L.l
  S.s
  S = LTrim(StringField(S, 2, ":"))
  ;Debug "Encoded_S: " + Back_L
  If LCase(Left(S, 6)) = "base64"
    Debug "Typ Base 64 gefunden " 
    Back_L = 1
  EndIf
  
  ProcedureReturn Back_L
EndProcedure
Procedure.s Lese_Block(FileHandle_L) ; liest die nächsten Strings bis zur nächsten Leerzeile und gibt sie als String zurück
  Back_S.s
  S.s
  Repeat
    S = ReadString(FileHandle_L) ; Zeilenweise auslesen
    ; Debug "ausgelesen: " + S
    Back_S + S
  Until S = ""
  ProcedureReturn Back_S
EndProcedure


; Mailteile extrahieren
Procedure.s Lese_TextBlock(S.s, FileHandle_L.l, Encoded_L.l) ; liest den nächsten textblock und gibt den Inhalt - evtl. decodiert - zurück
  Back_S.s
  
  ; den Datenblock auslesen
  S + Lese_Block(FileHandle_L) ; liest die nächsten Strings bis zur nächsten Leerzeile und gibt sie als String zurück
  ;Debug "Grösse des Body: " + Str(Len(S))
  
  If Encoded_L = 1 ; decodieren
    t = Len(S)
    ;Debug "------" + Str(t)
    If t < 64 ; die minimale Buffergrösse sicherstellen
      t = 64
    EndIf
    Temp_S.s = Space(t)
    Base64Decoder(@S, Len(S), @Temp_S, t)
    Back_S = Temp_S
    
  Else
    Back_S = S
  EndIf
  ProcedureReturn Back_S
EndProcedure
Procedure.l Lese_MailAnhang(FileHandle_L.l, Encoded_L.l, SaveAs_S.s) ; liest den Mailanhang und speichert ihn in einem File; gibt 1 zurück, wenn der Teil gespeichert werden konnte
  Back_L.l
  S.s
  Temp_S.s
  
  ; den Datenblock auslesen
  S = Lese_Block(FileHandle_L) ; liest die nächsten Strings bis zur nächsten Leerzeile und gibt sie als String zurück
  
  If Encoded_L = 1 ; evtl. decodieren
    t = Len(S)
    ;Debug "------" + Str(t)
    If t < 64 ; die minimale Buffergrösse sicherstellen
      t = 64
    EndIf
    Temp_S.s = Space(t)
    Base64Decoder(@S, Len(S), @Temp_S, t)
    S = Temp_S
  EndIf
  
  ; den Content speichern
  If CreateFile(#FileSave, ExePfad_GS + SaveAs_S)
    WriteData(#FileSave, @S, Len(S))
    CloseFile(#FileSave)
    Back_L = 1
  EndIf
  
  ProcedureReturn Back_L
EndProcedure

Procedure Decode_Mail(FileHandle_L.l) ; decodiert ein Mail, das als Datei gespeichert ist
  ; langsamer aber einfacher als das im Speicher zu machen
  S.s
  Ende_L.l ; 1, wenn Ende der Mailteile erreicht (nur bei mehrteiligen Mails)
  Subject_S.s
  SubjectPfad_S.s ; Das Subjekt des Mails auf Pfadeignung umstrukturiert
  Encoded_L.l ; 1, wenn Mail base64 encoded
  Encoded_Teil_L.l ; 1, wenn Teil des Mails base64 encoded
  Reply_to_S.s
  Content_Type_L.l = 1 ; wenn keine Angabe, dann von einfachem textfile ausgehen
  Content_Type_Teil_L.l = 1 ; Typ des  Teil des Mails -> keine Angabe, dann von einfachem textfile ausgehen
  Header_L.l = 1 ; 1, wenn beim Auslesen noch im Header
  Boundary_S.s ; enthält den Trenner-String zwischen verschiedenen Mailteilen
  MailTeil_L.l ; welcher Teil des Mails ist das (nur bei mehrteiligen Mails)
  
  While Eof(FileHandle_L) = 0
    S = ReadString(FileHandle_L) ; Zeilenweise auslesen
    ; Debug S
    If S <> "." ; Ende des Mails
      If Header_L ;{ wenn im Header, prüfe auf gewisse Einträge
        If S = "" ; leerzeile, dann ist das Ende des Headers erreicht
          Header_L = 0
          Debug "Ende des Headers"
        EndIf
        
        If FindString(S, "Subject", 1) ; wenn das Subjekt gefunden
          t = FindString(S, ":", 1)
          Subject_S = Right(S, Len(S)-t)
          Debug "Subjekt: " + Subject_S
          
          SubjectPfad_S = KorrigiereFileName(Subject_S)
          Debug SubjectPfad_S
          
        EndIf
        
        If FindString(S, "Reply-To", 1) ; wenn das Subjekt gefunden
          S = Trim(StringField(S, 2, ":"))
          Reply_to_S = Right(S, Len(S)-t)
          Debug "Reply_to_S: " + Reply_to_S
        EndIf
        
        If FindString(S, "Content-Transfer-Encoding", 1) ; wenn das Mail codiert ist
          Encoded_L = Hole_Content_Encoding(S)
        EndIf
        
        If FindString(S, "Content-Type", 1) ; Was enthält das Mail
          Content_Type_L = Hole_Content_Typ(S)
          ; den Trenn-String extrahieren
          If Content_Type_L = 3 ; mehrteilige Daten gemischt
            S = ReadString(FileHandle_L) ; lese nächste Zeile
            Boundary_S = StringField(S, 2, Chr(34)) ; hole den Trennstring
            Debug "Boundary_S " + Boundary_S
          EndIf
        EndIf
        ;}
      Else ; Inhalte des Mails (Body und Anhänge)
        ; je nach Art des Mails entsprechend verarbeiten
        Select Content_Type_L
          Case 1 ;{ einfaches textfile
            Debug "verarbeite als text"
            S = Lese_TextBlock(S, FileHandle_L, Encoded_L)
            Debug "Mailinhalt enc: " + S
            Content_Type_L = 0 ; keine weitere Verarbeitung
            ;}
            
          Case 2 ;{ Mail als HTML
            
            ;}
            
          Case 3 ;{ mehrteilige Daten gemischt
            Debug "  teile gesondert speichern und je nach Art der Teile evtl. weiterverarbeiten"
            Repeat
              MailTeil_L + 1
              Debug " "
              Debug " TEIL " + Str(MailTeil_L) + "----------------------------------"
              
              ; lese weiter aus, bis das erste Mal der Trennstring erscheint
              Repeat
                S = ReadString(FileHandle_L) ; Zeilenweise auslesen
                Debug S
              Until FindString(S, Boundary_S, 1) Or Eof(FileHandle_L)
              Debug "----- Boundary_S: "+ Boundary_S
              
              ; dann lese Content-Type und evtl. Content encoding
              S = ReadString(FileHandle_L) ; nächste Zeile
              
              If S <> "" ; wenn Leerzeile, dann war das der letzte Teil
                Content_Type_Teil_L = Hole_Content_Typ(S)
                Debug "Art des Teils: " + Str(Content_Type_Teil_L)
                
                ; Die nächsten Infos auslesen bis zur Leerzeile 
                Repeat
                  S = ReadString(FileHandle_L) ; Zeilenweise auslesen
                  If S <> ""
                    Encoded_Teil_L = Hole_Content_Encoding(S) ; ist dieser Teil verschlüsselt?
                    Debug "Encoded_Teil_L: " + Str(Encoded_Teil_L)
                  EndIf
                Until S = ""
                
                ; und verarbeite die Teile entsprechend
                If MailTeil_L = 1 And Content_Type_Teil_L = 1 ;{ ist der erste Teil Text -> Mailbody
                  S = Lese_TextBlock("", FileHandle_L, Encoded_Teil_L)
                  Debug "Mailinhalt Textpart: " + S
                  ;}
                ElseIf Content_Type_Teil_L = 1 ; ist ein weiterer Teil Text -> Als textfile abspeichern
                  Lese_MailAnhang(FileHandle_L, Encoded_Teil_L, SubjectPfad_S + " - " + Str(MailTeil_L) + ".txt")
                  
                ElseIf Content_Type_Teil_L = 2 ; HTML-Mail -> abspeichern
                  Debug "verarbeite als HTML " + Str(Encoded_Teil_L)
                  Lese_MailAnhang(FileHandle_L, Encoded_Teil_L, SubjectPfad_S + " - " + Str(MailTeil_L) + ".html")
                  
                ElseIf Content_Type_Teil_L = 3 ; 
                  
                Else
                  ; mit laufender Nummer speichern
                  Lese_MailAnhang(FileHandle_L, Encoded_Teil_L, SubjectPfad_S + " - " + Str(MailTeil_L) + ".part")
                  
                EndIf
              Else
                Ende_L = 1
              EndIf
            Until Ende_L Or Eof(FileHandle_L)
            
            
            ;}
        EndSelect
        
      EndIf
    EndIf
    
  Wend
  
EndProcedure

  
  
If ReadFile(#FileTemp, ExePfad_GS + "Beispiele\Mail3.txt") ; Hier der Link zu einem heruntergeladenen Mail
  
  Decode_Mail(#FileTemp)
  
  
  
  CloseFile(#FileTemp)
EndIf
und dann noch der Code, um Mails wieder zu versenden. Geht auch (gerade) mit Authentifizierung (z.B. gmx)

Code: Alles auswählen

;{ inits
If Not InitNetwork() 
  Debug "Error - Can not init the network"
  End
EndIf
;}

Declare.s Base64Encode(strText.s) 
Declare SendFiles() 
Declare.s GetMIMEType(Extension.s) 
Declare send(msg.s) 
Declare SendESMTPMail(name.s,sender.s,recipient.s,username.s,Password.s,smtpserver.s,subject.s,body.s) 

Global ConnectionID.l 
Global NewList Attachments.s() 
InsertElement(Attachments()) 
Attachments() = "Link zu irgendeiner Datei"

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


mailserver.s="mail.gmx.de" 
pop3server.s="pop.gmx.de" 
mailto.s="Zieladresse" 
mailfrom.s="Deineadresse"
MailUser_S.s = "Dein benutzername"
mailpass.s="Dein passwort" 
subject.s="nur ein Test" 
;Sending Mail with SMTP-AUTH 
SendESMTPMail("Absnedername",mailfrom, mailto, MailUser_S,mailpass,mailserver,subject,"This is the body") 


; Don´t fill the Username/Password if you want to sent regular 
;sendesmtpmail("Clipper","my@email.com","your@email.com","","","smtp.mailserver.com","Hallo","This is the body") 

Procedure SendESMTPMail(name.s,sender.s,recipient.s,username.s,Password.s,smtpserver.s,subject.s,body.s) 
  ConnectionID = OpenNetworkConnection(smtpserver, 25) 
  If ConnectionID 
    loop250.l=0 
    Repeat    
      If NetworkClientEvent(ConnectionID) 
        ReceivedData.s=Space(9999) 
        ct=ReceiveNetworkData(ConnectionID ,@ReceivedData,9999) 
        If ct 
          cmdID.s=Left(ReceivedData,3) 
          cmdText.s=Mid(ReceivedData,5,ct-6) 
          Debug "<" + cmdID + " " + cmdText 
          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(ConnectionID) 
    MessageRequester("","Ende") 
  EndIf 
EndProcedure 

Procedure send(msg.s) 
  ;Delay(10) 
  Debug "> " + msg 
  msg+#CRLF$
  SendNetworkData(ConnectionID, @msg, Len(msg)) 
EndProcedure 


Procedure SendFiles() 
  ResetList(Attachments()) 
  While(NextElement(Attachments())) 
    File.s=Attachments() 
    send("") 
    If ReadFile(0,File.s) 
      Debug File 
      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 


Procedure.s Base64Encode(strText.s) 
  Define.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 = PeekS(*B64EncodeBufferB) 
  FreeMemory(-1) 
  ProcedureReturn Result 
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
So, das wärs erst mal.

Verfasst: 07.04.2006 16:48
von Macros
Gute Sache :allright:

Verfasst: 07.04.2006 18:11
von Marvin
:o

(= :allright:)

Verfasst: 08.04.2006 06:40
von fsw
Gute Arbeit :allright:

Allerdings musste ich das:

Code: Alles auswählen

  For x = 0 To Anzahl_L - 1  ; get the List for every single mail
    S = GetMail(ConnectionID_L, x)
    Debug "GetMail: " + S
    If CreateFile(1, "Mail" + Str(x) + ".txt")
      WriteData(1, @S, Len(S))
      CloseFile(1)
    EndIf
    Debug " "
  Next
aendern zu:

Code: Alles auswählen

  For x = 1 To Anzahl_L ; get the List for every single mail
    S = GetMail(ConnectionID_L, x)
    Debug "GetMail: " + S
    If CreateFile(1, "Mail" + Str(x) + ".txt")
      WriteData(1, @S, Len(S))
      CloseFile(1)
    EndIf
    Debug " "
  Next
weil wenn z.B. 2 e-mails angezeigt werden
eine Datei "Mail0.txt" mit groesse 0 erzeugt wird
und eine Datei "Mail1.txt" mit anscheinend richtigem inhalt.

Die fehlermeldung lautet:
"-ERR n must be positive"

Wenn ich den geaenderten code nehme erhalte ich "Mail1.txt"
und "Mail2.txt" mit anscheinend richtigem inhalten.

Weiss nicht ob es hier in den USA anders ist als in Deutschland.
Duerfte eigentlich nicht sein, da die Spezifikationen doch
ueberall gleich sein muessten...

Nochmals vielen Dank fuer den code :D

Verfasst: 10.04.2006 08:41
von Dostej
Danke, hast recht. Ich habe das Mail0 übersehen.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de