No lanzar más de una instancia del servidor aunque sea en cuentas de usuario diferentes.
git-svn-id: https://192.168.0.254/svn/Proyectos.LuisLeon_FactuGES/trunk@265 c93665c3-c93d-084d-9b98-7d5f4a9c3376
This commit is contained in:
parent
c9d18a1e39
commit
2c31aa24b7
@ -155,7 +155,7 @@
|
||||
<VersionInfo Name="MajorVer">3</VersionInfo>
|
||||
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||
<VersionInfo Name="Release">3</VersionInfo>
|
||||
<VersionInfo Name="Build">0</VersionInfo>
|
||||
<VersionInfo Name="Build">1</VersionInfo>
|
||||
<VersionInfo Name="Debug">False</VersionInfo>
|
||||
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||
<VersionInfo Name="Special">False</VersionInfo>
|
||||
@ -167,7 +167,7 @@
|
||||
<VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompanyName">Rodax Software S.L.</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="FileVersion">3.0.3.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="FileVersion">3.0.3.1</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
|
||||
@ -176,6 +176,14 @@
|
||||
<VersionInfoKeys Name="ProductVersion">3.0.3.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompileDate">jueves, 26 de junio de 2008 11:49</VersionInfoKeys></VersionInfoKeys>
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
<Excluded_Packages>
|
||||
<Excluded_Packages Name="C:\Archivos de programa\RemObjects Software\Pascal Script\Dcu\D10\PascalScript_RO_D10.bpl">RemObjects Pascal Script - RemObjects SDK 3.0 Integration</Excluded_Packages>
|
||||
</Excluded_Packages>
|
||||
|
||||
@ -4,6 +4,7 @@ program FactuGES_Server;
|
||||
|
||||
uses
|
||||
uROComInit,
|
||||
// uROComboService,
|
||||
Forms,
|
||||
uServerMainForm in 'uServerMainForm.pas' {fServerForm},
|
||||
uAcercaDe in 'uAcercaDe.pas' {fAcercaDe},
|
||||
@ -131,16 +132,36 @@ uses
|
||||
schInfMargenArticuloClient_Intf in '..\Modulos\Informe margen por articulo\Model\schInfMargenArticuloClient_Intf.pas',
|
||||
schInfMargenArticuloServer_Intf in '..\Modulos\Informe margen por articulo\Model\schInfMargenArticuloServer_Intf.pas',
|
||||
schArticulosClient_Intf in '..\Modulos\Articulos\Model\schArticulosClient_Intf.pas',
|
||||
schArticulosServer_Intf in '..\Modulos\Articulos\Model\schArticulosServer_Intf.pas';
|
||||
schArticulosServer_Intf in '..\Modulos\Articulos\Model\schArticulosServer_Intf.pas',
|
||||
uCheckPrevious in 'Utiles\uCheckPrevious.pas';
|
||||
|
||||
{$R *.res}
|
||||
{$R ..\Servicios\RODLFile.res}
|
||||
|
||||
const
|
||||
FACTUGES_NAME = 'FactuGES Servidor';
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.Title := 'FactuGES (Servidor)';
|
||||
Application.CreateForm(TfServerForm, fServerForm);
|
||||
Application.CreateForm(TdmServer, dmServer);
|
||||
Application.Run;
|
||||
Application.Terminate;
|
||||
{ if ROStartService(FACTUGES_NAME, FACTUGES_NAME) then
|
||||
begin
|
||||
// Aqui hay que comprobar antes si el servicio ya está en ejecucion
|
||||
|
||||
ROService.CreateForm(TdmServer, dmServer);
|
||||
ROService.Run;
|
||||
Exit;
|
||||
end;}
|
||||
|
||||
|
||||
begin
|
||||
if not uCheckPrevious.CheckIfRunning(Application.ExeName) then
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.Title := FACTUGES_NAME;
|
||||
Application.CreateForm(TfServerForm, fServerForm);
|
||||
Application.CreateForm(TdmServer, dmServer);
|
||||
Application.Run;
|
||||
Application.Terminate;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
194
Source/Servidor/Utiles/uCheckPrevious.pas
Normal file
194
Source/Servidor/Utiles/uCheckPrevious.pas
Normal file
@ -0,0 +1,194 @@
|
||||
unit uCheckPrevious;
|
||||
|
||||
interface
|
||||
uses Windows, SysUtils;
|
||||
|
||||
function CheckIfRunning(const AExeName : String): Boolean;
|
||||
|
||||
function RestoreIfRunning(
|
||||
const AppHandle : THandle;
|
||||
MaxInstances : integer = 1) : boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
TLHelp32, StrUtils, Forms;
|
||||
|
||||
type
|
||||
PInstanceInfo = ^TInstanceInfo;
|
||||
TInstanceInfo = packed record
|
||||
PreviousHandle : THandle;
|
||||
RunCounter : integer;
|
||||
end;
|
||||
|
||||
var
|
||||
MappingHandle: THandle;
|
||||
InstanceInfo: PInstanceInfo;
|
||||
MappingName : string;
|
||||
|
||||
RemoveMe : boolean = True;
|
||||
|
||||
function CheckIfRunning(const AExeName : String): Boolean;
|
||||
var
|
||||
MyHandle: THandle;
|
||||
hWnd : Cardinal;
|
||||
Struct: TProcessEntry32;
|
||||
ACadena : String;
|
||||
ACadena2 : String;
|
||||
begin
|
||||
Result := False;
|
||||
ACadena2 := ExtractFileName(AExeName);
|
||||
try
|
||||
MyHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
|
||||
try
|
||||
Struct.dwSize:=Sizeof(TProcessEntry32);
|
||||
if Process32First(MyHandle, Struct) then
|
||||
begin
|
||||
ACadena := Struct.szExeFile;
|
||||
if Pos(ACadena2, ACadena) <> 0 then
|
||||
begin
|
||||
hWND := GetCurrentProcessId;
|
||||
if hWND <> Struct.th32ProcessID then
|
||||
begin
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
while Process32Next(MyHandle, Struct) do
|
||||
begin
|
||||
ACadena := Struct.szExeFile;
|
||||
if Pos(ACadena2, ACadena) <> 0 then
|
||||
begin
|
||||
hWND := GetCurrentProcessId;
|
||||
if hWND <> Struct.th32ProcessID then
|
||||
begin
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
CloseHandle(MyHandle);
|
||||
end;
|
||||
except on exception do
|
||||
//
|
||||
end
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function RestoreIfRunning(
|
||||
const AppHandle : THandle;
|
||||
MaxInstances : integer = 1) : boolean;
|
||||
begin
|
||||
Result := True;
|
||||
|
||||
MappingName := StringReplace(
|
||||
ParamStr(0),
|
||||
'\',
|
||||
'',
|
||||
[rfReplaceAll, rfIgnoreCase]);
|
||||
|
||||
MappingHandle := CreateFileMapping($FFFFFFFF,
|
||||
nil,
|
||||
PAGE_READWRITE,
|
||||
0,
|
||||
SizeOf(TInstanceInfo),
|
||||
PChar(MappingName));
|
||||
|
||||
if MappingHandle = 0 then
|
||||
RaiseLastOSError
|
||||
else
|
||||
begin
|
||||
if GetLastError <> ERROR_ALREADY_EXISTS then
|
||||
begin
|
||||
InstanceInfo := MapViewOfFile(MappingHandle,
|
||||
FILE_MAP_ALL_ACCESS,
|
||||
0,
|
||||
0,
|
||||
SizeOf(TInstanceInfo));
|
||||
|
||||
InstanceInfo^.PreviousHandle := AppHandle;
|
||||
InstanceInfo^.RunCounter := 1;
|
||||
|
||||
Result := False;
|
||||
end
|
||||
else //already runing
|
||||
begin
|
||||
MappingHandle := OpenFileMapping(
|
||||
FILE_MAP_ALL_ACCESS,
|
||||
False,
|
||||
PChar(MappingName));
|
||||
if MappingHandle <> 0 then
|
||||
begin
|
||||
InstanceInfo := MapViewOfFile(MappingHandle,
|
||||
FILE_MAP_ALL_ACCESS,
|
||||
0,
|
||||
0,
|
||||
SizeOf(TInstanceInfo));
|
||||
|
||||
if InstanceInfo^.RunCounter >= MaxInstances then
|
||||
begin
|
||||
RemoveMe := False;
|
||||
|
||||
if IsIconic(InstanceInfo^.PreviousHandle) then
|
||||
ShowWindow(InstanceInfo^.PreviousHandle, SW_RESTORE);
|
||||
SetForegroundWindow(InstanceInfo^.PreviousHandle);
|
||||
end
|
||||
else
|
||||
begin
|
||||
InstanceInfo^.PreviousHandle := AppHandle;
|
||||
InstanceInfo^.RunCounter := 1 + InstanceInfo^.RunCounter;
|
||||
|
||||
Result := False;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end; (*RestoreIfRunning*)
|
||||
|
||||
initialization
|
||||
//nothing special here
|
||||
//we need this section because we have the
|
||||
//finalization section
|
||||
|
||||
finalization
|
||||
//remove this instance
|
||||
{ if RemoveMe then
|
||||
begin
|
||||
MappingHandle := OpenFileMapping(
|
||||
FILE_MAP_ALL_ACCESS,
|
||||
False,
|
||||
PChar(MappingName));
|
||||
if MappingHandle <> 0 then
|
||||
begin
|
||||
InstanceInfo := MapViewOfFile(MappingHandle,
|
||||
FILE_MAP_ALL_ACCESS,
|
||||
0,
|
||||
0,
|
||||
SizeOf(TInstanceInfo));
|
||||
|
||||
InstanceInfo^.RunCounter := -1 + InstanceInfo^.RunCounter;
|
||||
end
|
||||
else
|
||||
RaiseLastOSError;
|
||||
end;
|
||||
|
||||
if Assigned(InstanceInfo) then UnmapViewOfFile(InstanceInfo);
|
||||
if MappingHandle <> 0 then CloseHandle(MappingHandle);}
|
||||
|
||||
end. (*unit CheckPrevious*)
|
||||
|
||||
|
||||
{
|
||||
********************************************
|
||||
Zarko Gajic
|
||||
About.com Guide to Delphi Programming
|
||||
http://delphi.about.com
|
||||
email: delphi.guide@about.com
|
||||
free newsletter: http://delphi.about.com/library/blnewsletter.htm
|
||||
forum: http://forums.about.com/ab-delphi/start/
|
||||
********************************************
|
||||
}
|
||||
Reference in New Issue
Block a user