Gestione Processi Windows con Visual Basic

Home | Visual Basic

Grazie a questo piccolo programma è possibile modificare la priorità di un processo di windows o chiuderlo, ovvero fare il cosiddetto kill di un eseguibile in memoria.

Può essere utile in molti frangenti, in effetti è una scorciatoi perche permette di fare delle operazioni che si dovrebbero fare con il Task Manager, cioè quello di diminuire o aumentare la priorità di processo in memoria, oppure di chiudere un programma definitivamente.

Prende come parametri il nome del processo, ovvero l'eseguibile che vogliamo modificare o chiudere ed un secondo parametro che rappresenta il nuovo grado di priorità o -1 se vogliamo fare il kill dell'applicazione.

Come si può vedere dal codice inizialmente il programma l'ho chiamato ImpostaPrioritaProcesso in quanto non prevedeva il kill, poi ho aggiunto anche le righe di codice per chiudere un processo. Copiando il sorgente in un progetto visual basic con un solo file .bas, è possibile dare qualsiasi nome, e modificare i messaggi di errore.

Il secondo parametro va da 5 (ovvero impostare il processo in tempo reale) fino a 0 (impostare il processo a priorità bassa, cioè fa qualcosa solo quando non vi sono altri processi che lavorano), in più c'è la possibilità di impostare il parametro a -1 ovvero chiusura del processo.

Il programma una volta compilato può anche essere lanciato in modo batch per da linea di comando, es. inserire in un file .bat il comando in moda da lanciarlo con un doppio click, invece di aprire il task manager.

Option Explicit
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) 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 hProcess As Long, ByVal uExitCode As Long) As Long

Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Const TH32CS_SNAPPROCESS = 2
Const MAX_PATH = 260


Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const BELOW_NORMAL_PRIORITY_CLASS = 16384
Private Const ABOVE_NORMAL_PRIORITY_CLASS = 32768
Private Const IDLE_PRIORITY_CLASS = &H40
Private Const HIGH_PRIORITY_CLASS = &H80
Private Const REALTIME_PRIORITY_CLASS = &H100

Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_SET_INFORMATION As Long = &H200
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF

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


Function GetProcessId(Process As String) As Long
    Dim hSnapShot As Long, pe32 As PROCESSENTRY32
    hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, ByVal 0)
    pe32.dwSize = Len(pe32)
    ProcessFirst hSnapShot, pe32
    Do
        If InStr(1, pe32.szExeFile, Process & vbNullChar, vbTextCompare) = 1 Then
            GetProcessId = pe32.th32ProcessID
            Exit Do
        End If
    Loop While ProcessNext(hSnapShot, pe32)
    CloseHandle hSnapShot
End Function

Sub Main()
    On Error GoTo errore
    Const fdwAccess1 As Long = PROCESS_QUERY_INFORMATION Or PROCESS_SET_INFORMATION
    Const fdwAccess2 As Long = PROCESS_ALL_ACCESS
    
    Dim strProcess As String
    Dim intPriority As Integer
    Dim a() As String
    Dim ProcessId As Long, hProcess As Long
    Dim lExitCode As Long, AppKill As Boolean
    a = Split(Command, " ")
    If IsNumeric(a(1)) And Len(a(0)) > 0 Then
        ProcessId = GetProcessId(a(0))
        
        If CInt(a(1)) <> -1 Then
            hProcess = OpenProcess(fdwAccess1, 0&, ProcessId)
        Else
            hProcess = OpenProcess(fdwAccess2, 0&, ProcessId)
        End If
        
        If hProcess Then
            Select Case CInt(a(1))
            Case -1
                AppKill = TerminateProcess(hProcess, lExitCode)
            Case 0
                Call SetPriorityClass(hProcess, IDLE_PRIORITY_CLASS)
            Case 1
                Call SetPriorityClass(hProcess, BELOW_NORMAL_PRIORITY_CLASS)
            Case 2
                Call SetPriorityClass(hProcess, NORMAL_PRIORITY_CLASS)
            Case 3
                Call SetPriorityClass(hProcess, ABOVE_NORMAL_PRIORITY_CLASS)
            Case 4
                Call SetPriorityClass(hProcess, HIGH_PRIORITY_CLASS)
            Case 5
                Call SetPriorityClass(hProcess, REALTIME_PRIORITY_CLASS)
            End Select
        Else
            hProcess = OpenProcess(fdwAccess2, 0&, ProcessId)
        End If
        
        Call CloseHandle(hProcess)
    Else
        MsgBox "ImpostaPrioritaProcesso.exe <nomeprocesso.exe> <priorità>" & vbCrLf & " 5 - Tempo Reale, ..., 2 - Normale, ..., 0 - Bassa"
    End If
    Exit Sub
errore:
    MsgBox "ImpostaPrioritaProcesso.exe <nomeprocesso.exe> <priorità>" & vbCrLf & " 5 - Tempo Reale, ..., 2 - Normale, ..., 0 - Bassa"
End Sub
Home