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

Source/Servidor/FactuGES_Server.bdsproj

@@ -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>

Source/Servidor/FactuGES_Server.dpr

@@ -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;
+{  if ROStartService(FACTUGES_NAME, FACTUGES_NAME) then
-  Application.Title := 'FactuGES (Servidor)';
+  begin
-  Application.CreateForm(TfServerForm, fServerForm);
+    // Aqui hay que comprobar antes si el servicio ya está en ejecucion
-  Application.CreateForm(TdmServer, dmServer);
+
-  Application.Run;
+    ROService.CreateForm(TdmServer, dmServer);
-  Application.Terminate;
+    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.

Source/Servidor/Utiles/uCheckPrevious.pas

@@ -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/
+********************************************
+}