Delphi / 通讯 · 2024年12月5日

Delphi Indy10 SSL邮件发送(带附件)

之前一直使用非加密的方式发送邮件（使用的QQ邮箱 25端口），但是2024年11月24日之后，发现发送邮件时都返回提示（如下）；大致问题应该就是需要使用加密端口465才能继续发送；找了较多的资料，居然都用不了；而且资料很少，还有个家伙直接提交的一个Exe，哎~~~ 要有共享精神好么~~！！

Login fail. A secure connection is requiered(such as ssl). More information at https://help.mail.qq.com/detail/0/1010
JavaScript

以下是DelphiXE11发送邮件的完整代码，大家可以直接使用；如果使用低版本的，调整以下引用头

unit uEMail;

interface

uses
  System.SysUtils,  Classes,  IdMessage, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient,
  IdSMTPBase, IdSMTP,  IdIOHandler, IdAttachment, IdAttachmentFile, System.IniFiles,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdSSLOpenSSLHeaders,
  System.RegularExpressions, IdAntiFreezeBase, IdAntiFreeze;

type
  //邮件发送状态
  TEMailSendState = (TEMSS_WaitSend = 0,
                     TEMSS_Error = 1,
                     TEMSS_Succ = 2,
                     TEMSS_Failed = 3
                    );

type
  TMailSetting = record
    Host         : string;   //邮件发送服务器
    Port         : Integer;  //端口
    UserName     : string;   //邮箱登录帐号
    UserPassWord : string;   //邮箱登录密码
    SenderName   : string;   //发送人
    FilePath     : string;   //附件文件路径
  end;

var
  Consignees : Tstringlist;  //接收人列表
  IdAntiFreeze:TIdAntiFreeze;
  IdSMTP : TIdSMTP;
  IdMessage : TIdMessage;
  GMailSetting : TMailSetting;
  fIdSSL : TIdSSLIOHandlerSocketOpenSSL;
  iResult: boolean;


function LoadIni:boolean;

function CheckEmailAdress(const EmailAddr: string): Boolean;//验证Email

{-------------------------------------------------------------------------------
  过程名:    SendEmail
  作用:
  作者:      Chrysalis(QQ:342667266)
  日期:      2024.12.05
  参数:      _Recipients : string;   收件人列表  英文分号进行分割，支持多个
            _Subject:string;         邮件发送的标题
            _Content:string;         邮件发送的内容
            _AttachList:string;      附件列表  完整路径 英文分号进行分割，支持多个
            var sErr:string          发送邮件失败时的错误
  返回值:    TEMailSendState
-------------------------------------------------------------------------------}
function SendEmail(_Recipients : string; _Subject, _Content, _AttachList:string; var sErr:string):TEMailSendState;

implementation

uses
 uPubFunc ;


function LoadIni:boolean;
var
  fFile: TIniFile;
