Websocket client and server library for Delphi

Andre Mussche, author of AsmProfiler, has released a WebSocket implementation for Delphi, based on Internet Direct (Indy). It includes both client and server code and is available on Github at https://github.com/andremussche/DelphiWebsockets.

WebSocket is a web technology providing for bi-directional, full-duplex communications channels over a single TCP connection.

Send secure SMTP email from Delphi applications

Introduction

Sending email from Windows, Android and iOS Delphi applications over public SMTP servers requires an encrypted connection. Internet Direct (Indy) configuration for SSL/TLS connections is shown in this example source code.

Disclaimer

This code is mostly based on code posted in the Embarcadero forum and here.

Example usage

procedure TFormMailDemo.ButtonSendClick(Sender: TObject);
var
  Mail: TSSLEmail;
begin
  if EditToEmail.Text <> '' then
  begin
    Mail := TSSLEmail.Create('mail.example.com', 465,
      'me@example.com', '***');

    try
      Mail.edSenderName := 'ABC Inc.';
      Mail.edSenderEmail := 'abc@example.com';
      Mail.edToEmail := EditToEmail.Text;
      Mail.edSubject := EditSubject.Text;
      Mail.edBody := MemoBody.Lines;

      Mail.SendEmail;

      EditToEmail.Text:='';
      EditSubject.Text:='';
      MemoBody.Clear;
    finally
      Mail.Free;
    end;
  end;
end;

Requirements

The code requires Internet Direct (Indy) version 10.6.
Note that the application needs the SSL dynamic link libraries, which can be found at indy.fulgan.com/SSL.

Supported platforms

The code has been tested with Delphi 2009 on Windows. The original code in the linked article reportedly works with Android.
For iOS, please also read this article.

Feedback and support

Feedback is welcome, please visit Habarisoft web page to find contact information. The source code is unsupported example code, use it at your own risk.

Source code

The source code for the SSL mail unit is shown below.

unit IndySecureMailClient;

interface

uses
  IdMessage, Classes, IdSMTP;

const
  SMTP_PORT_EXPLICIT_TLS = 587;

type
  TSSLEmail = class(TObject)
  private
    IdMessage: TIdMessage;
    SMTP: TIdSMTP;

    FedBody: TStrings;
    FedSMTPPort: Integer;
    FedToEmail: string;
    FedSubject: string;
    FedSMTPServer: string;
    FedCCEmail: string;
    FedPassword: string;
    FedBCCEmail: string;
    FedSenderName: string;
    FedUserName: string;
    FedPriority: TIdMessagePriority;
    FedSenderEmail: string;
    FedSSLConnection: Boolean;

    // Getter / Setter
    procedure SetBody(const Value: TStrings);

    procedure Init;
    procedure InitMailMessage;
    procedure InitSASL;
    procedure AddSSLHandler;

  public
    constructor Create; overload;
    constructor Create(const ASMTPServer: string;
      const ASMTPPort: Integer;
      const AUserName, APassword: string); overload;

    destructor Destroy; override;

    procedure SendEmail;

    // Properties
    property edBCCEmail: string read FedBCCEmail write FedBCCEmail;
    property edBody: TStrings read FedBody write SetBody;
    property edCCEmail: string read FedCCEmail write FedCCEmail;
    property edPassword: string read FedPassword write FedPassword;
    property edPriority: TIdMessagePriority read FedPriority write FedPriority;
    property edSenderEmail: string read FedSenderEmail write FedSenderEmail;
    property edSenderName: string read FedSenderName write FedSenderName;
    property edSMTPServer: string read FedSMTPServer write FedSMTPServer;
    property edSMTPPort: Integer read FedSMTPPort write FedSMTPPort;
    property edSSLConnection: Boolean read FedSSLConnection write FedSSLConnection;
    property edToEmail: string read FedToEmail write FedToEmail;
    property edUserName: string read FedUserName write FedUserName;
    property edSubject: string read FedSubject write FedSubject;

  end;

implementation

