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服务器，这已经足够了（只需确保在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.