Guybrush
Guybrush

Reputation: 1611

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!! :)

Upvotes: 1

Views: 2000

Answers (1)

Remy Lebeau
Remy Lebeau

Reputation: 598001

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.

Upvotes: 1

Related Questions