mailcenter.pas

一些小文档,不是很有用.但也还可以

{
  简单邮件收发例子
  作者：唐剑锋
  2000-2-3
}
unit MailCenter;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, Menus, ActnList, ImgList, TrayIcon, ComCtrls, ExtCtrls, Grids,
  DBGrids, MailCtrls, inetmsg;

const
  msReceived = 0;
  msCreated = 1;
  msReaded = 2;
  msSent = 2;
  msReplied = 4;
  msSending = 4;
  msDeleted = $80000000;

  maDeleteAfterDownload = 1;

type
  TDBGrid = class(DBGrids.TDBGrid)
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  end;

  TMailCenterForm = class(TForm)
    dbMail: TDatabase;
    tbMail: TTable;
    tbMailAccount: TTable;
    MainMenu: TMainMenu;
    miView: TMenuItem;
    miAccounts: TMenuItem;
    ActionList: TActionList;
    actMailAccount: TAction;
    actSend: TAction;
    actReceive: TAction;
    miTools: TMenuItem;
    S1: TMenuItem;
    R1: TMenuItem;
    ToolsImages: TImageList;
    LargeImages: TImageList;
    SmallImages: TImageList;
    trvFolder: TTreeView;
    Splitter1: TSplitter;
    Panel1: TPanel;
    MailViewer: TMailViewer;
    Splitter2: TSplitter;
    qryMail: TQuery;
    dsMail: TDataSource;
    dbgMail: TDBGrid;
    qryMailMAILID: TIntegerField;
    qryMailCREATETIME: TDateTimeField;
    qryMailRECEIVED: TBooleanField;
    qryMailREADED: TBooleanField;
    qryMailSENDING: TBooleanField;
    qryMailSENT: TBooleanField;
    qryMailREPLIED: TBooleanField;
    qryMailDELETED: TBooleanField;
    qryMailMAILHEADER: TBlobField;
    qryMailMAILCONTENT: TBlobField;
    qryMailSUBJECT: TStringField;
    qryMailSFROM: TStringField;
    qryMailSENDTO: TStringField;
    qryMailTIME: TStringField;
    actOpenMail: TAction;
    actNewMail: TAction;
    miFile: TMenuItem;
    N1: TMenuItem;
    actDeleteMail: TAction;
    D1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure actMailAccountExecute(Sender: TObject);
    procedure actReceiveExecute(Sender: TObject);
    procedure trvFolderChange(Sender: TObject; Node: TTreeNode);
    procedure qryMailAfterScroll(DataSet: TDataSet);
    procedure qryMailCalcFields(DataSet: TDataSet);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure actOpenMailExecute(Sender: TObject);
    procedure dbgMailDblClick(Sender: TObject);
    procedure actNewMailExecute(Sender: TObject);
    procedure actDeleteMailExecute(Sender: TObject);
    procedure actSendExecute(Sender: TObject);
  private
    FMailEditors: TList;
    FMailRootNode: TTreeNode;
    FInBoxNode: TTreeNode;
    FOutBoxNode: TTreeNode;
    FDraftNode: TTreeNode;
    FSentNode: TTreeNode;
    FRecycledNode: TTreeNode;
    procedure AddDefaultMailNodes;
    function AppPath: string;
    function DataPath: string;
  public
    procedure RefreshMailList;
  end;

var
  MailCenterForm: TMailCenterForm;

implementation

uses
  FileCtrl, MailAccts, MailRec, MailSnd, MailEditor;

{$R *.DFM}

const
  UnknownImageIndex = 0;
  DefaultImageIndex = 0;
  ClosedFolderImageIndex = 1;
  OpenedFolderImageIndex = 2;
  EmptyRecycledImageIndex = 3;
  FullRecycledImageIndex = 4;
  DefaultFunctionImageIndex = 5;
  DefaultFunctionFolderImageIndex = 6;
  InboxImageIndex = 7;
  OutBoxImageIndex = 8;
  DraftImageIndex = 9;
  SentImageIndex = 10;
  MailImageIndex = 11;
  MailRecycledImageIndex = 12;

  MailRootNodeID = 0;
  InBoxNodeID = 1;
  OutBoxNodeID = 2;
  DraftNodeID = 3;
  SentNodeID = 4;
  RecycledNodeID = 5;

