SendEMail 邮件发送

Pony
Pony
Pony
134
文章
18
评论
2020-04-0720:35:16 1 2469字
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.
//调用方法
procedure TForm1.Button1Click(Sender:TObject);
begin
    ConnectToSMTPserver('smtp.qq.com',25,'635887@qq.com','*****');
    SendEMail ('标题','内容','635887@qq.com');
    DisconnectToSMTPserver;
end;
Pony
  • 本文由 发表于 2020-04-0720:35:16
Microsoft Edge 经典博文

Microsoft Edge

在动手写介篇小文之前 其实小弟此前是一直看不上MS的浏览器的... 十几年IE... 一路从IE5.0、6.0、7.0、8... 一直干到它IE11... 至此个人宣布Say Bye bye... 相...
Delphi CheckBox 透明 经典博文

Delphi CheckBox 透明

其实本来高版本次的Delphi应该已经可以在设置里搞掂介个了 氮素... 在低版本次的Delphi里介个就需要一哈啦... 比如... Delphi2007? 哈哈~~ 上干货... procedur...

发表评论

评论:1   其中:访客  0   博主  1
    • Pony Pony

      其实25端口的邮件发送已然是末流…
      现在都是SSL的咯…
      且看网络里各路大神显身手…