哪位兄弟有DELPHI6？进来帮忙

Question

procedure TfrmMain.CheckMailExecute(Sender: TObject);
begin
  Showbusy(true);
  ShowStatus('Connecting....');
  if POP.Connected then
  begin
    POP.Disconnect;
  end;
  POP.Host := Pop3ServerName;
  POP.Port := Pop3ServerPort;
  POP.UserID := Pop3ServerUser;
  POP.Password := Pop3ServerPassword;
  POP.Connect;
  ToggleStatus(True);
  FMsgCount := POP.CheckMessages;
  FMailBoxSize := POP.RetrieveMailBoxSize div 1024;
  ShowFileStatus;
  if FMsgCount > 0 then
  begin
    ShowFileStatus;
    RetrievePOPHeaders(FMsgCount);
  end
  else
  begin
    ShowStatus('No messages on server');
  end;
  Showbusy(false);
end;

Answer 1

{***************************************************************
 *
 * Project  : MailDemo
 * Unit Name: Main
 * Purpose  :
 * Version  : 1.0
 * Date  : Sat 21 Apr 2001  -  15:54:11
 * Author  : Hadi Hari <[email protected]>
 * History  :
 *
 ****************************************************************}unit Main;interfaceuses
   Graphics,  Controls,  Forms,  Dialogs,  Grids,  Menus,  ComCtrls,  StdCtrls,
   ExtCtrls,  ActnList,  ImgList,  Buttons, Windows, Messages,
   SysUtils,  Classes,  FileCtrl, IdSMTP, IdComponent,
   IdTCPConnection, IdTCPClient, IdMessageClient, IdPOP3, IdBaseComponent,
   IdMessage,  ToolWin, 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;
    Purgeedmessages1: 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;implementationuses Setup, MsgEditor,  IniFiles; //, smtpauth;{$IFDEF MSWINDOWS}{$R *.dfm}{$ELSE}{$R *.xfm}{$ENDIF}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;
  ShowStatus(stTemp);
end;procedure TfrmMain.ResetHeadersGrid;
begin
  lvHeaders.Items.Clear;
end;procedure TfrmMain.FormActivate(Sender: TObject);
begin
  {Set up authentication dialog-box}
//  frmSMTPAuthentication.cboAuthType.ItemIndex := Ord( frmMessageEditor.SMTP.AuthenticationType );
//  frmSMTPAuthentication.edtAccount.Text := fmSetup.Account.Text;
//  frmSMTPAuthentication.edtPassword.Text := fmSetup.Password.Text;
//  frmSMTPAuthentication.EnableControls;  ResetHeadersGrid;
  ToggleStatus(False);
end;procedure TfrmMain.ToggleStatus(const Status: Boolean);
begin
  CheckMail.Enabled := not Status;
  Retrieve.Enabled := Status;
  Delete.Enabled := Status;
  Purge.Enabled := Status;
  Disconnect.Enabled := Status;
  if Status then
    ShowStatus('Connected')
  else
    ShowStatus('Not connected');
end;procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Disconnect.Execute;
end;procedure TfrmMain.CheckMailExecute(Sender: TObject);
begin
  Showbusy(true);
  ShowStatus('Connecting....');
  if POP.Connected then
  begin
    POP.Disconnect;
  end;
  POP.Host := Pop3ServerName;
  POP.Port := Pop3ServerPort;
  POP.UserID := Pop3ServerUser;
  POP.Password := Pop3ServerPassword;
  POP.Connect;
  ToggleStatus(True);
  FMsgCount := POP.CheckMessages;
  FMailBoxSize := POP.RetrieveMailBoxSize div 1024;
  ShowFileStatus;
  if FMsgCount > 0 then
  begin
    ShowFileStatus;
    RetrievePOPHeaders(FMsgCount);
  end
  else
  begin
    ShowStatus('No messages on server');
  end;
  Showbusy(false);
end;procedure TfrmMain.RetrieveExecute(Sender: TObject);
var
  stTemp: string;
  intIndex: Integer;
  li: TListItem;
begin
  stTemp := Statusbar1.Panels[1].text;
  if lvHeaders.Selected = nil then
  begin
    Exit;
  end;
  //initialise
  Showbusy(true);
  Msg.Clear;
  Memo1.Clear;
  lvMessageParts.Items.Clear;
  From.Caption := '';
  Cc.Caption := '';
  Subject.Caption := '';
  Date.Caption := '';
  Receipt.Caption := '';
  Organization.Caption := '';
  Priority.Caption := '';
  pnlAttachments.visible := false;  //get message and put into MSG
  ShowStatus('Retrieving message "' + lvHeaders.Selected.SubItems.Strings[3] +
    '"');
  POP.Retrieve(lvHeaders.Selected.Index + 1, Msg);
  statusbar1.Panels[0].text := lvHeaders.Selected.SubItems.Strings[3];  //Setup fields on screen from MSG
  From.Caption := Msg.From.Text;
  Recipients.Caption := Msg.Recipients.EmailAddresses;
  Cc.Caption := Msg.CCList.EMailAddresses;
  Subject.Caption := Msg.Subject;
  Date.Caption := FormatDateTime('dd mmm yyyy hh:mm:ss', Msg.Date);
  Receipt.Caption := Msg.ReceiptRecipient.Text;
  Organization.Caption := Msg.Organization;
  Priority.Caption := IntToStr(Ord(Msg.Priority) + 1);  //Setup attachments list
  ShowStatus('Decoding attachments (' + IntToStr(Msg.MessageParts.Count) + ')');
  for intIndex := 0 to Pred(Msg.MessageParts.Count) do
  begin
    if (Msg.MessageParts.Items[intIndex] is TIdAttachment) then
    begin //general attachment
      pnlAttachments.visible := true;
      li := lvMessageParts.Items.Add;
      li.ImageIndex := 8;
      li.Caption := TIdAttachment(Msg.MessageParts.Items[intIndex]).Filename;
      //  li.SubItems.Add(TIdAttachment(Msg.MessageParts.Items[intIndex]).ContentType);
    end
    else
    begin //body text
      if Msg.MessageParts.Items[intIndex] is TIdText then
      begin
        Memo1.Lines.Clear;
        Memo1.Lines.AddStrings(TIdText(Msg.MessageParts.Items[intIndex]).Body);
      end
    end;
  end;
  ShowStatus(stTemp);
  Showbusy(false);