uses
  IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
  IdMessageClient, IdSMTPBase, IdBaseComponent, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdSASLLogin,
  IdSASL_CRAM_SHA1, IdSASL, IdSASLUserPass, IdSASL_CRAMBase, IdSASL_CRAM_MD5,
  IdSASLSKey, IdSASLPlain, IdSASLOTP, IdSASLExternal, IdSASLDigest,
  IdSASLAnonymous, IdUserPassProvider;

constructor TSSLEmail.Create;
begin
  inherited;

  Init;

  FedBody := TStringList.Create;
end;

procedure TSSLEmail.Init;
begin
  edSSLConnection := True;
  edPriority := TIdMessagePriority.mpNormal;
end;

constructor TSSLEmail.Create(const ASMTPServer: string;
  const ASMTPPort: Integer; const AUserName, APassword: string);
begin
  Create;

  edSMTPServer := ASMTPServer;
  edSMTPPort := ASMTPPort;
  edUserName := AUserName;
  edPassword := APassword;
end;

destructor TSSLEmail.Destroy;
begin
  edBody.Free;

  inherited;
end;

// Setter / Getter -----------------------------------------------------------

procedure TSSLEmail.SetBody(const Value: TStrings);
begin
  FedBody.Assign(Value);
end;

// Send the mail -------------------------------------------------------------

procedure TSSLEmail.SendEmail;
begin
  IdMessage := TIdMessage.Create;
  try
    InitMailMessage;

    SMTP := TIdSMTP.Create;
    try
      if edSSLConnection then
      begin
        AddSSLHandler;

        if edSMTPPort = SMTP_PORT_EXPLICIT_TLS then
          SMTP.UseTLS := utUseExplicitTLS
        else
          SMTP.UseTLS := utUseImplicitTLS;
      end;

      if (edUserName<>'') or (edPassword<>'') then
      begin
        SMTP.AuthType := satSASL;
        InitSASL;
      end
      else
      begin
        SMTP.AuthType := satNone;
      end;

      SMTP.Host := edSMTPServer;
      SMTP.Port := edSMTPPort;
      SMTP.ConnectTimeout := 30000;
      SMTP.UseEHLO := True;
      SMTP.Connect;

      try
        SMTP.Send(IdMessage);
      finally
        SMTP.Disconnect;
      end;
    finally
      SMTP.Free;
    end;
  finally
    IdMessage.Free;
  end;
end;

// Prepare the mail ----------------------------------------------------------

procedure TSSLEmail.InitMailMessage;
begin
  IdMessage.ContentType := 'text/plain';
  IdMessage.Charset := 'UTF-8';
  IdMessage.Body := edBody;
  IdMessage.Sender.Text := edSenderEMail;
  IdMessage.From.Name := edSenderName;
  IdMessage.From.Address := edSenderEMail;
  IdMessage.ReplyTo.EMailAddresses := edSenderEmail;
  IdMessage.Recipients.EMailAddresses := edToEmail;
  IdMessage.Subject := edSubject;
  IdMessage.Priority := edPriority;
  IdMessage.CCList.EMailAddresses := edCCEMail;
  IdMessage.ReceiptRecipient.Text := '';
  IdMessage.BccList.EMailAddresses := edBCCEMail;
end;

procedure TSSLEmail.AddSSLHandler;
var
  SSLHandler: TIdSSLIOHandlerSocketOpenSSL;
begin
  SSLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(SMTP);
  // SSL/TLS handshake determines the highest available SSL/TLS version dynamically
  SSLHandler.SSLOptions.Method := sslvSSLv23;
  SSLHandler.SSLOptions.Mode := sslmClient;
  SSLHandler.SSLOptions.VerifyMode := [];
  SSLHandler.SSLOptions.VerifyDepth := 0;
  SMTP.IOHandler := SSLHandler;
end;

