Количество процессов с заданным именем

Ответы на вопросы, чаще всего задаваемые в форумах VBStreets. Для тех, кому лень искать.
hCORe
VB - Экстремал
VB - Экстремал
Аватара пользователя
 
Сообщения: 2332
Зарегистрирован: 22.02.2003 (Сб) 15:21
Откуда: parent directory

Количество процессов с заданным именем

Сообщение hCORe » 07.06.2004 (Пн) 15:09

Приводимый пример может быть очень полезен тем, кто пишет какие-то сложные приложения. Им наверняка хорошо известно, что несколько копий сторонней программы, работающие вместе, могут конфликтовать друг с другом. При запуске программы написанной на VB можно проверять App.PrevInstance, но что делать, если она написана на C/C++ или Delphi? Вот тогда и приходит на помощь функция GetProcesses. Эта функция универсальна и работает на всех системах - как на 9x/ME, так и на NT. Однако, если клиентская машина работает под Windows 9x/ME или Windows XP, целесообразнее вызывать функцию GetProcesses9x.

Вот полный код модуля с этой функцией:
Код: Выделить всё
'функции API

'информация о памяти
Public Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
'уничтожение манипулятора
Public Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
'открытие процесса
Public Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
'список процессов
Public Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
'имя модуля
Public Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
'список модулей
Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
'создание "моментального снимка" системы
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
'получение версии
Public Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
'установка таймера
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
'снятие таймера
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
'состояние памяти
Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
'первый процесс в снимке
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
'следующий процесс в снимке
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

'константы API
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0
Public Const WIN95_System_Found = 1
Public Const WINNT_System_Found = 2
Public Const Default_Log_Size = 10000000
Public Const Default_Log_Days = 0
Public Const SPECIFIC_RIGHTS_ALL = &HFFFF
Public Const STANDARD_RIGHTS_ALL = &H1F0000

Public Const TH32CS_SNAPHEAPLIST = &H1
Public Const TH32CS_SNAPTHREAD = &H4
Public Const TH32CS_SNAPMODULE = &H8
Public Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Public Const TH32CS_INHERIT = &H80000000

'структуры API
Type MEMORYSTATUS
    dwLength As Long
    dwMemoryLoad As Long
    dwTotalPhys As Long
    dwAvailPhys As Long
    dwTotalPageFile As Long
    dwAvailPageFile As Long
    dwTotalVirtual As Long
    dwAvailVirtual As Long
End Type

Type PROCESS_MEMORY_COUNTERS
    cb As Long
    PageFaultCount As Long
    PeakWorkingSetSize As Long
    WorkingSetSize As Long
    QuotaPeakPagedPoolUsage As Long
    QuotaPagedPoolUsage As Long
    QuotaPeakNonPagedPoolUsage As Long
    QuotaNonPagedPoolUsage As Long
    PagefileUsage As Long
    PeakPagefileUsage As Long
End Type

Public Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * 260
    End Type

Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long '1 = Windows 95.
    '2 = Windows NT
    szCSDVersion As String * 128
End Type

Private Function getVersion() As Long

    Dim osinfo As OSVERSIONINFO
    Dim RetValue As Integer

    osinfo.dwOSVersionInfoSize = 148
    osinfo.szCSDVersion = Space$(128)
    RetValue = GetVersionExA(osinfo)
    getVersion = osinfo.dwPlatformId

End Function

Private Function StrZToStr(s As String) As String
    StrZToStr = Left$(s, Len(s) - 1)
End Function

