main.pas

Indy控件使用示例程序

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  110660: Main.pas 
{
{   Rev 1.0    25/10/2004 23:18:36  ANeillans    Version: 9.0.17
{ Verified
}
{-----------------------------------------------------------------------------
 Demo Name: Main
 Author:    Hadi Hariri <[e-mail]>
 Copyright: Indy Pit Crew
 Purpose:
 History:
-----------------------------------------------------------------------------
 Notes:

 Demonstrates basic email component usage

Verified:
  Indy 9:
    D7: 25th Oct 2004 by Andy Neillans
}


unit Main;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Grids, Menus, ComCtrls, IdSMTP, IdComponent, IdTCPConnection,
   IdTCPClient, IdMessageClient, IdPOP3, IdBaseComponent, IdMessage,
   StdCtrls, ExtCtrls, ToolWin, ActnList, ImgList, Buttons,
   IdAntiFreezeBase, IdAntiFreeze;

type
   TfrmMain = class(TForm)
      ActionList1: TActionList;
      Actions1: TMenuItem;
      Button1: TBitBtn;
      Cc: TLabel;
      CheckMail: TAction;
      Checkmail1: TMenuItem;
      Date: TLabel;
      Delete: TAction;
      Deletecurrentmessage1: TMenuItem;
      Disconnect: TAction;
      Disconnect1: TMenuItem;
      Exit1: TMenuItem;
      From: TLabel;
      IdAntiFreeze1: TIdAntiFreeze;
      ImageList1: TImageList;
      Label1: TLabel;
      Label10: TLabel;
      Label11: TLabel;
      Label4: TLabel;
      Label5: TLabel;
      Label6: TLabel;
      Label7: TLabel;
      Label8: TLabel;
      Label9: TLabel;
      lvHeaders: TListView;
      lvMessageParts: TListView;
      MainMenu1: TMainMenu;
      Memo1: TMemo;
      Msg: TIdMessage;
      N2: TMenuItem;
      N3: TMenuItem;
      Organization: TLabel;
      Panel1: TPanel;
      pnlBottom: TPanel;
      pnlBottomBottom: TPanel;
      pnlMain: TPanel;
      pnlAttachments: TPanel;
      pnlServerName: TPanel;
      pnlTop: TPanel;
      POP: TIdPOP3;
      Priority: TLabel;
      Purge: TAction;
      Purgemarkedmessages1: TMenuItem;
      Receipt: TLabel;
      Recipients: TLabel;
      Retrieve: TAction;
      Retrievecurrentmessage1: TMenuItem;
      SaveDialog1: TSaveDialog;
      Send: TAction;
      Send1: TMenuItem;
      Setup: TAction;
      Setup1: TMenuItem;
      Splitter1: TSplitter;
      StatusBar1: TStatusBar;
      StatusBar2: TStatusBar;
      Subject: TLabel;
      ToolBar1: TToolBar;
      ToolButton1: TToolButton;
      ToolButton10: TToolButton;
      ToolButton11: TToolButton;
      ToolButton12: TToolButton;
      ToolButton2: TToolButton;
      ToolButton3: TToolButton;
      ToolButton4: TToolButton;
      ToolButton5: TToolButton;
      ToolButton6: TToolButton;
      ToolButton7: TToolButton;
      ToolButton8: TToolButton;
      ToolButton9: TToolButton;
    Selectfromdeletion1: TMenuItem;
      function FindAttachment(stFilename: string): integer;
      procedure Button1Click(Sender: TObject);
      procedure CheckMailExecute(Sender: TObject);
      procedure DeleteExecute(Sender: TObject);
      procedure DisconnectExecute(Sender: TObject);
      procedure Exit1Click(Sender: TObject);
      procedure FormActivate(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure lvMessagePartsClick(Sender: TObject);
      procedure pnlServerNameClick(Sender: TObject);
      procedure PurgeExecute(Sender: TObject);
      procedure RetrieveExecute(Sender: TObject);
      procedure SendExecute(Sender: TObject);
      procedure SetupExecute(Sender: TObject);
      procedure ShowBusy(blBusy: boolean);
      procedure ShowFileStatus;
      procedure ShowStatus(stStatus: string);
    procedure lvHeadersDblClick(Sender: TObject);
    procedure Selectfromdeletion1Click(Sender: TObject);
   private
    { Private declarations }
      procedure RetrievePOPHeaders(inMsgCount: Integer);
      procedure ResetHeadersGrid;
      procedure ToggleStatus(const Status: Boolean);
      procedure ReadConfiguration;
   public
    { Public declarations }
    FAttachPath: string;
    FMsgCount, FMailBoxSize: integer;
   end;

var
   frmMain: TfrmMain;
   Pop3ServerName: String;
   Pop3ServerPort: Integer;
   Pop3ServerUser: String;
   Pop3ServerPassword: String;
   SmtpServerName: String;
   SmtpServerPort: Integer;
   SmtpServerUser: String;
   SmtpServerPassword: String;
   SmtpAuthType: Integer;
   UserEmail: String;

implementation

uses Setup, MsgEditor, inifiles; //, smtpauth;

{$R *.DFM}

procedure TfrmMain.ShowBusy(blBusy: boolean);
begin
   if blBusy then
      screen.cursor := crHourglass
   else
      screen.cursor := crDefault;
end; (*  *)

procedure TfrmMain.ShowStatus(stStatus: string);
begin
   Statusbar1.Panels[1].text := stStatus;
   StatusBar1.Refresh;
end; (*  *)

procedure TfrmMain.ShowFileStatus;
begin
   Statusbar2.Panels[0].text := IntToStr(FMsgCount);
   Statusbar2.Panels[1].text := format('Mail takes up %dK on the server', [FMailBoxSize]);
   StatusBar1.Refresh;
end; (*  *)

function TfrmMain.FindAttachment(stFilename: string): integer;
var
   intIndex: Integer;
   found: boolean;
begin
   intIndex := -1;
   result := -1;
   if (Msg.MessageParts.Count < 1) then exit; //no attachments (or anything else)
   found := false;
   stFilename := uppercase(stFilename);
   repeat
      inc(intIndex);
      if (Msg.MessageParts.Items[intIndex] is TIdAttachment) then
         begin //general attachment
            if stFilename = uppercase(TIdAttachment(Msg.MessageParts.Items[intIndex]).Filename) then
               found := true;
         end;
   until found or (intIndex > Pred(Msg.MessageParts.Count));
   if found then
      result := intIndex
   else
      result := -1;
end; (*  *)

procedure TfrmMain.Button1Click(Sender: TObject);
var
   intIndex: integer;
   fname: string;
   intMSGIndex: integer;
begin
  // Find selected
   for intIndex := 0 to lvMessageParts.Items.Count - 1 do
      if lvMessageParts.Items[intIndex].Selected then
         begin
            //now find which TIdAttachment it is in MSG
            intMSGIndex := FindAttachment(lvMessageParts.Items[intIndex].caption);
            if intMSGIndex > 0 then
               begin
                  fname := FAttachPath + TIdAttachment(Msg.MessageParts.Items[intMSGIndex]).filename;
                  SaveDialog1.FileName := fname;
                  if SaveDialog1.Execute then
                     begin
                        Showbusy(true);
                        TIdAttachment(Msg.MessageParts.Items[intMSGIndex]).SaveToFile(SaveDialog1.FileName);
                        Showbusy(false);
                     end;
               end;
         end;
end;

procedure TfrmMain.RetrievePOPHeaders(inMsgCount: Integer);
var
   stTemp: string;
   intIndex: integer;
   itm: TListItem;
begin
   stTemp := Statusbar1.Panels[1].text;
   lvHeaders.Items.Clear;
   for intIndex := 1 to inMsgCount do
      begin
         // Clear the message properties
         ShowStatus(format('Messsage %d of %d', [intIndex, inMsgCount]));
         Application.ProcessMessages;
         Msg.Clear;
         POP.RetrieveHeader(intIndex, Msg);
         // Add info to ListView
         itm := lvHeaders.Items.Add;
         itm.ImageIndex := 5;
         itm.Caption := Msg.Subject;
         itm.SubItems.Add(Msg.From.Text);
         itm.SubItems.Add(DateToStr(Msg.Date));
         itm.SubItems.Add(IntToStr(POP.RetrieveMsgSize(intIndex)));
         itm.SubItems.Add('n/a');
//         itm.SubItems.Add(POP.RetrieveUIDL(intIndex));
      end;