SémaphoreRésolu

Question

Salut,

Voilà, je voudrais faire un truc pas compliqué :
Je voudrais pouvoir lancer mon application plusieurs fois. Mais pas plus qu'un nombre de fois prédéterminé (3 fois dans l'exemple ci-dessous).
Jusque là ça va, j'y arrive.
Où ça ne va plus, c'est lorsque je supprime une de ces 3 applications. Je voudrais pouvoir avoir le droit d'en relancer une nouvelle car le nombre maxi n'est plus atteint. 
Mais ça le fait pas...

Voici un bout de code où j'ai condensé mon problème :

Const   NbreProcess : Integer = 3;
var      Sem : THandle;



procedure TForm1.FormCreate(Sender: TObject);
  var count : Integer;
  begin
  Sem := CreateSemaphore(nil,0,NbreProcess,'SpécialSem');
  if Sem = 0 then ShowMessage('Erreur d''ouverture du sémaphore !')
  else begin
    if not(releaseSemaphore(Sem,1,@count)) then begin
      ShowMessage('Pas plus de ' + IntToStr(NbreProcess) + ' processus !');
      Halt;
    end
    else Caption := 'Processus N° ' + IntToStr(Count+1);
    Top := Top + 32 * Count;
  end;
end;



procedure TForm1.FormDestroy(Sender: TObject);
  var Count : Integer;
  begin
  //releaseSemaphore(Sem,1,@count);// <- C'est pas bon...
  CloseHandle(Sem);
end;




procedure TForm1.btnLancerClick(Sender: TObject);
  begin
  ShellExecute(0,nil,pchar(Application.ExeName),nil,nil,SW_SHOW);
end;
---------------------------------------------------------------------

Je précise que j'aimerais bien utiliser l'API CreateSemaphore car c'est le sujet qui m'intéresse en ce moment.
Merci à toux ceux qui se pencheront sur mon 'tit problème.

Cari

WhiteHippo · Accepted Answer

Bonjour

La nuit porte conseil, il y a quelquechose qui me chagrinait dans ton code, tu incrémentes toujours le compteur, mais tu ne le décrémente jamais !!! Cela doit etre effectué avec une "wait function".

Voici un bout de code qui résume tout ça. 

N.B. Il me semble plus approprié de mettre ce code dans le source du projet, en effet, quel interet de créer un processus, pour après s'apercevoir que le nombre de processus est atteint et qu'il faut alors le tuer.

program Project1;



uses
  SysUtils,
  Forms,
  Windows,
  Dialogs,
  Unit1 in 'Unit1.pas' {Form1};



{$R *.res}



const
  SEMAPHORE_ALL_ACCESS = EVENT_ALL_ACCESS;
  NomSemaphore = 'SpécialSem' ;
  NbreProcess : Integer = 3;
var
  Sem : THandle;
  count : Integer;
begin
  // On essaye dans un premier temps d'ouvrir le sémaphore si celui ci a déjà été créé
  Sem := OpenSemaphore(SEMAPHORE_ALL_ACCESS,true,NomSemaphore);
  if ( Sem=0 ) then
  begin
    // Pas trouvé, donc on le crée
    ShowMessage('Première création du sémaphore !');
    Sem := CreateSemaphore(nil,0,NbreProcess,NomSemaphore);
    if Sem = 0 then
    begin
      ShowMessage('Erreur d''ouverture du sémaphore !') ;
      Halt;
    end ;
  end;



  // On vérifie le nombre de processus lancés
  if not(releaseSemaphore(Sem,1,@count)) then
  begin
    ShowMessage('Pas plus de ' + IntToStr(NbreProcess) + ' processus !');
    Halt;
  end ;



  // Limitation non atteinte
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;



  // Le fait d'utiliser WaitForSingleObject qui va permettre
  // au système de vérifier l'état du compteur du sémaphore.
  // et surtout de le décrémenter de 1 !!
  // On attend 10 ms juste histoire de ... ;)
  WaitForSingleObject (Sem, 10) ;
end.



P.S. Il n'y a pas de fermeture de handle car cela n'est normallement pas nécessaire :
"Use the CloseHandle function to close the handle. The system closes the handle automatically when the process terminates. The semaphore object is destroyed when its last handle has been closed." 

Cordialement. <hr />"L'imagination est plus importante que le savoir." Albert Einstein

WhiteHippo · Answer

Bonsoir Caribensila

Une remarque en passant, il ne faudrait pas plutot verifier si ton sémaphore est présent avant ? 

Quelquechose du genre :

   
// Vérification de la présence du sémaphore créé par le premier programme lancé.
  Sem := OpenSemaphore(...) ;
  // Si et seulement si celui ci est inexistant, on le crée 
  // sinon on utilise le handle de celui déjà créé.
  if Sem = 0 then
    if not CreateSemaphore(nil,0,NbreProcess,'SpécialSem') then halt;

    
Cordialement. 
<hr />"L'imagination est plus importante que le savoir." Albert Einstein

Caribensila · Answer

Bonsoir WhiteHippo,

