TIdTCPServer OnExecute 无限循环运行

Question

TIdTCPServer 组件有问题。我用它来读取远程服务器发送的数据。

下面是我使用的代码：

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;

问题是，一旦我的TIdTCPServer 获取了一些数据，它就会启动一个无限循环并占用 100% 的 CPU。

我在这里做错了什么？

Answer 1

一个问题是您实际上从未读取任何数据，因此InputBuffer 将始终为空，a 将始终为空。 OnExecute 事件本身是循环的，因此您没有做任何事情来使其定期产生 CPU 时间片。

另一个问题是您的逐字符读取和连接效率非常低，并且没有考虑到 SizeOf(Char) 在 Delphi 2009+ 中为 2 或 ReadChar() 可识别 Unicode。

试试这个：

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;

或者：

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;