Announcement

**Erik Christensen** · 7 Dec 2008, 12:09 PM

' Ensure that a given program has just one instance (version 2)
'
' 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
'
' This version is based on the file size. It will kill instances with the
' same file size even if the file has been renamed by someone.
'
' Best regards,

'
' Erik Christensen ---------- 7 December, 2008

Code:

' Ensure that a given program has just one instance (version 2)
'
' 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
'
' This version is based on the file size. It will kill instances with the
' same file size even if the file has been renamed by someone.
'
' Best regards,
'
' Erik Christensen ---------- 7 December, 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
    DIM FileSize AS DWORD
    DIM f AS STRING
    DIM DirDataVar AS DIRDATA
    DIM kk 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) ' path and filename
        IF INSTR(strExe,strProcessName)>0 THEN
            f = DIR$(strExe, TO DirDataVar)    ' get file data including file size
            FileSize = DirDataVar.FileSizeLow  ' get size of file
            kk = lngR
            EXIT FOR
        END IF
    NEXT lngR
    '
    FOR lngR= 1 TO PARSECOUNT(Reply,$CRLF)
        strModule = PARSE$(Reply,$CRLF,lngR)
        strExe = PARSE$(strModule,"|",2) ' path and filename
        f = DIR$(strExe, TO DirDataVar)  ' get file data including file size
        IF DirDataVar.FileSizeLow = FileSize AND lngR <> kk THEN ' kill other files of same size even if renamed.
            ProcID = VAL(PARSE$(strModule,"|",1))
            KillByTerminate(ProcID)
        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

Announcement

Forum Guidelines

Ensure that a given program has just one instance

Ensure that a given program has just one instance

Comment