unit1.pas

利用Delphi7

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mask, IdBaseComponent, IdMessage, IdComponent,
  IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP;

type
  TSMTPForm = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    btnSend: TButton;
    AttachAdd: TButton;
    GroupBox6: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    HostName: TEdit;
    HostPort: TEdit;
    EditFrom: TEdit;
    EditTo: TEdit;
    EditUser: TEdit;
    EditSubject: TEdit;
    MemoMesg: TMemo;
    AttachmentList: TListBox;
    MemoInfo: TMemo;
    EditPass: TMaskEdit;
    MailMessage: TIdMessage;
    IdSMTP: TIdSMTP;
    AddAttachDlg: TOpenDialog;
    Label9: TLabel;
    EditCC: TEdit;
    Label10: TLabel;
    EditBCC: TEdit;
    procedure btnSendClick(Sender: TObject);
    procedure IdSMTPConnected(Sender: TObject);
    procedure IdSMTPDisconnected(Sender: TObject);
    procedure AttachAddClick(Sender: TObject);
    procedure AttachmentListKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure IdSMTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure IdSMTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdSMTPWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  SMTPForm: TSMTPForm;

implementation

{$R *.dfm}

procedure TSMTPForm.btnSendClick(Sender: TObject);

begin
  MemoInfo.Clear;

  //校验服务器属性
  if (Trim(HostName.Text)='') or  (Trim(HostPort.Text)='') then
    begin
    ShowMessage('请设置所要连接的SMTP服务器属性！');
    HostPort.Text:='25';
    HostName.SetFocus;
    Exit;
    end;

   //检测地址信息
  if (Trim(EditFrom.Text)='') or (Trim(EditTo.Text)='') then
     begin
     ShowMessage('请输入收信人或者发信人地址！');
     EditFrom.SetFocus ;
     Exit;
     end;

   //用户账号检验
  if (Trim(EditUser.Text)='') or (Trim(EditPass.Text)='') then
     begin
     ShowMessage('请正确输入用户登录帐号和密码！');
     EditUser.SetFocus;
     Exit;
     end;

   //对MailMessage属性进行赋值
    with MailMessage do
    begin
      Subject := EditSubject.Text;                      //邮件主题
      Body.Assign(MemoMesg.Lines);                      //邮件正文
      From.Address:=Trim(EditFrom.Text);                //发信人地址
      Recipients.EMailAddresses := Trim(editTo.Text);   //收件人地址
      CCList.EMailAddresses :=EditCC.Text;
      BCCList.EMailAddresses:=EditBCC.Text;
      //  for indexnum:=0 to AttachmentList.Items.Count  do
      //      TIdAttachment.Create(MailMessage.MessageParts,);
    end;

    //设置连接到服务器属性
   with  IdSMTP do
    begin
    Host:=Trim(HostName.Text);               //SMTP服务器地址
    Port:=StrToInt(Trim(HostPort.Text));     //SMTP服务器端口
    UserName:=Trim(EditUser.Text);           //用户账号
    Password:=Trim(EditPass.Text);           // 用户密码
    end;

    //连接到服务器
    MemoInfo.Lines.Add('准备连接到服务器！'+HostName.Text);

    try
      IdSMTP.Connect();  //调用 Connect连接服务器
      except             //连接失败
         begin
          MemoInfo.Lines.Add('无法连接到服务器！'+HostName.Text);
          Exit;
        end ;
      end;

     //检测SMTP服务器是否需要验证
      if (IdSMTP.AuthSchemesSupported.IndexOf ( 'LOGIN' ) <> -1)   then
         begin    //服务器要求验证
           MemoInfo.Lines.Add('服务器要求验证');
           IdSMTP.AuthenticationType:=atlogin;
         end
         else
           begin  //服务器不要求验证
               MemoInfo.Lines.Add('服务器不需要验证');
           end;
        MemoInfo.Lines.Add('开始验证');

      try
          if IdSMTP.Authenticate then              //验证通过
             MemoInfo.Lines.Add('服务器验证通过')
          else
             MemoInfo.Lines.Add('服务器验证失败'); //验证失败
      except
        begin
          MemoInfo.Lines.Add('服务器验证失败');
          IdSMTP.Disconnect;
          exit;
        end;
      end;

      //发送信件
       try
        IdSMTP.Send(MailMessage);
       except
          MemoInfo.Lines.Add('发送失败');
       end;

       IdSMTP.Disconnect;
       
end;

procedure TSMTPForm.IdSMTPConnected(Sender: TObject);
begin
 MemoInfo.Lines.Add('已经连接到服务器！'+HostName.Text)
end;

procedure TSMTPForm.IdSMTPDisconnected(Sender: TObject);
begin
    MemoInfo.Lines.Add('断开连接');
end;

procedure TSMTPForm.AttachAddClick(Sender: TObject);
begin
if AddAttachDlg.Execute then
      begin
       AttachmentList.Items.Add(AddAttachDlg.FileName);
       TIdAttachment.Create(MailMessage.MessageParts, AddAttachDlg.FileName); 
      end;
end;

procedure TSMTPForm.AttachmentListKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
   index:Integer;
begin
   //有效性检查
   if AttachmentList.ItemIndex=-1 then
      exit;

   //如果按Delete键，则删除该附件
   if Key<>VK_DELETE then
      exit;

   //删除列表中项
   index:=AttachmentList.ItemIndex;
   AttachmentList.Items.Delete(index);
   MailMessage.MessageParts.Delete(index);
end;

procedure TSMTPForm.IdSMTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
 MemoInfo.Lines.Add('发送信件成功');
end;

procedure TSMTPForm.IdSMTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
 MemoInfo.Lines.Add('开始发送信件');
end;

procedure TSMTPForm.IdSMTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
 MemoInfo.Lines.Add('正在发送信件');
end;

end.