从 TIdTCPServer 调用时 TIdNotify.Notify() 不起作用答案

【问题标题】：TIdNotify.Notify() doesn't work when called from TIdTCPServer从 TIdTCPServer 调用时 TIdNotify.Notify() 不起作用
【发布时间】：2020-12-02 06:39:24
【问题描述】：

我有一个 Lazarus 控制台应用程序，其中有一个简单的 TIdTCPServer。为了成为一个线程安全的应用程序，我添加了TLog.LogMsg()（它使用TIdNotify）。

问题是，当我从主线程调用这个函数时，消息出现在控制台上，但是当从TIdTCPServer的OnExecute或OnConnect事件调用时，消息没有显示。

你能帮我解决这个问题吗？

program Srv;

{$I Synopse.inc}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp, Generics.Collections, IdTCPServer, IdCustomTCPServer, IdContext, IdGlobal, Db, mORMot, mORMotSQLite3, IdSync, functions, SynCommons, SynSQLite3Static;

type

  { TMyApplication }
  TMyApplication = class(TCustomApplication)

   var IdTCPServer: TIdTCPServer;

   protected
    procedure DoRun; override;
    procedure ServerOnConnect(AContext: TIdContext);
    procedure ServerOnExecute(AContext: TIdContext);

  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;

  type
    TLog = class(TIdNotify)
    protected
      FMsg: string;
      procedure DoNotify; override;
    public
      class procedure LogMsg(const AMsg: string);
    end;

{ TMyApplication }

    procedure TLog.DoNotify;
    var i:integer;
    begin
     writeln(FMsg);
    end;

    class procedure TLog.LogMsg(const AMsg: string);
    begin
      with TLog.Create do
      try
        FMsg := AMsg;
        Notify;
      except
        Free;
        raise;
      end;
    end;

procedure TMyApplication.ServerOnExecute(AContext: TIdContext);
begin
  TLog.LogMsg('test OnExecute'); // the message is not displayed
end;

procedure TMyApplication.ServerOnConnect(AContext: TIdContext);
begin
 TLog.LogMsg('connect');        // the message is not displayed
end;

procedure TMyApplication.DoRun;
begin

  TLog.LogMsg('test main 1'); //the message is displayed
  IdTCPServer := TIdTCPServer.Create;
  try
    //Server.Name := 'Server';
    IdTCPServer.ListenQueue := 15;
    IdTCPServer.MaxConnections := 0;
    IdTCPServer.TerminateWaitTime := 5000;
    IdTCPServer.Bindings.Add.IP   := '0.0.0.0';
    IdTCPServer.Bindings.Add.Port := 80;
    IdTCPServer.Bindings.Add.IPVersion:=Id_IPv4;
    IdTCPServer.OnConnect := ServerOnConnect;
  //  IdTCPServer.OnDisconnect := ServerOnDiconnect;
    //Server.OnException := IdTCPServer1Exception;
    IdTCPServer.OnExecute := ServerOnExecute;
    IdTCPServer.Active := True;
    TLog.LogMsg('test main 2'); //the message is displayed

  finally
   // IdTCPServerCmd.Free;
  end;
  readln;

  // stop program loop
  Terminate;
end;

constructor TMyApplication.Create(TheOwner: TComponent);
begin

  inherited Create(TheOwner);
  StopOnException := True;

end;


destructor TMyApplication.Destroy;
begin
  IdTCPServer.Free;
  inherited Destroy;

end;

var
  Application: TMyApplication;
begin
  Application := TMyApplication.Create(nil);
  Application.Title := 'My Application';
  Application.Run;
  Application.Free;
end.

【问题讨论】：

标签： delphi indy lazarus indy10

【解决方案1】：

您的主线程没有消息循环来处理TThread.Synchronize()/TThread.Queue() 请求。它在Readln() 上被阻止。由于您在控制台应用程序中而不是 GUI 应用程序中，因此您需要在主线程中定期手动调用 Classes.CheckSynchronize()。

附带说明，您拨打IdTCPServer.Bindings.Add() 的次数过多。在您的示例中，您只需调用它 1 次，创建 1 个绑定，并为其分配 3 个属性值。但相反，您调用它 3 次，使用 3 个单独的属性设置创建 3 个单独的绑定。它应该看起来更像这样：

with IdTCPServer.Bindings.Add do
begin
  IP := '0.0.0.0';
  Port := 80;
  IPVersion := Id_IPv4;
end;

可以简化为 0.0.0.0 和 Id_IPv4 已经是默认值，因此可以从您的代码中省略它们。 TIdTCPServer 有一个 DefaultPort 属性，您可以使用它来代替。如果没有明确定义，TIdTCPServer.Active 属性设置器将创建自己的默认绑定。

【讨论】：