Semaphore Object funktioniert gar nicht ! wo ist der Fehler?

[stoxx]

Wenn ich folgenden Code compiliere passiert folgendes.
Beim ersten Mal drücken auf Button1 wird das Semaphore createt.
Beim zweiten Mal drücken des Button1 erscheint völlig korrekt die Meldung, dass das Semaphore schon gesetzt ist.
Nun drücke ich auf Button2 um das Semaphore wieder zurückzusetzen.
Wenn ich dann auf Button1 drücke, ist das Semaphore immer noch gesetzt. Wieso ?
Das gleiche auch mit Mutex. Was mach ich falsch ?

Code:

var
  Form1: TForm1;
  hSem : THandle;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 hSem := CreateSemaphore(nil,0,1,PCHAR('TS'));
  if (hSem <> 0) and (GetLastError() = ERROR_ALREADY_EXISTS) then
     MessageDlg('Semaphore gesetzt', mtWarning, [mbOK], 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 if hsem <> 0 then releaseSemaphore(hsem,1,nil);
end;

[Christian Seehase]

Moin Stoxx,

statt ReleaseSemaphore nimm' mal CloseHandle.
ReleaseSemaphore erhöht den Counter um den angegebenen Wert.

[stoxx]

geht auch nicht, Du hast es nicht probiert richtig ?
Wenn ich das Programm zwischendurch beende, kein Problem.
Aber so gehts irgendwie nicht.

zweimal Button1, einmal button2 und dann wieder button1 .. und immernoch registriert

[Christian Seehase]

Moin Stoxx,

Zitat:

Zitat von stoxx

zweimal Button1, einmal button2 und dann wieder button1 .. und immernoch registriert

logisch.
Wenn Du zweimal eine Semaphore mit dem gleichen Namen erzeugst, erhältst Du jedesmal ein anderes Handle zurück, weil Du dann zwei gleichnamige Objekte erzeugst, Dir aber nur von einem das Handle merkst.
Du zerstörst also nur das zweite Objekt, und hast keinen Zugriff mehr auf das erste.
Wenn Du Dir eine Liste mit den Handeln erzeugst, und die alle wieder per CloseHandle schliesst, geht's.

[stoxx]

ach mensch

Das funktioniert nicht so, wie ich will.
Es geht darum, dass zwar das Programm an sich zweimal gestartet werden kann.
In diesem Programm gibt es aber ein Modul, was nur einmal laufen soll.
Wenn also in dem einem Programm das Formular gerade angezeigt wird, soll es in dem anderen Programm nicht angezeigt werden können.

Dafür hab ich folgendes getan:
Eine Procedure, die prüft, ob es das Fenster schon aktiv ist.
Wenn nicht schon selbst gestartet, dann prüfen ob ein Semaphore Object der anderen Instanz des Programms existiert.

Code:

var 
  FormTS: TFormTS; 
  hSem : THandle = 0; 


implementation 

{$R *.dfm} 

/////////////////////////////////////////////////////////////////////////////////// 


class function TFormTS.bereitsaktiv : boolean; 
begin 
 result := true; 
 if hsem <> 0 then result := true else  // dann schon selber gestartet 
 begin 
 // prüfen ob andere Instanz des Programms dieses Modul geöffnet hat 
 hSem := CreateSemaphore(nil,0,1,PCHAR('TS')); 
  if (hSem <> 0) and (GetLastError() = ERROR_ALREADY_EXISTS) then 
   result := true else result := false; 
 end; 
end;

Der Aufruf erfolgt so: Und soll korrekt anzeigen, ob das Modul schon geladen ist.

Code:

///////////////////////////////////////////////////////////////////////////////////// 
procedure TFormMain.Automatisierung1Click(Sender: TObject); 
begin 
if TFormTS.bereitsaktiv then 
 MessageDlg('bereits aktiv !', mtWarning, [mbOK], 0) 
else 
 FormTS.show; 
end; 


im Formclose des Forms steht folgendes. 

Code: 
if hsem <> 0 then 
 begin 
   CloseHandle(hsem); 
   hsem := 0; 
 end;

und nun passiert folgendes:

in der einen laufenden Programm Instanz zeige ich das Fenster.
Wenn ich in der anderen laufenden Instanz des Programms dies nun auch tun will, zeigt er völlig korrekt die Meldung, dass es bereits aktiv wäre.
Wenn ich nun in dem anderen Programm das Fenster schließe, lässt sich ein keiner Der Versionen das Fenster wieder öffnen.
Wichtig bei diesem Test ist, dass man einen Check bei gerade geöffnetem Fenter machen muss !
hmmm

[stoxx]

aah .. jetzt gehts *freu*
Ist mir doch die Lösung noch im Bett eingefallen. War ein Logik fehler !
:wall:


Danke nochmal !!

Code:

class function TFormTS.bereitsaktiv : boolean;
begin
 result := true;
 if hsem <> 0 then result := true else  // dann schon selber gestartet
 begin
 // prüfen ob andere Instanz des Programms dieses Modul geöffnet hat
 hSem := CreateSemaphore(nil,0,1,PCHAR('TS'));
  if (hSem <> 0) and (GetLastError() = ERROR_ALREADY_EXISTS) then
   begin
    result := true;
    closehandle(hsem);
    hSem := 0 ;
   end else result := false;
 end;
end;