main.pas

这是一套全面的网络组件

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  clMailMessage, clMC, clIMAP4, Menus, StdCtrls, ExtCtrls, ActnList,
  ComCtrls, ImgList, clTcpClient, clImapUtils, clCert;

type
  TIMAPViewMode = (clIMAPViewAll, clIMAPViewSub);

  TMainWindow = class(TForm)
    MainMenu: TMainMenu;
    mnHelp: TMenuItem;
    mnAbout: TMenuItem;
    clIMAP4: TclIMAP4;
    Parser: TclMailMessage;
    mnFile: TMenuItem;
    mnLogin: TMenuItem;
    mnLogout: TMenuItem;
    mnFileBreak1: TMenuItem;
    mnExit: TMenuItem;
    mnSettings: TMenuItem;
    mnAccount: TMenuItem;
    mnView: TMenuItem;
    Allfolders1: TMenuItem;
    Subscribedfolders1: TMenuItem;
    mnBreak: TMenuItem;
    Cleareventswindow1: TMenuItem;
    Splitter1: TSplitter;
    GroupBox1: TGroupBox;
    Events: TMemo;
    GroupBox2: TGroupBox;
    Splitter2: TSplitter;
    Actions: TActionList;
    actFolderNew: TAction;
    actFolderDelete: TAction;
    actFolderSubscribe: TAction;
    actFolderUnsubscribe: TAction;
    actFolderViewAll: TAction;
    actFolderViewSub: TAction;
    mnFolder: TMenuItem;
    Newfolder1: TMenuItem;
    Deletefolder1: TMenuItem;
    Subscribe1: TMenuItem;
    Unsubscribe1: TMenuItem;
    Folders: TTreeView;
    actLogin: TAction;
    actLogout: TAction;
    actFolderRename: TAction;
    gbFolderInfo: TGroupBox;
    Message1: TMenuItem;
    actMsgAppend: TAction;
    actMsgCopy: TAction;
    actMsgDelete: TAction;
    actMsgPurge: TAction;
    actMsgView: TAction;
    actMsgViewSrc: TAction;
    Appendmessage1: TMenuItem;
    Copymessage1: TMenuItem;
    Deletemessage1: TMenuItem;
    Purgemessages1: TMenuItem;
    Viewmessage1: TMenuItem;
    Viewmessagesource1: TMenuItem;
    Panel1: TPanel;
    MsgList: TListView;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    edFldName: TEdit;
    edFldRO: TEdit;
    edFldExists: TEdit;
    edFldResent: TEdit;
    edFld1Unseen: TEdit;
    actMsgSearch: TAction;
    Searchmessages1: TMenuItem;
    FolderPopup: TPopupMenu;
    MsgPopup: TPopupMenu;
    Newfolder2: TMenuItem;
    Deletefolder2: TMenuItem;
    Subscribe2: TMenuItem;
    Unsubscribe2: TMenuItem;
    Searchmessages2: TMenuItem;
    Appendmessage2: TMenuItem;
    Copymessage2: TMenuItem;
    Deletemessage2: TMenuItem;
    Purgemessages2: TMenuItem;
    Viewmessage2: TMenuItem;
    Viewmessagesource2: TMenuItem;
    Images: TImageList;
    edSubscribed: TEdit;
    Label7: TLabel;
    procedure mnAboutClick(Sender: TObject);
    procedure mnExitClick(Sender: TObject);
    procedure mnAccountClick(Sender: TObject);
    procedure Cleareventswindow1Click(Sender: TObject);
    procedure actFolderNewUpdate(Sender: TObject);
    procedure actFolderDeleteUpdate(Sender: TObject);
    procedure actFolderSubscribeUpdate(Sender: TObject);
    procedure actFolderNewExecute(Sender: TObject);
    procedure actFolderDeleteExecute(Sender: TObject);
    procedure actFolderSubscribeExecute(Sender: TObject);
    procedure actFolderUnsubscribeExecute(Sender: TObject);
    procedure actFolderViewAllExecute(Sender: TObject);
    procedure actFolderViewSubExecute(Sender: TObject);
    procedure actLoginUpdate(Sender: TObject);
    procedure actLogoutUpdate(Sender: TObject);
    procedure actLoginExecute(Sender: TObject);
    procedure actLogoutExecute(Sender: TObject);
    procedure actFolderRenameUpdate(Sender: TObject);
    procedure actFolderRenameExecute(Sender: TObject);
    procedure actMsgAppendUpdate(Sender: TObject);
    procedure actMsgAppendExecute(Sender: TObject);
    procedure actMsgCopyUpdate(Sender: TObject);
    procedure actMsgCopyExecute(Sender: TObject);
    procedure actMsgDeleteUpdate(Sender: TObject);
    procedure actMsgDeleteExecute(Sender: TObject);
    procedure actMsgPurgeUpdate(Sender: TObject);
    procedure actMsgPurgeExecute(Sender: TObject);
    procedure actMsgViewUpdate(Sender: TObject);
    procedure actMsgViewExecute(Sender: TObject);
    procedure actMsgViewSrcExecute(Sender: TObject);
    procedure FoldersChange(Sender: TObject; Node: TTreeNode);
    procedure actMsgSearchUpdate(Sender: TObject);
    procedure actMsgSearchExecute(Sender: TObject);
    procedure clIMAP4Close(Sender: TObject);
    procedure clIMAP4SendCommand(Sender: TObject; const AText: String);
    procedure clIMAP4ReceiveResponse(Sender: TObject; AList: TStrings);
    procedure FormDestroy(Sender: TObject);
    procedure clIMAP4VerifyServer(Sender: TObject;
      ACertificate: TclCertificate; const AStatusText: String;
      AStatusCode: Integer; var AVerified: Boolean);
  private
    FViewMode: TIMAPViewMode;
    FCertificateVerified: Boolean;
    procedure GetFoldersList;
    procedure AddFolderToList(Name: string; Subscribed: boolean);
    function GetFolderName(Node: TTreeNode): string;
    procedure UpdateMailboxInfo;
    procedure UpdateMessage(Item:TListItem);
    Procedure UpdateMessages;
  end;