type
  TMailEditorObject = class
  private
    FMailEditor: TMailEditorForm;
    FMailID: Integer;
    procedure MailEditorClose(Sender: TObject; var Action: TCloseAction);
    procedure MailEditorSave(Sender: TObject; AStream: TStream;
      var Saved: Boolean);
    procedure MailEditorNew(Sender: TObject);
    procedure MailEditorSending(Sender: TObject; var CanSend: Boolean);
    procedure MailEditorSent(Sender: TObject);
  public
    constructor Create(MailID: Integer);
  end;

constructor TMailEditorObject.Create(MailID: Integer);
var
  sm: TStream;
begin
  inherited Create;
  FMailID := MailID;
  FMailEditor := TMailEditorForm.Create(nil);
  MailCenterForm.FMailEditors.Add(Self);
  FMailEditor.OnClose := MailEditorClose;
  FMailEditor.OnSave := MailEditorSave;
  FMailEditor.OnNew := MailEditorNew;
  FMailEditor.OnSending := MailEditorSending;
  FMailEditor.OnSent := MailEditorSent;
  sm := TMemoryStream.Create;
  try
    with MailCenterForm.tbMail do
    begin
      if Locate('MAILID', MailID, []) then
      begin
        FMailEditor.ReadOnly := FieldByName('RECEIVED').AsBoolean or
          FieldByName('SENDING').AsBoolean or FieldByName('SENT').AsBoolean;
        TBlobField(FieldByName('MAILCONTENT')).SaveToStream(sm);
        sm.Position := 0;
        FMailEditor.LoadFromStream(sm);
        FMailEditor.Show;
      end;
    end;
  finally
    sm.Free;
  end;
end;

procedure TMailEditorObject.MailEditorClose(Sender: TObject;
  var Action: TCloseAction);
begin
  MailCenterForm.FMailEditors.Remove(Self);
  Action := caFree;
  Free;
end;

procedure TMailEditorObject.MailEditorSave(Sender: TObject; AStream: TStream;
  var Saved: Boolean);
var
  msg: TMessage;
  sm: TStream;
begin
  with MailCenterForm.tbMail do
  begin
    if Locate('MAILID', FMailID, []) then
    begin
      Edit;
      try
        TBlobField(FieldByName('MAILCONTENT')).LoadFromStream(AStream);
        AStream.Position := 0;
        msg := TMessage.Create(nil);
        sm := TMemoryStream.Create;
        try
          msg.Message.LoadHeaderFromStream(AStream);
          msg.Message.SaveHeaderToStream(sm);
          sm.Position := 0;
          TBlobField(FieldByName('MAILHEADER')).LoadFromStream(sm);
        finally
          sm.Free;
          msg.Free;
        end;
        Post;
      except
        Cancel;
        raise;
      end;
      MailCenterForm.RefreshMailList;
    end;
  end;
end;

procedure TMailEditorObject.MailEditorNew(Sender: TObject);
begin
  MailCenterForm.actNewMail.Execute;
end;

procedure TMailEditorObject.MailEditorSending(Sender: TObject; var CanSend: Boolean);
begin
  with MailCenterForm.tbMail do
    CanSend := Locate('MAILID', FMailID, []) and not FieldByName('RECEIVED').AsBoolean and
      not FieldByName('SENDING').AsBoolean and not FieldByName('SENT').AsBoolean and
      not FieldByName('DELETED').AsBoolean;
end;

procedure TMailEditorObject.MailEditorSent(Sender: TObject);
begin
  with MailCenterForm.tbMail do
    if Locate('MAILID', FMailID, []) then
    begin
      Edit;
      FieldByName('SENDING').AsBoolean := True;
      Post;
      MailCenterForm.RefreshMailList;
    end;
end;

procedure TDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  Windows.SetFocus(Handle);
  inherited;
end;

