Servidor: permitir ejecutarlo como servicio
git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES2/trunk@271 0c75b7a4-871f-7646-8a2f-f78d34cc349f
This commit is contained in:
parent
138165a5d8
commit
fcc30d355e
Binary file not shown.
@ -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;
|
||||
|
||||
|
||||
@ -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" />
|
||||
|
||||
@ -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"
|
||||
|
||||
161
Source/Servidor/Utiles/uCiaServiceTools.pas
Normal file
161
Source/Servidor/Utiles/uCiaServiceTools.pas
Normal file
@ -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.
|
||||
@ -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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user