Récupérer le chemin complet de l'éxécutable d'un processus en connaissant son no
vinc2
Messages postés
6
Date d'inscription
dimanche 21 août 2005
Statut
Membre
Dernière intervention
4 juin 2009
-
3 avril 2009 à 19:25
cs_casy Messages postés 7741 Date d'inscription mercredi 1 septembre 2004 Statut Membre Dernière intervention 24 septembre 2014 - 3 avril 2009 à 21:26
cs_casy Messages postés 7741 Date d'inscription mercredi 1 septembre 2004 Statut Membre Dernière intervention 24 septembre 2014 - 3 avril 2009 à 21:26
A voir également:
- Récupérer le chemin complet de l'éxécutable d'un processus en connaissant son no
- Récupérer données json (javascript) - Conseils pratiques -Javascript
- Alternative processus excel ✓ - Forum VB.NET
- No such nick - Forum IRC
- Recuperer miniature youtube ✓ - Forum PHP
- Vba msgbox yes no - Forum Visual Basic
1 réponse
cs_casy
Messages postés
7741
Date d'inscription
mercredi 1 septembre 2004
Statut
Membre
Dernière intervention
24 septembre 2014
40
3 avril 2009 à 21:26
3 avril 2009 à 21:26
Voici le code d'exemple issu de l'APIGuide :
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 Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) 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 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
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 ' This process
th32DefaultHeapID As Long
th32ModuleID As Long ' Associated exe
cntThreads As Long
th32ParentProcessID As Long ' This process's parent
process
pcPriClassBase As Long ' Base priority of process
threads
dwFlags As Long
szExeFile As String * 260 ' MAX_PATH
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
Public Function GetProcesses(ByVal EXEName As String)
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 'Specifies the size, In bytes,
of the lpidProcess array
Dim lngCBSizeReturned As Long 'Receives the number of bytes returned
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
'Turn on Error
handler
On Error GoTo Error_handler
booResult = False
EXEName = UCase$(Trim$(EXEName))
lngLength = Len(EXEName)
'ProcessInfo.bolRunning = False
Select Case getVersion()
'I'm not
bothered about windows 95/98 becasue this class probably wont be used on it
anyway.
Case WIN95_System_Found 'Windows
95/98
Case WINNT_System_Found 'Windows
NT
lngCBSize = 8 ' Really needs To be 16, but Loop
will increment prior to calling API
lngCBSizeReturned = 96
Do While lngCBSize <= lngCBSizeReturned
DoEvents
'Increment
Size
lngCBSize = lngCBSize * 2
'Allocate Memory
for Array
ReDim lngProcessIDs(lngCBSize / 4) As Long
'Get Process ID's
lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize,
lngCBSizeReturned)
Loop
'Count number
of processes returned
lngNumElements = lngCBSizeReturned / 4
'Loop thru each
process
For lngLoop = 1 To lngNumElements
DoEvents
'Get a
handle to the Process and Open
lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION
Or PROCESS_VM_READ,
0,
lngProcessIDs(lngLoop))
If lngHwndProcess <> 0 Then
'Get an array of the module handles for the
specified process
lngReturn = EnumProcessModules(lngHwndProcess,
lngModules(1),
200,
lngCBSize2)
'If the Module
Array is retrieved, Get the ModuleFileName
If lngReturn <> 0 Then
'Buffer with spaces first to allocate memory
for byte array
strModuleName = Space(MAX_PATH)
'Must be set prior to calling
API
lngSize = 500
'Get
Process Name
lngReturn = GetModuleFileNameExA(lngHwndProcess,
lngModules(1),
strModuleName, lngSize)
'Remove trailing
spaces
strProcessName = Left(strModuleName, lngReturn)
'Check for Matching Upper case
result
strProcessName = UCase$(Trim$(strProcessName))
strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "", 0, 0, GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "") - 1)
If strProcName2 = EXEName Then
Debug.Print strProcessName
'#### CODE Original
#############################################
' 'Get the Site of the Memory
Structure
' pmc.cb =
LenB(pmc)
'
' lret =
GetProcessMemoryInfo(lngHwndProcess, pmc, pmc.cb)
'
' Debug.Print EXEName & "::" &
CStr(pmc.WorkingSetSize / 1024)
'
'###########################################################
End If
End If
End If
'Close the handle
to this process
lngReturn = CloseHandle(lngHwndProcess)
DoEvents
Next
End Select
IsProcessRunning_Exit:
'Exit
early to avoid error handler
Exit Function
Error_handler:
Err.Raise Err, Err.Source, "ProcessInfo", Error
Resume Next
End Function
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 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
' Append delimiter text to the end of the list as a
terminator.
strList = strList & strDelimiter
' Calculate the offset for the item required based on the
number of columns the list
' 'strList' has
i.e. 'lngNumColumns' and from which row the element is to be
' selected i.e. 'lngRow'.
lngColumn = IIf(lngRow = 0, lngColumn, (lngRow * lngNumColumns) +
lngColumn)
' Search for the 'lngColumn'
item from the list 'strList'.
For lngCounter = 0 To lngColumn - 1
' Remove each item
from the list.
strList = Mid$(strList, InStr(strList, strDelimiter) +
Len(strDelimiter),
Len(strList))
' If list
becomes empty before 'lngColumn' is found then just
' return an empty string.
If Len(strList) = 0 Then
GetElement = ""
Exit Function
End If
Next lngCounter
' Return the
sought list element.
GetElement = Left$(strList, InStr(strList, strDelimiter) -
1)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function GetNumElements (ByVal strList As String,
' ByVal strDelimiter As
String)
' As
Integer
'
' strList = The element list.
' strDelimiter = The delimiter by which the elements
in
' 'strList' are
seperated.
'
' The
function returns an integer which is the count of the
' number of elements in 'strList'.
'
' Author: Roger
Taylor
'
' Date:26/12/1998
'
' Additional Information:
'
' Revision
History:
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetNumElements(ByVal strList As String, ByVal strDelimiter As String) As Integer
Dim intElementCount As Integer
' If no elements
in the list 'strList' then just return 0.
If Len(strList) = 0 Then
GetNumElements = 0
Exit Function
End If
' Append delimiter
text to the end of the list as a terminator.
strList = strList & strDelimiter
' Count the number of elements in
'strlist'
While InStr(strList, strDelimiter) >
0
intElementCount = intElementCount + 1
strList = Mid$(strList, InStr(strList, strDelimiter) +
1, Len(strList))
Wend
' Return the number of
elements in 'strList'.
GetNumElements = intElementCount
End Function
'If you're
using VB4 or VB5, uncomment the following function:
'Function Replace(sInput As String, WhatToReplace As String,
ReplaceWith As String) As String
'Dim Ret As
Long
'Replace = sInput
'Ret = -Len(ReplaceWith) + 1
'Do
'Ret = InStr(Ret +
Len(ReplaceWith), Replace, WhatToReplace, vbTextCompare)
'If Ret = 0 Then Exit Do
'Replace = Left$(Replace, Ret - 1) + ReplaceWith +
Right$(Replace, Len(Replace) - Ret - Len(WhatToReplace) + 1)
'Loop
'End
Function
---- Sevyc64 (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE # http://aide-office-vba.monforum.com/index.php
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 Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) 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 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
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 ' This process
th32DefaultHeapID As Long
th32ModuleID As Long ' Associated exe
cntThreads As Long
th32ParentProcessID As Long ' This process's parent
process
pcPriClassBase As Long ' Base priority of process
threads
dwFlags As Long
szExeFile As String * 260 ' MAX_PATH
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
Public Function GetProcesses(ByVal EXEName As String)
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 'Specifies the size, In bytes,
of the lpidProcess array
Dim lngCBSizeReturned As Long 'Receives the number of bytes returned
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
'Turn on Error
handler
On Error GoTo Error_handler
booResult = False
EXEName = UCase$(Trim$(EXEName))
lngLength = Len(EXEName)
'ProcessInfo.bolRunning = False
Select Case getVersion()
'I'm not
bothered about windows 95/98 becasue this class probably wont be used on it
anyway.
Case WIN95_System_Found 'Windows
95/98
Case WINNT_System_Found 'Windows
NT
lngCBSize = 8 ' Really needs To be 16, but Loop
will increment prior to calling API
lngCBSizeReturned = 96
Do While lngCBSize <= lngCBSizeReturned
DoEvents
'Increment
Size
lngCBSize = lngCBSize * 2
'Allocate Memory
for Array
ReDim lngProcessIDs(lngCBSize / 4) As Long
'Get Process ID's
lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize,
lngCBSizeReturned)
Loop
'Count number
of processes returned
lngNumElements = lngCBSizeReturned / 4
'Loop thru each
process
For lngLoop = 1 To lngNumElements
DoEvents
'Get a
handle to the Process and Open
lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION
Or PROCESS_VM_READ,
0,
lngProcessIDs(lngLoop))
If lngHwndProcess <> 0 Then
'Get an array of the module handles for the
specified process
lngReturn = EnumProcessModules(lngHwndProcess,
lngModules(1),
200,
lngCBSize2)
'If the Module
Array is retrieved, Get the ModuleFileName
If lngReturn <> 0 Then
'Buffer with spaces first to allocate memory
for byte array
strModuleName = Space(MAX_PATH)
'Must be set prior to calling
API
lngSize = 500
'Get
Process Name
lngReturn = GetModuleFileNameExA(lngHwndProcess,
lngModules(1),
strModuleName, lngSize)
'Remove trailing
spaces
strProcessName = Left(strModuleName, lngReturn)
'Check for Matching Upper case
result
strProcessName = UCase$(Trim$(strProcessName))
strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "", 0, 0, GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "") - 1)
If strProcName2 = EXEName Then
Debug.Print strProcessName
'#### CODE Original
#############################################
' 'Get the Site of the Memory
Structure
' pmc.cb =
LenB(pmc)
'
' lret =
GetProcessMemoryInfo(lngHwndProcess, pmc, pmc.cb)
'
' Debug.Print EXEName & "::" &
CStr(pmc.WorkingSetSize / 1024)
'
'###########################################################
End If
End If
End If
'Close the handle
to this process
lngReturn = CloseHandle(lngHwndProcess)
DoEvents
Next
End Select
IsProcessRunning_Exit:
'Exit
early to avoid error handler
Exit Function
Error_handler:
Err.Raise Err, Err.Source, "ProcessInfo", Error
Resume Next
End Function
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 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
' Append delimiter text to the end of the list as a
terminator.
strList = strList & strDelimiter
' Calculate the offset for the item required based on the
number of columns the list
' 'strList' has
i.e. 'lngNumColumns' and from which row the element is to be
' selected i.e. 'lngRow'.
lngColumn = IIf(lngRow = 0, lngColumn, (lngRow * lngNumColumns) +
lngColumn)
' Search for the 'lngColumn'
item from the list 'strList'.
For lngCounter = 0 To lngColumn - 1
' Remove each item
from the list.
strList = Mid$(strList, InStr(strList, strDelimiter) +
Len(strDelimiter),
Len(strList))
' If list
becomes empty before 'lngColumn' is found then just
' return an empty string.
If Len(strList) = 0 Then
GetElement = ""
Exit Function
End If
Next lngCounter
' Return the
sought list element.
GetElement = Left$(strList, InStr(strList, strDelimiter) -
1)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function GetNumElements (ByVal strList As String,
' ByVal strDelimiter As
String)
' As
Integer
'
' strList = The element list.
' strDelimiter = The delimiter by which the elements
in
' 'strList' are
seperated.
'
' The
function returns an integer which is the count of the
' number of elements in 'strList'.
'
' Author: Roger
Taylor
'
' Date:26/12/1998
'
' Additional Information:
'
' Revision
History:
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetNumElements(ByVal strList As String, ByVal strDelimiter As String) As Integer
Dim intElementCount As Integer
' If no elements
in the list 'strList' then just return 0.
If Len(strList) = 0 Then
GetNumElements = 0
Exit Function
End If
' Append delimiter
text to the end of the list as a terminator.
strList = strList & strDelimiter
' Count the number of elements in
'strlist'
While InStr(strList, strDelimiter) >
0
intElementCount = intElementCount + 1
strList = Mid$(strList, InStr(strList, strDelimiter) +
1, Len(strList))
Wend
' Return the number of
elements in 'strList'.
GetNumElements = intElementCount
End Function
'If you're
using VB4 or VB5, uncomment the following function:
'Function Replace(sInput As String, WhatToReplace As String,
ReplaceWith As String) As String
'Dim Ret As
Long
'Replace = sInput
'Ret = -Len(ReplaceWith) + 1
'Do
'Ret = InStr(Ret +
Len(ReplaceWith), Replace, WhatToReplace, vbTextCompare)
'If Ret = 0 Then Exit Do
'Replace = Left$(Replace, Ret - 1) + ReplaceWith +
Right$(Replace, Len(Replace) - Ret - Len(WhatToReplace) + 1)
'Loop
'End
Function
---- Sevyc64 (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE # http://aide-office-vba.monforum.com/index.php
