Kevin Westwood
Kevin Westwood

Reputation: 7789

Send email from Delphi 2007 app

I have a legacy delphi 2007 application that sends email alarms via TurboPower Internet Professional 1.15 (tpipro). I have recently revisited the application to find that the email send no longer is working because of the TLS/SSL requirements from most email servers. Now my question is where to go from here.

I Have Delphi XE2, but really have no desire to take the time to update my application to work on this ide. It has many library dependencies and so forth.

Is there a 3rd party email client that is up to date that will work on Delphi 2007? Or perhaps a .dll that could be used?

Upvotes: 2

Views: 1448

Answers (4)

hubalazs
hubalazs

Reputation: 449

Here are the Demo codes: http://www.indyproject.org/sockets/demos/index.en.aspx

IdPOP3 / IdSMTP / IdMessage

Upvotes: 2

Misha
Misha

Reputation: 1826

Just did this yesterday (you can replace my own classes with VCL classes to get it to work):

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.

Upvotes: 3

Shaun07776
Shaun07776

Reputation: 1052

Just to give you some more options

You could also try IPWorks its not free thou, you can find it Here or you might wanna look at ICS (Internet Component Suite) Which is freeware and you can find that Here

Indy is the obvious choice as it comes installed with Delphi XE2

Upvotes: 4

RRUZ
RRUZ

Reputation: 136431

You can use the Indy library which is included in delphi, these components support TLS and SSL (take a look to the TIdSmtp Component), you can find the last version of Indy Here.

Upvotes: 5

Related Questions