Indy TCP Server 无法通过服务工作？

Question

我想运行 Indy Server 来自服务，我使用了以下代码但没有任何反应。当我运行服务时，我在启动服务器时没有收到任何异常，但是当我尝试连接时我也没有收到 "Connected" 消息。我是做错了还是这件事不可能？服务器代码在普通应用程序中测试，没问题，它接收连接。

我刚开始学习服务，我读了一些教程，他们说服务的一个非常常见的用途是检查应用程序的更新，所以我认为我的服务器应该可以工作...

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(667B01);
 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）。

至于您的 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(667B01);
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.

Indy TCP Server 无法通过服务工作？

Indy TCP Server is not working from a service?

delphi

tcp

indy

server