end;procedure TfrmMain.DeleteExecute(Sender: TObject);
begin
  if lvHeaders.Selected <> nil then
  begin
    Showbusy(true);
    POP.Delete(lvHeaders.Selected.Index + 1);
    lvHeaders.Selected.ImageIndex := 3;
    Showbusy(false);
  end;
end;procedure TfrmMain.PurgeExecute(Sender: TObject);
begin
  POP.Disconnect;
  ToggleStatus(False);
  CheckMailExecute(Sender);
end;procedure TfrmMain.DisconnectExecute(Sender: TObject);
begin
  if POP.Connected then
  begin
    try
      POP.Reset;
    except
      ShowStatus('Your POP server doesn''t have Reset feature');
    end;
    POP.Disconnect;
    ToggleStatus(False);
  end;
end;procedure TfrmMain.SetupExecute(Sender: TObject);
begin
  Application.CreateForm(TfmSetup, fmSetup);
  fmSetup.ShowModal;
end;procedure TfrmMain.SendExecute(Sender: TObject);
begin
  frmMessageEditor.ShowModal;
end;procedure TfrmMain.lvMessagePartsClick(Sender: TObject);
var
  i: Integer;
begin
  {display message parts we selected}
   if lvMessageParts.Selected <> nil then
      begin
         if lvMessageParts.Selected.Index > Msg.MessageParts.Count then
            begin
               MessageDlg('Unknown index', mtInformation, [mbOK], 0);
            end
         else
            begin
              for i := 0 to Msg.MessageParts.Count - 1 do begin
                if Msg.MessageParts.Items[i] is TIdAttachment then begin
                  if SaveDialog1.Execute then
                    TIdAttachment(Msg.MessageParts.Items[i]).SaveToFile(
                      SaveDialog1.FileName);
                    break;
                end;
              end;
            end;
      end;
end;
procedure TfrmMain.Exit1Click(Sender: TObject);
begin
  close;
end;procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // read the configuration from ini file
  ReadConfiguration;  name := 'frmMain';  //setup path to put attachments into
  FAttachPath := IncludeTrailingBackSlash(ExtractFileDir(Application.exename));
    //starting directory
  FAttachPath := FAttachPath + 'Attach\';
  if not DirectoryExists(FAttachPath) then
    ForceDirectories(FAttachPath);  FMsgCount := 0;
  FMailBoxSize := 0;
  Showbusy(false);
end;procedure TfrmMain.pnlServerNameClick(Sender: TObject);
begin
  SetupExecute(Sender); //show setup screen
end;procedure TfrmMain.ReadConfiguration;
var
  MailIni: TIniFile;
begin
  MailIni := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'Mail.ini');
  with MailIni do
  begin
    Pop3ServerName := ReadString('Pop3', 'ServerName', 'pop3.server.com');
    Pop3ServerPort := StrToInt(ReadString('Pop3', 'ServerPort', '110'));
    Pop3ServerUser := ReadString('Pop3', 'ServerUser', 'your_login');
    Pop3ServerPassword := ReadString('Pop3', 'ServerPassword', 'your_password');    SmtpServerName := ReadString('Smtp', 'ServerName', 'smtp.server.com');
    SmtpServerPort := StrToInt(ReadString('Smtp', 'ServerPort', '25'));
    SmtpServerUser := ReadString('Smtp', 'ServerUser', 'your_login');
    SmtpServerPassword := ReadString('Smtp', 'ServerPassword', 'your_password');
    SmtpAuthType := ReadInteger('Smtp', 'SMTPAuthenticationType', 0);    UserEmail := ReadString('Email', 'PersonalEmail', '[email protected]');
  end;
  MailIni.Free;
end;procedure TfrmMain.lvHeadersDblClick(Sender: TObject);
begin
  RetrieveExecute(Sender);
end;procedure TfrmMain.Selectfromdeletion1Click(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to lvHeaders.Items.Count - 1 do
  begin
    Showbusy(true);
    POP.Delete(i + 1);
    lvHeaders.Items[i].ImageIndex := 3;
    Showbusy(false);
  end;
end;end.