Option Explicit 'inclure les processus dans la vue Private Const TH32CS_SNAPPROCESS As Long = &H2 'des infos sur un processus Public Type PROCESSENTRY32 dwSize As Long 'taille de cette structure (à initialiser avant l'appel à Process32First ou Process32Next) cntUsage As Long 'nombre de handles du processus ouverts th32ProcessID As Long 'ID du processus th32DefaultHeapID As Long 'interne à windows th32ModuleID As Long 'interne à windows cntThreads As Long 'nombre de threads du processus th32ParentProcessID As Long 'ID du processus parent pcPriClassBase As Long 'classe de priorité de base dwFlags As Long 'réservé szExeFile As String * 260 'NT/2000/XP : nom du fichier Exe (sans le chemin) '9x/ME : chemin et nom du fichier Exe End Type 'crée une vue des processus du système 'renvoie un handle à fermer avec CloseHandle quand on en a plus besoin Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long 'renvoie le premier processus de la liste Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, ByRef lppe As PROCESSENTRY32) As Long 'renvoie les processus suivants Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, ByRef lppe As PROCESSENTRY32) As Long 'renvoie l'ID du processus appelant Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long 'ferme un handle Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long 'NT/2000/XP/2003 Private Const VER_PLATFORM_WIN32_NT As Long = 2 'des infos sur la version de windows Private Type OSVERSIONINFO dwOSVersionInfoSize As Long 'taille de cette structure (à initialiser avant appel à GetVersionEx) dwMajorVersion As Long 'numéro majeur dwMinorVersion As Long 'numéro mineur dwBuildNumber As Long 'numéro de compilation dwPlatformId As Long '3.x/9x Me/NT 2000 XP 2003 szCSDVersion As String * 128 ' Maintenance string for PSS usage End Type 'renvoie la version de windows Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long 'accès en lecture de la mémoire Private Const PROCESS_VM_READ As Long = (&H10) 'accès en collecte d'informations Private Const PROCESS_QUERY_INFORMATION As Long = (&H400) 'obtient un handle vers un processus par son PID Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 'met une zone mémoire à 0 Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long) 'NT/2000/XP/2003... seulement 'renvoie le nom du module "hModule" du processus "hProcess" (ouvert avec OpenProcess) Private Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long 'énumére les modules d'un processus Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef lpcbNeeded As Long) As Long 'renvoie le nom et le chemin du processus parent de "ProcessID" Public Function GetParentProcessName(ProcessID As Long) As String Dim hToolHelp As Long 'handle de la vue des processus du système Dim p As PROCESSENTRY32 'infos sur le processus "ProcessID" Dim pp As PROCESSENTRY32 'infos sur le processus parent de "ProcessID" 'on demande une vue des processus du système hToolHelp = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&) 'on initialise la taille de la structure des infos p.dwSize = Len(p) 'on demande les infos sur le premier processus de la vue If Process32First(hToolHelp, p) Then 'si ce n'est pas le processus recherché If p.th32ProcessID <> ProcessID Then 'on réinitialise la taille de la structure des infos p.dwSize = Len(p) 'tant qu'il y a des processus dans la vue Do While Process32Next(hToolHelp, p) 'si le processus est celui recherché, on quitte la boucle If p.th32ProcessID = ProcessID Then Exit Do 'sinon on réinitialise la taille de la structure des infos p.dwSize = Len(p) Loop End If End If 'si NT, pour avoir le chemin complet de l'exe, il faut utiliser GetModuleFileNameEx avec l'id du processus parent If IsWindowNT Then 'on demande le chemin et le nom du processus GetParentProcessName = GetProcessFileName(p.th32ParentProcessID) 'on ferme la vue CloseHandle hToolHelp 'on renvoie le résultat Exit Function Else 'sinon, sous 9x/ME, szExeFile du processus parent contient le chemin et le nom complet de l'exe du processus 'on cherche le processus parent dans la vue des processus 'on initialise la taille de la structure des infos pp.dwSize = Len(pp) 'on demande le premier processus de la vue If Process32First(hToolHelp, pp) Then 'si ce n'est pas celui recherché If pp.th32ProcessID <> p.th32ParentProcessID Then 'on réinitialise la taille de la structure des infos pp.dwSize = Len(pp) 'tant qu'il y a encore des processus dans la vue Do While Process32Next(hToolHelp, pp) 'si le processus est celui recherché, on quitte la boucle If pp.th32ProcessID = p.th32ParentProcessID Then Exit Do 'sinon, on réinitialise la taille de la structure des infos pp.dwSize = Len(pp) Loop End If End If End If 'on copie le nom complet de l'exe GetParentProcessName = pp.szExeFile 'sans le vbNullChar de la fin de chaine GetParentProcessName = Left$(GetParentProcessName, InStr(GetParentProcessName, vbNullChar) - 1) 'on ferme le handle de la vue CloseHandle hToolHelp End Function 'renvoie le chemin complet du processus ou FileName en cas d'erreur Public Function GetProcessFileName(PID As Long, Optional FileName As String) As String On Error GoTo Fin 'si c le processus 0 (idle), windows ne lui donne pas de nom particulier If PID = 0 Then GetProcessFileName = "Idle" 'si c le processus 4 (system), windows ne lui donne pas de nom particulier ElseIf PID = 4 Then GetProcessFileName = "System" Else 'sinon, on demande son nom Dim hProcess As Long 'handle du processus Dim hModule As Long 'handle du module de l'exe Dim ret As Long 'résultat 'on demande un handle pour le processus hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0&, PID) 'si erreur : par exemple error_access_denied avec CSRSS.exe If hProcess = 0 Then GoTo Fin 'on demande le handle du module de l'exe EnumProcessModules hProcess, hModule, 4&, ret 'on alloue de la place pour son nom complet GetProcessFileName = Space(260) 'on demande son nom complet GetModuleFileNameEx hProcess, hModule, GetProcessFileName, 260 'on ferme le handle CloseHandle hProcess 'on retire le vbNUllChar de fin de chaine GetProcessFileName = Left$(GetProcessFileName, InStr(GetProcessFileName, vbNullChar) - 1) End If Exit Function Fin: 'si erreur, on renvoie FileName GetProcessFileName = FileName End Function 'renvoie le nom complet du processus parent du notre Public Function GetCurrentProcessParent() As String GetCurrentProcessParent = GetParentProcessName(GetCurrentProcessId) End Function 'indique si on execute ce code sous NT Private Function IsWindowNT() As Boolean Dim os As OSVERSIONINFO 'initialisation de la taille de la structure os.dwOSVersionInfoSize = Len(os) 'demande de la version de windows GetVersionEx os 'est-ce NT/2000/XP IsWindowNT (os.dwPlatformId VER_PLATFORM_WIN32_NT) End Function
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question