Public Function GetProcesses(ByVal EXEName As String) As Long

    Dim booResult As Boolean
    Dim lngLength As Long
    Dim lngProcessID As Long
    Dim strProcessName As String
    Dim lngSnapHwnd As Long
    Dim udtProcEntry As PROCESSENTRY32
    Dim lngCBSize As Long
    Dim lngCBSizeReturned As Long
    Dim lngNumElements As Long
    Dim lngProcessIDs() As Long
    Dim lngCBSize2 As Long
    Dim lngModules(1 To 200) As Long
    Dim lngReturn As Long
    Dim strModuleName As String
    Dim lngSize As Long
    Dim lngHwndProcess As Long
    Dim lngLoop As Long
    Dim b As Long
    Dim c As Long
    Dim e As Long
    Dim d As Long
    Dim pmc As PROCESS_MEMORY_COUNTERS
    Dim lret As Long
    Dim strProcName2 As String
    Dim strProcName As String

    On Error GoTo Error_handler

    booResult = False

    EXEName = UCase$(Trim$(EXEName))
    lngLength = Len(EXEName)

    Dim lngCount As Long
    lngCount = 0
   
    Select Case getVersion()
        Case WIN95_System_Found
            GetProcesses = GetProcesses9x(EXEName)
            Exit Function
        Case Else

            lngCBSize = 8
            lngCBSizeReturned = 96

            Do While lngCBSize <= lngCBSizeReturned
                DoEvents
                lngCBSize = lngCBSize * 2
                ReDim lngProcessIDs(lngCBSize / 4) As Long
                lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
            Loop

            lngNumElements = lngCBSizeReturned / 4

            For lngLoop = 1 To lngNumElements
                DoEvents

                lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop))

                If lngHwndProcess <> 0 Then
                   lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)

                   If lngReturn <> 0 Then
                    strModuleName = Space(MAX_PATH)
                    lngSize = 500
                    lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), strModuleName, lngSize)
                    strProcessName = Left(strModuleName, lngReturn)
                    strProcessName = UCase$(Trim$(strProcessName))
                    strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "\", 0, 0, GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "\") - 1)
                    If UCase(strProcName2) = UCase(EXEName) Then
                        pmc.cb = LenB(pmc)
                        lret = GetProcessMemoryInfo(lngHwndProcess, pmc, pmc.cb)
                        lngCount = lngCount + 1
                    End If
                End If
            End If
            lngReturn = CloseHandle(lngHwndProcess)
            DoEvents
        Next

    End Select

GetProcesses = lngCount
IsProcessRunning_Exit:
Exit Function
Error_handler:
    Resume Next
End Function

Public Function GetProcesses9x(EXEName As String) As Long
On Error Resume Next
    Dim hSnapShot As Long, uProcess As PROCESSENTRY32
    Dim strNm As String, lngCount As Long
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    r = Process32First(hSnapShot, uProcess)
    lngCount = 0
    Do While r
        DoEvents
        strNm = Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0))
        If UCase(strNm) = UCase(EXEName) Then lngCount = lngCount + 1
        r = Process32Next(hSnapShot, uProcess)
    Loop
    CloseHandle hSnapShot
    GetNumberOfProcesses = lngCount
End Function

Public Function GetElement(ByVal strList As String, ByVal strDelimiter As String, ByVal lngNumColumns As Long, ByVal lngRow As Long, ByVal lngColumn As Long) As String

    Dim lngCounter As Long

    strList = strList & strDelimiter

    lngColumn = IIf(lngRow = 0, lngColumn, (lngRow * lngNumColumns) + lngColumn)

    For lngCounter = 0 To lngColumn - 1

        strList = Mid$(strList, InStr(strList, strDelimiter) + Len(strDelimiter), Len(strList))

        If Len(strList) = 0 Then
            GetElement = ""
            Exit Function
        End If

    Next lngCounter
   
    GetElement = Left$(strList, InStr(strList, strDelimiter) - 1)

End Function


Public Function GetNumElements(ByVal strList As String, ByVal strDelimiter As String) As Integer

    Dim intElementCount As Integer

    If Len(strList) = 0 Then
        GetNumElements = 0
        Exit Function
    End If

    strList = strList & strDelimiter

    While InStr(strList, strDelimiter) > 0
        intElementCount = intElementCount + 1
        strList = Mid$(strList, InStr(strList, strDelimiter) + 1, Len(strList))
    Wend

    GetNumElements = intElementCount

End Function


Также прилагается программа-пример:
http://amelso.narod.ru/testing/appinstances.zip
Моду создают модоки, а распространяют модозвоны.

Вернуться в Популярные вопросы

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 14

    TopList