Servidor: permitir ejecutarlo como servicio

git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES2/trunk@271 0c75b7a4-871f-7646-8a2f-f78d34cc349f

Source/Servidor/FactuGES_Server.dpr

@@ -113,15 +113,25 @@ uses
   schReferenciasClient_Intf in '..\Modulos\Referencias\Model\schReferenciasClient_Intf.pas',
   uRptFichasEmpleado_Server in '..\Modulos\Contactos\Reports\uRptFichasEmpleado_Server.pas' {RptFichasEmpleado: TDataModule},
   uRptEtiquetasContacto_Server in '..\Modulos\Contactos\Reports\uRptEtiquetasContacto_Server.pas' {RptEtiquetasContacto: TDataModule},
-  uRptWordFacturaCliente in '..\Modulos\Facturas de cliente\Reports\uRptWordFacturaCliente.pas' {RptWordFacturaCliente: TDataModule};
+  uRptWordFacturaCliente in '..\Modulos\Facturas de cliente\Reports\uRptWordFacturaCliente.pas' {RptWordFacturaCliente: TDataModule},
+  uCiaServiceTools in 'Utiles\uCiaServiceTools.pas';
 
 {$R *.res}
 {$R ..\Servicios\RODLFile.res}
 
+const
+  FACTUGES_NAME = 'FactuGES Servidor';
+
 begin
+  if CiaStartService(FACTUGES_NAME) then begin
+    CiaService.CreateForm(TfServerForm, fServerForm);
+    CiaService.Run;
+    Exit;
+  end;
+
   Application.Initialize;
 //  ReportMemoryLeaksOnShutdown := True;
-  Application.Title := 'FactuGES (Servidor)';
+  Application.Title := FACTUGES_NAME;
 
   Application.ShowMainForm := False;
 

Source/Servidor/FactuGES_Server.dproj

@@ -35,7 +35,10 @@
     <Borland.Personality>Delphi.Personality</Borland.Personality>
     <Borland.ProjectType />
     <BorlandProject>
-<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">3082</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion"></VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys><VersionInfoKeys Name="CompileDate"></VersionInfoKeys></VersionInfoKeys><Excluded_Packages>
+<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters><Parameters Name="RunParams">/install</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">3082</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys><VersionInfoKeys Name="CompileDate">domingo, 10 de febrero de 2008 12:11</VersionInfoKeys></VersionInfoKeys><Excluded_Packages>
+      
+      
+      
       
       
       
@@ -255,6 +258,7 @@
     <DCCReference Include="Utiles\AHWord97.pas" />
     <DCCReference Include="Utiles\RegExpr.pas" />
     <DCCReference Include="Utiles\uBusinessUtils.pas" />
+    <DCCReference Include="Utiles\uCiaServiceTools.pas" />
     <DCCReference Include="Utiles\uDatabaseUtils.pas" />
     <DCCReference Include="Utiles\uReferenciasUtils.pas" />
     <DCCReference Include="Utiles\uRestriccionesUsuarioUtils.pas" />

Source/Servidor/FactuGES_Server.rc

@@ -14,7 +14,7 @@ BEGIN
          BEGIN
               VALUE "FileVersion", "1.0.0.0\0"
               VALUE "ProductVersion", "1.0.0.0\0"
-              VALUE "CompileDate", "jueves, 07 de febrero de 2008 12:41\0"
+              VALUE "CompileDate", "domingo, 10 de febrero de 2008 12:11\0"
          END
     END
     BLOCK "VarFileInfo"

Source/Servidor/Utiles/uCiaServiceTools.pas

