Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi IDIMAP4 - Mails abrufen und ggf. löschen (https://www.delphipraxis.net/59058-idimap4-mails-abrufen-und-ggf-loeschen.html)

FriFra 16. Dez 2005 19:09


IDIMAP4 - Mails abrufen und ggf. löschen
 
Ich habe gerade mal versucht über IMAP Mails abzurufen... das hat allerdings nicht funktioniert.
Codeauszug (umgebaute POP3 Routine):
Delphi-Quellcode:
      //IMAP4
      IdIMAP41.Connect;

      //Das muss ich machen, da ich sonst schon beim Abfragen des
      //LastCmdResult eine Fehlermeldung bekomme
      while IdIMAP41.ConnectionState<>csAuthenticated do
      Application.ProcessMessages;

      if IdIMAP41.LastCmdResult.TextCode = '1' then
        Memo2.Lines.Add('<< +OK Ready')
      else
        Memo2.Lines.Add('<< +OK Result ' + IdIMAP41.LastCmdResult.TextCode);

      aCount := IdIMAP41.MailBox.TotalMsgs; //<-Hier crasht's... ich kann nicht auf MailBox zugreifen (?)
      aSize := IdIMAP41.RetrieveMailBoxSize;
      Memo2.Lines.Add('<< +OK ' + IntToStr(aCount) + ' ' + IntToStr(aSize));
      IdSMTP1.Connect;
      if IdSMTP1.Connected = True then
      begin
        Memo2.Lines.Add(IntToStr(aCount) + ' messages waiting');

        for n := 1 to aCount do
        begin
          TmpMsg := TIdMessage.Create(nil);
          try
            if IdIMAP41.Retrieve(n, TmpMsg) = True then
              Memo1.Lines.Add('retrieved')
            else
              Memo1.Lines.Add('NOT retrieved');

            MS := TMemoryStream.Create;
            try
              TmpMsg.SaveToStream(MS);

              Memo2.Lines.Add('<< +OK ' + IntToStr(MS.Size));
            finally
              MS.Free;
            end;

            Memo2.Lines.Add('Message from: ' +
              ExtractMail(TmpMsg.Headers.Values['From']));
            Memo2.Lines.Add('to: ' +
              ExtractMail(TmpMsg.Headers.Values['To']));

            TmpMsg.Headers.BeginUpdate;

            if UserField <> '' then
            begin
              if TmpMsg.Headers.IndexOfName(UserField) = -1 then
                TmpMsg.Headers.Add(UserField);
            end;
            if TmpMsg.Headers.IndexOfName('Envelope_to') = -1 then
              TmpMsg.Headers.Add('Envelope_to');

            FoundApparentlyTo := False;
            for m := 0 to TmpMsg.Headers.Count - 1 do
            begin
              if Copy(LowerCase(TmpMsg.Headers[m]), 1, 13) =
                LowerCase('Apparently-To') then
              begin
                SendTo := Copy(TmpMsg.Headers[m], 16,
                  Length(TmpMsg.Headers[m]));
                TmpMsg.Headers[m] := 'Apparently-To: ' + Envelope_to;
                FoundApparentlyTo := True;
              end
              else if Copy(LowerCase(TmpMsg.Headers[m]), 1, 11) =
                LowerCase('Envelope_to') then
              begin
                TmpMsg.Headers[m] := 'Envelope_to: ' + Envelope_to;
              end
              else if (UserField <> '') and
                (Copy(LowerCase(TmpMsg.Headers[m]),
                1,
                Length(UserField)) = LowerCase(UserField)) then
                TmpMsg.Headers[m] := UserField + ': ' + Envelope_to;
            end;
            if FoundApparentlyTo = False then
            begin
              for m := 0 to TmpMsg.Headers.Count - 1 do
              begin
                if Copy(LowerCase(TmpMsg.Headers[m]), 1, 2) = LowerCase('To')
                  then
                begin
                  SendTo := Copy(TmpMsg.Headers[m], 5,
                    Length(TmpMsg.Headers[m]));
                  TmpMsg.Headers[m] := 'To: ' + Envelope_to;
                  break;
                end;
              end;
            end;
            TMpMsg.Headers.Add('SendTo: ' + SendTo);

            TmpMsg.Headers.EndUpdate;

            TmpMsg.ProcessHeaders;

            for m := 0 to TmpMsg.Headers.Count - 1 do
              Memo1.Lines.Add('Headers[' + IntToStr(m) + '] ' +
                TmpMsg.Headers[m]);

            try
              IdSMTP1.Send(TmpMsg);

              if IdSMTP1.LastCmdResult.TextCode = '250' then
              begin
                if CheckBox1.Checked = True then
                  Memo2.Lines.Add('<< +OK leave Message on Server')
                else if IdPop31.Delete(n) = True then
                  Memo2.Lines.Add('<< +OK Message deleted')
                else
                begin
                  Memo2.Lines.Add('<< +Error Message not deleted');
                  ErrCnt := ErrCnt + 1;
                end;
              end
              else
                Memo2.Lines.Add('<< +OK ' +
                  DeQuote(IdSMTP1.LastCmdResult.Text.CommaText));
            except
              Memo2.Lines.Add('<< +Error ' +
                DeQuote(IdSMTP1.LastCmdResult.Text.CommaText));
              ErrCnt := ErrCnt + 1;
            end;
          finally
            TmpMsg.Free;
          end;
        end;

        if ErrCnt = 0 then
          Memo2.Lines.Add('<< +OK Everything done')
        else
          Memo2.Lines.Add('<< +Error ' + IntToStr(ErrCnt) +
            ' errors while processing');

        IdSMTP1.Disconnect;
        IdIMAP41.Disconnect;
      end
      else
        Memo2.Lines.Add('<< +Error not connected to SMTP');

Christian Seehase 14. Jun 2007 12:02

Re: IDIMAP4 - Mails abrufen und ggf. löschen
 
Moin FriFra,

die Frage ist zwar schon recht alt, aber ich stehe (besser: stand ;-)) gerade vor dem gleichen Problem.

Um auf die Daten einer IMAP-Mailbox zugreifen zu können, muss man diese erst einmal auswählen.

Delphi-Quellcode:
if idIMAP4.SelectMailBox('inbox') then //...
Welche Namen für Mailboxen möglich sind, ist, z.B., in der Indy-Hilfe zum Thema TIdIMAP4.MailBoxSeparator nachzulesen.
INBOX ist hier die Standardmailbox für den angemeldeten User.


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:51 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz