Indy TCP服务器不能从服务中运行？

Question

我想从服务中运行Indy服务器，并使用下面的代码，但没有任何反应。当我运行服务时，我在启动服务器时没有收到任何例外，但是当我尝试连接时，我没有收到“连接”消息。我做错了还是这件事不可能？服务器代码已在正常的应用程序中测试过，没关系，它接收连接。

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

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）。

至于你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.