@@ -0,0 +1,161 @@
+unit uCiaServiceTools;
+
+interface
+
+uses
+   SysUtils, Classes, Windows, SvcMgr, WinSvc;
+
+type
+  TCiaService = class(TService)
+  protected
+    procedure Start(Sender: TService; var Started: boolean);
+    procedure Stop(Sender: TService; var Stopped: boolean);
+    procedure Execute(Sender: TService);
+  public
+    function GetServiceController: TServiceController; override;
+    constructor CreateNew(AOwner: TComponent; Dummy: integer = 0); override;
+    procedure CreateForm(InstanceClass: TComponentClass; var Reference);
+    procedure Run;
+  end;
+
+function CiaStartService(DisplayName: string): Boolean;
+function CiaIsService: boolean;
+
+var
+  CiaService: TCiaService;
+
+implementation
+
+var
+   FIsService: boolean;
+   FServiceName: string;
+   FDisplayName: string;
+
+//------------------------------------------------------------------------------
+//---- TCiaService -------------------------------------------------------------
+//------------------------------------------------------------------------------
+procedure ServiceController(CtrlCode: dword); stdcall;
+begin
+   CiaService.Controller(CtrlCode);
+end;
+
+//------------------------------------------------------------------------------
+function TCiaService.GetServiceController: TServiceController;
+begin
+   result := ServiceController;
+end;
+
+//------------------------------------------------------------------------------
+procedure TCiaService.CreateForm(InstanceClass: TComponentClass; var Reference);
+begin
+   SvcMgr.Application.CreateForm(InstanceClass, Reference);
+end;
+
+//------------------------------------------------------------------------------
+procedure TCiaService.Run;
+begin
+   SvcMgr.Application.Run;
+end;
+
+//------------------------------------------------------------------------------
+constructor TCiaService.CreateNew(AOwner: TComponent; Dummy: integer);
+begin
+   inherited;
+   AllowPause  := False;
+   Interactive := True;
+   DisplayName := FDisplayName;
+   Name        := FServiceName;
+   OnStart     := Start;
+   OnStop      := Stop;
+end;
+
+//------------------------------------------------------------------------------
+procedure TCiaService.Start(Sender: TService; var Started: boolean);
+begin
+   Started := True;
+end;
+
+//------------------------------------------------------------------------------
+procedure TCiaService.Execute(Sender: TService);
+begin
+   while not Terminated do
+      ServiceThread.ProcessRequests(True);
+end;
+
+//------------------------------------------------------------------------------
+procedure TCiaService.Stop(Sender: TService; var Stopped: boolean);
+begin
+   Stopped := True;
+end;
+
+//------------------------------------------------------------------------------
+//---- Various -----------------------------------------------------------------
+//------------------------------------------------------------------------------
+function CiaIsService: boolean;
+begin
+   Result := FIsService;
+end;
+
+//------------------------------------------------------------------------------
+function CiaStartService(DisplayName: string): Boolean;
+var
+   Mgr, Svc: Integer;
+   UserName, ServiceStartName: string;
+   Config: Pointer;
+   Size: DWord;
+   n: integer;
+begin
+   FDisplayName := DisplayName;
+   FServiceName := DisplayName;
+
+   for n := 1 to Length(FServiceName) do
+      if FServiceName[n] = ' ' then
+         FServiceName[n] := '_';
+
+   FIsService := FindCmdLineSwitch('install',   ['-','\','/'], True) or
+                 FindCmdLineSwitch('uninstall', ['-','\','/'], True);
+
+   if FIsService then begin
+      SvcMgr.Application.Initialize;
+      CiaService := TCiaService.CreateNew(SvcMgr.Application, 0);
+      Result := True;
+      Exit;
+   end;
+
+   Mgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
+   if Mgr <> 0 then begin
+      Svc := OpenService(Mgr, PChar(FServiceName), SERVICE_ALL_ACCESS);
+      FIsService := Svc <> 0;
+      if FIsService then begin
+         QueryServiceConfig (Svc, nil, 0, Size);
+         Config := AllocMem(Size);
+         try
+            QueryServiceConfig(Svc, Config, Size, Size);
+            ServiceStartName := PQueryServiceConfig(Config)^.lpServiceStartName;
+            if CompareText(ServiceStartName, 'LocalSystem') = 0 then
+               ServiceStartName := 'SYSTEM';
+         finally
+            Dispose(Config);
+         end;
+         CloseServiceHandle(Svc);
+      end;
+      CloseServiceHandle(Mgr);
+   end;
+
+   if FIsService then begin
+      Size := 256;
+      SetLength(UserName, Size);
+      GetUserName(PChar(UserName), Size);
+      SetLength(UserName, StrLen(PChar(UserName)));
+      FIsService := CompareText(UserName, ServiceStartName) = 0;
+   end;
+
+   Result := FIsService;
+
+   if FIsService then begin
+      SvcMgr.Application.Initialize;
+      CiaService := TCiaService.CreateNew(SvcMgr.Application, 0);
+   end;
+end;
+
+end.

Source/Servidor/uServerMainForm.pas

@@ -51,13 +51,17 @@ var
 implementation
 
 uses
-  uDataModuleServer, uConfiguracion, uAcercaDe, uServerAppUtils;
+  uDataModuleServer, uConfiguracion, uAcercaDe, uServerAppUtils,
+  uCiaServiceTools;
 
 {$R *.dfm}
 
 procedure TfServerForm.actCerrarExecute(Sender: TObject);
 begin
-  Close;
+   if CiaIsService then
+      PostThreadMessage(CiaService.ServiceThread.ThreadID, WM_QUIT, 0, 0)
+   else
+      Application.Terminate;
 end;
 
 procedure TfServerForm.actRestartExecute(Sender: TObject);