procedure TSSLEmail.InitSASL;
var
  IdUserPassProvider: TIdUserPassProvider;
  IdSASLCRAMMD5: TIdSASLCRAMMD5;
  IdSASLCRAMSHA1: TIdSASLCRAMSHA1;
  IdSASLPlain: TIdSASLPlain;
  IdSASLLogin: TIdSASLLogin;
  IdSASLSKey: TIdSASLSKey;
  IdSASLOTP: TIdSASLOTP;
  IdSASLAnonymous: TIdSASLAnonymous;
  IdSASLExternal: TIdSASLExternal;
begin
  IdUserPassProvider := TIdUserPassProvider.Create(SMTP);
  IdUserPassProvider.Username := edUserName;
  IdUserPassProvider.Password:= edPassword;

  IdSASLCRAMSHA1 := TIdSASLCRAMSHA1.Create(SMTP);
  IdSASLCRAMSHA1.UserPassProvider := IdUserPassProvider;
  IdSASLCRAMMD5 := TIdSASLCRAMMD5.Create(SMTP);
  IdSASLCRAMMD5.UserPassProvider := IdUserPassProvider;
  IdSASLSKey := TIdSASLSKey.Create(SMTP);
  IdSASLSKey.UserPassProvider := IdUserPassProvider;
  IdSASLOTP := TIdSASLOTP.Create(SMTP);
  IdSASLOTP.UserPassProvider := IdUserPassProvider;
  IdSASLAnonymous := TIdSASLAnonymous.Create(SMTP);
  IdSASLExternal := TIdSASLExternal.Create(SMTP);
  IdSASLLogin := TIdSASLLogin.Create(SMTP);
  IdSASLLogin.UserPassProvider := IdUserPassProvider;
  IdSASLPlain := TIdSASLPlain.Create(SMTP);
  IdSASLPlain.UserPassProvider := IdUserPassProvider;

  SMTP.SASLMechanisms.Add.SASL := IdSASLCRAMSHA1;
  SMTP.SASLMechanisms.Add.SASL := IdSASLCRAMMD5;
  SMTP.SASLMechanisms.Add.SASL := IdSASLSKey;
  SMTP.SASLMechanisms.Add.SASL := IdSASLOTP;
  SMTP.SASLMechanisms.Add.SASL := IdSASLAnonymous;
  SMTP.SASLMechanisms.Add.SASL := IdSASLExternal;
  SMTP.SASLMechanisms.Add.SASL := IdSASLLogin;
  SMTP.SASLMechanisms.Add.SASL := IdSASLPlain;
end;

end.

How to: Habari Client for RabbitMQ evaluation with CloudAMQP

Habari Client for RabbitMQ is a library for Delphi and Free Pascal which provides access to the RabbitMQ open source message broker. Habarisoft offers example aplications for this client library including chat and performance tests, which need an installation of RabbitMQ. But while the RabbitMQ server installation itself is very simple, it also requires an installed Erlang run time environment, and so the preparing steps for client library evaluation take some time.

Fortunately, there is an easy way to avoid the RabbitMQ installation: CloudAMQP, a service which provides managed RabbitMQ servers in the cloud.

After a simple registration, clients can connect to the server using various standard protocols (AMQP, MQTT, STOMP). The CloudAMQ console page displays a connection URL for AMQP connections, which can be used with Habari Client for RabbitMQ chat application after small changes.

A valid URL for the Habari Chat demo application for CloudAMQP has the form stomp://<Server>?connect.host=<VHost>.

Example:

stomp://spotted-monkey.rmq.cloudamqp.com?connect.host=qwerty

Connection configuration

 

 

 

 

 

With the free CloudAMQP plan you can use up to three connections (chat applications) simultaneously.

Habari Client for RabbitMQ

ActiveMQ, Qpid, HornetQ and RabbitMQ in Comparison

An article by Thomas Beyer (also available in German language) gives a short introduction into popular messaging solutions which are available as free open source projects.

“Newer architectures and the standardized AMQP protocol have led to a flood of message brokers. All brokers take claim to be fast, robust and reliable. But what really distinguish the broker? How do I choose the right broker? Should we continue to use established brokers such as the ActiveMQ or try a more modern one? This article attempts to answer these questions and help the reader in selecting a suitable broker.”

