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.
Asynchronous client:
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;
Server:
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;
Article ID: 71, Created: July 18, 2013 at 11:42 PM, Modified: March 17, 2020 at 3:04 PM