1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
| Private Declare Function _
CloseHandle Lib "Kernel32.dll" (ByVal _
Handle As Long) As Long
Private Declare Function _
OpenProcess Lib "Kernel32.dll" (ByVal _
dwDesiredAccessas As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcId As Long) As Long
Private Declare Function _
EnumProcesses Lib "PSAPI.DLL" (ByRef _
lpidProcess As Long, ByVal cb As Long, _
ByRef cbNeeded As Long) As Long
Private Declare Function _
GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal _
bhProcess As Long, _
ByVal hModule As Long, ByVal _
ModuleName As String, _
ByVal nSize As Long) As Long
Private Declare Function _
EnumProcessModules Lib "PSAPI.DLL" (ByVal _
hProcess As Long, ByRef _
lphModule As Long, ByVal cb As Long, ByRef _
cbNeeded As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 260
Private 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
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long ' Le processus
th32DefaultHeapID As Long
th32ModuleID As Long ' exe associé
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 260
End Type
Private Function Processus(ByVal _
ID As Integer) As String
On Error Resume Next
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 pmc As PROCESS_MEMORY_COUNTERS
Dim strProcName, strProcName2 As String
Dim NbProc, ListeProc(1 To 10000) As String
NbProc = 0
booResult = False
' nom de Explorer
EXEName = "explorer.exe"
EXEName = UCase$(Trim$(EXEName))
lngLength = Len(EXEName)
lngCBSize = 8
lngCBSizeReturned = 96
Do While lngCBSize <= lngCBSizeReturned
DoEvents
'Incremente la taille
lngCBSize = lngCBSize * 2
'Loue la mémoire
ReDim lngProcessIDs(lngCBSize / 4) As Long
'Prends l' ID du processus
lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
Loop
'Compte les processus
lngNumElements = lngCBSizeReturned / 4
For lngLoop = 1 To lngNumElements
DoEvents
'Donne le handle du processus et l' ouvre
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
NbProc = NbProc + 1
strModuleName = Space(MAX_PATH)
lngSize = 500
'Prend le nom du processus
lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), strModuleName, lngSize)
'Enlève les espaces
strProcessName = Left(strModuleName, lngReturn)
ListeProc(NbProc) = strProcessName
End If
End If
'Ferme les handles du processus
lngReturn = CloseHandle(lngHwndProcess)
DoEvents
Next
If ID = 0 Then
Processus = NbProc
ElseIf ID > 0 And ID <= NbProc Then
Processus = ListeProc(ID)
Else
Processus = ""
End If
End Function
Sub Form_Load() 'pour l' appeller
'Si i=0 --> variable= nombre de procesus
'Sinon --> variable= nom ou chemin d' accès du processus "i"
variable = Processus(i)
MsgBox (variable)
End Sub |
Partager