procedure TMailCenterForm.AddDefaultMailNodes;
begin
  trvFolder.Items.BeginUpdate;
  try
    FMailRootNode := trvFolder.Items.AddFirst(nil, '个人文件夹');
    FMailRootNode.ImageIndex := MailImageIndex;
    FMailRootNode.SelectedIndex := MailImageIndex;
    FMailRootNode.Data := Pointer(MailRootNodeID);
    FInBoxNode := trvFolder.Items.AddChild(FMailRootNode, '收件箱');
    FInBoxNode.ImageIndex := InboxImageIndex;
    FInBoxNode.SelectedIndex := InboxImageIndex;
    FInBoxNode.Data := Pointer(InBoxNodeID);
    FOutBoxNode := trvFolder.Items.AddChild(FMailRootNode, '发件箱');
    FOutBoxNode.ImageIndex := OutBoxImageIndex;
    FOutBoxNode.SelectedIndex := OutBoxImageIndex;
    FOutBoxNode.Data := Pointer(OutBoxNodeID);
    FDraftNode := trvFolder.Items.AddChild(FMailRootNode, '草稿');
    FDraftNode.ImageIndex := DraftImageIndex;
    FDraftNode.SelectedIndex := DraftImageIndex;
    FDraftNode.Data := Pointer(DraftNodeID);
    FSentNode := trvFolder.Items.AddChild(FMailRootNode, '已发送的邮件');
    FSentNode.ImageIndex := SentImageIndex;
    FSentNode.SelectedIndex := SentImageIndex;
    FSentNode.Data := Pointer(SentNodeID);
    FRecycledNode := trvFolder.Items.AddChild(FMailRootNode, '垃圾箱');
    FRecycledNode.ImageIndex := MailRecycledImageIndex;
    FRecycledNode.SelectedIndex := MailRecycledImageIndex;
    FRecycledNode.Data := Pointer(RecycledNodeID);
    FMailRootNode.Expanded := True;
  finally
    trvFolder.Items.EndUpdate;
  end;
end;

function TMailCenterForm.AppPath: string;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

function TMailCenterForm.DataPath: string;
begin
  Result := AppPath + 'Data\';
end;

procedure TMailCenterForm.RefreshMailList;
var
  MailID: Integer;
begin
  if not qryMail.Active then Exit;
  MailID := qryMail.FieldByName('MAILID').AsInteger;
  qryMail.DisableControls;
  try
    qryMail.Active := False;
    MailViewer.Clear;
    qryMail.Active := True;
    qryMail.Locate('MAILID', MailID, []);
  finally
    qryMail.EnableControls;
  end;
end;

procedure TMailCenterForm.FormCreate(Sender: TObject);
begin
  FMailEditors := TList.Create;
  ForceDirectories(DataPath);
  dbMail.Params.Values['Path'] := DataPath;
  dbMail.Connected := True;
  if not tbMail.Exists then tbMail.CreateTable;
  tbMail.Active := True;
  if not tbMailAccount.Exists then tbMailAccount.CreateTable;
  tbMailAccount.Active := True;
  AddDefaultMailNodes;
end;

procedure TMailCenterForm.FormDestroy(Sender: TObject);
begin
  while FMailEditors.Count > 0 do
    TMailEditorObject(FMailEditors[0]).FMailEditor.Close;
  FMailEditors.Free;
end;

procedure TMailCenterForm.actMailAccountExecute(Sender: TObject);
begin
  SetMailAccounts;
end;

procedure TMailCenterForm.actReceiveExecute(Sender: TObject);
begin
  StartReceiveMail;
end;

procedure TMailCenterForm.trvFolderChange(Sender: TObject;
  Node: TTreeNode);
