delphi SendEMail 邮件发送单元

本文整理自网络，侵删。

 
感谢网友分享qq风华(1393774265)  


unit SendEMailLib;

interface

uses
  Winapi.Windows,
  System.SysUtils,
  IdMessage,
  IdBaseComponent,
  IdComponent,
  IdTCPConnection,
  IdTCPClient,
  IdExplicitTLSClientServerBase,
  IdMessageClient,
  IdSMTPBase,
  IdSMTP,
  IdAttachmentFile,
  IdAntiFreezeBase,
  IdAntiFreeze;

var
  IdSMTP: TIdSMTP;
  IdMessage: TIdMessage;
  IdAntiFreeze:TIdAntiFreeze; //indy为堵塞式，加上这个组件让界面不会假死

procedure ConnectToSMTPserver(Host:string;Port:Word;UserName,PassWord:string;MaxWaitTime:DWord = 300000);
procedure DisconnectToSMTPserver;  //断开发信服务器
procedure SendEMail(Subject,Body,RecipientsEMailAddresses:string);  //发送邮件
procedure AddAttachmentFile(FileAddress:string);  //添加附件文件
procedure ClearAllAttachments;  //清除所有附件

implementation

procedure ConnectToSMTPserver(Host:string;Port:Word;UserName,PassWord:string;MaxWaitTime:DWord = 300000);
var       //连接发信服务器
  OldGetTickCount:DWORD;
begin
  IdSMTP := TIdSMTP.Create();
  IdMessage := TIdMessage.Create();
  IdAntiFreeze := TIdAntiFreeze.Create();
  IdAntiFreeze.OnlyWhenIdle := False;
  OldGetTickCount := GetTickCount;
  IdSMTP.Host:= Host;
  IdSMTP.Port:= Port;
  IdSMTP.Username:= UserName;
  IdSMTP.Password:= PassWord;
  try
    IdSMTP.Connect;
    idSMTP.Authenticate;
    if (GetTickCount - OldGetTickCount > MaxWaitTime) then raise Exception.Create('Error Message');
    //超过最长等待时间则报错
  except
    MessageBox(0,'已自动断开连接，请重新连接服务器！','连接发信服务器失败！',MB_OK + MB_ICONSTOP);
    idSMTP.Disconnect;
    IdSMTP.Free;
    IdMessage.Free;
    IdAntiFreeze.Free;
  end;
end;

procedure DisconnectToSMTPserver;  //断开发信服务器
begin
  IdSMTP.Disconnect();
  IdSMTP.Free;
  IdMessage.Free;
  IdAntiFreeze.Free;
end;

procedure SendEMail(Subject,Body,RecipientsEMailAddresses:string);  //发送邮件
begin
  try
    IdMessage.From.Address := IdSMTP.Username;                       //发件人地址
    IdMessage.Recipients.EMailAddresses:= RecipientsEMailAddresses;  //收件人地址
    IdMessage.Subject:= Subject;                                     //邮件标题
    IdMessage.CharSet:= 'UTF-8';
    IdMessage.Body.Clear;
    IdMessage.Body.Add(Body);                                        //发送内容
    IdMessage.Priority:= mpHigh;                                     //优先级
    IdSMTP.Send(IdMessage);                                          //发送邮件
    MessageBox(0, '您可以选择发送下一封邮件或者断开连接。', '发送邮件成功！', MB_OK + MB_ICONINFORMATION);
  except
    on E:Exception do
    begin
      MessageBox(0, PWideChar('错误信息：' + E.Message), '发送邮件失败！', MB_OK + MB_ICONSTOP);
    end;
  end;
end;

procedure AddAttachmentFile(FileAddress:string);  //添加附件文件
begin
  try
    TIdAttachmentFile.Create(IdMessage.MessageParts,FileAddress);
  except
    on E:Exception do
    begin
      MessageBox(0, PWideChar('错误信息：' + E.Message), '添加附件失败！', MB_OK + MB_ICONSTOP);
    end;
  end;
end;

procedure ClearAllAttachments;  //清除所有附件
begin
  IdMessage.MessageParts.Clear;
end;
end.

 

相关阅读 >>

Delphi xe firemonkey的stylebook皮肤控件的使用

Delphi tdirectory.getdirectories

Delphi中调用必应搜索(bing)的api函数

Delphi获取其它进程窗口句柄的3种方法

Delphi 删除只读文件

Delphi webbrowser1 设置获取编码

Delphi kmp(字符串匹配)算法

Delphi length 统计指定字符串的长度(即个数)

Delphi 读取全网站链接

Delphi xe android 调试错误：connection closed gracefully

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » delphi SendEMail 邮件发送单元