Indy TIdMessage TExt auslesen

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