Search code examples
delphitcpstreamindy

Use TCPServer to ask TCPClient for a stream with Delphi


here I am once more... Now I am trying playing with streams. My goal is to use TCPServer to ask TCPClient for a stream and receive it correctly. Here is what I am trying without sucess:

procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
  SCmd: string;
  Client: TClient;
  LQueue: TStringList;
  WQueue: TStringList;
  Stream: TMemoryStream;
begin
  Client := TClient(AContext.Data);
  // Send Cmd
  LQueue := nil;
  try
    WQueue := Client.QMsg.Lock;
    try
      if (WQueue.Count > 0) then
      begin
        LQueue := TStringList.Create;
        LQueue.Assign(WQueue);
        WQueue.Clear;
      end;
    finally
      Client.QMsg.Unlock;
    end;
    if (LQueue <> nil) then
    begin
      SCmd := LQueue[0];
      AContext.Connection.IOHandler.Write(SCmd);
    end;
  finally
    LQueue.Free;
  end;
  // Receive Data
  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    if not AContext.Connection.IOHandler.CheckForDataOnSource(100) then Exit;
    AContext.Connection.IOHandler.CheckForDisconnect;
  end;
  if (SCmd = 'sendfile') then
  begin
    Stream := TMemoryStream.Create;
    try
      AContext.Connection.IOHandler.ReadStream(Stream, -1);
      Stream.Position := 0;
      Stream.SaveToFile(ExtractFilePath(Application.ExeName) + 'test.zip');
    finally
       Stream.Free;
    end;
  end;
end;

On client side I created a thread for listening and process commands. Here is the code:

procedure TClientProc.Execute;
begin
  TCPClient := TIdTCPClient.Create(nil);
  while (not Terminated) do
  begin
    with TCPClient do
    begin
      if (Connected) then
      try
        FCmd := Trim(IOHandler.ReadLn);
        if (FCmd <> '') then Synchronize(CommandProc);
      except
      end else
      begin
        if (FCnt >= FInt) then
        try
          ConnectTimeout := 4000;
          Port := StrToInt(FPort);
          Host := FHost;
          Connect;
        except
          FCnt := 0;
        end else
        begin
         Inc(FCnt);
        end;
      end;
      Sleep(1000);
    end;
  end;
  TCPClient.Disconnect;
  TCPClient.Free;
end;

Procedure TClientProc.CommandProc;
var
  Stream: TMemoryStream;
begin
  if FCmd = 'sendfile' then
  begin
    Stream := TMemoryStream.Create;
    try
      Stream.LoadFromFile(ExtractFilePath(Application.ExeName) + 'test.zip');
      Stream.Position := 0;
      TCPClient.IOHandler.Write(Stream, 0, True);
    finally
      Stream.Free;
    end;
  end;
end;

Please, what I am doing wrong?

Btw, HAPPY NEW YEAR!! :)


Solution

  • On the server side, if there are multiple commands in the TClient's queue by the time OnExecute has a chance to check it, you are throwing away all but the first command. You need to process them all.

    Try something more like this:

    procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
    var
      SCmd: string;
      Client: TClient;
      WQueue: TStringList;
      Stream: TMemoryStream;
    begin
      Client := TClient(AContext.Data);
      // Send Cmd
      WQueue := Client.QMsg.Lock;
      try
        if (WQueue.Count > 0) then
        begin
          SCmd := WQueue[0];
          WQueue.Delete(0);
        end;
      finally
        Client.QMsg.Unlock;
      end;
      if (SCmd = '') then
      begin
        AContext.Connection.IOHandler.Write(SCmd);
        if (SCmd = 'sendfile') then
        begin
          Stream := TMemoryStream.Create;
          try
            AContext.Connection.IOHandler.ReadStream(Stream, -1);
            Stream.Position := 0;
            Stream.SaveToFile(ExtractFilePath(Application.ExeName) + 'test.zip');
          finally
            Stream.Free;
          end;
        end;
      end;
    end;
    

    Of course, this only works if the server is the only party sending commands. If the client ever sends commands to the server, that will make the code much more difficult to manage, and requires a more detailed protocol, because the server needs to be able to differentiate when inbound data belongs to a command versus a response.