var
  MainWindow: TMainWindow;

implementation

uses Account, AccData, CopyDlg, NewFldr, MessageSourceForm, MessageForm,
  Search;

{$R *.DFM}
const NAStr = 'N/A';

procedure TMainWindow.mnAboutClick(Sender: TObject);
begin
  ShowMessage('Clever Internet Suite Demos'#$D#$A'www.CleverComponents.com');
end;

procedure TMainWindow.mnExitClick(Sender: TObject);
begin
  Close();
end;

procedure TMainWindow.mnAccountClick(Sender: TObject);
begin
  with TAccountDialog.Create(Self) do try
    ShowModal;
  finally
    Release;
  end;
end;

procedure TMainWindow.Cleareventswindow1Click(Sender: TObject);
begin
  Events.Lines.Clear;
end;

procedure TMainWindow.actFolderNewUpdate(Sender: TObject);
begin
  actFolderNew.Enabled := clIMAP4.Active;
end;

procedure TMainWindow.actFolderDeleteUpdate(Sender: TObject);
begin
  actFolderDelete.Enabled := clIMAP4.Active and Assigned(Folders.Selected);
end;

procedure TMainWindow.actFolderRenameUpdate(Sender: TObject);
begin
  actFolderRename.Enabled := clIMAP4.Active and Assigned(Folders.Selected);
end;

procedure TMainWindow.actFolderSubscribeUpdate(Sender: TObject);
begin
  actFolderSubscribe.Enabled := clIMAP4.Active and (FViewMode = clIMAPViewAll) and
                                Assigned(Folders.Selected);
  actFolderUnsubscribe.Enabled := clIMAP4.Active and
                                Assigned(Folders.Selected) and
                                (Folders.Selected.ImageIndex = 1);
end;


procedure TMainWindow.actFolderNewExecute(Sender: TObject);
var S: string;
begin
  with TNewFolderDialog.Create(Self) do try
    if ShowModal = mrOk then begin
      if (rgCreateAs.ItemIndex = 0) and (Folders.Selected <> nil) then
        S := GetFolderName(Folders.Selected.Parent)
      else
        S := GetFolderName(Folders.Selected);
      if (S <> '') then S := S + clIMAP4.MailBoxSeparator;
      S := S + edName.Text;
      clIMAP4.CreateMailBox(S);
      if FViewMode = clIMAPViewSub then clIMAP4.SubscribeMailBox(S);
      AddFolderToList(S, FViewMode = clIMAPViewSub);
    end;
  finally
    Release;
  end;
end;

procedure TMainWindow.actFolderDeleteExecute(Sender: TObject);
begin
  if MessageDlg('Ok to delete folder "' + Folders.Selected.Text + '"?',
                mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
    clIMAP4.DeleteMailBox(GetFolderName(Folders.Selected));
    Folders.Selected.Delete;
  end;
end;

procedure TMainWindow.actFolderRenameExecute(Sender: TObject);
var S: string;
    IsSubscribed: boolean;
begin
  if InputQuery('Rename Folder', 'Rename folder "' + Folders.Selected.Text + '" to', S) then begin
    IsSubscribed := Folders.Selected.ImageIndex = 1;
    clIMAP4.RenameMailBox(GetFolderName(Folders.Selected), S);
    Folders.Selected.Delete;
    AddFolderToList(S, IsSubscribed);
  end;
end;

procedure TMainWindow.actFolderSubscribeExecute(Sender: TObject);
begin
  clIMAP4.SubscribeMailBox(GetFolderName(Folders.Selected));
  Folders.Selected.ImageIndex := 1;
  Folders.Selected.SelectedIndex := 1;
  ShowMessage('Folder subscribed successfully.');
end;

procedure TMainWindow.actFolderUnsubscribeExecute(Sender: TObject);
begin
  clIMAP4.UnsubscribeMailBox(GetFolderName(Folders.Selected));
  if (FViewMode = clIMAPViewAll) then begin
    Folders.Selected.ImageIndex := 0;
    Folders.Selected.SelectedIndex := 0;
  end else
    Folders.Selected.Delete;
  ShowMessage('Folder unsubscribed successfully.');
end;

procedure TMainWindow.actFolderViewAllExecute(Sender: TObject);
begin
  if (FViewMode <> clIMAPViewAll) then begin
    FViewMode := clIMAPViewAll;
    actFolderViewAll.Checked := True;
    actFolderViewSub.Checked := False;
    GetFoldersList;
  end;
end;

procedure TMainWindow.actFolderViewSubExecute(Sender: TObject);
begin
  if (FViewMode <> clIMAPViewSub) then begin
    FViewMode := clIMAPViewSub;
    actFolderViewAll.Checked := False;
    actFolderViewSub.Checked := True;
    GetFoldersList;
  end;
end;


procedure TMainWindow.actLoginUpdate(Sender: TObject);
begin
  actLogin.Enabled := not clIMAP4.Active;
end;

procedure TMainWindow.actLogoutUpdate(Sender: TObject);
begin
  actLogout.Enabled := clIMAP4.Active;
end;

procedure TMainWindow.actLoginExecute(Sender: TObject);
begin
  FCertificateVerified := False;

  with TAccountData.Create do try
    clIMAP4.Server := Server;
    clIMAP4.Port := Port;
    clIMAP4.UserName := Login;
    clIMAP4.Password := Password;
    if UseSSL then
      clIMAP4.UseTLS := ctAutomatic
    else
      clIMAP4.UseTLS := ctNone;
    clIMAP4.TimeOut := Timeout * 1000;
    clIMAP4.UseSPA := UseSPA;
    clIMAP4.Open;
  finally
    Free;
  end;
  GetFoldersList;
end;

procedure TMainWindow.actLogoutExecute(Sender: TObject);
begin
  clIMAP4.Close;