TTCPDaemon = class(TThread)
  private
    fSock   : TTCPBlockSocket;
    fPort   : string;
  public
    property Port: string read fPort write fPort;
    constructor Create (APort: string);
    destructor Destroy; override;
    procedure Execute; override;
  end; 

  TSQLDaemon = class(TThread)
  private
    fClient  : string;
    fSock    : TTCPBlockSocket;
    fTimeOut : integer;
    fDBConn  : TDBConnection;
  public
    property TimeOut: integer read fTimeOut write fTimeOut;
    procedure Stop;
    procedure SendData(AStatus: Integer; AStream: TMemoryStream);
    procedure SendStream(AStream: TMemoryStream);
    procedure SendString(AValue: PChar);
    constructor Create (HSock: TSocket; Client: string);
    destructor Destroy; override;
    procedure Execute; override;
  end;      

rocedure TTCPDaemon.Execute;
var
  s : string;
  sIP : string;
  ClientSock : TSocket;
begin
  try
    fSock.CreateSocket;
    fSock.SetLinger(True, 1);
    fSock.Bind('0.0.0.0', fPort);
    fSock.Listen;
    if fSock.LastError <> 0 then begin
      s := 'Код ошибки ' + IntToStr(fSock.LastError) + #13#10 + fSock.LastErrorDesc;
      raise Exception.Create(s);
    end; // if fSock.LastError <> 0
    repeat
      if Terminated then Break;
      if fSock.CanRead(1000) then begin
        ClientSock := fSock.Accept;
        if fSock.LastError <> 0 then begin
          s := 'Socket LastError ' + IntToStr(fSock.LastError) + #13#10 + fSock.LastErrorDesc;
          raise Exception.Create(s);
        end; // if fSock.LastError <> 0
        sIP := fSock.GetRemoteSinIP + ':' + IntToStr(fSock.GetRemoteSinPort);
        //ClientAdd(sIP);
        TSQLDaemon.Create(ClientSock, sIP);
      end; // if CanRead(1000)
      Sleep(1);
    until False;
  except
    on E:Exception do begin
      s := E.Message;
      SaveToLog(s);
    end;
  end;
end;