Блог

У меня есть консольное приложение Lazarus, где у меня есть простой TIdTCPServer . Чтобы быть потокобезопасным приложением, я добавил TLog.LogMsg() (который использует TIdNotify ).

Проблема в том, что когда я вызываю эту функцию из основного потока, на консоли появляется сообщение, но когда оно вызывается из OnExecute OnConnect события или TIdTCPServer , сообщение не отображается.

Можете ли вы помочь мне с этой проблемой?

 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.
 

В вашем основном потоке нет цикла сообщений для обработки TThread.Synchronize() / TThread.Queue() запросов. Он заблокирован Readln() . Поскольку вы находитесь в консольном приложении, а не в приложении с графическим интерфейсом, вам необходимо периодически вручную вызывать 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 свойств создаст свои собственные привязки по умолчанию, если они не определены явно.