begin
  fFile := TIniFile.Create(GetCurrentDir + '\Config.ini');
  try
    with GMailSetting do
    begin
      Host          := fFile.ReadString('EMAIL','Host','smtp.qq.com');
      Port          := fFile.ReadInteger('EMAIL','Port',25);
      UserName      := fFile.ReadString('EMAIL','UserName','00000000@qq.com');
      UserPassWord  := fFile.ReadString('EMAIL','UserPassWord','');
      SenderName    := fFile.ReadString('EMAIL','SenderName','00000000@qq.com');
      FilePath      := fFile.ReadString('EMAIL','FilePath', ExtractFilePath(ParamStr(0)) + 'files\email\');
    end;
  finally
    freeandnil(fFile);
  end;
end;

//验证Email
function CheckEmailAdress(const EmailAddr: string): Boolean;
const
  EMAIL_REGEX = '^((?>[a-zA-Z\d!#$%&''*+\-/=?^_`{|}~]+\x20*|"((?=[\x01-\x7f])' + '[^"\\]|\\[\x01-\x7f])*"\x20*)*(?<angle><))?((?!\.)' + { }
    '(?>\.?[a-zA-Z\d!#$%&''*+\-/=?^_`{|}~]+)+|"((?=[\x01-\x7f])[^"\\]|\\[\x01-\x7f])*")@(((?!-)[a-zA-Z\d\-]+(?<!-)\.)+[a-zA-Z]' +       { }
    '{2,}|\[(((?(?<!\[)\.)(25[0-5]|2[0-4]\d|[01]?\d?\d)){4}|[a-zA-Z\d\-]*[a-zA-Z\d]:((?=[\x01-\x7f])[^\\\[\]]|\\[\x01-\x7f])+)\])(?(angle)>)$';
begin
  try
    Result := TRegEx.IsMatch(EmailAddr, EMAIL_REGEX);
  finally
  end;
end;

//发送邮件
function SendEmail(_Recipients : string; _Subject, _Content, _AttachList:string; var sErr:string):TEMailSendState;
var
  sRealRecipients, _sFilePath : string;
  idAtta : TIdAttachmentFile;
  I: Integer;
  sList, _AList : TStringList;
begin
  Result := TEMSS_Error;
  if Trim(_Recipients) = '' then Exit;

  //检查发送列表有效性，踢出无效的，发送有效的
  sErr := '';
  sRealRecipients := '';
  //按英文分号进行分割
  sList := TStringList.Create;
  try
    if not SplitString(Trim(_Recipients), sList, ';') then
      sErr := sErr + '[通知邮件地址] 填写有问题' + #13
    else
    begin
      if sList.Count > 10 then
        sErr := sErr + '[通知邮件地址] 不能超过10个地址' + #13
      else
      begin
        for I := 0 to sList.count - 1 do
        begin
          if Trim(sList.Strings[I]) = '' then Continue;
          if not CheckEmailAdress(Trim(sList.Strings[I])) then
            sErr := sErr + Format('电子邮件地址 [%s] 格式不正确',[Trim(sList.Strings[I])]) + #13
          else
          begin
            if pos(Trim(sList.Strings[I]), sRealRecipients) = 0 then
              sRealRecipients := sRealRecipients + Trim(sList.Strings[I]) + ';';
          end;
        end;
      end;
    end;
  finally
    sList.Free;
  end;

  if sRealRecipients = '' then Exit;
  if not Assigned(IdMessage) then Exit;
  if not Assigned(IdSMTP) then Exit;
  IdSMTP.Host := GMailSetting.Host;
  IdSMTP.Port := GMailSetting.Port;
  IdSMTP.Username := GMailSetting.UserName;
  IdSMTP.Password := GMailSetting.UserPassWord;
  IdSMTP.AuthType := satDefault  ;   //如果邮箱服务器需要身份验证，需要这句；
  IdSMTP.ValidateAuthLoginCapability := True;
  IdSMTP.UseTLS := utUseImplicitTLS;   //支持邮件发送SSL
  IdMessage.Body.Clear;         // 先清空上次发送的内容
  IdMessage.MessageParts.Clear; // 先清空上次发送的附件

  IdMessage.CharSet      :='GB2312';                    //不设置这个中文会乱码
  IdMessage.Priority     := mpHigh;                     //优先级
  IdMessage.From.Address := GMailSetting.UserName;      //设置发件人
  IdMessage.Recipients.EMailAddresses := _Recipients;   //设置收件人
  IdMessage.Subject      := _Subject;                   //设置邮件发送的标题
  IdMessage.Body.Text    := _Content;                   //设置邮件发送的内容

  //解析附件列表
  if _AttachList <> '' then
  begin
    //按英文分号进行分割
    _AList := TStringList.Create;
    try
      _AList.StrictDelimiter := True ;      //排除空格的方式
      _AList.Delimiter     := ';';
      _AList.DelimitedText := _AttachList;
      if _AList.Count <= 0 then Exit;
      for I := 0 to _AList.count - 1 do
      begin
        if Trim(_AList.Strings[I]) = '' then Continue;
        //检查需要发送的附件是否存在
        _sFilePath := GMailSetting.FilePath + Trim(_AList.Strings[I]);
        if FileExists(_sFilePath) then
        begin
          idAtta := TIdAttachmentFile.Create(IdMessage.MessageParts, _sFilePath); //附件
          idAtta.ContentType         := 'application/octet-stream';
          idAtta.ContentDisposition  := 'attachment';
          idAtta.ContentTransfer     := 'base64';
          idAtta.FileIsTempFile      := False;   //非临时文件，不需要删除
          idAtta.FileName          := ExtractFileName(Trim(_AList.Strings[I]));
        end;
      end;
    finally
      _AList.Free;
    end;
  end;

  try
    try
      IdSMTP.Connect;
      IdSMTP.Authenticate;     //登录验证
      if IdSMTP.Connected then
      begin
        IdSMTP.Send(IdMessage);
        Result := TEMSS_Succ;
      end
      else
      begin
        Result := TEMSS_Error;
      end;
    except
      on E:Exception do
      begin
        Result := TEMSS_Error;
        sErr := Format('发送邮件时发生错误 - %s',[E.Message]);
      end;
    end;
  finally
    if IdSMTP.Connected then
    begin
      IdSMTP.Disconnect(True);
    end;
  end;
end;

initialization
  IdAntiFreeze := TIdAntiFreeze.Create(nil);
  IdSMTP := TIdSMTP.Create(nil);
  IdMessage := TIdMessage.Create(nil);

  LoadIni;
  fIdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  fIdSSL.SSLOptions.Method := sslvSSLv23;
  fIdSSL.SSLOptions.Mode := sslmClient;
  IdSMTP.IOHandler := fIdSSL;
//  iResult := IdSSLOpenSSLHeaders.Load();

finalization
  if Assigned(IdMessage) then
    IdMessage.Free;
  if Assigned(IdSMTP) then
    IdSMTP.Free;
  if Assigned(fIdSSL) then
    fIdSSL.Free;
  if Assigned(IdAntiFreeze) then
    IdAntiFreeze.Free;

end.
JavaScript

引用前需要先配置一个配置文件Config.ini，自行修改函数也可以

Host 填写邮件服务器的地址，我这里使用的是QQ邮箱
Port 填写邮件服务器的SSL端口，QQ邮箱的SSL端口就是465； 非SSL端口是25
UserName 填写QQ邮箱账号
UserPassWord 填写授权码； 这个要特别注意，不是填你QQ邮箱的密码
SenderName 填写QQ邮箱账号和UserName一致即可
格式如下

[EMAIL]
Host=smtp.qq.com
Port=465
UserName=00000000@qq.com
UserPassWord=XXXXXXXXXXXXXX
SenderName=00000000@qq.com
JavaScript

使用方法

//引用方法 先调用 LoadIni 加载默认参数 我默认时当前路径的Config.ini
//程序初始化时调用一次
LoadIni

//后续在需要发送邮件时调用
SendEmail('1234567@qq.com;43212@qq.com',
          '这个是标题',
          '这个是内容',
          'c:/test.txt;c:/ok.txt;',
          sErr
          )
JavaScript

另外说一下使用25端口非加密方式发送邮件的方法，很简单；把上面代码中屏蔽如下代码，配置文件中的port修改为25即可；

IdSMTP.UseTLS := utUseImplicitTLS; //支持邮件发送SSL
JavaScript

祝各位好运

您可能还喜欢...