' Ensure that a given program has just one instance
'
' See discussion here: http://www.powerbasic.com/support/pb...d.php?p=303346
'
' Thanks to the Powerbasic Forum and in particular to Graham McPhee
' and Wayne Diamond for their routines, see these links:
' http://www.powerbasic.com/support/pb...ad.php?t=37879
' http://www.powerbasic.com/support/pb...ad.php?t=24019
'
' Best regards
'
' Erik ----------- 29 November, 2008
'
' See discussion here: http://www.powerbasic.com/support/pb...d.php?p=303346
'
' Thanks to the Powerbasic Forum and in particular to Graham McPhee
' and Wayne Diamond for their routines, see these links:
' http://www.powerbasic.com/support/pb...ad.php?t=37879
' http://www.powerbasic.com/support/pb...ad.php?t=24019
'
' Best regards

'
' Erik ----------- 29 November, 2008
Code:
' Ensure that a given program has just one instance ' ' See discussion here: http://www.powerbasic.com/support/pbforums/showthread.php?p=303346 ' ' Thanks to the Powerbasic Forum and in particular to Graham McPhee ' and Wayne Diamond for their routines, see these links: ' http://www.powerbasic.com/support/pbforums/showthread.php?t=37879 ' http://www.powerbasic.com/support/pbforums/showthread.php?t=24019 ' ' Best regards ' ' Erik ----------- 29 November, 2008 #COMPILE EXE #DIM ALL ' #INCLUDE "win32api.inc" ' ' Processes running . PB_Processes.inc (Provided by Graham McPhee) ' DECLARE FUNCTION EnumProcesses (lpidProcess AS DWORD, BYVAL cb AS DWORD, cbNeeded AS DWORD) AS LONG DECLARE FUNCTION GetModuleFileNameEx (BYVAL hProcess AS DWORD, BYVAL hModule AS DWORD, ModuleName AS ASCIIZ, BYVAL nSize AS DWORD) AS DWORD DECLARE FUNCTION EnumProcessModules (BYVAL hProcess AS DWORD, BYREF lphModule AS DWORD, BYVAL cb AS DWORD, cbNeeded AS DWORD) AS LONG ' TYPE PROCESSENTRY32 dwSize AS DWORD cntUsage AS DWORD th32ProcessID AS DWORD ' This process th32DefaultHeapID AS LONG PTR th32ModuleID AS DWORD ' Associated exe cntThreads AS DWORD th32ParentProcessID AS DWORD ' This process's parent process pcPriClassBase AS LONG ' Base priority of process threads dwFlags AS DWORD szExeFile AS ASCIIZ * %MAX_PATH END TYPE ' SUB KillByTerminate (BYVAL ProcID AS LONG) ' Provided by Wayne Diamond LOCAL hProc AS LONG hProc = OpenProcess(BYVAL %PROCESS_TERMINATE, BYVAL 0, BYVAL ProcID) IF hProc <> %NULL THEN TerminateProcess BYVAL hProc, BYVAL %NULL CloseHandle hProc END SUB ' FUNCTION ReduceProcessesToOne(strProcessName AS STRING) AS LONG ' DIM Reply AS STRING DIM lngR AS INTEGER DIM lngCount AS LONG DIM strModule AS STRING DIM strEXE AS STRING DIM ProcID AS LONG CALL EnumModules(Reply) ' pick up the processes in a string ' FOR lngR= 1 TO PARSECOUNT(Reply,$CRLF) strModule = PARSE$(Reply,$CRLF,lngR) strExe = PARSE$(strModule,"|",2) IF INSTR(strExe,strProcessName)>0 THEN IF lngCount = 1 THEN ProcID = VAL(PARSE$(strModule,"|",1)) KillByTerminate(ProcID) ELSE INCR lngCount END IF END IF NEXT lngR ' FUNCTION = lngCount ' END FUNCTION ' FUNCTION funProcessCount(strProcessName AS STRING) AS LONG ' Provided by Graham McPhee ' count the number of processes running by this name ' DIM Reply AS STRING DIM lngR AS INTEGER DIM lngCount AS LONG DIM strModule AS STRING DIM strEXE AS STRING CALL EnumModules(Reply) ' pick up the processes in a string ' FOR lngR= 1 TO PARSECOUNT(Reply,$CRLF) strModule = PARSE$(Reply,$CRLF,lngR) strExe = PARSE$(strModule,"|",2) IF INSTR(strExe,strProcessName)>0 THEN INCR lngCount END IF NEXT lngR ' FUNCTION = lngCount ' END FUNCTION ' FUNCTION ProcessRunning(ProcessID AS DWORD)AS INTEGER ' Provided by Graham McPhee ' return true or false for process is running --------- (not used in this program) ' DIM Reply AS STRING DIM intR AS INTEGER DIM strModule AS STRING ' FUNCTION = %FALSE ' CALL EnumModules(Reply) IF TRIM$(Reply) = "" THEN ' nothing running ? FUNCTION = %FALSE EXIT FUNCTION ELSE FOR intR= 1 TO PARSECOUNT(Reply,$CRLF) strModule = PARSE$(Reply,$CRLF,intR) IF VAL(PARSE$(strModule,"|",1)) = ProcessID THEN FUNCTION = %TRUE END IF NEXT intR END IF ' END FUNCTION SUB EnumModules(Reply AS STRING) ' Provided by Graham McPhee LOCAL Proc AS PROCESSENTRY32 LOCAL cb AS DWORD, cbNeeded AS DWORD LOCAL i AS LONG, j AS LONG, nModules AS LONG, nProcesses AS LONG, hProcess AS DWORD, lResult AS LONG LOCAL hPsApiDll AS DWORD, hEnumProcesses AS DWORD, hGetModuleFileNameEx AS DWORD, hEnumProcessModules AS DWORD hPsApiDll = GetModuleHandle("psApi.dll") IF hPsApiDll = 0 THEN hPsApiDll = LoadLibrary("psApi.dll") hEnumProcesses = GetProcAddress(hPsApiDll, "EnumProcesses") hGetModuleFileNameEx = GetProcAddress(hPsApiDll, "GetModuleFileNameExA") hEnumProcessModules = GetProcAddress(hPsApiDll, "EnumProcessModules") cb = 100 DO REDIM ProcessIDs(1 TO cb / 4) AS DWORD CALL DWORD hEnumProcesses USING EnumProcesses (ProcessIDs(1), cb, cbNeeded) TO lResult IF cb > cbNeeded THEN EXIT DO cb = cb * 2 LOOP ' Reply = "" nProcesses = cbNeeded / 4 FOR i = 1 TO nProcesses hProcess = OpenProcess(%PROCESS_QUERY_INFORMATION OR %PROCESS_VM_READ OR _ %PROCESS_CREATE_THREAD OR %PROCESS_VM_OPERATION OR _ %PROCESS_VM_WRITE, %False, ProcessIDs(i)) IF hProcess THEN LOCAL CmdLine AS STRING ' cb = 100 DO REDIM Modules(1 TO cb / 4) AS DWORD CALL DWORD hEnumProcessModules USING _ EnumProcessModules (hProcess, Modules(1), cb, cbNeeded) TO lResult IF lResult = 0 THEN cbNeeded = 0: EXIT DO IF cb > cbNeeded THEN EXIT DO ELSE cb = cb * 2 LOOP IF cbNeeded >= 4 THEN CALL DWORD hGetModuleFileNameEx USING GetModuleFileNameEx _ (hProcess, Modules(1), Proc.szExeFile, SIZEOF(Proc.szExeFile)) TO lResult IF lResult THEN Reply = Reply + STR$(ProcessIDs(i))+ "|" + Proc.szExeFile + $CRLF END IF CloseHandle hProcess END IF NEXT nProcesses END SUB ' FUNCTION PBMAIN () AS LONG LOCAL i AS LONG, j AS LONG, FileName AS STRING, k AS DWORD FileName = "Notepad.exe" RANDOMIZE TIMER again: FOR j = 1 TO RND(0, 3) ' make a random number of instances - just for illustration! k = SHELL(FileName, 4) NEXT SLEEP 500 ' this is to allow the system sufficent time to record the program instances. i = funProcessCount(FileName) IF i = 1 THEN GOTO again MSGBOX "Presently there are" + STR$(i) + " instances of "+FileName+$CRLF+$CRLF+ _ "When you press OK, just one instance will exist on the system.",%MB_ICONINFORMATION OR %MB_SYSTEMMODAL, _ "Ensure just one instance of program:" IF i < 1 THEN k = SHELL(FileName, 4) SLEEP 500 ' this is to allow the system sufficent time to record the program instances. j = funProcessCount(FileName) MSGBOX "Now there is just" + STR$(j) + " instance of "+FileName, %MB_ICONINFORMATION OR %MB_SYSTEMMODAL, _ "Ensure just one instance of program:" ELSEIF i > 1 THEN ReduceProcessesToOne(FileName) SLEEP 500 ' this is to allow the system sufficent time to record the program instances. j = funProcessCount(FileName) MSGBOX "Now there is just" + STR$(j) + " instance of "+FileName, %MB_ICONINFORMATION OR %MB_SYSTEMMODAL, _ "Ensure just one instance of program:" END IF END FUNCTION
Comment