diff --git a/Source/Servidor/FactuGES_Server.RES b/Source/Servidor/FactuGES_Server.RES
index c84347bf..b76ad531 100644
Binary files a/Source/Servidor/FactuGES_Server.RES and b/Source/Servidor/FactuGES_Server.RES differ
diff --git a/Source/Servidor/FactuGES_Server.dpr b/Source/Servidor/FactuGES_Server.dpr
index 044397ec..e2777eb3 100644
--- a/Source/Servidor/FactuGES_Server.dpr
+++ b/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;
diff --git a/Source/Servidor/FactuGES_Server.dproj b/Source/Servidor/FactuGES_Server.dproj
index cf71a968..34ecde3c 100644
--- a/Source/Servidor/FactuGES_Server.dproj
+++ b/Source/Servidor/FactuGES_Server.dproj
@@ -35,7 +35,10 @@
Delphi.Personality
-FalseTrueFalseTrueFalse1000FalseFalseFalseFalseFalse308212521.0.0.0
+FalseTrueFalse/installTrueFalse1000FalseFalseFalseFalseFalse308212521.0.0.01.0.0.0domingo, 10 de febrero de 2008 12:11
+
+
+
@@ -255,6 +258,7 @@
+
diff --git a/Source/Servidor/FactuGES_Server.rc b/Source/Servidor/FactuGES_Server.rc
index cc48858f..e84d3a39 100644
--- a/Source/Servidor/FactuGES_Server.rc
+++ b/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"
diff --git a/Source/Servidor/Utiles/uCiaServiceTools.pas b/Source/Servidor/Utiles/uCiaServiceTools.pas
new file mode 100644
index 00000000..383ddd6f
--- /dev/null
+++ b/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.
diff --git a/Source/Servidor/uServerMainForm.pas b/Source/Servidor/uServerMainForm.pas
index 01418af8..b2141acb 100644
--- a/Source/Servidor/uServerMainForm.pas
+++ b/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);