Projects

javaControl

August 4, 2008 by Java

Browsing clsProcessController.cls (7.20 KB)

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsProcessController"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' clsProcessController: exposes a process controller interface
'
' Copyright (c) 2008 - 2010 JaviteSoft ( http://www.javitesoft.com )

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByRef lProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, ByRef lpExitCode As Long) As Long
Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function IsWindowApi Lib "user32" Alias "IsWindow" (ByVal hWnd As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, ByRef uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, ByRef uProcess As PROCESSENTRY32) As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long

Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2
Private Const PROCESS_TERMINATE = &H1
Private Const PROCESS_SET_INFORMATION = &H200
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const SYNCHRONIZE = &H100000
    
Private 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 * MAX_PATH
End Type

Public Enum ProcessPriorityClasses
    NORMAL_PRIORITY_CLASS = &H20
    IDLE_PRIORITY_CLASS = &H40
    HIGH_PRIORITY_CLASS = &H80
    REALTIME_PRIORITY_CLASS = &H100
    BELOW_NORMAL_PRIORITY_CLASS = &H4000
    ABOVE_NORMAL_PRIORITY_CLASS = &H8000
End Enum

Private m_ProcessId As Long

Public Function InitById(ByVal pId As Long) As clsProcessController
    m_ProcessId = pId
    Set InitById = Me
End Function

Public Function InitByWindow(ByVal hWnd As Long) As clsProcessController

    Dim ThreadId As Long
    
    If IsWindowApi(hWnd) Then
        ThreadId = GetWindowThreadProcessId(hWnd, m_ProcessId)
        Set InitByWindow = InitById(m_ProcessId)
    Else
        Set InitByWindow = Nothing
    End If
    
End Function

Public Function InitByName(ByVal procName As String) As clsProcessController

    Dim hSnapshot As Long
    Dim uProcess As PROCESSENTRY32
    Dim rProcess As Long
    Dim szExename As String
    Dim pId As Long
    
    szExename = ""
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    
    If hSnapshot Then
    
        uProcess.dwSize = Len(uProcess)
        rProcess = ProcessFirst(hSnapshot, uProcess)
        
        Do While rProcess
                    
            szExename = uProcess.szExeFile
            If InStr(szExename, vbNullChar) Then _
                szExename = Left(szExename, InStr(szExename, vbNullChar) - 1)
            
            If LCase(procName) = LCase(szExename) Then
            
                pId = uProcess.th32ProcessID
                Exit Do
                
            End If
                    
            rProcess = ProcessNext(hSnapshot, uProcess)
        
        Loop
        
        CloseHandle hSnapshot
        
    End If
    
    Set InitByName = InitById(pId)
    
End Function

Public Property Get ProcessID() As Long
    ProcessID = m_ProcessId
End Property

Public Property Get ProcessName() As String

    Dim hSnapshot As Long
    Dim uProcess As PROCESSENTRY32
    Dim rProcess As Long
    Dim szExename As String
    
    szExename = ""
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    
    If hSnapshot Then
    
        uProcess.dwSize = Len(uProcess)
        rProcess = ProcessFirst(hSnapshot, uProcess)
        
        Do While rProcess
        
            If uProcess.th32ProcessID = m_ProcessId Then
            
                szExename = uProcess.szExeFile
                If InStr(szExename, vbNullChar) Then _
                    szExename = Left(szExename, InStr(szExename, vbNullChar) - 1)
                    
                Exit Do
                
            End If
            
            rProcess = ProcessNext(hSnapshot, uProcess)
        
        Loop
        
        CloseHandle hSnapshot
        
    End If
    
    ProcessName = szExename
    
End Property

Public Property Get PriorityClass() As ProcessPriorityClasses

    Dim hProcess As Long
    
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, m_ProcessId)
    PriorityClass = GetPriorityClass(hProcess)
    CloseHandle hProcess

End Property

Public Property Let PriorityClass(ByVal PriorityClass As ProcessPriorityClasses)

    Dim hProcess As Long
    
    hProcess = OpenProcess(PROCESS_SET_INFORMATION, 0, m_ProcessId)
    Call SetPriorityClass(hProcess, PriorityClass)
    CloseHandle hProcess

End Property

Public Function Kill() As Boolean

    Dim hProcess As Long
    Dim lExitCode As Long
    Dim ret As Boolean
    
    ret = False
    hProcess = OpenProcess(PROCESS_TERMINATE Or SYNCHRONIZE, 0, m_ProcessId)
    
    If hProcess Then
    
        Call GetExitCodeProcess(hProcess, lExitCode)
        ret = CBool(TerminateProcess(hProcess, lExitCode))
            
    End If
    
    CloseHandle hProcess
    Kill = ret

End Function

Public Function BeginProcessEnum() As clsProcessEnum

    ' return a new process enumerator class
    Dim thisProcessEnum As New clsProcessEnum
    thisProcessEnum.Init Me
    
    Set BeginProcessEnum = thisProcessEnum

End Function

Public Sub EndProcessEnum(ByVal objEnum As clsProcessEnum)
    Set objEnum = Nothing
End Sub

Public Function BuildProcessIdCollection() As Collection

    Dim hSnapshot As Long
    Dim uProcess As PROCESSENTRY32
    Dim rProcess As Long
    Dim pIds As New Collection

    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)

    If hSnapshot Then
    
        uProcess.dwSize = Len(uProcess)
        rProcess = ProcessFirst(hSnapshot, uProcess)
        
        Do While rProcess

            pIds.Add uProcess.th32ProcessID
            rProcess = ProcessNext(hSnapshot, uProcess)

        Loop

        CloseHandle hSnapshot
        
    End If

    Set BuildProcessIdCollection = pIds

End Function

Download clsProcessController.cls

Back to file list

---

Back to project page