Asynchronous SSL client / server

Download source code - Delphi and C++Builder

 

There are two demo programs, client and server, that work in SSL mode with the ability to send data from server to a client at any time.
The server program uses TclTcpServer class as basic for implementing new TclSslServer class. When you click the Send button, the program loops through all active connections and sends data.
At the client-side, we used the TclAsyncClient component. This component asynchronously waits for server data and displays it immediately once received.

procedure TForm2.btnConnectClick(Sender: TObject);
begin
  if (clAsyncClient1.Active) then raise Exception.Create('Client already connected');
 
  clAsyncClient1.Server := edtServer.Text;
  clAsyncClient1.Port := StrToInt(edtPort.Text);
  clAsyncClient1.TimeOut := 10000;
 
  //is necessary when using self-signed certificate by server
  clAsyncClient1.CertificateFlags := [cfIgnoreCommonNameInvalid, cfIgnoreUnknownAuthority];
 
  //specifies TLS 1.0 protocols (also available SSL 2.0 and SSL 3.0)
  clAsyncClient1.TlsFlags := [tfUseTLS];
 
  //forces the component to start SSL negotiation immediately once connected
  clAsyncClient1.UseTls := True;
 
  clAsyncClient1.Open();
 
  Caption := 'SSL Client - Connected';
end;
 
procedure TForm2.btnSendClick(Sender: TObject);
var
  stream: TStream;
  len: Int64;
  s: TclString;
begin
  stream := TMemoryStream.Create();
  try
    //write the size of data
    s := edtData.Text;
    len := Length(s);
    stream.Write(len, SizeOf(len));
 
    //write data
    stream.Write(PclChar(s)^, len);
 
    stream.Position := 0;
    clAsyncClient1.WriteData(stream);
  finally
    stream.Free();
  end;
end;
 
procedure TForm2.clAsyncClient1Read(Sender: TObject);
var
  stream: TMemoryStream;
  len: Int64;
  s: TclString;
begin
  stream := TMemoryStream.Create();
  try
    case (clAsyncClient1.ReadData(stream)) of
      saWrite: clAsyncClient1.WriteData(nil);
      saNone:
      begin
        if (stream.Size > SizeOf(Int64)) then
        begin
          //read size of incoming data
          stream.Position := 0;
          stream.Read(len, SizeOf(len));
 
          Assert((stream.Size - stream.Position) 
          = len, 'To be simple, this situation is not handled in this sample');
 
          SetLength(s, len);
 
          //copy data
          stream.Read(PclChar(s)^, len);
 
          memResponse.Lines.Add('Received from server: ' + s);
        end;
      end;
    end;
  finally
    stream.Free();
  end;
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  FServer.Port := StrToInt(edtPort.Text);
 
  //forces the component to start SSL negotiation immediately once connecting
  FServer.UseTLS := stImplicit;
 
  //specifies TLS 1.0 protocols (also available SSL 2.0 and SSL 3.0)
  FServer.TLSFlags := [tfUseTLS];
 
  //do not request client certificate for impersonation purposes
  FServer.RequireClientCertificate := False;
 
  FServer.Start();
end;
 
procedure TForm1.DoGetCertificate(Sender: TObject; var ACertificate: TclCertificate;
  AExtraCerts: TclCertificateList; var Handled: Boolean);
begin
  //creates self-signed server certificate
  if (clCertificateStore1.Items.Count = 0) then
  begin
    clCertificateStore1.Items.Add(clCertificateStore1.CreateSelfSigned(
    'CN=CleverTester,O=CleverComponents,E=CleverTester@company.mail', 0));
  end;
  ACertificate := clCertificateStore1.Items[0];
  Handled := True;
end;
 
procedure TForm1.btnSendClick(Sender: TObject);
var
  i: Integer;
  stream: TStream;
  len: Int64;
  s: TclString;
begin
  FServer.BeginWork();
  stream := TMemoryStream.Create();
  try
    //write the size of data
    s := edtData.Text;
    len := Length(s);
    stream.Write(len, SizeOf(len));
 
    //write data
    stream.Write(PclChar(s)^, len);
 
    for i := 0 to FServer.ConnectionCount - 1 do
    begin
      stream.Position := 0;
      FServer.Connections[i].WriteData(stream);
    end;
  finally
    stream.Free();
    FServer.EndWork();
  end;
end;