Je suis tout-à-fait de ton avis, mais je suis parti d'un exemple d'Olivier Dahan qui procédait comme ça. Et, de fait, ça fonctionne.

Je crois que le problème est que je n'arrive pas à décrémenter le sémaphore quand je supprime une des applications.

Mais bon, il n'est pas exclu que je n'ai rien compris à la logique du sémaphore.



D'ailleurs, pour le moment, il est exclu que j'y ai compris le moindre truc, semble-t-il...

Je verrais ça demain car ça commence à me gonfler sérieux, là...

En tout cas merci. Je vais vais essayer de creuser ta suggestion.

Caribensila · Answer

Cher WhiteHippo,


La nuit semble plus prodigue avec toi qu'avec moi.

Après une nuit peuplée de sémaphores déjantés appelant désespérément des mutex handicapés profonds, je n'étais pas plus avancé au réveil qu'au coucher.




Et voilà que grâce à toi, tout s'éclaire brusquement !

Les Sémaphores, les Mutex, les fonctions d'attente se livrent à mes yeux dans toute la beauté d'un monde nouveau. Et c'est à toi que je dois cet éclair de compréhension exaltant. Mon univers devient coloré et parfumé.


Sois béni !


C'est ainsi que j'ose à peine te désavouer en ce qui concerne le CloseHandle. N'y vois nulle offense mais plutôt une mise en garde en guise de remerciement.


Je cite Olivier Dahan qui conseille le CloseHandle :

« C'est en effet une bonne habitude à prendre que de libérer explicitement ce qui est créé dans l'application ; si cette fiche principale est amenée à devenir une fiche secondaire lors de l'évolution du programme, la non-libération du Mutex pourrrait bloquer un autre processus tant que l'application reste active. Si on choisit de créer le Mutex avec la fiche, il doit donc être détruit avec elle. » 


Bien sûr il parle de Mutex et pas de Sémaphore. Mais leur nature profonde n'est-elle pas semblable?


Encore merci.


Cari

WhiteHippo · Answer

Cari

14:30 et pas encore reveillé 

La portion de code donné, DANS CE CAS LA, n'est nullement concerné, étant donné qu'il ne se situe pas dans une fiche, mais dans le source du projet. 

Cordialement. 
<hr />"L'imagination est plus importante que le savoir." Albert Einstein

Caribensila · Answer

:)))   T'as raison (comme d'hab!).

Mais je ne parlais que de « bonne habitude à prendre » dans le cas général ; au cas où un quidam de passage adapterait ton code à ses propres besoins...
Ca me semblait utile de le signaler.

salim07360 · Answer

salut , 


 j bien lu ton message , mais ,, je trouve que les procedures que tu vienne de les citer ne sont pas adaptées au programme principal , donc , apparament , tu doit les supprimer , et les remplacer par des fonctions , comme ça , ça ira ........merçi , j'attend ta réponse ....

Caribensila · Answer

Salut Salim07360,

Si tu veux placer ce code dans l'unité principale  pour, par exemple, gérer l'affichage des Fiches, ce n'est pas plus compliqué.
Cependant, comme l'a fait remarquer WhiteHippo, ce n'est pas très logique...

Voici quand même un exemple :


const NbreProcess : Integer = 3; //Nbre maxi de processus autorisés.
        SEMAPHORE_ALL_ACCESS  = EVENT_ALL_ACCESS;




var   HdleSem : THandle; //Handle du Sémaphore.
       Count     : Integer; //Nbre d'accès au Sémaphore dejà utilisés.





procedure TForm1.FormCreate(Sender: TObject);
  begin
  HdleSem := OpenSemaphore(SEMAPHORE_ALL_ACCESS,true,'NomSem');//On essaie d'ouvrir le sémaphore.
  if HdleSem=0 then begin //Si pas encore créé, c'est donc la 1ère instance et..
    HdleSem := CreateSemaphore(nil,0,NbreProcess,'NomSem'); //..on le crée.
    if HdleSem = 0 then begin //Si échec de la création..
      ShowMessage('Erreur d''ouverture du sémaphore !') ;
      Halt; //..on quitte.
    end;

    {Fonction d'attente qui décrémente le compteur du Sémaphore quand on supprime un des process.}
    WaitForSingleObject(HdleSem,0) ;
  end;



  if not(releaseSemaphore(HdleSem,1,@count)) then begin //Si l'ajout d'un nouvel accès au Sémaphore échoue..
    ShowMessage('Pas plus de ' + IntToStr(NbreProcess) + ' processus !'); //.. c'est que le nombre maxi est atteint et..
    Halt;      //..on quitte..
  end ;



 {Gestion de l'affichage:} 
  Caption := Caption + ' ~ Processus N° ' + IntToStr(Count+1);
  Top := Top + 32 * Count;
end;




procedure TForm1.FormDestroy(Sender: TObject);
  begin
   CloseHandle(HdleSem);
end;

@+      Cari

offlake · Answer

Cette exemple m'a aidé !! je suis tellement reconnaissant CARI  BEN SILA !!
BY OFFLAKE

Sémaphore

9 réponses

Votre réponse

Discussions similaires