unit1.~pas

E-mail发送系统 DELPHI

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    EdtFrom: TEdit;
    EdtTo: TEdit;
    EdtSub: TEdit;
    EdtPass: TEdit;
    Label5: TLabel;
    Memo1: TMemo;
    StatusBar1: TStatusBar;
    BtnSend: TBitBtn;
    BtnExit: TBitBtn;
    BtnAppend: TBitBtn;
    SMTP1: TIdSMTP;
    Msg: TIdMessage;
    OpenDialog1: TOpenDialog;
    ComboBox1: TComboBox;
    Label6: TLabel;
    ListBox1: TListBox;
    Label7: TLabel;
    BtnDelete: TBitBtn;
    procedure BtnSendClick(Sender: TObject);
    procedure BtnExitClick(Sender: TObject);
    procedure SMTP1Connected(Sender: TObject);
    procedure SMTP1Disconnected(Sender: TObject);
    procedure BtnAppendClick(Sender: TObject);
    procedure BtnDeleteClick(Sender: TObject);
   
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//发送邮件
procedure TForm1.BtnSendClick(Sender: TObject);
var
    AdrFrom:string;
    i,cnt,len:integer;
begin
  try
    //显示状态
    StatusBar1.SimpleText:='正在连接';
    //获得发信人邮件地址
    AdrFrom:=EdtFrom.text;
    //获得字符串长度
    len:=length(AdrFrom);
    //检查邮件地址输入是否规范
    for i:=1 to len do
      if AdrFrom[i]='@' then
      begin
        cnt:=i;
        break;
      end;
    //填写邮件发送服务器的地址
    smtp1.Host:='smtp.'+copy(AdrFrom,cnt+1,len-cnt);
    //如果是用sina的服务器发送，则其smtp地址与通常的不一样
    //此处，读者可以自定义，添加各种不同的邮件服务器地址
    if copy(AdrFrom,cnt+1,4)='sina' then
      smtp1.Host:='smtp.'+copy(AdrFrom,cnt+1,len-cnt)+'.cn';
    //填写用户名
    smtp1.Username:=copy(AdrFrom,1,cnt-1);
    //填写密码
    smtp1.Password:=EdtPass.Text;
    with Msg do
    begin
      //填写信件正文
      Body.Assign(memo1.Lines);
      //填写发信人地址
      From.Address:=EdtFrom.Text;
      //填写收信人地址
      Recipients.EMailAddresses:=EdtTo.Text;
      //填写邮件标题
      subject:=EdtSub.Text;
      //设定邮件发送优先级
      case combobox1.ItemIndex of
        0:priority:=mphigh;
        1:priority:=mpnormal;
        2:priority:=mplow;
      end;
    end;
    //连接服务器，超时时间为2秒
    smtp1.Connect(2000);
    //发送邮件
    smtp1.send(Msg);
  finally
    //断开连接
    smtp1.disconnect;
    StatusBar1.SimpleText:='发送成功';
  end;
end;

//退出
procedure TForm1.BtnExitClick(Sender: TObject);
begin
  close;
end;

//连接时显示状态
procedure TForm1.SMTP1Connected(Sender: TObject);
begin
  StatusBar1.SimpleText:='已经连接，发送邮件中，请稍候';
end;

//断开时显示状态
procedure TForm1.SMTP1Disconnected(Sender: TObject);
begin
  StatusBar1.SimpleText:='连接断开';
end;

//增加附件
procedure TForm1.BtnAppendClick(Sender: TObject);
begin
  //打开发送附件的对话框
  if  opendialog1.Execute then
  begin
    //粘贴附件
    Tidattachment.Create(Msg.MessageParts,opendialog1.FileName);
    //附件显示在列表框中
    listbox1.Items.Add(opendialog1.FileName);
  end;
end;



//删除附件
procedure TForm1.BtnDeleteClick(Sender: TObject);
var
  index:integer;
begin
  if listbox1.ItemIndex>-1 then
  begin
    index:=listbox1.ItemIndex;
    //删除选定的附件
    Msg.MessageParts.Delete(index);
    //从列表框中删除选定的附件
    listbox1.Items.Delete(index);
  end;
end;

end.