unit tcpclient;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, blcksock;
type
TErrorHook = procedure(Sender: TObject;
const Value: Integer;
const Desc: String) of object;
TConnectHook = procedure(Sender: TObject) of object;
TDisconnectHook = procedure(Sender: TObject) of object;
PTCPClient = ^TTCPClient;
{ TTCPClient }
TTCPClient = class(TThread)
private
FLine: String;
FHost: String;
FPort: Integer;
FCertFile: String;
FConnected: Boolean;
FOnError: TErrorHook;
FOnConnect: TConnectHook;
FOnDisconnect: TDisconnectHook;
procedure DoUpdateVisualControls;
procedure DoOnConnect;
procedure DoOnDisconnect;
procedure DoOnError;
protected
procedure Execute; override;
public
Socket: TTCPBlockSocket;
constructor Create(CreateSuspended: Boolean;
const StackSize: SizeUInt=DefaultStackSize);
property Host: String read FHost write FHost;
property Port: Integer read FPort write FPort;
property CertFile: String read FCertFile write FCertFile;
property Connected: Boolean read FConnected;
property OnError: TErrorHook read FOnError write FOnError;
property OnConnect: TConnectHook read FOnConnect write FOnConnect;
property OnDisconnect: TDisconnectHook read FOnDisconnect
write FOnDisconnect;
end;
implementation
{ TTCPClient }
procedure TTCPClient.DoOnConnect;
begin
if FOnConnect <> nil then
FOnConnect(Self);
end;
procedure TTCPClient.DoOnDisconnect;
begin
if FOnDisconnect <> nil then
FOnDisconnect(Self);
end;
procedure TTCPClient.DoOnError;
begin
if FOnError <> nil then
FOnError(Self, Socket.LastError, Socket.LastErrorDesc);
end;
procedure TTCPClient.DoUpdateVisualControls;
begin
//update virtual tree for example, use FLine here
end;
procedure TTCPClient.Execute;
var
Line: String;
begin
try
Socket.SSL.CertCAFile := FCertFile;
Socket.Connect(FHost, IntToStr(FPort));
Socket.SSLDoConnect;
if Socket.LastError <> 0 then
begin
Synchronize(@DoOnError);
Exit;
end
else
begin
Synchronize(@DoOnConnect);
FConnected := True;
end;
repeat
while Socket.CanRead(1000) do
begin
Line := Socket.RecvString(1);
if Line = '' then
Exit;
FLine := Line;
Synchronize(@DoUpdateVisualControls);
// WriteLn(Line);
end;
until False;
finally
DoOnDisconnect;
Socket.Free;
end;
end;
constructor TTCPClient.Create(CreateSuspended: Boolean;
const StackSize: SizeUInt=DefaultStackSize);
begin
inherited Create(CreateSuspended, StackSize);
Socket := TTCPBlockSocket.Create;
Socket.ConvertLineEnd := True;
end;
end.