Indy TIdMessage TExt auslesen

[LokutusvB]

Hallo Leute,

ich experimentiere jetzt einige Zeit in der TIdMessage-Komponente von Indy. Das Laden einer Email, das Anzeigen von Betreff, Absender usw. klappt super. Was mir jedoch überhaupt nicht gelingen will, ist den normalen Nachrichteninhalt als einfachen Text anzuzeigen, egal ob HTML- oder Textmail. Keine der Body-Möglichkeiten greift hier, egal ob Text, GetText oder CommaText. Wie komme ich an den Inhalt einer normalen Mail heran um ihn mir anzeigen lassen zu können? Dokumentationen der Indy-Komponenten findet man ja leider nicht wirklich im Netz, selbst die Indyseite verlinkt fehlerhaft.

Zusatz:
Nach dem ich endlich direkt in der Indy-Installation eine Doku finden konnte, mußte ich einsehen, das Body der total falsche Anhaltspunkt ist. MessageParts ist das richtige Stichwort. Allerdings nützt mir das Herauslesen des TiDTextes auch nicht so viel, da mir unklar ist, wie ich den anzeigen kann.

[nahpets]

Hallo,

hilft Dir das (soeben aus 'nem Programm geklaut):

Delphi-Quellcode:

 
begin  
  sl.Clear;
  sl.Add('');
  sl.Add(IdMessage.Headers.Text);
  sl.Add('');
  sl.Add(idMessage.Body.Text);
  sl.Add('');
  For i := 0 To IDMessage.MessageParts.Count - 1 Do Begin
    If IdMessage.MessageParts.Items[i] Is TIDText Then with IdMessage.MessageParts.Items[i] As TIDText do Begin
      sl.Add('');
      // ContentType: text/html
      If AnsiContainsText(IdMessage.MessageParts.Items[i].ContentType,'html') Then Begin
        sl.Add(AnsiReplaceText(WrapText(Body.Text, 80),#13#10#13#10,#13#10));
      End else Begin
        sl.Add(Body.Text);
      End;
    End;
  End; 
End;

[LokutusvB]

Danke dir, ich schaue mir das mal an.

ich habe es so gemacht:

Delphi-Quellcode:

if (mail.MessageParts.Count > 0) then begin
  for ii := 0 to mail.MessageParts.Count - 1 do begin
    //text := mail.MessageParts.I
    if (mail.MessageParts.Items[ii].ClassName = 'TIdText') then begin
      text := TIdText(mail.MessageParts.Items[ii]);
      memoText.Lines.Add(text.Body.Text);
    end;
  end;
end;

Allerdings bekomme ich so, warum auch immer, nur reine Textmails angezeigt. Das kann mir doch einfach all die html-Tags einfach niederschreiben, anstatt gar nichts zu bringen. Wieso wird der Text mancher Emails einfach nicht angezeigt?

Ich werde deine Methode gleich mal probieren.

[nahpets]

Hallo,

die beiden Routinen sollten eigentlich identischen Ergebnissen führen.

[LokutusvB]

Ich bin noch basteln, aber logisch betrachtet hast du recht. Wenn in TiDText nichts steht, kann ich manipulieren wie ich will, Body.Text bleibt trotzdem leer. Wie kann ich mir denn den Text einer jeden eMail laden, egal welches Format die Mail besitzt?

[nahpets]

Hallo,

mit dem folgenden Code lese ich Email-Dateien aus 'nem Verzeichnis "am laufenden Meter" ein.
So wie das ist, wirst Du damit nichts anfangen können, aber das Wesentliche solltest Du Dir da raussuchen können.
Das Ganze sieht an einigen Stellen sehr verworren aus, nur so ist es mir gelungen, auch fehlerhafte Mails weitgehend "vernünftig" einzulesen.

Delphi-Quellcode:

procedure TfmMain.rdUCEFile(sDirectory: String; sr: TSearchRec);
var
          sl         : TStringList;
          st         : TMemoryStream;
          i          : Integer;
          iIdx       : Integer;
          sFileName  : String;
          sAtDomain  : String;
          sIndexName : String;
          sXSCL      : String;
          bFound     : Boolean;
          bCheckOk   : Boolean;
          sLevel     : String;
          iLevel     : Integer;
          sReceived  : String;
begin
  sIndexName         := tbUCE.IndexName;
  tbUCE.IndexName    := 'FileName';
  bFound             := tbUCE.FindKey([sr.Name]);
  tbUCE.IndexName    := sIndexName;
  // Mail noch nicht in der Datenbank?
  if not bFound then begin
    sl := TStringList.Create;
    st := TMemoryStream.Create;
    Try
      Try
        sFileName := sr.FindData.cFileName;
        sl.LoadFromFile(sDirectory + '\' + sFileName);
        sl.Add('');
        sl.Add('.');
        sl.Add(' ');
        sl.Add('');
        sl.Add('');
        sl.SaveToStream(st);
        st.Position := 0;
        Try
          IdMessage.LoadFromStream(st);
        except
          on e : Exception do Begin
            IDMessage.NoEncode := Not IDMessage.NoEncode;
            IDMessage.NoDecode := Not IDMessage.NoDecode;
            st.Position := 0;
            Try
              IdMessage.LoadFromStream(st);
            except
              on e : Exception do Begin
                WriteToLogFile(FormatFileName(sFileName) + ' | Verarbeitungsfehler (IdMessage.LoadFromStream(st)): ' + e.Message);
              end;
            end;
            IDMessage.NoEncode := Not IDMessage.NoEncode;
            IDMessage.NoDecode := Not IDMessage.NoDecode;
          end;
        end;
        bCheckOk  := False;
        sXSCL     := FormatXSCL(IdMessage.Headers.Values['X-SCL']);
        sLevel    := Copy(Trim(sXSCL),1,1);
        iLevel    := StrToIntDef(sLevel,0);
        // IP des absendenden Host (IP) holen.
        sReceived := GetReceived(IdMessage.Headers.Values['Received']);

        // Hier muss die Überprüfung der Mails anhand der Kriterien in den Eingabefeldern
        // geprüft werden
        // Muss die Mail zugestellt werden?
        iIdx := slZustellen.IndexOf(IdMessage.Headers.Values['X-Sender']);
        If iIdx = -1 Then begin
          sAtDomain := Copy(IdMessage.Headers.Values['X-Sender'],Pos('@',IdMessage.Headers.Values['X-Sender']),255);
          iIdx := slZustellen.IndexOf(sAtDomain);
          If iIdx = -1 Then begin
            // Hier müssen wir dann noch einen(?) Exoten abarbeiten.
            sAtDomain := 'xxx.xxx.xxx';  // <- den muss keiner wissen ;-)
            If Pos(sAtDomain,IdMessage.Headers.Values['X-Sender']) <> 0 then begin
              iIdx := slZustellen.IndexOf(sAtDomain);
            end;
          end;
        End;

        If iIdx > -1 Then Begin
          WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | zugestellt: ' + slZustellen[iIdx] + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | ' + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
          RenameFile(sDirectory + '\' + sFileName,edPickUp.Text + '\' + sFileName);
          bCheckOk := True;
        End;
        if Not bCheckOk then begin
          iIdx := slZustellen.IndexOf(IdMessage.From.Address);
          If iIdx = -1 Then begin
            sAtDomain := Copy(IdMessage.From.Address,Pos('@',IdMessage.From.Address),255);
            iIdx := slZustellen.IndexOf(sAtDomain);
          End;
          If iIdx > -1 Then begin
            WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | zugestellt: ' + slZustellen[iIdx] + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | ' + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
            RenameFile(sDirectory + '\' + sFileName,edPickUp.Text + '\' + sFileName);
            bCheckOk := True;
          end;
        end;
        if Not bCheckOk then begin
          iIdx := slZustellen.IndexOf(IdMessage.Recipients.EMailAddresses);
          If iIdx > -1 Then begin
            WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | zugestellt: ' + slZustellen[iIdx] + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | ' + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
            RenameFile(sDirectory + '\' + sFileName,edPickUp.Text + '\' + sFileName);
            bCheckOk := True;
          end;
        end;
        if Not bCheckOk then begin
          i    := 0;
          iIdx := -1;
          If slZustellBetreff.Count > 0 then Repeat
            iIdx := Pos(slZustellBetreff[i],IdMessage.Subject);
            Inc(i);
          Until (i > slZustellBetreff.Count - 1) or (iIdx > 0);
          If iIdx > 0 Then begin
            WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | zugestellt: ' + slZustellBetreff[i - 1] + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | ' + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
            RenameFile(sDirectory + '\' + sFileName,edPickUp.Text + '\' + sFileName);
            bCheckOk := True;
          end;
        end;
        if not bCheckOk Then Begin
          // Haben wir einen Absender, der immer ignoriert wird?
          iIdx := slIgnore.IndexOf(IdMessage.From.Address);
          If iIdx > -1 Then Begin
            WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | gelöscht (abzulehnender Absender): ' + slIgnore[iIdx] + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | ' + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
            RenameFile(sDirectory + '\' + sFileName,edDeleted.Text + '\' + sFileName);
            bCheckOk := True;
          End;
          If Not bCheckOk Then begin
            iIdx := slIgnore.IndexOf(IdMessage.Headers.Values['X-Sender']);
            If iIdx > -1 Then Begin
              WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | gelöscht (abzulehnender Absender): ' + slIgnore[iIdx] + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | ' + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
              RenameFile(sDirectory + '\' + sFileName,edDeleted.Text + '\' + sFileName);
              bCheckOk := True;
            End;
          End;
          // Haben wir einen Betreff, der zum Löschen führt?
          If Not bCheckOk Then begin
            iIdx := slSubject.IndexOf(IdMessage.Subject);
            If iIdx > -1 Then Begin
              WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | gelöscht (Betreff): ' + IdMessage.Subject + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | ' + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
              RenameFile(sDirectory + '\' + sFileName,edDeleted.Text + '\' + sFileName);
              bCheckOk := True;
            End;
          end;
          // Gibt es irgendeine Phrase aus der Wortliste?
          If Not bCheckOk Then begin
            sl.Clear;
            sl.Add('');
            sl.Add(IdMessage.Headers.Text);
            sl.Add('');
            sl.Add(idMessage.Body.Text);
            sl.Add('');
            for i := 0 To IDMessage.MessageParts.Count - 1 Do Begin
              If IdMessage.MessageParts.Items[i] Is TIDText Then with IdMessage.MessageParts.Items[i] As TIDText do Begin
                sl.Add('');
                // ContentType: text/html
                if AnsiContainsText(IdMessage.MessageParts.Items[i].ContentType,'html') Then Begin
                  WebIndex.MaxLineSize := 80;
                  WebIndex.HTML.Text := Body.Text;
                  WebIndex.PrepareHtmlText;
                  sl.Add(AnsiReplaceText(WrapText(WebIndex.HTML.Text, 80),#13#10#13#10,#13#10));
                End else Begin
                  sl.Add(Body.Text);
                end;
              End;
            End;
            // Hier wird noch nicht der Teil mit den Message-Informationen berücksichtigt,
            // dies könnte aber wesentlich für die Erkennung von Spam mit Anhängen sein.
            // Wie z. B.: Sperrung.zip, Hinweis.zip...
            sl.Add('');
            for i := 0 To IdMessage.MessageParts.Count - 1 Do Begin
              sl.Add('');
              sl.Add('StoredPathName: ' + IdMessage.MessageParts.Items[i].StoredPathName);
              sl.Add('ContentTransfer: ' + IdMessage.MessageParts.Items[i].ContentTransfer);
              sl.Add('ContentType: ' + IdMessage.MessageParts.Items[i].ContentType);
              sl.Add('Headers.Text: ' + IdMessage.MessageParts.Items[i].Headers.Text);
            end;
            For iIdx := 0 To slWortliste.Count - 1 Do begin
              bCheckOk := AnsiContainsText(sl.Text,slWortliste[iIdx]);
              if bCheckOk Then Begin
                WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | gelöscht (Wortliste): ' + slWortliste[iIdx] + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | '  + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
                RenameFile(sDirectory + '\' + sFileName,edDeleted.Text + '\' + sFileName);
                Break;
              End;
            end;
          end;
          // Ist ein regulärer Ausdruck in der Mail zu finden?
          If Not bCheckOk Then Begin
            For iIdx := 0 To slRegular.Count - 1 Do begin
              Try
                bCheckOk := FindRegExpr(sl.Text,slRegular[iIdx]);
                if bCheckOk Then Begin
                  WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | gelöscht (regulärer Ausdruck): ' + slRegular[iIdx] + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | '  + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
                  RenameFile(sDirectory + '\' + sFileName,edDeleted.Text + '\' + sFileName);
                  Break;
                end;
              except
                on e : Exception Do begin
                  WriteToLogFile(FormatFileName(sFileName) + ' | ' + sXSCL + ' | Fehler im regulären Ausdruck: ' + slRegular[iIdx] + ' | ' + IdMessage.Subject + ' | ' + sReceived + ' | '  + IdMessage.From.Address + ' | ' + IdMessage.Headers.Values['TO']);
                end;
              end;
            end;
          end;
          If not bCheckOk then Begin
            tbUCE.Append;
            for i := 0 To tbUCE.FieldCount - 1 Do begin
              tbUCE.Fields[i].AsString := IdMessage.Headers.Values[tbUCE.Fields[i].FieldName];
            end;
            tbUCE.FieldByName('FileName').AsString := sFileName;
            tbUCE.FieldByName('From').AsString := IdMessage.From.Address;
            tbUCE.FieldByName('CountParts').AsInteger := IdMessage.MessageParts.Count;
            tbUCE.FieldByName('BODY').AsString := sl.Text;
            Case IdMessage.ReplyTo.Count Of
              0 : ;
            else
              tbUCE.FieldByName('Reply-To').AsString := IdMessage.ReplyTo[0].Address;
            End;
            tbUCE.FieldByName('FileSize').AsInteger := sr.Size;
            tbUCE.Post;
          end;
        end;
      Except
        on e : Exception Do begin
          WriteToLogFile(FormatFileName(sFileName) + ' | Verarbeitungsfehler (rdUCEFile(sDirectory: String; sr: TSearchRec)): ' + e.Message);
        end;
      End;
    Finally
      st.Free;
      sl.Free;
    end;
  end;
end;

[LokutusvB]

Ich bin langsam am verzweifeln. So wie du das einliest, kann ich es leider nicht machen, da mein Delphi 5 die StrUtils noch nicht inne hat. Vielleicht ist zusätzlich meine Indy-Komponente auch zu alt.

Ich habe jetzt, da ich dachte, dass es vielleicht am De- oder Encodireren liegt, mit den beiden Klassen TIdDecoderQuotedPrintable und TIdEncoderQuotedPrintable experimentiert, mit dem Ergebnis, das nun sogar der Betreff nicht mehr gelesen und angezeigt werden kann. Kann ich der TidMessage-Komponente nicht einfach irgendwie sagen, sie soll Anzeigen ohne irgend welche Filterungen? Oder kann ich das auch irgendwie ohne TidMessage lösen ohne größeren Aufwand?

[nahpets]

Hallo,

bevor ich Dir die Fragen beantworten kann:

In welcher Form liegen Dir die EMails vor?

Als Textdatei?

Mails sind grundsätzlich erstmal reine Textdateien, Du könntest daher diese einfach in ein Memo, eine Stringliste... einlesen.

Wenn Du in dem eingelesenen Text nun nach <html suchst, bist Du (bei erfolgreicher Suche) am Anfang des HTML's. Nun liest Du ab dort solange weiter, bis Du auf </html> stößt.

Eventuell gehst Du vor der Suche her und ersetzt alle < durch Zeilenvorschub+< und alle > durch >+Zeilenvorschub, dann hast Du alle Tags in einer einzelnen Zeile und kannst dann per IndexOf nach <html> und </html> suchen.

'ne Mail sieht prinzipell etwa so aus:

Code:

x-sender: [email][e-mail][/email]
x-receiver: [email][e-mail][/email]
X-SCL: 8 92.51%
Received: from [123.123.123.123] ([123.123.123.123]) by welcher.server.xxxx.xxx with Microsoft SMTPSVC(6.0.3790.3959);
    Wed, 35 May 4711 07:44:35 +0100
To: <[e-mail]>
Subject:  Meds Discount for [email][e-mail][/email]
From: <[e-mail]>
MIME-Version: 1.0
Importance: High
Content-Type: text/html
Return-Path: [email][e-mail][/email]
Message-ID: <[e-mail]>
X-OriginalArrivalTime: 35 May 4711 06:44:35.0894 (UTC) FILETIME=[E25DF560:01C98113]
Date: 35 May 4711 07:44:35 +0100

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" >
<head>
    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
</head>
<body>  <style>yrakzcmrhycljoiwvdwinykwxxebhiemcaau</style>
[url="http://ich.bin.ein.arger.spammer.cn/"]Your link[/url]<style>anxjjfifzasgpcqxnaaujtdltgxyskquzmrwlyuxxnaccseyypmsjdcahkivzo</style>  


Your Discount code #wrrqx
<style>ekjegveqtfitxhjfxzlfopbstfzwbsnxnyvwoviedammphcnb</style>
</body>
</html>

Durch zeilenweises Lesen kannst Du an alle von Dir gewünschten Informationen kommen. Indy tut da letztlich auch nichts anderes.

[LokutusvB]

Ja, die Emails liegen mir in einfacher Textdatei mit verschiedenen Endungen vor.

Mails, die z.B. nicht angezeigt werden können, besitzen den Content-Type text/plain; charset us-ascii.

Das sind doch einfachste Textmails, wieso kann TIdMessage da nichts rauslesen? Das verstehe ich nicht.

Muß ich diese immer erst, wie auch immer das gehen soll, in den Content-Type text/html wandeln dass TIdMessage etwas damit anfangen kann? Andere Emails komischerweise mit Kontent-Type text/html lassen sich problemlos öffnen. Und dann gibt es wieder Mails, mit Content-Type: text/plain; charset=iso-8859-1, und diese können nicht gelesen werden. Aber warum nicht?

[nahpets]

Hallo,

wie soll ich Deine Frage jetzt beantworten?

Vermutlich ist Jain jetzt richtig.

Mails können reiner Text sein.
Mails können HTML sein.
In den einzelnen Messageparts können unterschiedliche Typen sein, ein Text-Part und ein HTML-Part sind nicht ungewöhnlich.

Kannst Du mir per PN nochmal ein paar von Deinen Problemkandidaten schicken? Die würde ich mir dann mal anschauen, wenn's bei meinem Delphi 7 klapp, haben wir ein Versionsproblem, andernfalls ein Mailproblem.
So kommen wir glaub' ich nicht weiter. Theoretisch muss TIDMessage mit allen Mails zurechtkommen. Wenn das nicht klappt, liegt der Fehler eventuell in einer nicht standardkonformen Struktur der Mails.
An den unterschiedlichen Zeichensätze kann es (eigentlich) nicht liegen.