mailrec.pas

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

unit MailRec;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TrayIcon, msgexchg, ImgList, ComCtrls, StdCtrls, inetmsg, DB;

type
  TMailReceive = class(TForm)
    MessageExchanger: TMessageExchanger;
    tiMails: TTrayIcon;
    imMails: TImageList;
    pbMail: TProgressBar;
    lvLog: TListView;
    lInfo: TLabel;
    pbList: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    procedure MessageExchangerBeforeReceive(Sender: TObject);
    procedure MessageExchangerAfterReceive(Sender: TObject);
    procedure tiMailsDblClick(Sender: TObject);
    procedure MessageExchangerAfterReceiveMessage(Sender: TObject;
      APOPAccount: TPOPAccount; AStream: TStream; var Delete: Boolean);
    procedure MessageExchangerAfterGetMessageList(Sender: TObject;
      APOPAccount: TPOPAccount; Count: Integer);
    procedure MessageExchangerBeforeReceiveMessage(Sender: TObject;
      APOPAccount: TPOPAccount; MessageSize: Integer; var AStream: TStream;
      var Receive: Boolean);
    procedure MessageExchangerMessageReceiving(Sender: TObject;
      APOPAccount: TPOPAccount; BytesReceived: Integer);
    procedure MessageExchangerBeforePOPConnect(Sender: TObject;
      APOPAccount: TPOPAccount);
    procedure MessageExchangerBeforePOPDisconnect(Sender: TObject;
      APOPAccount: TPOPAccount);
    procedure MessageExchangerBeforeDeleteMessage(Sender: TObject;
      APOPAccount: TPOPAccount);
    procedure MessageExchangerBeforeGetMessageList(Sender: TObject;
      APOPAccount: TPOPAccount);
    procedure MessageExchangerDeleteMessageFail(Sender: TObject;
      APOPAccount: TPOPAccount; E: Exception; var Retry: Boolean);
    procedure MessageExchangerGetMessageListFail(Sender: TObject;
      APOPAccount: TPOPAccount; E: Exception; var Retry: Boolean);
    procedure MessageExchangerPOPConnectFail(Sender: TObject;
      APOPAccount: TPOPAccount; E: Exception; var Retry: Boolean);
    procedure MessageExchangerReceiveMessageFail(Sender: TObject;
      APOPAccount: TPOPAccount; AStream: TStream; E: Exception;
      var Retry: Boolean);
    procedure MessageExchangerAfterDeleteMessage(Sender: TObject;
      APOPAccount: TPOPAccount);
    procedure MessageExchangerAfterPOPConnect(Sender: TObject;
      APOPAccount: TPOPAccount);
    procedure MessageExchangerAfterPOPDisconnect(Sender: TObject;
      APOPAccount: TPOPAccount);
  private
    FMailNo: Integer;
    procedure AddInfo(const Info: string; State: Integer);
  public
    { Public declarations }
  end;

var
  MailReceive: TMailReceive;

procedure StartReceiveMail;

implementation

{$R *.DFM}

uses
  MailCenter;

procedure StartReceiveMail;
begin
  if MailReceive.MessageExchanger.Receiving then Exit;
  MailReceive.MessageExchanger.POPAccounts.Clear;
  with MailCenterForm.tbMailAccount do
  begin
    First;
    while not Eof do
    begin
      MailReceive.MessageExchanger.PopAccounts.Add(
        FieldByName('POPHOST').AsString,
        FieldByName('USERID').AsString,
        FieldByName('PASSWORD').AsString,
        FieldByName('POPPORT').AsInteger,
        FieldByName('STYLE').AsInteger and maDeleteAfterDownload = maDeleteAfterDownload);
      Next;
    end;
  end;
end;

procedure TMailReceive.AddInfo(const Info: string; State: Integer);
var
  im: TListItem;
begin
  lInfo.Caption := Info;
  im := lvLog.Items.Insert(0);
  im.Caption := Info;
  im.ImageIndex := State;
  case State of
    1: im.SubItems.Add('开始');
    2: im.SubItems.Add('成功');
  else
    im.SubItems.Add('失败');
  end;
  im.SubItems.Add(DateTimeToStr(Now));
end;

procedure TMailReceive.MessageExchangerBeforeReceive(Sender: TObject);
begin
  pbMail.Position := 0;
  pbList.Position := 0;
  tiMails.Active := True;
  AddInfo('正在接收邮件。', 1);
end;

procedure TMailReceive.MessageExchangerAfterReceive(Sender: TObject);
begin
  tiMails.Active := False;
  AddInfo('接收邮件完成。', 2);
  pbMail.Position := 0;
  pbList.Position := 0;
end;

procedure TMailReceive.tiMailsDblClick(Sender: TObject);
begin
  Show;
end;

procedure TMailReceive.MessageExchangerAfterReceiveMessage(Sender: TObject;
  APOPAccount: TPOPAccount; AStream: TStream; var Delete: Boolean);
var
  I: Integer;
  Msg: TMessage;
  sm: TStream;
