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;

Add Feedback