Delphi 使用Indy的TidPOP3接收邮件

最近测试了下delphi的Indy控件包中的TIdPOP3接收邮件功能，由于有些邮件服务器必须支持加密方式，所以，本测试直接使用的是加密方式（SSL），如果不需要加密方式，只需要更改服务端口以及断开POP3控件的IOHandler即可。

使用中应该先连接服务器，然后在进行读取或者删除处理，之后要断开服务器。

程序代码如下：

{新的POP3邮件接收函数包，使用POP3的协议
 对于没有加密（SLL）的端口为：110
 如果使用SSL加密协议，端口号：995

 函数包提供 连接，读取，删除，断开 四个函数
 在使用前一定要先连接，连接好以后才可以进行读取，删除等操作，最后需要断开

 直接使用加密的协议SSL.

}
unit uPOP3_Email;

interface
uses
  IdPOP3,IdMessage,IdBaseComponent,SysUtils,
  IdAttachment, Classes, IdSSLOpenSSL,
  IdText,Windows,IdExplicitTLSClientServerBase;

//连接POP3服务器函数
//入口参数：
// Host : POP3服务器的地址，采用SLL加密，端口默认为995
//Account: 邮件账户（邮件地址）

//PSW : 账户密码

//出口参数：连接成功，返回True,失败返回False
function ConnectPOP3Server(Host,Account,PSW : string; var ErrMsg : string) : Boolean;


//断开POP3邮件服务器
procedure DisconnectPOP3Server;

//取得邮件数量,返回当前邮件的数量
function Mail_GetCount : Integer;

//删除邮件
//入口参数：
// Index ： 邮件索引号
//出口参数：成功True,失败False
function Mail_Delete(Index : integer) : Boolean;


{取得邮件标题信息函数
 入口参数:
   Index      : 对应的邮件索引号，从1开始
   EmailTime  : 邮件发送时间
   EmailSubject: 邮件标题
   EmailBody  : 邮件的正式内容
   EmailSendAddress : 发送者地址
   ErrMsg : 返回错误信息
 返回参数：
   True : 表示返回成功，False : 表示返回失败
}
function Mail_GetEmailInfo(Index : integer; var EmailTime : TDateTime; var EmailSubject, EmailBody, EmailSendAddress, EmailAttachFileName, ErrMsg : string) : Boolean;



var
  POP3 : TIdPOP3;
  OpenSSLHandler: TIdSSLIOHandlerSocketOpenSSL;
  IdMessage : TIdMessage;
  ConnectOK : Boolean;

implementation


function ConnectPOP3Server(Host,Account,PSW : string; var ErrMsg : string) : Boolean;
begin
  if POP3.Connected then
    POP3.Disconnect;
  POP3.Host := Host;
  POP3.Username := Account;
  POP3.Password := PSW;
  try
    POP3.Connect;
    if POP3.Connected then Result := True;
  except on E: Exception do
    begin
      Result := False;
      ErrMsg := E.Message;
    end;
  end;
  ConnectOK := Result;
end;



//断开POP3邮件服务器
procedure DisconnectPOP3Server;
begin
  POP3.Disconnect;
  ConnectOK := False;
end;


//取得邮件数量,返回当前邮件的数量
function Mail_GetCountA : Integer;
begin
  Result := 0;
  if not ConnectOK then Exit;
  try
    Result := POP3.CheckMessages;  //取得邮件数量
  except on E: Exception do
    Result := -10;   //出现错误
  end;
end;

//删除邮件
//入口参数：
// Index ： 邮件索引号
//出口参数：成功True,失败False
function Mail_Delete(Index : integer) : Boolean;
begin
  Result := False;
  if not ConnectOK then Exit;
  try
    POP3.Delete(Index);
    Result := True;
  except on E: Exception do
  end;
end;


{取得邮件标题信息函数
 入口参数:
   Index      : 对应的邮件索引号，从1开始
   EmailTime  : 邮件发送时间
   EmailSubject: 邮件标题
   EmailBody  : 邮件的正式内容
   EmailSendAddress : 发送者地址
   EmailAttachFileName : 附件文件名称，附件直接保存在当前目录下的TMP目录中
   ErrMsg : 返回错误信息
 返回参数：
   True : 表示返回成功，False : 表示返回失败
}
function Mail_GetEmailInfo(Index : integer; var EmailTime : TDateTime; var EmailSubject, EmailBody, EmailSendAddress, EmailAttachFileName, ErrMsg : string) : Boolean;
var
 Count,i : integer;
 FileName : string;

begin
  Result := False;
  if not ConnectOK then Exit;
  try
    IdMessage.Clear;
    //读取内容
    EmailBody := '';
    if POP3.Retrieve(Index,IdMessage) then
      begin
        EmailSubject := IdMessage.Subject;     //标题
        EmailSendAddress := IdMessage.Sender.Text;   //发送邮件地址
        EmailTime := IdMessage.Date;           //邮件发送时间
        EmailSendAddress := IdMessage.From.Address;
        //取得当前邮件的附件数量
        Count := IdMessage.MessageParts.Count;
        if Count = 0 then //说明没有附件
         begin
           EmailBody := IdMessage.Body.Text
         end
        else     //说明有附件
         begin
           for i := 0 to Count- 1 do
             begin
               if (IdMessage.MessageParts.Items[i] is TidText) then
                begin
                 EmailBody := TidText(IdMessage.MessageParts.Items[1]).Body.Text;
                end;
               if (IdMessage.MessageParts.Items[i] is TIdAttachment) then
                begin
                 EmailAttachFileName := TIdAttachment(IdMessage.MessageParts.Items[i]).FileName;  //附件文件名称
                 FileName := ExtractFilePath(ParamStr(0));
                 ForceDirectories(FileName + '\TMP');
                 FileName := FileName + '\TMP\' + EmailAttachFileName;
                 TIdAttachment(IdMessage.MessageParts.Items[i]).SaveToFile(FileName); //保存附件
                 Continue;
                end;
             end;
         end;
       Result := True;
      end;
  except on E: Exception do
  end;

end;



initialization
  POP3 := TIdPOP3.Create(nil);
  OpenSSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  OpenSSLHandler.SSLOptions.Method := sslvTLSv1; //sslvSSLv23 ;//sslvSSLv3;
  POP3.IOHandler := OpenSSLHandler;
  POP3.Port := 995;  //加密的端口号
  POP3.UseTLS := utUseImplicitTLS;
  POP3.ReadTimeout := 1000 * 60 * 5; //5分钟
  POP3.ConnectTimeout := 1000 * 60 * 5; //连接超时5分钟
  IdMessage := TIdMessage.Create(nil);
  ConnectOK := False;

finalization
  IdMessage.Free;
  POP3.Free;
  OpenSSLHandler.Free;

end.

由于使用Live Writer的【代码插入】插件，对于delphi代码注释的着色并不是很彻底，所以，又手工修改了下，导致颜色不一致。