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.