mailsnd.pas

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

unit MailSnd;

interface

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

type
  TMailSender = class(TForm)
    MessageExchanger: TMessageExchanger;
    tiMails: TTrayIcon;
    imMails: TImageList;
    pbMail: TProgressBar;
    lvLog: TListView;
    lInfo: TLabel;
    Label1: TLabel;
    procedure tiMailsDblClick(Sender: TObject);
    procedure MessageExchangerBeforeSMTPConnect(Sender: TObject;
      AMessage: TSMTPMessage);
    procedure MessageExchangerBeforeSMTPDisconnect(Sender: TObject;
      AMessage: TSMTPMessage);
    procedure MessageExchangerAfterSMTPDisconnect(Sender: TObject;
      AMessage: TSMTPMessage);
    procedure MessageExchangerAfterSMTPConnect(Sender: TObject;
      AMessage: TSMTPMessage);
    procedure MessageExchangerSMTPConnectFail(Sender: TObject;
      AMessage: TSMTPMessage; E: Exception; var Retry: Boolean);
    procedure MessageExchangerAfterSendMessage(Sender: TObject;
      AMessage: TSMTPMessage; AStream: TStream);
    procedure MessageExchangerBeforeSendMessage(Sender: TObject;
      AMessage: TSMTPMessage; var AStream: TStream; var Send: Boolean);
    procedure MessageExchangerMessageSending(Sender: TObject;
      AMessage: TSMTPMessage; BytesSent: Integer);
    procedure MessageExchangerSendMessageFail(Sender: TObject;
      AMessage: TSMTPMessage; AStream: TStream; E: Exception;
      var Retry: Boolean);
  private
    FSmtpHost: string;
    FSmtpPort: Integer;
    FUserID: string;
    FMailID: Integer;
    FMailSubject: string;
    procedure AddInfo(const Info: string; State: Integer);
  public
    { Public declarations }
  end;

var
  MailSender: TMailSender;

procedure StartSendMail;

implementation

{$R *.DFM}

uses
  MailCenter;

procedure AddMail;
var
  sm: TStream;
  msg: TMessage;
  V: Variant;
begin
  V := VarArrayCreate([0, 1], varBoolean);
  V[0] := True;
  V[1] := False;
  with MailCenterForm.tbMail do
  begin
    if Locate('SENDING;DELETED', V, []) then
    begin
      sm := TMemoryStream.Create;
      try
        TBlobField(FieldByName('MAILCONTENT')).SaveToStream(sm);
        sm.Position := 0;
        msg := TMessage.Create(nil);
        try
          msg.Message.LoadHeaderFromStream(sm);
          sm.Position := 0;
          with MailSender do
          begin
            FMailID := FieldByName('MAILID').AsInteger;
            FMailSubject := msg.Subject;
            MessageExchanger.SMTPMessages.Add(FSmtpHost, FUserID, msg.SendTo, sm, FSmtpPort);
          end;
        finally
          msg.Free;
        end;
      except
        sm.Free;
        raise;
      end;
    end;
  end;
end;

procedure StartSendMail;
begin
  if MailSender.MessageExchanger.Sending then Exit;
  with MailCenterForm.tbMailAccount do
  begin
    First;
    while not Eof do
    begin
      if FieldByName('SMTPHOST').AsString <> '' then
      begin
        MailSender.FSmtpHost := FieldByName('SMTPHOST').AsString;
        MailSender.FSmtpPort := FieldByName('SMTPPORT').AsInteger;
        MailSender.FUserID := FieldByName('USERID').AsString;
        Break;
      end;
      Next;
    end;
  end;
  AddMail;
end;

procedure TMailSender.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 TMailSender.tiMailsDblClick(Sender: TObject);
begin
  Show;
end;

procedure TMailSender.MessageExchangerBeforeSMTPConnect(Sender: TObject;
  AMessage: TSMTPMessage);
begin
  tiMails.Active := True;
  AddInfo('正在连接 ' + AMessage.Host + ' 主机。', 1);
end;

procedure TMailSender.MessageExchangerBeforeSMTPDisconnect(Sender: TObject;
  AMessage: TSMTPMessage);
begin
  AddInfo('正在断开 ' + AMessage.Host + ' 主机。', 1);
end;

procedure TMailSender.MessageExchangerAfterSMTPDisconnect(Sender: TObject;
  AMessage: TSMTPMessage);
begin
  AddInfo('断开主机成功。', 2);
  tiMails.Active := False;
end;

procedure TMailSender.MessageExchangerAfterSMTPConnect(Sender: TObject;
  AMessage: TSMTPMessage);
begin
  AddInfo('连接主机成功。', 2);
end;

procedure TMailSender.MessageExchangerSMTPConnectFail(Sender: TObject;
  AMessage: TSMTPMessage; E: Exception; var Retry: Boolean);
begin
  AddInfo('连接主机失败。', 3);
end;

procedure TMailSender.MessageExchangerAfterSendMessage(Sender: TObject;
  AMessage: TSMTPMessage; AStream: TStream);
begin
  AddInfo('邮件发送成功。', 2);
  pbMail.Position := 0;
  with MailCenterForm, tbMail do
    if Locate('MAILID', FMailID, []) then
    begin
      tbMail.Edit;
      tbMail.FieldByName('SENDING').AsBoolean := False;
      tbMail.FieldByName('SENT').AsBoolean := True;
      tbMail.Post;
      RefreshMailList;
    end;
  AddMail;
end;

procedure TMailSender.MessageExchangerBeforeSendMessage(Sender: TObject;
  AMessage: TSMTPMessage; var AStream: TStream; var Send: Boolean);
begin
  AddInfo(Format('正在发送邮件：%s。', [FMailSubject]), 1);
  pbMail.Position := 0;
  pbMail.Max := AStream.Size;
end;

procedure TMailSender.MessageExchangerMessageSending(Sender: TObject;
  AMessage: TSMTPMessage; BytesSent: Integer);
begin
  pbMail.Position := BytesSent;
end;

procedure TMailSender.MessageExchangerSendMessageFail(Sender: TObject;
  AMessage: TSMTPMessage; AStream: TStream; E: Exception;
  var Retry: Boolean);
begin
  AddInfo('邮件发送失败。', 3);
  pbMail.Position := 0;
  with MailCenterForm, tbMail do
    if Locate('MAILID', FMailID, []) then
    begin
      tbMail.Edit;
      tbMail.FieldByName('SENDING').AsBoolean := False;
      tbMail.Post;
      RefreshMailList;
    end;
  AddMail;
end;

end.