Doppelter Programmaufruf

[horsthorn]

Da ich mit den dafür vorgesehenen Code-Fetzen nicht klar komme (zu blöd dafür )
und ich den doppelten Programmaufruf verhindern will, habe ich mir was "gebacken"
Zu Anfang kommt nach den Declarationen das:

VAR startdatei$=$APPDATADIR+"\\irgendwas.txt"
IF FILEEXISTS(startdatei$)
Messagebox("Programm ist schon aktiv !","Fehler",64)
END
ENDIF
'------------------ PROGRAMMSTART
ASSIGN #1,startdatei$
REWRITE #1,"Irgendwas"
CLOSE #1
......
......
PROC PROGRAMM_ENDE
ASSIGN #2,startdatei$
ERASE #2
END
ENDPROC

...und das schöne dabei ist: Es funktioniert
Ist die Datei noch vorhanden, erkennt das Programm beim zweiten Start das und beendet sich.
Klappt ohne API -
Man kann die Messagebox auch weg lassen. Finde es aber mit Meldung besser:

[ts-soft]

1. dafür besser den tmp-Ordner verwenden.
2. Bei einem Programmabsturz wird das Programm nie wieder starten.

Für mich wäre das keine Alternative. Wenn keine Mutex oder API,
dann kannst Du immer noch eine FileMap anlegen, mit %hWnd als
Wert kannste da noch Messages versenden o. ä.

[Jac de Lad]

Ich finde auch Mutex am besten, ein Source dafür ist hier irgendwo schon zu finden. Ist auch ganz klein, nur 5 Zeilen oder so.

[horsthorn]

So besser ?

DEF CreateMutex(3) !"KERNEL32","CreateMutexA"
DEF GetLastError(0) !"KERNEL32.dll","GetLastError"
PROC CHECK_START   
 PARAMETERS name$      
 DECLARE mutex&,error&
   name$=SUBSTR$(name$,-1,"\\")
   mutex& = CreateMutex(0,1,addr(name$))
   error& = GetLastError()
        IF error& = 183
        MESSAGEBOX("Das Programm \n\n"+UPPER$(programm$)+"  "+vers$+"\n\nwurde schon einmal gestartet !","Doppelstart !",64)
                END
        ENDIF
ENDPROC

CHECK_START programm$

Danke für euer "Meckern"
Das spornt mich immer wieder an !

[JörgG]

Hey Horst, so sieht meine Standard-Prüfung für Doppelstart aus - habe ich derzeit hier im Forum angefragt habe mich letztendlich für diesen Vorschlag entschieden (steht dann bei mir immer gleich hinter den Declarationen)

Def Createmutex(3) !"KERNEL32","CreateMutexA"
Def WaitForSingleObject(2) !"KERNEL32.dll","WaitForSingleObject" 

Proc dopp ' return ist <> 0 wenn doppelstart vorliegt
  Parameters Name$    ' Mutexname
  Declare Mutex&, WaitFor&
  Mutex& = Createmutex(0,0,Addr(Name$))
  WaitFor&=WaitForSingleObject(Mutex&,1)
  Return WaitFor&
Endproc

IF dopp("mutexstring")<>0 'falls kein mutex erstellt werden konnte (also ein doppelstart vorliegt) gibt die proc dopp einen wert ungleich 0 zurück
  end
endif

... nur der Vollständigkeit halber (für deine Schnipselsammlung )

[horsthorn]

@Jörg
Danke

PS: "Alte chinesische Volksweisheit:"
Es führen viele Wege nach Rom !

[Frabbing]

Danke für euer "Meckern"
Das spornt mich immer wieder an !

Ja, und ist auch immer mal wieder nötig.