Inoffizielles deutsches Xbase-Forum

Code: Alles auswählen

#include "DLL.CH"
#define MUTEX_ALL_ACCESS  2031617
#Define CRLF Chr(13)+Chr(10)

Proc Appsys

LOCAL cMutex:=Upper(AppName())+Chr(0)
LOCAL nH:=DllCall("KERNEL32.DLL", DLL_STDCALL,;
                  "OpenMutexA", MUTEX_ALL_ACCESS, 0, cMutex)

Set Date to German
Set Deleted On
Set Collation to German
Set Console ON
Set Charset to Ansi


IF nH=0
  nH:=DllCall("KERNEL32.DLL",DLL_STDCALL,"CreateMutexA",0,0,cMutex)
ELSE
  MsgBox("Das Programm wird bereits ausgeführt!",cMutex)
  QUIT
ENDIF
DllCall("KERNEL32.DLL",DLL_STDCALL,"ReleaseMutex",nH)

Return

Code: Alles auswählen

FUNCTION makeappfile(nMod)
******************************************************************
local cFile := exename() + ".XUF"
static nUsrHnd
DEFAULT nUsrHnd to -1
DEFAULT nMod to 0
if nMod = 1 // close file
     if nUsrHnd > 0
          FCLOSE(nUsrHnd)
     endif
     return .t.
endif
if nUsrHnd = -1 // first Login

else
     if nUsrHnd > 0
          FCLOSE(nUsrHnd)
     endif
endif
IF (nUsrHnd := FCREATE( cFile )) == -1              // Exist
     dc_msgbox("The system " + exename() + " already started !!!, start cancelled", , , , ,3)
     return .f.
endif
FWRITE(nUsrHnd, cFile )
FCLOSE(nUsrHnd)
return .t.


FUNCTION checkrunning(cExe)
******************************************************************
local nUsrHnd
local cFile := cExe + ".exe.XUF"
IF (nUsrHnd := FCREATE( cFile )) == -1              // Exist
     return .t.
endif
FCLOSE(nUsrHnd)
filedelete(cFile)
return .f.

Code: Alles auswählen

   // Prüfe ob Programm bereits läuft
   IF CheckIfAppIsOpen( AppName(), .F. )[2]
      // Programm abbrechen, da es bereits läuft
      // !!! evtl. laufende Applikation nach vorne holen !!!
      QUIT
   ENDIF

Code: Alles auswählen

...
********************************************************************************
* Defines
********************************************************************************
#DEFINE PROCESS_QUERY_INFORMATION  1024
#DEFINE PROCESS_VM_READ              16


********************************************************************************
FUNCTION CheckIfAppIsOpen( cAppName, lClose )
 * Prüfe ob die Applikation <cAppName> bereits läuft
 * Parameter: cAppName: Name der Exe
 * Return: .T. für läuft, sonst .F.
********************************************************************************

   LOCAL lOpen      := .F., ;
         aProcesses := space(10240), ;
         cbNeeded   := 0,;
         nPid, ;
         nProcHandle, ;
         aModules   := space(4*10), ;
         cbNeeded2  := 0, ;
         n, ;
         nMax, ;
         cname      := space(64), ;
         nPidDel    := NIL, ;
         nAnzApp    := 0
//         xRet

   EnumProcesses( @aProcesses, LEN(aProcesses) , @cbNeeded )

   // Anzahl laufender Prozesse
   nMax := len(trim(aProcesses))/4

   FOR n:= 1 TO nMax
      nPid := Bin2U(substr(aProcesses,1+((n-1)*4),4))
      IF nPidDel==NIL .OR. (nPIdDel==nPid)
         nProcHandle  := OpenProcess( PROCESS_QUERY_INFORMATION + PROCESS_VM_READ ,0, nPid )
         IF EnumProcessModules( nProcHandle, @aModules,len(aModules)/4, @cbNeeded2) != 0
            cName := space(128)
//            xRet  := GetModuleBaseNameA( nProcHandle,bin2u(substr(aModules,1,4)),@cName,len(cName))
            GetModuleBaseNameA( nProcHandle,bin2u(substr(aModules,1,4)),@cName,len(cName))
            cName := strtran(cname,chr(0),"")
//            CloseHandle(nProcHandle)
            IF upper(Alltrim(cName))==upper(cAppName)
               nAnzApp += 1
               nProcHandle := OpenProcess(1,0,nPId)
               IF lClose
                  TerminateProcess(nProcHandle,1)
                  CloseHandle(nProcHandle)
               ENDIF
            ENDIF
         ENDIF
      ENDIF
   NEXT n

   IF nAnzApp > 1
      lOpen := .T.
   ENDIF

RETURN { nAnzApp, lOpen }



DLLFUNCTION EnumProcesses(@lpidProcess,cb,@cbNeeded);
            USING STDCALL FROM PSAPI.DLL
DLLFUNCTION OpenProcess(dwDesiredAccess,bInheritHandle,dwProcessId);
            USING STDCALL FROM KERNEL32.DLL
DLLFUNCTION EnumProcessModules(hProcess,@lphModule,cb,@lpcbNeeded);
            USING STDCALL FROM PSAPI.DLL
DLLFUNCTION GetModuleBaseNameA(hProcess,hModule,@lpBaseName,nSize);
            USING STDCALL FROM PSAPI.DLL
DLLFUNCTION CloseHandle(nHandle);
            USING STDCALL FROM KERNEL32.DLL
DLLFUNCTION TerminateProcess(hProcess,uExitCode) ;
            USING STDCALL FROM KERNEL32.DLL

DLLFUNCTION BringWindowToTop( nHwnd ) ;
            USING STDCALL FROM USER32.DLL
DLLFUNCTION SetForegroundWindow( nHwnd ) ;
            USING STDCALL FROM USER32.DLL