unit uEchoSrv;

interface  

uses
  Windows, Messages, SysUtils, StrUtils, Variants,Classes,
  StdCtrls, blcksock, uLogging, uLoggingThread;

type
  TProcessingData = function(const AData: string): string of object;

  TListenerThread = class(TLoggingThread)
     constructor Create(ASuspended: boolean; AIP: string; APort: Integer);
     destructor Destroy;override;
  private
     FSocket: TTCPBlockSocket;//объект сокета
     FThreadList: TList; //список дескрипторов потоков для работы с клиентами
     FProcessingData: TProcessingData;
     FHost: string;
     FPort: Integer;
     function GetIsTerminated: boolean;
  protected
     procedure Execute;override;
     procedure ServerStatus(Sender: TObject; Reason: THookSocketReason;
  const Value: String);
  public
     property Socket: TTCPBlockSocket read FSocket;
     property Host: string read FHost write FHost;
     property Port: Integer read FPort write FPort;
     property IsTerminated: boolean read GetIsTerminated;
     property ProcessingData: TProcessingData read FProcessingData write FProcessingData;
  end;

  TTCPThread = class(TLoggingThread)
  private
    FSocket: TTCPBlockSocket;
  protected
    var
      FProcessingData: TProcessingData;
    procedure Execute;override;
  public
    //ASocket - дескриптор сокета из очереди подключений.
    constructor Create(ASuspended: boolean; ASocket: integer);
    destructor Destroy; override;
    property Socket:TTCPBlockSocket read FSocket;
  end;

implementation    
{ TListenerThread }
 
constructor TListenerThread.Create(ASuspended: boolean; AIP: string; APort: Integer);
begin
  FSocket:=TTCPBlockSocket.Create;
  FThreadList:=TList.Create;
  FHost := AIP;
  FPort := APort;
  FSocket.OnStatus := ServerStatus;
  inherited Create(ASuspended);
  LogWriter.Suffix := '_EchoServer';
end;
 
destructor TListenerThread.Destroy;
var T:TTCPThread;
begin
  //завершаем все работающие нити
  while FThreadList.Count <> 0 do
    begin
      T:=TTCPThread(FThreadList.Extract(FThreadList.Last));
      T.Terminate;
      T.WaitFor;
      T.Free;
    end;
  //освобождаем память
  FThreadList.Free;
  FSocket.Free;
  inherited;
end;

function TListenerThread.GetIsTerminated: boolean;
begin
  Result := Terminated;
end;
 
procedure TListenerThread.Execute;
var T:TTCPThread;
begin
  FSocket.CreateSocket;//создаем новый сокет
  //связываем сокет с локальным адресом
  //выбор номера порта оставляем на усмотрение Synapse
  //FSocket.Bind(FSocket.LocalName,'0');
  FSocket.Bind(FHost,IntToStr(FPort));
  if FSocket.LastError=0 then begin //связываение с локальным адресом прошло успешно
     FSocket.Listen; //переходим в режим ожидания
    repeat
      if FSocket.CanRead(100) then begin//можем произвести чтение
       
        //получаем дескриптор сокета и создаем новую нить для клиента
        T:=TTCPThread.Create(false,FSocket.Accept);
        //определяем обработчик события ONStatus для новой нити
        T.Socket.OnStatus:=FSocket.OnStatus;
        T.FProcessingData := FProcessingData;
        //добавляем указатель на нить в список
        FThreadList.Add(pointer(T));
      end;
    until Terminated;//"гуляем" по циклу до тех пор, пока пользователь не остановит
  end
  else
    Self.LogWriter.Write('Ошибка при подключении ' + FSocket.LastErrorDesc, leError);//ошибка связывания - показываем её пользователю
end;

procedure TListenerThread.ServerStatus(Sender: TObject; Reason: THookSocketReason;
  const Value: String);
begin
  case Reason of
    HR_Bind: begin
               Self.LogWriter.Write ('Bind: '+Value);
               {lblAddress.Caption:=Server.Socket.GetLocalSinIP+':'+
                   IntToStr(Server.Socket.GetLocalSinPort) }
             end;
    HR_CanRead: Self.LogWriter.Write('Готов к чтению');
    HR_CanWrite: Self.LogWriter.Write('Готов к записи');
    HR_Listen: Self.LogWriter.Write('Прослушивание');
    HR_Accept: Self.LogWriter.Write('Подключение с адреса '+ Socket.GetRemoteSinIP);
    HR_ReadCount: Self.LogWriter.Write('Прочитано символов '+Value);
    HR_WriteCount: Self.LogWriter.Write('Записано символов '+Value);
    HR_Wait: Self.LogWriter.Write('Ожидание');
    HR_Error: Self.LogWriter.Write('Ошибка '+ Socket.LastErrorDesc, leError);
  end;
