Email服务器

开发平台：
Delphi

ViewMailListArchive.pas：源码内容
							unit ViewMailListArchive;
(******************************************************************************)
(*                                                                            *)
(* Hermes View Mail List Archive Dialog Box                                   *)
(* Part of Hermes SMTP/POP3 Server.                                           *)
(* Copyright(C) 2000 by Alexander J. Fanti, All Rights Reserver Worldwide.    *)
(*                                                                            *)
(* Created January 30, 2000 by Alexander J. Fanti.  See License.txt           *)
(*                                                                            *)
(* Used by: AddEditMailList                                                   *)
(* Uses: UtilU1                                                               *)
(*                                                                            *)
(* Description: This Modal dialog window allows the user to see a mail list   *)
(*              archive file, truncate or erase it.                           *)
(*                                                                            *)
(******************************************************************************)
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, Menus;
type
  TfrmViewMailListArchive = class(TForm)
    reArchive: TRichEdit;
    PopupMenu1: TPopupMenu;
    puSave: TMenuItem;
    puSaveAs: TMenuItem;
    puErase: TMenuItem;
    puTruncate: TMenuItem;
    N1: TMenuItem;
    puEdit: TMenuItem;
    puRefresh: TMenuItem;
    SaveDialog1: TSaveDialog;
    StatusBar1: TStatusBar;
    N2: TMenuItem;
    puClose: TMenuItem;
    Panel1: TPanel;
    lblWarning: TLabel;
    procedure puRefreshClick(Sender: TObject);
    procedure puSaveClick(Sender: TObject);
    procedure puSaveAsClick(Sender: TObject);
    procedure puEraseClick(Sender: TObject);
    procedure puTruncateClick(Sender: TObject);
    procedure puEditClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Panel1Resize(Sender: TObject);
    procedure reArchiveChange(Sender: TObject);
    procedure puCloseClick(Sender: TObject);
  private
    { Private declarations }
    FFilename, FListName : String;
    FEdited : Boolean;
    procedure Display;
  public
    { Public declarations }
    procedure View(ListName, Filename : String);
  end;
var
  frmViewMailListArchive: TfrmViewMailListArchive;
implementation
uses UtilU1;
{$R *.DFM}
procedure TfrmViewMailListArchive.View(ListName, Filename : String);
begin
  FFilename := Filename;
  FListName := ListName;
  FEdited := False;
  if FileExists(FFilename) then reArchive.Lines.LoadFromFile(FFilename)
    else reArchive.Lines.Clear;
  StatusBar1.Panels[1].Text := IntToStr(GetFileSize(FFilename)) + ' bytes';
  Display;
  ShowModal;
end;
procedure TfrmViewMailListArchive.Display;
begin
  Caption := 'Mail List (' + FListName + ') Archive - ' + FFilename;
  if FEdited then StatusBar1.Panels[0].Text := 'EDITED'
    else StatusBar1.Panels[0].Text := '';
  // Do not display file size here...
  // it's too demanding because of frequency of call...
  // We'll display it only when we load or save the file.
  StatusBar1.Panels[2].Text := IntToStr(reArchive.Lines.Count) + ' lines';
end;
procedure TfrmViewMailListArchive.Panel1Resize(Sender: TObject);
begin
  lblWarning.Width := Panel1.Width - (2 * lblWarning.Left);
end;
procedure TfrmViewMailListArchive.reArchiveChange(Sender: TObject);
begin
  if not reArchive.ReadOnly then begin
    FEdited := True;
    Display;
  end;
end;
procedure TfrmViewMailListArchive.puRefreshClick(Sender: TObject);
begin
  reArchive.Lines.LoadFromFile(FFilename);
  FEdited := False;
  StatusBar1.Panels[1].Text := IntToStr(GetFileSize(FFilename)) + ' bytes';
  Display;
end;
procedure TfrmViewMailListArchive.puSaveClick(Sender: TObject);
begin
  reArchive.Lines.SaveToFile(FFilename);
  FEdited := False;
  StatusBar1.Panels[1].Text := IntToStr(GetFileSize(FFilename)) + ' bytes';
  Display;
end;
procedure TfrmViewMailListArchive.puSaveAsClick(Sender: TObject);
begin
  if SaveDialog1.Execute then begin
    FFilename := SaveDialog1.Filename;
    Caption := 'Mail List (' + FListName + ') Archive - ' + FFilename;
    reArchive.Lines.SaveToFile(FFilename);
    FEdited := False;
  end;
  StatusBar1.Panels[1].Text := IntToStr(GetFileSize(FFilename)) + ' bytes';
  Display;
end;
procedure TfrmViewMailListArchive.puEraseClick(Sender: TObject);
begin
  reArchive.Lines.Clear;
  FEdited := True;
  Display;
end;
procedure TfrmViewMailListArchive.puTruncateClick(Sender: TObject);
var
  Lines, Drop : Longint;
  tempStr : String;
begin
  tempStr := InputBox('Truncate Archive to...',
                      'How many lines? (0 = cancel)', '0');
  try
    Lines := StrToInt(tempStr);
  except
    on E: Exception do Lines := -1;
  end;
  if Lines > 0 then
    if Lines < reArchive.Lines.Count then begin
      Drop := reArchive.Lines.Count -(Lines +1);
      while (Drop >= 0) and (reArchive.Lines.Count > 0) do begin
        reArchive.Lines.Delete(0);
        Dec(Drop);
      end;
    end;
  FEdited := True;
  Display;
end;
procedure TfrmViewMailListArchive.puEditClick(Sender: TObject);
begin
  puEdit.Checked := not puEdit.Checked;
  reArchive.ReadOnly := not puEdit.Checked;
  Display;
end;
procedure TfrmViewMailListArchive.puCloseClick(Sender: TObject);
begin
  Close;
end;
procedure TfrmViewMailListArchive.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
  x : Longint;
begin
  CanClose := True;
  if FEdited then begin
    x := MessageDlg('Archive has been edited.' + #13 + #10 +
                    'Do you want to save this version?',
                    mtConfirmation, [mbYes, mbNo, mbCancel], 0);
    if x = mrYes then begin
      reArchive.Lines.SaveToFile(FFilename);
      FEdited := False;
      StatusBar1.Panels[1].Text := IntToStr(GetFileSize(FFilename)) + ' bytes';
      Display;
    end;
    if x = mrCancel then CanClose := False;
  end;
end;
end.

						