Internet - programa completo de email client com copia no server ou nao

unit Unit1;

interface

Uses

  Windows, Forms,Sysutils, Messages, Dialogs, IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient,

  IdPOP3, IdBaseComponent, IdMessage, IdAntiFreezeBase, IdAntiFreeze, STDCtrls,

  IdIntercept, IdLogBase, IdLogEvent, Classes, Controls, ExtCtrls;

type

  TForm1 = class(TForm)

    msg: TIdMessage;

    pop: TIdPOP3;

    IdLogEvent1: TIdLogEvent;

    IdAntiFreeze1: TIdAntiFreeze;

    ListBox2: TListBox;

    Memo1: TMemo;

    Panel1: TPanel;

    Button1: TButton;

    CheckBox1: TCheckBox;

    edUser: TEdit;

    edPass: TEdit;

    edServer: TEdit;

    Label1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    procedure Button1Click(Sender: TObject);

    procedure IdLogEvent1Received(ASender: TComponent; const AText,AData: String);

    procedure IdLogEvent1Sent(ASender: TComponent; const AText, AData: String);

  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

Var NumMsg, CurMsg, x : Integer;

    FileName, Path : String;

begin

   Memo1.Clear;

   Listbox2.Items.Clear;

   Path := 'C:\WINDOWS\DESKTOP\';

   if POP.Connected then POP.Disconnect;

   // Dados para a conexão

   POP.Host     := edServer.Text;

   POP.Port     := 110;

   POP.Username := edUser.Text;

   POP.Password := edPass.Text;

   POP.Connect;

   Try

     // Pega a quantidade de mensagens existentes na caixa postal

     NumMsg := POP.CheckMessages;

     Memo1.Lines.Add('Quantidade de mensagens: '+IntToStr(NumMsg) );

     If NumMsg>0 Then Begin;

        // Recupera individualmente cada mensagem

        For CurMsg := 1 to NumMsg do Begin

          // Recupera o Header da Mensagem

          Msg.Clear;

          POP.Retrieve(CurMsg,msg);

          Memo1.Lines.Add('Mensagem Número '+IntToStr(CurMsg));

          Memo1.Lines.Add('De: '+msg.From.Text);

          Memo1.Lines.Add('Para: '+Msg.Recipients.EmailAddresses);

          Memo1.Lines.Add('Assunto: '+Msg.Subject);

          Memo1.Lines.Add('Data: '+FormatDateTime('dd/mm/yyyy hh:mm:ss', Msg.Date));

          // Identifica os tipos Mime contidos no corpo do email

          For x := 0 to Pred(Msg.MessageParts.Count) do begin

             // Se for Attachment - Salva os arquivos anexos...

             if (Msg.MessageParts.Items[x] is TIdAttachment) then begin

                 FileName := Path+TIdAttachment(Msg.MessageParts.Items[x]).filename;

                 If FileExists(FileName) then DeleteFile(FileName);

                 TIdAttachment(Msg.MessageParts.Items[x]).SaveToFile(FileName);

                 Memo1.Lines.Add('Arquivo '+FileName+' foi salvo');

             // Se não for Attachment - Considera como corpo da mensagem

             end else begin

                 if Msg.MessageParts.Items[x] is TIdText then begin

                    Memo1.Lines.Add('Texto: '+TIdText(Msg.MessageParts.Items[x]).Body.Text);

                 end

             end;

          end;

          // Deleta a mensagem do Servidor de Email

          If not CheckBox1.Checked Then Pop.Delete(CurMsg);

          Memo1.Lines.Add('---');

        End;

     End;

   Finally

      POP.Disconnect;

   End;

end;

{ Observaçoes:

  O Componente AntiFreeze é usado para evitar o "congelamento" da aplicação

  durante as requisições Socket.

}

procedure TForm1.IdLogEvent1Received(ASender: TComponent; const AText, AData: String);

begin

   Listbox2.Items.Add('Recebido: '+ADAta);

end;

procedure TForm1.IdLogEvent1Sent(ASender: TComponent; const AText,

  AData: String);

begin

   Listbox2.Items.Add('Enviado: '+ADAta);

end;

end.

============= DFM

object Form1: TForm1

  Left = 210

  Top = 133

  Width = 673

  Height = 298

  Caption = 'Mail Checker'

  Color = clBtnFace

  Font.Charset = ANSI_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  PixelsPerInch = 96

  TextHeight = 13

  object ListBox2: TListBox

    Left = 0

    Top = 152

    Width = 665

    Height = 112

    Align = alBottom

    ItemHeight = 13

    TabOrder = 0

  end

  object Memo1: TMemo

    Left = 241

    Top = 0

    Width = 424

    Height = 152

    Align = alClient

    TabOrder = 1

  end

  object Panel1: TPanel

    Left = 0

    Top = 0

    Width = 241

    Height = 152

    Align = alLeft

    TabOrder = 2

    object Label1: TLabel

      Left = 8

      Top = 16

      Width = 36

      Height = 13

      Caption = 'Usuário'

    end

    object Label2: TLabel

      Left = 144

      Top = 16

      Width = 30

      Height = 13

      Caption = 'Senha'

    end

    object Label3: TLabel

      Left = 8

      Top = 58

      Width = 66

      Height = 13

      Caption = 'Servidor  POP'

    end

    object Button1: TButton

      Left = 153

      Top = 125

      Width = 75

      Height = 25

      Caption = 'Checar Email'

      TabOrder = 0

      OnClick = Button1Click

    end

    object CheckBox1: TCheckBox

      Left = 8

      Top = 104

      Width = 217

      Height = 17

      Caption = 'Deixar uma cópia no servidor'

      TabOrder = 1

    end

    object edUser: TEdit

      Left = 8

      Top = 32

      Width = 121

      Height = 21

      TabOrder = 2

    end

    object edPass: TEdit

      Left = 144

      Top = 32

      Width = 82

      Height = 21

      PasswordChar = '*'

      TabOrder = 3

    end

    object edServer: TEdit

      Left = 8

      Top = 72

      Width = 217

      Height = 21

      TabOrder = 4

    end

  end

  object msg: TIdMessage

    AttachmentEncoding = 'MIME'

    BccList = <>

    CCList = <>

    Encoding = meMIME

    Recipients = <>

    ReplyTo = <>

    Left = 248

    Top = 16

  end

  object pop: TIdPOP3

    Intercept = IdLogEvent1

    MaxLineAction = maException

    ReadTimeout = 0

    Left = 280

    Top = 16

  end

  object IdLogEvent1: TIdLogEvent

    Active = True

    OnReceived = IdLogEvent1Received

    OnSent = IdLogEvent1Sent

    Left = 312

    Top = 16

  end

  object IdAntiFreeze1: TIdAntiFreeze

    OnlyWhenIdle = False

    Left = 344

    Top = 16

  end

end