main.pas

这是一套全面的网络组件

unit main;

interface

uses
  Classes, Graphics, Controls, Forms, ExtCtrls, ComCtrls, ImgList, Menus,
  clPOP3, clMC, clSMTP, MessagePersister, clMailMessage, clEncoder,
  Dialogs, Progress, clTcpClient, clCert;

type
  TMainForm = class(TForm)
    tvFolders: TTreeView;
    Splitter1: TSplitter;
    lvMessages: TListView;
    FolderImages: TImageList;
    MessageImages: TImageList;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    NewMessage1: TMenuItem;
    Properties1: TMenuItem;
    N2: TMenuItem;
    Exit1: TMenuItem;
    Edit1: TMenuItem;
    DeleteMessage1: TMenuItem;
    MarkasRead1: TMenuItem;
    MarkasUnread1: TMenuItem;
    ools1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    Accounts1: TMenuItem;
    clSMTP: TclSMTP;
    clPOP3: TclPOP3;
    Message1: TMenuItem;
    Send1: TMenuItem;
    Receive1: TMenuItem;
    MessageParser: TclMailMessage;
    PopupMenu: TPopupMenu;
    NewMessage2: TMenuItem;
    SendMessage1: TMenuItem;
    ReceiveMessage1: TMenuItem;
    DeleteMessage2: TMenuItem;
    N1: TMenuItem;
    Properties2: TMenuItem;
    LoadMessage1: TMenuItem;
    SaveMessage1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure tvFoldersChange(Sender: TObject; Node: TTreeNode);
    procedure Exit1Click(Sender: TObject);
    procedure NewMessage1Click(Sender: TObject);
    procedure lvMessagesDblClick(Sender: TObject);
    procedure DeleteMessage1Click(Sender: TObject);
    procedure MarkasRead1Click(Sender: TObject);
    procedure MarkasUnread1Click(Sender: TObject);
    procedure Receive1Click(Sender: TObject);
    procedure Send1Click(Sender: TObject);
    procedure Accounts1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Properties1Click(Sender: TObject);
    procedure lvMessagesCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure lvMessagesKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LoadMessage1Click(Sender: TObject);
    procedure SaveMessage1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure clPOP3VerifyServer(Sender: TObject;
      ACertificate: TclCertificate; const AStatusText: String;
      AStatusCode: Integer; var AVerified: Boolean);
    procedure clSMTPVerifyServer(Sender: TObject;
      ACertificate: TclCertificate; const AStatusText: String;
      AStatusCode: Integer; var AVerified: Boolean);
  private
    FAccounts: TclMailAccounts;
    FMessageList: TclMailMessageList;
    FLoading: Boolean;
    FProgress: TfrmProgress;
    FIsStop: Boolean;
    FEditMode: Boolean;
    FPopVerified: Boolean; 
    FSmtpVerified: Boolean;
    procedure AddListItem(AMessage: TclMailMessageItem);
    procedure LoadListView(AStatus: TclMailMessageStatus);
    procedure LoadFolders;
    procedure LoadMessageList;
    procedure StoreMessageList;
    procedure LoadMessageStatuses;
    procedure CreateNewMessage;
    procedure DoOnMessageListChanged(Sender: TObject);
    function GetSelectedMessage: TclMailMessageItem;
    function GetSelectedStatus: TclMailMessageStatus;
    procedure LoadAccounts;
    procedure StoreAccounts;
    procedure ReceiveMessages;
    procedure SendMessages;
    procedure SendMessage(AMessage: TclMailMessageItem);
    function GetMessageCount(AStatus: TclMailMessageStatus): Integer;
    function GetMessageFileName: string;
    function GetAccountFileName: string;
    procedure DoStopProcess(Sender: TObject);
  end;

const
  cTlsMode: array[Boolean] of TclClientTlsMode = (ctNone, ctAutomatic);
  
var
  MainForm: TMainForm;

implementation

uses
  AccountsForm, MessageForm, MessageSourceForm, SysUtils, clMCUtils, CommCtrl, Windows,
  Types;

{$R *.dfm}

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FProgress := TfrmProgress.Create(nil);
  FProgress.OnStop := DoStopProcess;
  FAccounts := TclMailAccounts.Create(nil);
  FMessageList := TclMailMessageList.Create();
  FMessageList.OnMessageChanged := DoOnMessageListChanged;
  LoadMessageList();
  LoadMessageStatuses();
  LoadAccounts();
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  StoreAccounts();
  StoreMessageList();
  FMessageList.Free();
  FAccounts.Free();
  FProgress.Free();
  clSMTP.Close();
  clPOP3.Close();
end;

procedure TMainForm.LoadMessageStatuses();
begin
  tvFolders.Items[0].Data := Pointer(msInbox);
  tvFolders.Items[1].Data := Pointer(msOutbox);
  tvFolders.Items[2].Data := Pointer(msSent);
  tvFolders.Items[3].Data := Pointer(msDeleted);
  tvFolders.Items[4].Data := Pointer(msDraft);
end;

procedure TMainForm.AddListItem(AMessage: TclMailMessageItem);
const
  PiorityMap: array[TclMessagePriority] of Integer = (2, -1, 1);
  