end;  

constructor TTCPThread.Create(ASuspended: boolean; ASocket: integer);
begin
  FSocket:=TTCPBlockSocket.Create;
  FSocket.Socket:=ASocket;
  FSocket.GetSins;
  inherited Create(ASuspended);
  LogWriter.Suffix := '_EchoServer';
end;
 
destructor TTCPThread.Destroy;
begin
  FSocket.Free;
  inherited;
end;
 
procedure TTCPThread.Execute;
var S, S_Out:string;
begin
 //работаем пока не поступит сигнал на остановку
  while not Terminated do begin
    try
      //есть данные ожидающие чтения
      if FSocket.WaitingData <> 0 then begin
        S_Out := '';
        //получаем данные
        s:=FSocket.RecvPacket(2000);
        Self.LogWriter.SuspendedWrite('Получена строка ' + s);
        //ошибок при получении данных не было
        if FSocket.LastError = 0 then begin
          if Assigned(FProcessingData) then begin
            S_Out := FProcessingData(S);
            Self.LogWriter.SuspendedWrite('Ответ сервера ' + S_Out);
            FSocket.SendString(S_Out);
          end;
        end
        else
          Self.LogWriter.Write('Ошибка при получении данных ' + FSocket.LastErrorDesc, leError);//ошибка связывания - показываем её пользователю
        Self.LogWriter.WriteList;
      end;
    except
      On E:Exception do
        Self.LogWriter.Write('TTCPThread.Execute ' + e.Message); 
    end;
    sleep(10);//"спим" 10 миллисекунд
  end;
end;

end.

unit uEchoClnt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,
  blcksock, StdCtrls, uLogging;

type
  TEchoClient = class (TLoger)   
 
  const
    cReadTimeout = 30000;
    constructor Create;
    destructor destroy; override;
  private
    FEnabled: boolean;
    FSocket: TTCPBlockSocket;
    FHost: string;
    FPort: Integer;
  public
    function Connect(AData: string = ''): string;
    procedure Disconnect;
    function SendString(AData: string; NeedConfirm: boolean = True; CustomTimeout: Integer = cReadTimeout): string;
    property Enabled_: boolean read FEnabled write FEnabled;
    property Host: string read FHost write FHost;
    property Port: Integer read FPort write FPort;
  end;

implementation
USES uCassTypes;

constructor TEchoClient.Create;
begin
  inherited;
  LogWriter.Suffix := '_EchoClient';
  FSocket := TTCPBlockSocket.Create;
  FSocket.RaiseExcept:=True;
  Host := 'localhost';
  Port := 49001;
end;

destructor TEchoClient.Destroy;
begin
  FreeAndNil(FSocket);
  inherited Destroy;
end;

function TEchoClient.Connect(AData: string = ''): string;
var SomeStr: string;
begin
  try  
    FSocket.Connect(FHost, IntToStr(FPort));  
    Self.LogWriter.SuspendedWrite(Format('Выполнено подключение к хосту %s на порт %d', [FHost, FPort]));
    if AData = '' then  
      Self.LogWriter.WriteList;  
    Result := '';
  except  
    on E:Exception do begin  
      if AData <> '' then  
        SomeStr := ' Строка ' + AData  
      else  
        SomeStr := '';  
      Self.LogWriter.Write(Format('Ошибка при подключении к порту %d (%s).%s',
        [FPort, E.Message, SomeStr]), leError);
      Enabled_ := false;  
      Result := E.Message;  
    end;  
  end;
end;

procedure TEchoClient.Disconnect;
begin
  Self.LogWriter.Write('Отключение от хоста');
  FSocket.CloseSocket;
end;

function TEchoClient.SendString(AData: string; NeedConfirm: boolean = True; CustomTimeout: Integer = cReadTimeout): string;
//NeedConfirm - если требуется ответ, например, запрос какого-либо параметра.
var Sending: boolean;
    i: integer;