Article URL: http://predic8.com/activemq-hornetq-rabbitmq-apollo-qpid-comparison.htm

Apache ActiveMQ 5.10.0 released

Apache ActiveMQ 5.10.0 resolves more than 234 issues, mostly bug fixes and improvements. It has the following new features:

  • Java 8 support
  • Apache Shiro Security Plugin – http://activemq.apache.org/shiro.html
  • Hardened MQTT support
  • Hardened AMQP support
  • Hardened LevelDB store
  • Improved RAR/JCA adapter
  • Improved Runtime configuration plugin
  • Improved Web console

Source: http://activemq.apache.org/activemq-5100-release.html

A Delphi and Free Pascal STOMP based client library is available from Habarisoft.

Habari Client Libraries

 

RabbitMQ use cases: NYTimes

Michael Laing, a Systems Architect at NYTimes, gave a great decription of their use of RabbitMQ and their overall architecture on the RabbitMQ mailing list, which later also appeared on High Scalability –  NYTimes Architecture: No Head, No Master, No Single Point of Failure

We use Rabbit MQ as our message passing system. Right now, the messages we handle are things like Breaking News Alerts and Live Video alerts. Our internal clients send the fabrik these messages over AMQP. We then send them around our stack, ensuring they are delivered.

We have Rabbit in all layers of our stack, with shovels connecting them. Our own internal code helps route the messages based on there services level. Some messages, like Breaking News, must go out as quickly as possible. So we spread these out over out clusters AND shovel them to clusters in other regions for processing. From there the messages get send to the front end for delivery.

We also use Rabbit for individual messages. If you are a registered NYTimes users, we can send you personally a message. Things like credit card expiring.

 

Query ActiveMQ Broker Statistics with Delphi

Broker Configuration

To configure ActiveMQ to use the statistics plugin add the following to the ActiveMQ XML configuration:

<plugins>
  <statisticsBrokerPlugin/>
</plugins>

The statistics plugin looks for messages sent to particular destinations.

Query running broker statistics

To query the running statistics of the message broker, the client sends an empty message to a Destination named ActiveMQ.Statistics.Broker, and sets the replyto field with the Destination you want to receive the result on. The statistics plugin will send a  MapMessage filled with the statistics for the running ActiveMQ broker.

Source code

program DestStatistics;

(**
  Requires ActiveMQ 5.3 or higher
  To configure ActiveMQ to use the statistics plugin, add the following to the ActiveMQ XML configuration:
  <broker>
  ...
    <plugins>
      <statisticsBrokerPlugin/>
    </plugins>
  ...
  </broker>

  Usage:
  ------
  DestStatistics [destination]
  If no destination is specified, the program returns the broker statistics

  Reference
  ---------

http://activemq.apache.org/statisticsplugin.html


https://issues.apache.org/activemq/browse/AMQ-2379


http://rajdavies.blogspot.com/2009/10/query-statistics-for-apache-activemq.html

  You can also use wildcards too, and receive a separate message for every destination matched.
*)

{$APPTYPE CONSOLE}

uses
  SysUtils,
  BTCommAdapterIndy, BTMessageTransformerXMLMapOmni,
  BTJMSInterfaces, BTJMSConnection, BTSessionIntf, BTSerialIntf,
  BTStompTypes, BTTypes,
  Classes;

var
  Connection: IConnection;
  Session: ISession;
  Producer: IMessageProducer;
  Consumer: IMessageConsumer;
  Destination, ReplyQueue: IQueue;
  JMSMessage: ITextMessage;
  Reply: IMapMessage;
  MapNames: PMStrings;
  I: Integer;
  Key: string;

