Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Ensure that a given program has just one instance

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Ensure that a given program has just one instance

    ' 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
    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

  • #2
    ' 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
    Last edited by Erik Christensen; 7 Dec 2008, 04:41 PM.

    Comment

    Working...
    X