begin
  if not Assigned(trvFolder.Selected) then Exit;
  qryMail.Active := False;
  MailViewer.Clear;
  case Integer(trvFolder.Selected.Data) of
    InBoxNodeID: qryMail.SQL.Text := 'SELECT * FROM MAILDATA WHERE RECEIVED = TRUE AND DELETED = FALSE ORDER BY CREATETIME DESC';
    OutBoxNodeID: qryMail.SQL.Text := 'SELECT * FROM MAILDATA WHERE RECEIVED = FALSE AND SENDING = TRUE AND DELETED = FALSE ORDER BY CREATETIME DESC';
    DraftNodeID: qryMail.SQL.Text := 'SELECT * FROM MAILDATA WHERE RECEIVED = FALSE AND SENT = FALSE AND SENDING = FALSE AND DELETED = FALSE ORDER BY CREATETIME DESC';
    SentNodeID: qryMail.SQL.Text := 'SELECT * FROM MAILDATA WHERE RECEIVED = FALSE AND SENT = TRUE AND DELETED = FALSE ORDER BY CREATETIME DESC';
    RecycledNodeID: qryMail.SQL.Text := 'SELECT * FROM MAILDATA WHERE DELETED = TRUE ORDER BY CREATETIME DESC';
  else
    Exit;
  end;
  qryMail.Active := True;
end;

procedure TMailCenterForm.qryMailAfterScroll(DataSet: TDataSet);
var
  sm: TStream;
begin
  sm := TMemoryStream.Create;
  try
    TBlobField(DataSet.FieldByName('MAILCONTENT')).SaveToStream(sm);
    sm.Position := 0;
    MailViewer.LoadFromStream(sm);
  finally
    sm.Free;
  end;
end;

procedure TMailCenterForm.qryMailCalcFields(DataSet: TDataSet);
var
  msg: TMessage;
  sm: TStream;
begin
  msg := TMessage.Create(nil);
  sm := TMemoryStream.Create;
  try
    TBlobField(DataSet.FieldByName('MAILHEADER')).SaveToStream(sm);
    sm.Position := 0;
    msg.Message.LoadHeaderFromStream(sm);
    DataSet.FieldByName('SUBJECT').AsString := msg.Subject;
    DataSet.FieldByName('SFROM').AsString := msg.From;
    DataSet.FieldByName('SENDTO').AsString := msg.SendTo;
    DataSet.FieldByName('TIME').AsString := msg.Date;
  finally
    sm.Free;
    msg.Free;
  end;
end;

procedure TMailCenterForm.FormShow(Sender: TObject);
begin
  WindowState := wsMaximized;
end;

procedure TMailCenterForm.actOpenMailExecute(Sender: TObject);
var
  MailID, I: Integer;
begin
  if qryMail.Active and not qryMail.IsEmpty then
  begin
    MailID := qryMail.FieldByName('MAILID').AsInteger;
    for I := 0 to FMailEditors.Count - 1 do
      if TMailEditorObject(FMailEditors[I]).FMailID = MailID then
      begin
        TMailEditorObject(FMailEditors[I]).FMailEditor.Show;
        Exit;
      end;
    TMailEditorObject.Create(MailID);
  end;
end;

procedure TMailCenterForm.dbgMailDblClick(Sender: TObject);
begin
  actOpenMail.Execute;
end;

procedure TMailCenterForm.actNewMailExecute(Sender: TObject);
begin
  tbMail.Append;
  tbMail.FieldByName('CREATETIME').AsDateTime := Now;
  tbMail.FieldByName('RECEIVED').AsBoolean := False;
  tbMail.FieldByName('READED').AsBoolean := False;
  tbMail.FieldByName('SENDING').AsBoolean := False;
  tbMail.FieldByName('SENT').AsBoolean := False;
  tbMail.FieldByName('REPLIED').AsBoolean := False;
  tbMail.FieldByName('DELETED').AsBoolean := False;
  tbMail.Post;
  TMailEditorObject.Create(tbMail.FieldByName('MAILID').AsInteger);
  RefreshMailList;
end;

procedure TMailCenterForm.actDeleteMailExecute(Sender: TObject);
var
  MailID: Integer;
begin
  if qryMail.Active and not qryMail.IsEmpty then
  begin
    MailID := qryMail.FieldByName('MAILID').AsInteger;
    if tbMail.Locate('MAILID', MailID, []) then
      if tbMail.FieldByName('DELETED').AsBoolean then
        tbMail.Delete
      else
      begin
        tbMail.Edit;
        tbMail.FieldByName('DELETED').AsBoolean := True;
        tbMail.Post;
      end;
    RefreshMailList;
  end;
end;

procedure TMailCenterForm.actSendExecute(Sender: TObject);
begin
  StartSendMail;
end;

end.