begin
  Sending := false;
  i := 0;
  while (not Sending) and (i < 3) do begin
    try
      if NeedConfirm then begin
        Disconnect;
        Connect(AData);
      end;
      Self.LogWriter.SuspendedWrite('Передача строки ' + AData);
      FSocket.SendString(AData);
      if NeedConfirm then begin
        Result := FSocket.RecvPacket(CustomTimeout);
        Self.LogWriter.Write('Ответ сервера ' + Result);
      end
      else
        Self.LogWriter.Write('Ожидание ответа не предусмотрено');
      Sending := true;
    except
      ON e:Exception do begin
        Result := cSendError;
        Self.LogWriter.Write(Format('Ошибка при передаче %s, порт %d, строка %s', [e.Message, FPort, AData]), leError);
        sleep(100);
        i := i + 1;
      end;
    end;
  end;
  if not Sending then begin
    Disconnect;
    Connect;
  end;
end;

end.

procedure TTCPThread.Execute;
var S, S_Out:string;
begin
 //работаем пока не поступит сигнал на остановку
  while not Terminated do begin
    try
      //есть данные ожидающие чтения
      if FSocket.WaitingData <> 0 then begin
        S_Out := '';
        //получаем данные
        s:=FSocket.RecvPacket(2000);
        Self.LogWriter.SuspendedWrite('Получена строка ' + s);
        //ошибок при получении данных не было
        if FSocket.LastError = 0 then begin
          if Assigned(FProcessingData) then begin
            S_Out := FProcessingData(S);
            Self.LogWriter.SuspendedWrite('Ответ сервера ' + S_Out);
            FSocket.SendString(S_Out);
          end;
        end
        else
          Self.LogWriter.Write('Ошибка при получении данных ' + FSocket.LastErrorDesc, leError);//ошибка связывания - показываем её пользователю
        //Если команда на завершение - сбрасываем флаг активности
        if UpperCase(s) = 'BYE' then
          IsActive := False;
        Self.LogWriter.WriteList;
      end;
    except
      On E:Exception do
        Self.LogWriter.Write('TTCPThread.Execute: ' + e.Message, leError);
    end;
    sleep(10);//"спим" 10 миллисекунд
  end;
end;

procedure TListenerThread.Execute;
var T:TTCPThread;

  procedure KillInactive;
  var i: integer;
      CurrentThread: TTCPThread;
  begin
    for i := FThreadList.Count-1 downto 0 do begin
      CurrentThread := TTCPThread(FThreadList[i]);
      if CurrentThread <> nil then begin
        if not CurrentThread.IsActive then begin
          FThreadList.Delete(i);
          CurrentThread.Terminate;
          CurrentThread.WaitFor;
          CurrentThread.Free;
          Self.LogWriter.Write(Format('Поток %d завершил работу и будет удален. Оставшееся количество потоков %d', [i, FThreadList.Count]));
        end;
      end;
    end;
  end;


begin
  try
    FSocket.CreateSocket;//создаем новый сокет
    //связываем сокет с локальным адресом
    //выбор номера порта оставляем на усмотрение Synapse
    //FSocket.Bind(FSocket.LocalName,'0');
    FSocket.Bind(FHost,IntToStr(FPort));
    if FSocket.LastError=0 then begin //связываение с локальным адресом прошло успешно
       FSocket.Listen; //переходим в режим ожидания
      repeat
        try
          if FSocket.CanRead(100) then begin//можем произвести чтение

            //получаем дескриптор сокета и создаем новую нить для клиента
            T:=TTCPThread.Create(false,FSocket.Accept);
            //Устанавливаем флаг активности
            T.IsActive := True;
            T.FreeOnTerminate := False;
            //определяем обработчик события ONStatus для новой нити
            T.Socket.OnStatus:=FSocket.OnStatus;
            T.FProcessingData := FProcessingData;
            //добавляем указатель на нить в список
            FThreadList.Add(pointer(T));
            Self.LogWriter.SuspendedWrite(Format('Количество TCP-потоков %d', [FThreadList.Count]));
          end;
          //Проверка на наличие неактивных потоков
          KillInactive;
        except
          on E:Exception do
            Self.LogWriter.Write('TListenerThread repeat: ' + e.Message, leError);
        end;
      until Terminated;//"гуляем" по циклу до тех пор, пока пользователь не остановит
    end
    else
      Self.LogWriter.Write('Ошибка при подключении ' + FSocket.LastErrorDesc, leError);//ошибка связывания - показываем её пользователю
    Self.LogWriter.WriteList;
  except
    on E:Exception do
      Self.LogWriter.Write('TListenerThread.Execute: ' + e.Message, leError);
  end;
end;