2012-10-25 206 views
6

我試圖建立一個DataSnap Rest應用程序作爲Windows服務運行,但該向導只有「獨立VCL應用程序」,「獨立控制檯應用程序」和「ISAPI動態鏈接庫「(我正在使用Delphi XE2企業版)。有人可以幫助我。謝謝。DataSnap Rest服務器窗口服務

+1

爲什麼關閉請求?這個問題如何不具有建設性? –

回答

4

如果DataSnap REST嚮導可以選擇創建Windows服務(您將如何運行應用程序服務器?),這樣會更方便一些,但是您可以通過一些小操作來解決它。

我第一次碰到這個問題時,我創建了一個常規DataSnap REST服務器作爲VCL應用程序和常規Windows服務,並將相關部分從REST服務器複製到服務中。只要確保服務的輸出目錄與VCL應用程序的目錄相同即可。

服務的.dpr可能是這樣的:

program Service; 

uses 
    Vcl.SvcMgr, 
    Web.WebReq, 
    IdHTTPWebBrokerBridge, 
    WebModuleUnit1 in '..\GUI\WebModuleUnit1.pas' {WebModule1: TWebModule}, 
    ServerMethodsUnit1 in '..\GUI\ServerMethodsUnit1.pas' {ServerMethods1: TDSServerModule}, 
    ServerContainerUnit1 in '..\GUI\ServerContainerUnit1.pas' {ServerContainer1: TDataModule}, 
    Unit1 in 'Unit1.pas' {Service1: TService}; 

{$R *.RES} 

begin 
    if not Application.DelayInitialize or Application.Installing then 
    Application.Initialize; 

    if WebRequestHandler <> nil then 
    WebRequestHandler.WebModuleClass := WebModuleClass; 

    Application.CreateForm(TService1, Service1); 
    Application.Run; 
end. 

服務的主要單位可能是這樣的:

unit Unit1; 

interface 

uses 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, 
    Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, 
    IdHTTPWebBrokerBridge, Web.HTTPApp; 

type 
    TService1 = class(TService) 
    procedure ServiceCreate(Sender: TObject); 
    procedure ServiceExecute(Sender: TService); 
    procedure ServiceStart(Sender: TService; var Started: Boolean); 
    procedure ServiceStop(Sender: TService; var Stopped: Boolean); 
    private 
    FServer: TIdHTTPWebBrokerBridge; 
    procedure TerminateThreads; 
    public 
    function GetServiceController: TServiceController; override; 
    end; 

var 
    Service1: TService1; 

implementation 

{$R *.DFM} 

uses 
    //Datasnap.DSService; // XE2 
    Datasnap.DSSession; // XE3 

procedure ServiceController(CtrlCode: DWord); stdcall; 
begin 
    Service1.Controller(CtrlCode); 
end; 

{ TService1} 

function TService1.GetServiceController: TServiceController; 
begin 
    Result := ServiceController; 
end; 

procedure TService1.ServiceCreate(Sender: TObject); 
begin 
    FServer := TIdHTTPWebBrokerBridge.Create(Self); 
end; 

procedure TService1.ServiceExecute(Sender: TService); 
begin 
    while not Terminated do 
    begin 
    Sleep(1000); 
    ServiceThread.ProcessRequests(False); 
    end; 
end; 

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean); 
begin 
    if not FServer.Active then 
    begin 
    FServer.Bindings.Clear; 
    FServer.DefaultPort := 8080; 
    FServer.Active := True; 
    end; 
end; 

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean); 
begin 
    TerminateThreads; 
    FServer.Active := False; 
    FServer.Bindings.Clear; 

    ServiceThread.Terminate; 
end; 

procedure TService1.TerminateThreads; 
begin 
    if TDSSessionManager.Instance <> nil then 
    TDSSessionManager.Instance.TerminateAllSessions; 
end; 

end. 
+0

Service1.ServiceExecute可以保留'空'(沒有代碼)? – mjn

+0

mjn:很確定它可以。 –

+0

謝謝,我會嘗試 – JoFan