begin
  with MailCenterForm.tbMail do
  begin
    Append;
    try
      FieldByName('CREATETIME').AsDateTime := Now;
      FieldByName('RECEIVED').AsBoolean := True;
      FieldByName('READED').AsBoolean := False;
      FieldByName('SENDING').AsBoolean := False;
      FieldByName('SENT').AsBoolean := False;
      FieldByName('REPLIED').AsBoolean := False;
      FieldByName('DELETED').AsBoolean := False;
      I := AStream.Position;
      TBlobField(FieldByName('MAILCONTENT')).LoadFromStream(AStream);
      AStream.Position := I;
      Msg := TMessage.Create(nil);
      try
        Msg.Message.LoadHeaderFromStream(AStream);
        sm := TMemoryStream.Create;
        try
          Msg.Message.SaveHeaderToStream(sm);
          sm.Position := 0;
          TBlobField(FieldByName('MAILHEADER')).LoadFromStream(sm);
        finally
          sm.Free;
        end;
      finally
        Msg.Free;
      end;
      Post;
    except
      Cancel;
      raise;
    end;
  end;
  Delete := True;
  pbList.Position := pbList.Position + 1;
  AddInfo('第 ' + IntToStr(FMailNo - 1) + ' 封邮件接收完成。', 2);
end;

procedure TMailReceive.MessageExchangerAfterGetMessageList(Sender: TObject;
  APOPAccount: TPOPAccount; Count: Integer);
begin
  pbList.Max := Count;
  AddInfo('获取邮件列表成功，共有 ' + IntToStr(Count) + ' 封邮件。', 2);
end;

procedure TMailReceive.MessageExchangerBeforeReceiveMessage(
  Sender: TObject; APOPAccount: TPOPAccount; MessageSize: Integer;
  var AStream: TStream; var Receive: Boolean);
begin
  pbMail.Max := MessageSize;
  if not Receive then pbList.Position := pbList.Position + 1;
  AddInfo('正在接收第 ' + IntToStr(FMailNo) + ' 封邮件。', 1);
  FMailNo := FMailNo + 1;
end;

procedure TMailReceive.MessageExchangerMessageReceiving(Sender: TObject;
  APOPAccount: TPOPAccount; BytesReceived: Integer);
begin
  pbMail.Position := BytesReceived;
end;

procedure TMailReceive.MessageExchangerBeforePOPConnect(Sender: TObject;
  APOPAccount: TPOPAccount);
begin
  AddInfo('正在以 ' + APOPAccount.Account + ' 身份连接 ' +
    APOPAccount.Host + ' 主机。', 1);
end;

procedure TMailReceive.MessageExchangerBeforePOPDisconnect(Sender: TObject;
  APOPAccount: TPOPAccount);
begin
  AddInfo('正在断开 ' + APOPAccount.Host + ' 主机。', 1);
end;

procedure TMailReceive.MessageExchangerBeforeDeleteMessage(Sender: TObject;
  APOPAccount: TPOPAccount);
begin
  AddInfo('正在删除第 ' + IntToStr(FMailNo - 1) + ' 封邮件。', 1);
end;

procedure TMailReceive.MessageExchangerBeforeGetMessageList(
  Sender: TObject; APOPAccount: TPOPAccount);
begin
  AddInfo('正在获取邮件列表。', 1);
end;

procedure TMailReceive.MessageExchangerDeleteMessageFail(Sender: TObject;
  APOPAccount: TPOPAccount; E: Exception; var Retry: Boolean);
begin
  AddInfo('删除第 ' + IntToStr(FMailNo - 1) + ' 封邮件失败。', 3);
end;

procedure TMailReceive.MessageExchangerGetMessageListFail(Sender: TObject;
  APOPAccount: TPOPAccount; E: Exception; var Retry: Boolean);
begin
  AddInfo('获取邮件列表失败。', 3);
end;

procedure TMailReceive.MessageExchangerPOPConnectFail(Sender: TObject;
  APOPAccount: TPOPAccount; E: Exception; var Retry: Boolean);
begin
  AddInfo('连接主机失败。', 3);
end;

procedure TMailReceive.MessageExchangerReceiveMessageFail(Sender: TObject;
  APOPAccount: TPOPAccount; AStream: TStream; E: Exception;
  var Retry: Boolean);
begin
  AddInfo('接收第 ' + IntToStr(FMailNo - 1) + ' 封邮件失败。', 3);
end;

procedure TMailReceive.MessageExchangerAfterDeleteMessage(Sender: TObject;
  APOPAccount: TPOPAccount);
begin
  AddInfo('删除第 ' + IntToStr(FMailNo - 1) + ' 封邮件成功。', 2);
end;

procedure TMailReceive.MessageExchangerAfterPOPConnect(Sender: TObject;
  APOPAccount: TPOPAccount);
begin
  AddInfo('连接主机成功。', 2);
  FMailNo := 1;
end;

procedure TMailReceive.MessageExchangerAfterPOPDisconnect(Sender: TObject;
  APOPAccount: TPOPAccount);
begin
  AddInfo('断开主机成功。', 2);
end;

end.