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.