var
  Item: TListItem;
begin
  Item := lvMessages.Items.Add();
  Item.Caption := '';
  Item.SubItems.Add(AMessage.From);
  Item.SubItems.Add(AMessage.Subject);
  Item.SubItems.Add(DateTimeToStr(AMessage.Date));
  Item.Data := AMessage;
  Item.ImageIndex := PiorityMap[AMessage.Priority];
end;

function TMainForm.GetMessageCount(AStatus: TclMailMessageStatus): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to FMessageList.Count - 1 do
  begin
    if (FMessageList[i].Status = AStatus) then
    begin
      Inc(Result);
    end;
  end;
end;

procedure TMainForm.LoadFolders;
const
  FolderCaptions: array[TclMailMessageStatus] of string = (
    'Drafts', 'Outbox', 'Sent Items', 'Inbox', 'Deleted Items'
  );
var
  i, MessageCount: Integer;
  TreeNode: TTreeNode;
  Status: TclMailMessageStatus;
begin
  tvFolders.Items.BeginUpdate();
  try
    for i := 0 to tvFolders.Items.Count - 1 do
    begin
      TreeNode := tvFolders.Items[i];
      Status := TclMailMessageStatus(TreeNode.Data);
      MessageCount := GetMessageCount(Status);
      if MessageCount > 0 then
      begin
        TreeNode.Text := Format('%s (%d)', [FolderCaptions[Status], MessageCount]);
      end else
      begin
        TreeNode.Text := FolderCaptions[Status];
      end;
    end;
  finally
    tvFolders.Items.EndUpdate();
  end;
end;

procedure TMainForm.LoadListView(AStatus: TclMailMessageStatus);
var
  i: Integer;
begin
  lvMessages.Items.BeginUpdate();
  try
    lvMessages.Clear();
    for i := 0 to FMessageList.Count - 1 do
    begin
      if (FMessageList[i].Status = AStatus) then
      begin
        AddListItem(FMessageList[i]);
      end;
    end;
  finally
    lvMessages.Items.EndUpdate();
  end;
end;

function TMainForm.GetMessageFileName: string;
begin
  Result := ExtractFilePath(ParamStr(0));
  if (Result <> '') and (Result[Length(Result)] <> '\') then
  begin
    Result := Result + '\';
  end;
  Result := Result + 'messages.dat';
end;

function TMainForm.GetAccountFileName: string;
begin
  Result := ExtractFilePath(ParamStr(0));
  if (Result <> '') and (Result[Length(Result)] <> '\') then
  begin
    Result := Result + '\';
  end;
  Result := Result + 'accounts.dat';
end;

procedure TMainForm.LoadMessageList();
begin
  FLoading := True;
  try
    FMessageList.Load(GetMessageFileName());
  finally
    FLoading := False;
  end;
end;

procedure TMainForm.StoreMessageList();
begin
  FMessageList.Store(GetMessageFileName());
end;

procedure TMainForm.CreateNewMessage();
var
  Msg: TclMailMessageItem;
begin
  if FEditMode then Exit;
  FEditMode := True;
  try
    Msg := FMessageList.Add();
    if TfrmMessage.NewMessage(Msg, GetCompleteEmailAddress(FAccounts.Name, FAccounts.EMail)) then
    begin
      SendMessage(Msg);  
    end else
    begin
      tvFolders.Items[4].Selected := True;
    end;
  finally
    FEditMode := False;
  end;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  tvFolders.Items[0].Selected := True;
end;

procedure TMainForm.tvFoldersChange(Sender: TObject; Node: TTreeNode);
begin
  LoadFolders();
  LoadListView(GetSelectedStatus());
end;

procedure TMainForm.Exit1Click(Sender: TObject);
begin
  Close();
end;

procedure TMainForm.NewMessage1Click(Sender: TObject);
begin
  CreateNewMessage();
end;

procedure TMainForm.DoOnMessageListChanged(Sender: TObject);
begin
  if (not FLoading) then
  begin
    LoadFolders();
    LoadListView(GetSelectedStatus());
    Application.ProcessMessages();
  end;
end;

procedure TMainForm.lvMessagesDblClick(Sender: TObject);
var
  Msg: TclMailMessageItem;
begin
  if FEditMode then Exit;
  FEditMode := True;
  try
    Msg := GetSelectedMessage();
    if (Msg <> nil) then
    begin
      if TfrmMessage.ShowMessage(Msg) then
      begin
        SendMessage(Msg);
      end;
    end;
  finally
    FEditMode := False;
  end;
end;

procedure TMainForm.DeleteMessage1Click(Sender: TObject);
var
  Msg: TclMailMessageItem;
begin
  Msg := GetSelectedMessage();
  if (Msg <> nil) then
  begin
    if (Msg.Status = msDeleted) then
    begin
      Msg.Free();
    end else
    begin
      Msg.Status := msDeleted;
    end;
  end;
end;

function TMainForm.GetSelectedMessage: TclMailMessageItem;
begin
  if (lvMessages.Selected <> nil) then
  begin
    Result := TclMailMessageItem(lvMessages.Selected.Data);
  end else
  begin