从Delphi 2007应用程序发送电子邮件

时间:2012-05-07 15:05:29

标签: delphi email delphi-2007

我有一个传统的delphi 2007应用程序,通过TurboPower Internet Professional 1.15(tpipro)发送电子邮件警报。我最近重新访问了该应用程序,发现由于大多数电子邮件服务器的TLS / SSL要求,电子邮件发送不再有效。现在我的问题是从这里开始。

我有Delphi XE2,但我真的不想花时间更新我的应用程序来处理这个ide。它有许多库依赖等等。

是否有适用于Delphi 2007的最新第三方电子邮件客户端?或者也许是可以使用的.dll?

4 个答案:

答案 0 :(得分:5)

您可以使用delphi中包含的Indy库,这些组件支持TLS和SSL(查看TIdSmtp组件),您可以找到Indy Here的最新版本。 / p>

答案 1 :(得分:4)

只是为了给你更多选择

你也可以尝试IPWorks它不是免费的,你可以找到它Here或者你可能想看看ICS(Internet组件套件)哪个是免费软件你可以找到Here

Indy是安装Delphi XE2

的明显选择

答案 2 :(得分:3)

昨天做了这个(你可以用VCL类替换我自己的类来使它工作):

unit SmtpClientUnt;

interface

uses
  Classes, IdSslOpenSsl, IdSmtp, CsiBaseObjectsUnt, DevExceptionsUnt;

type
  ESmtpClient = class(EDevException);

  TSmtpClient = class sealed(TCsiBaseObject)
  private
    FHostName: string;
    FIdSmtpClient: TIdSmtp;
    FIoHandler: TIdSslIoHandlerSocketOpenSsl;
    FUseTls: Boolean;
  protected
    procedure CheckIsOpen(const pEventAction: string);
    function GetHostName: string; virtual;
    function GetIsOpen: Boolean; virtual;
    function GetObjectName: string; override;
  public
    const LC_SMTP_CLIENT = 'SMTP Client';

    constructor Create(const pHostName: string; pUseTls: Boolean = False);
    destructor Destroy; override;
    procedure Close;
    procedure Open(const pUserName: string = ''; const pPassword: string = '');
    procedure Reconnect;
    procedure SendMessage(pToAddresses: TStrings; const pFromAddress: string;
                          const pSubject: string; const pBody: string;
                          pAttachmentFiles: TStrings = nil);
    property HostName: string read GetHostName;
    property IsOpen: Boolean read GetIsOpen;
  end;

implementation

uses
  SysUtils, IdAttachmentFile, IdEmailAddress, IdExplicitTlsClientServerBase, IdMessage,
  CsiExceptionsUnt, CsiGlobalsUnt, CsiSingletonManagerUnt, CsiStringsUnt;

{ TSmtpClient }

procedure TSmtpClient.CheckIsOpen(const pEventAction: string);
begin
  if not IsOpen then
    raise ESmtpClient.Create('Cannot ' + pEventAction +
                             ' while the SMTP client is not open', slError, 1,
                             ObjectName);
end;

procedure TSmtpClient.Close;
begin
  if IsOpen then begin
    CsiGlobals.AddLogMsg('Closing SMTP client', LC_SMTP_CLIENT, llVerbose, ObjectName);
    FIdSmtpClient.Disconnect;
  end;
end;

constructor TSmtpClient.Create(const pHostName: string; pUseTls: Boolean);
begin
  FHostName := pHostName;
  FUseTls := pUseTls;
  inherited Create;
  if FHostName = '' then
    raise ESmtpClient.Create('Cannot create SMTP client - empty host name', slError, 2,
                             ObjectName);

  FIdSmtpClient := TIdSmtp.Create(nil);
  FIdSmtpClient.Host := pHostName;

  if FUseTls then begin
    FIoHandler := TIdSslIoHandlerSocketOpenSsl.Create(nil);
    FIdSmtpClient.IoHandler := FIoHandler;
    FIdSmtpClient.UseTls := utUseRequireTls;
  end;
end;

destructor TSmtpClient.Destroy;
begin
  Close;

  if FUseTls and Assigned(FIdSmtpClient) then begin
    FIdSmtpClient.IoHandler := nil;
    FreeAndNil(FIoHandler);
  end;

  FreeAndNil(FIdSmtpClient);
  inherited;
end;

function TSmtpClient.GetHostName: string;
begin
  if Assigned(FIdSmtpClient) then
    Result := FIdSmtpClient.Host
  else
    Result := FHostName;
end;

function TSmtpClient.GetIsOpen: Boolean;
begin
  Result := Assigned(FIdSmtpClient) and FIdSmtpClient.Connected;
end;

function TSmtpClient.GetObjectName: string;
var
  lHostName: string;
begin
  Result := inherited GetObjectName;
  lHostName := HostName;
  if lHostName <> '' then
    Result := Result + ' ' + lHostName;
end;

procedure TSmtpClient.Open(const pUserName: string; const pPassword: string);
begin
  if not IsOpen then begin
    with FIdSmtpClient do begin
      Username := pUserName;
      Password := pPassword;
      Connect;
    end;

    CsiGlobals.AddLogMsg('SMTP client opened', LC_SMTP_CLIENT, llVerbose, ObjectName);
  end;
end;

procedure TSmtpClient.Reconnect;
begin
  Close;
  Open;
end;

procedure TSmtpClient.SendMessage(pToAddresses: TStrings; const pFromAddress: string;
                                  const pSubject: string; const pBody: string;
                                  pAttachmentFiles: TStrings);
var
  lMessage: TIdMessage;
  lAddress: string;
  lName: string;
  lIndex: Integer;
  lAddressItem: TIdEMailAddressItem;
  lAttachmentFile: TIdAttachmentFile;
  lFileName: string;
begin
  CheckIsOpen('send message');

  lMessage := TIdMessage.Create(nil);
  try
    with lMessage do begin
      CsiSplitFirstStr(pFromAddress, ',', lAddress, lName);
      From.Address := lAddress;
      From.Name := lName;
      Subject := pSubject;
      Body.Text := pBody;
    end;

    for lIndex := 0 to pToAddresses.Count - 1 do begin
      lAddressItem := lMessage.Recipients.Add;
      CsiSplitFirstStr(pToAddresses.Strings[lIndex], ',', lAddress, lName);
      lAddressItem.Address := lAddress;
      lAddressItem.Name := lName;
    end;

    if Assigned(pAttachmentFiles) then
      for lIndex := 0 to pAttachmentFiles.Count - 1 do begin
        lAttachmentFile := TIdAttachmentFile.Create(lMessage.MessageParts);
        lFileName := pAttachmentFiles.Strings[lIndex];
        lAttachmentFile.StoredPathName := lFileName;
        lAttachmentFile.FileName := lFileName;
      end;

    FIdSmtpClient.Send(lMessage);
  finally
    lMessage.Free;
  end;
end;

procedure InitialiseUnit;
begin
  CsiAllCapWords.AddString('SMTP');
end;

initialization

CsiSingletonManager.RegisterHook(InitialiseUnit, nil);

end.

答案 3 :(得分:2)

以下是演示代码: http://www.indyproject.org/sockets/demos/index.en.aspx

IdPOP3 / IdSMTP / IdMessage