Indy TCP Server無法通過服務工作？

Question

我想從服務運行Indy Server，我使用了以下代碼，但沒有任何反應。 當我運行該服務時，在啟動服務器時沒有收到任何異常，但在嘗試連接時也沒有收到“已連接”消息。 我做錯了還是這件事不可能？ 服務器代碼已在普通應用程序中經過測試，可以，它可以接收連接。

我剛剛開始學習服務，並且閱讀了一些教程，他們說服務的一種非常普遍的用法是檢查應用程序的更新，因此我認為我的服務器應該可以工作。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext;

type
  TMarusTestService = class(TService)
    IdTCPServer1: TIdTCPServer;
    procedure ServiceExecute(Sender: TService);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  public
    function GetServiceController: TServiceController; override;
  end;

var
  MarusTestService: TMarusTestService;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  MarusTestService.Controller(CtrlCode);
end;

function TMarusTestService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TMarusTestService.IdTCPServer1Execute(AContext: TIdContext);
var f:textfile;
begin
 AssignFile(f,'f:\service.txt');
 Rewrite(f);
 Writeln(f,'Connected');
 CloseFile(f);
 repeat
  AContext.Connection.Socket.ReadLongWord;
  AContext.Connection.Socket.Write($93667B01);
 until false;
end;

procedure TMarusTestService.ServiceExecute(Sender: TService);
var f:textfile;
begin
  IdTCPServer1.Bindings.Clear;
  IdTCPServer1.Bindings.Add.SetBinding('192.168.1.2', 1280);
  try
   IdTCPServer1.Active:=True;
  except
    on E: Exception do
     begin
      AssignFile(f,'f:\service.txt');
      Rewrite(f);
      Writeln(f,'Exception: '+E.ClassName+#13+E.Message);
      CloseFile(f);
     end;
  end;

  while not Terminated do
   ServiceThread.ProcessRequests(true);
end;

procedure TMarusTestService.ServiceStart(Sender: TService;
  var Started: Boolean);
begin
  IdTCPServer1.Bindings.Clear;
  IdTCPServer1.Bindings.Add.SetBinding('192.168.1.2', 280);
  IdTCPServer1.Active:=True;
end;

procedure TMarusTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  IdTCPServer1.Active:=false;
end;

end.

Answer 1

服務已激活后 ，服務的OnExecute處理程序將清除TIdTCPServer.Binding集合。 只需完全擺脫OnExecute處理程序，讓TService自行為您處理SCM請求。 您的OnStart處理程序已經在激活TCP服務器，這已經足夠了（只需確保在OnStop事件中將Started := True設置為Stopped := True OnStop ）。

至於您的TIdTCPServer事件，應將'Connected'日志消息移至OnConnect事件，並擺脫OnExecute事件內部的循環（因為TIdTCPServer已經為您循環了該事件）。

嘗試更多類似這樣的方法：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdContext,
  SyncObjs;

type
  TMarusTestService = class(TService)
    IdTCPServer1: TIdTCPServer;
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private
    CS: TCriticalSection;
    procedure Log(const Msg: String);
  public
    function GetServiceController: TServiceController; override;
  end;

var
  MarusTestService: TMarusTestService;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  MarusTestService.Controller(CtrlCode);
end;

function TMarusTestService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TMarusTestService.ServiceCreate(Sender: TObject);
begin
  CS := TCriticalSection.Create;
end;

procedure TMarusTestService.ServiceDestroy(Sender: TObject);
begin
  CS.Free;
end;

procedure TMarusTestService.Log(const Msg: String);
const
  LogFileName = 'f:\service.txt';
var
  f: TextFile;
begin
  CS.Enter;
  try
    AssignFile(f, LogFileName);
    if FileExists(LogFileName) then 
      Append(f)
    else
      Rewrite(f);
    try
      WriteLn(f, '[', DateTimeToStr(Now), '] ', Msg);
    finally
      CloseFile(f);
    end;
  finally
    CS.Leave;
  end;
end;

procedure TMarusTestService.IdTCPServer1Connect(AContext: TIdContext);
begin
  Log('Connected');
end;

procedure TMarusTestService.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  Log('Disconnected');
end;

procedure TMarusTestService.IdTCPServer1Execute(AContext: TIdContext);
begin
  AContext.Connection.Socket.ReadLongWord;
  AContext.Connection.Socket.Write($93667B01);
end;

procedure TMarusTestService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  IdTCPServer1.Bindings.Clear;
  IdTCPServer1.Bindings.Add.SetBinding('192.168.1.2', 280, Id_IPv4);

  try
    IdTCPServer1.Active := True;
  except
    on E: Exception do
    begin
      Log('Exception: (' + E.ClassName + ') ' + E.Message);
      Win32ErrCode := 0;
      ErrCode := 1;
      Started := False;
      Exit;
    end;
  end;

  Log('Service Started');
  Started := True;
end;

procedure TMarusTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  IdTCPServer1.Active := False;
  Log('Service Stopped');
  Stopped := True;
end;

end.