begin
  Connection := TBTJMSConnection.MakeConnection;
  try
    try
      // Create and assign the message transformer
      SetTransformer(Connection, TBTMessageTransformerXMLMapOmni.Create(nil));

      Connection.Start;
      Session := Connection.CreateSession(False, amAutoAcknowledge);

      // listen on reply queue
      ReplyQueue := Session.CreateQueue('Habari' + '?' +
        BTStompTypes.SH_TRANSFORMATION + '=' + TRANSFORMER_ID_MAP_XML);
      Consumer := Session.CreateConsumer(ReplyQueue);

      // create the pseudo destination
      if ParamCount = 0 then
      begin
        Destination := Session.CreateQueue('ActiveMQ.Statistics.Broker');
      end
      else
      begin
        Destination := Session.CreateQueue('ActiveMQ.Statistics.Destination.' + ParamStr(1));
      end;

      // display destination name
      WriteLn('Request statistics for ' + Destination.QueueName + ' ...');

      // create the message and set reply queue name
      JMSMessage := Session.CreateTextMessage;
      JMSMessage.JMSReplyTo := ReplyQueue;
      Producer := Session.CreateProducer(Destination);
      Producer.Send(JMSMessage);

      // read the result message
      Reply := Consumer.Receive(1000) as IMapMessage;

      // list the map key/values
      while Assigned(Reply) do
      begin
        MapNames := Reply.GetMapNames;
        for I := 0 to Length(MapNames) - 1 do
        begin
          Key := MapNames[I];
          WriteLn(Key + '=' + Reply.GetString(Key));
        end;
        WriteLn;
        Reply := Consumer.Receive(1000) as IMapMessage;
      end;

      WriteLn('No more message on queue ' + ReplyQueue.QueueName);

      Connection.Stop;

    except
      on E: Exception do
        WriteLn(E.Message);
    end;
  finally
    Connection.Close;
  end;

  WriteLn('Press any key');
  ReadLn;
end.

 


Query Statistics for Apache ActiveMQ with Delphi

RabbitMQ 3.3.1 free open source message broker released

The RabbitMQ team announced the release of RabbitMQ 3.3.1. This release fixes a number of bugs in 3.3.0 and earlier versions, including security bugs in the MQTT and shovel plugins. Binary and source distributions of the new release can be found on the download page.

For application integration in Delphi and Free Pascal, Habarisoft offers a commercial client library for RabbitMQ 3.2.4 and newer.

Habari Web Components 2.8 released

The new release 2.8 of the web application framework for Delphi and Free Pascal is available now. Changes include:

  • FPCUnit test project
  • validation of context names and mappings
  • new tutorials with source code
  • updated Flightplan demo for jQuery Mobile
  • Log4D (logging framework) source code workarounds for Free Pascal

Flightplan Demo (using jQuery Mobile 1.4.2)

DUnit and FPCUnit Tests

FPCUnit Tests

About

Habari Web Components is a web application framework for small to medium size HTTP services, based on the popular open source TCP/IP library for Delphi and Free Pascal, Internet Direct (Indy). If you like to see it in action, download and run the off-line demo applications, or go to the on-line demo. Need more information? Browse the on-line API documentation, or read the Getting Started document.

  • supports Delphi 2009 and Free Pascal 2.6.0 or newer with Internet Direct (Indy) 10.6
  • full source code included, with DUnit/FPCUnit tests and example applications
  • redistribution with your application does not require any additional fees
  • free updates for one year

Example source code for Hello World web component

This web component answers HTTP GET requests with a hello world response (content type text/plain). The full tutorial project code is included in the demo download.

unit HelloWorldResource;

interface

uses djWebComponent, IdCustomHTTPServer;

type
  THelloWorldResource = class(TdjWebComponent)
  public
    procedure OnGet(
      Request: TIdHTTPRequestInfo;
      Response: TIdHTTPResponseInfo); override;
  end;

implementation

procedure THelloWorldResource.OnGet(
  Request: TIdHTTPRequestInfo;
  Response: TIdHTTPResponseInfo);
begin
  Response.ContentText := 'Hello world!';
  Response.ContentType := 'text/plain';
end;

end.

 

Habari Web Components

Indy 10 TIdTCPServer: Server-side message push example

