TIdTCPServer OnExecute runs in an infinite loop

Question

I am having a problem with the TIdTCPServer component. I use it to read data sent by remote server.

Below is the code I use:

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
const
  START_PACKET = #11;
  END_PACKET = #10;
var
  IO : TIdIOHandler;
  c  : Char;
  a  : AnsiString;
begin
  a := '';
  IO := AContext.Connection.IOHandler;

  while (IO.InputBuffer.Size > 0) do
  begin
    c := IO.ReadChar;

    if c = START_PACKET then
    begin
      repeat
        c := IO.ReadChar; //(TEncoding.ASCII);
        a := a + c;
      until (c = END_PACKET) or (IO.InputBufferIsEmpty);
    end;
  end;

  if a <> '' then
  begin
    //let's send replay to server
    IO.Write(CreateReply(a));

    //now we need to save what we received to database
    //I use critical section
    try
      EnterCriticalSection(LockDB);

      with DataModule2.results do
      begin
        Close;
        Params[0].AsDateTime := Today;
        Params[1].AsString := a;
        ExecSQL;
      end;
    finally
      LeaveCriticalSection(LockDB);
    end;
  end;
end;

The problem is that once my TIdTCPServer gets some data it starts an infinite loop and takes 100% of CPU.

What am I doing wrong here?

Answer 1

One problem is that you are never actually reading any data, so the InputBuffer will always be empty and a will thus always be blank. The OnExecute event itself is looped, so you are not doing anything to make it yield CPU time slices periodically.

Another problem is that your char-by-char reading and concatenation is very inefficient, and it doesn't take into account that SizeOf(Char) is 2 in Delphi 2009+ or that ReadChar() is Unicode-aware.

Try this instead:

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
const
  START_PACKET = #11;
  END_PACKET = #10;
var
  IO : TIdIOHandler;
  a, buf : AnsiString;
  buflen : Integer;
  c : AnsiChar;
begin
  a := '';
  IO := AContext.Connection.IOHandler;

  IO.WaitFor(START_PACKET);

  // this is just one example of how to append characters using
  // buffering. use whatever is more comfortable for you...

  SetLength(buf, 1024);
  buflen := 0;

  repeat
    c := AnsiChar(IO.ReadByte);
    if buflen = Length(buf) then
    begin
      a := a + buf;
      buflen := 0;
    end;
    buf[buflen+1] := c;
    Inc(buflen);
  until (c = END_PACKET) or (IO.InputBufferIsEmpty);

  if buflen > 0 then
  begin
    SetLength(buf, buflen);
    a := a + buf;
  end;
  buf := '';

  //let's send replay to server
  IO.Write(CreateReply(a));

  //now we need to save what we received to database
  //I use critical section
  EnterCriticalSection(LockDB);
  try
    with DataModule2.results do
    begin
      Close;
      Params[0].AsDateTime := Today;
      Params[1].AsString := a;
      ExecSQL;
    end;
  finally
    LeaveCriticalSection(LockDB);
  end;
end;

Alternatively:

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
const
  START_PACKET = #11;
  END_PACKET = $#10;
var
  IO : TIdIOHandler;
  a : AnsiString;
  c : AnsiChar;
  i : Integer;
begin
  IO := AContext.Connection.IOHandler;

  IO.WaitFor(START_PACKET);

  if IO.InputBufferIsEmpty then
  begin
    IO.CheckForDataOnSource(IdTimeoutDefault);
    IO.CheckForDisconnect;
  end;

  i := IO.InputBuffer.IndexOf(END_PACKET);
  if i = -1 then i := IO.InputBuffer.Size;

  a := IO.ReadString(i);

  if a <> '' then
  begin
    //let's send replay to server
    IO.Write(CreateReply(a));

    //now we need to save what we received to database
    //I use critical section
    EnterCriticalSection(LockDB);
    try
      with DataModule2.results do
      begin
        Close;
        Params[0].AsDateTime := Today;
        Params[1].AsString := a;
        ExecSQL;
      end;
    finally
      LeaveCriticalSection(LockDB);
    end;
  end;
end;