Custom TCP client / server

 
 

Client:

TMyClient = class(TclTcpCommandClient)
protected
    function GetResponseCode(const AResponse: string): Integer; override;
    procedure OpenSession; override;
    procedure CloseSession; override;
public
    procedure Login;
    procedure GetLines(ALines: TStrings);
    procedure SendLines(ALines: TStrings);
end;

...

procedure TMyClient.CloseSession;
begin
    SendCommandSync('CLOSE', [OkResponse]);
end;

procedure TMyClient.GetLines(ALines: TStrings);
begin
    SendCommandSync('GETLINES', [OkResponse]); WaitMultipleLines(0);
    ALines.AddStrings(Response);
end;

procedure TMyClient.SendLines(ALines: TStrings);
begin
    SendCommandSync('SENDLINES', [OkResponse]); SendMultipleLines(ALines, '.');
    WaitResponse([OkResponse]);
end;

function TMyClient.GetResponseCode(const AResponse: string): Integer;
begin
    if (Trim(AResponse) = '.') then
    begin
        Result := SOCKET_DOT_RESPONSE;
    end else
    begin
        Result := StrToIntDef(Trim(AResponse), SOCKET_WAIT_RESPONSE);
    end;
end;

procedure TMyClient.Login;
begin
    SendCommandSync('LOGIN %s', [OkResponse], [UserName]);
end;

procedure TMyClient.OpenSession;
begin
    WaitResponse([OkResponse]);
end;

Server:

TMyServer = class(TclTcpCommandServer)
private
    procedure HandleCLOSE(AConnection: TclCommandConnection; const ACommand: string; AParams: TclTcpCommandParams);
    procedure HandleGETLINES(AConnection: TclCommandConnection; const ACommand: string; AParams: TclTcpCommandParams);
    procedure HandleSENDLINES(AConnection: TclCommandConnection; const ACommand: string; AParams: TclTcpCommandParams);
    procedure HandleSENDLINESData(AConnection: TclCommandConnection; const ACommand: string; AParams: TclTcpCommandParams);
protected
    procedure DoAcceptConnection(AConnection: TclUserConnection; var Handled: Boolean); override;
    procedure GetCommands; override;
end;

...

procedure TMyServer.HandleSENDLINES(AConnection: TclCommandConnection; const ACommand: string; AParams: TclTcpCommandParams);
begin
    AcceptMultipleLines(AConnection, TclMyCommandInfo.Create(ACommand, HandleSENDLINESData));
    SendResponse(AConnection, ACommand, '100');
end;

procedure TMyServer.HandleSENDLINESData(AConnection: TclCommandConnection; const ACommand: string; AParams: TclTcpCommandParams);
begin
    AcceptCommands(AConnection);
    DoSendLines(AConnection, AParams.RawData);
    SendResponse(AConnection, 'SENDLINES', '100');
end;

procedure TMyServer.HandleCLOSE(AConnection: TclCommandConnection; const ACommand: string; AParams: TclTcpCommandParams);
begin
    try
        SendResponseAndClose(AConnection, ACommand, '100');
    except
        on EclSocketError do ;
    end;
end;

procedure TMyServer.HandleGETLINES(AConnection: TclCommandConnection; const ACommand: string; AParams: TclTcpCommandParams);
var
    lines: TStrings;
begin
    SendResponse(AConnection, ACommand, '100');
    lines := TStringList.Create();
    try
        lines.Add('This is a first line of data');
        lines.Add('This is a second line of data');
        lines.Add('This is a third line of data');
        SendMultipleLines(AConnection, lines, '.');
    except
        lines.Free();
        raise;
    end;
end;

procedure TMyServer.GetCommands;
begin
    Commands.Add(TclMyCommandInfo.Create('LOGIN', HandleLOGIN));
    Commands.Add(TclMyCommandInfo.Create('CLOSE', HandleCLOSE));
    Commands.Add(TclMyCommandInfo.Create('GETLINES', HandleGETLINES));
    Commands.Add(TclMyCommandInfo.Create('SENDLINES', HandleSENDLINES));
end;