ServerPushExample

This example uses a Delphi 2009 VCL application with a main form, which contains only one visual component, a TMemo named “MemoLog”.

Client and server are both started in the FormCreate event.

procedure TServerPushExampleForm.FormCreate(Sender: TObject);
begin
  ExampleServer := TMyPushServer.Create;
  ExampleServer.DefaultPort := 8088;
  ExampleServer.Active := True;

  ExampleClient := TMyPushClientThread.Create('localhost', 8088,
    MemoLog.Lines);
end;

Server

The server code uses a TIdTCPCustomServer subclass which waits for a random time and then sends a string to the client.

function TMyPushServer.DoExecute(AContext: TIdContext): Boolean;
begin
  Result := inherited;

  // simulate hard work
  Sleep(Random(3000));

  AContext.Connection.IOHandler.WriteLn(
    'Completed at ' + TimeToStr(Now), IndyTextEncoding_UTF8);
end;

Client

The client code uses a TThread subclass to run asynchronously without blocking the main VCL thread. It contains a private TIdTCPClient instance, and periodically tries to receive a string from the connection.

...
  S := TCPClient.IOHandler.ReadLn(IndyTextEncoding_UTF8);
...

Full Delphi Form Code

Below is the full code for the example main form.

unit Unit1;

interface

uses
  IdCustomTCPServer, IdTCPClient, IdContext,
  SysUtils, Classes, Forms, StdCtrls, Controls;

type
  TMyPushClientThread = class(TThread)
  private
    TCPClient: TIdTCPClient;
    FLog: TStrings;
  public
    constructor Create(AHost: string; APort: Word; ALog: TStrings);
    destructor Destroy; override;
    procedure Execute; override;
  end;

  TMyPushServer = class (TIdCustomTCPServer)
  protected
    function DoExecute(AContext: TIdContext): Boolean; override;
  end;

  TServerPushExampleForm = class(TForm)
    MemoLog: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ExampleClient: TMyPushClientThread;
    ExampleServer: TMyPushServer;
  end;

var
  ServerPushExampleForm: TServerPushExampleForm;

implementation

uses
  IdGlobal;

{$R *.dfm}

procedure TServerPushExampleForm.FormCreate(Sender: TObject);
begin
  ExampleServer := TMyPushServer.Create;
  ExampleServer.DefaultPort := 8088;
  ExampleServer.Active := True;

  ExampleClient := TMyPushClientThread.Create('localhost', 8088, MemoLog.Lines);
end;

procedure TServerPushExampleForm.FormDestroy(Sender: TObject);
begin
  ExampleServer.Free;
  ExampleClient.Terminate;
  ExampleClient.WaitFor;
  ExampleClient.Free;
end;

{ TMyPushServer }

function TMyPushServer.DoExecute(AContext: TIdContext): Boolean;
begin
  Result := inherited;

  // simulate hard work
  Sleep(Random(3000));

  AContext.Connection.IOHandler.WriteLn(
    'Completed at ' + TimeToStr(Now), IndyTextEncoding_UTF8);
end;

{ TMyPushClientThread }

constructor TMyPushClientThread.Create(AHost: string; APort: Word; ALog: TStrings);
begin
  inherited Create(False);

  FLog := ALog;

  TCPClient := TIdTCPClient.Create;
  TCPClient.Host := AHost;
  TCPClient.Port := APort;
  TCPClient.ReadTimeout := 500;
end;

destructor TMyPushClientThread.Destroy;
begin
  TCPClient.Free;
  inherited;
end;

procedure TMyPushClientThread.Execute;
var
  S: string;
begin
  TCPClient.Connect;

  while not Terminated do
  begin
    S := TCPClient.IOHandler.ReadLn(IndyTextEncoding_UTF8);

    if not TCPClient.IOHandler.ReadLnTimedout then
    begin
      TThread.Queue(nil,
        procedure
        begin
          FLog.Append(S);
        end);
    end;

  end;

  TCPClient.Disconnect;
end;

end.