Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0273: Prozessliste als Exenamen anzeigen lassen

 von 

Beschreibung 

Mit der CreateToolhelpSnapshot läßt sich, wie der Name schon vermuten läßt, ein Snapshot der laufenden Prozesse erstellen. Danach ist es möglich über die "eingefangenen" Prozesse zu iterieren und einige interessante Information auszulesen, wie z.B. den absoluten Pfad der Exe unter Windows 9x.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

CloseHandle, CreateToolhelp32Snapshot, Process32First (ProcessFirst), Process32Next (ProcessNext)

Download:

Download des Beispielprojektes [2,45 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Listen-Steuerelement "List1"

Option Explicit

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
        (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 Sub CloseHandle Lib "kernel32" (ByVal hPass _
        As Long)

Const TH32CS_SNAPPROCESS As Long = 2&
Const MAX_PATH As Integer = 260

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

Private Sub Form_Load()
    Timer1.Interval = 300
    Timer1.Enabled = True
End Sub

Private Sub GetExeNames()
    Dim hSnapShot As Long, Result As Long
    Dim aa As String, bb As String
    Dim Process As PROCESSENTRY32

    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    If hSnapShot = 0 Then Exit Sub

    Process.dwSize = Len(Process)
    Result = ProcessFirst(hSnapShot, Process)
  
    Do While Result <> 0
        aa = Process.szExeFile
        
        ' Um den vollen Pfadnamen unter Windows NT basierenden Systemen
        ' auszulesen, siehe http://support.microsoft.com/support/kb/articles/Q187/9/13.asp.
        
        aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
        
        If Right$(LCase(aa), 4) = ".exe" Then
            List1.AddItem aa
        End If
        
        Result = ProcessNext(hSnapShot, Process)
    Loop
    Call CloseHandle(hSnapShot)
End Sub

Private Sub Timer1_Timer()
    List1.Clear
    Call GetExeNames
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 22 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Tom am 05.03.2011 um 19:54

WOW !!!

UUUR Geil !!
Exakt danach hab ich gesucht !!!!

Kommentar von Vladi am 27.10.2008 um 07:48

Wie schon viele festgestellt haben, geht leider nicht in
Womdows NT. In Windows 2000 hat man die "Toolhelp"-APIs
implementiert. Aber die Redmonter haben die Ausgabe der
EXE-Files (PROCESSENTRY32.szExefile) in dieser Version
um ihre Pfadnamen beraubt (bzw. geschlampt).

Kommentar von Vassili am 12.08.2005 um 08:38

Eine Frage, (falls denn hier noch reingeschaut wird)

Hat die API Funktion CloseHandle(x) hier größere Bedeutung? denn bei mir führt das Prog die funktion nicht aus. Nach einem Fehlerbericht kam heraus:

"Falsche DLL-Aufrufkonvention"

Was des zu bedeuten hat. kein plan. apis sind nicht mein großes ding (leider).

Hab gelesen, dass closehandle ein offenes handle beendet (logisch ^^) aber nirgends gibts ein anderes handle in diesem projekt.

Kommentar von Pascal Scholtes am 23.06.2004 um 17:16

Super, ich muss mal ein großes Lob loswerden : die Tips hier sind Spitze und bisher habe ich immer gefunden was ich suchte !

Kommentar von ethana am 17.11.2003 um 12:56

Wie erhalte ich unter Windows XP den absoluten Pfad der Exe ????

Kommentar von Cadburry am 18.06.2003 um 13:30

?? Ist es auch möglich von den einzelnen anwendungen auch die Prozessorlast zu ermitteln....???

Kommentar von Artur am 04.02.2003 um 19:44

Hi, bin wie Josef an hWnd der aufgelisteten Prozesse interessiert. Wie kriege ich die raus? Und noch was: was kann ich mit th32ProcessID von PROCESSENTRY32-Struktur anfangen?

Kommentar von chris am 09.10.2002 um 15:58

Ich habe einen Prozess in der VDM, den ich überwachen muss! Geht mit diesem Beispiel leider nicht, da er nur den ntvdm.exe-Prozess anzeigt, aber leider nicht mein 16Bit Programm! Wie ist es möglich, diese Programme (16Bit) die unter der ntvdm laufen zu erkennen, da ich ein LogFile schreiben soll, dass die Zeit misst, die dieses 16Bit Programm geöffnet ist??
Danke schon im vorraus! MfG Chris
P.S.: Eure Seite ist echt gut! Hat mir schon oft geholfen!

Kommentar von Eric Tiggemann am 10.07.2002 um 15:08

Dank an Steffen Mende.
6) funktioniert unter W2K einwandfrei :)

Kommentar von Josef am 18.06.2002 um 18:34

Zu den einzelnen Programmen würde ich gern die "hWnd" ausgegeben haben.
Können Sie mir da helfen?
Danke

Kommentar von Jörg Borchardt am 26.03.2002 um 13:53

Die NT-Lösung geht ebenfalls nicht, weil die Konstanten PROCESS_QUERY_INFORMATION und PROCESS_VM_READ nicht definiert sind und auch nicht vom API-Viewer zur Verfügung gestellt werden!

Kommentar von Jörg Borchardt am 26.03.2002 um 13:45

Habe ebenfalls das NT4-Problem: kein Einsprungpunkt!
Lösung wäre wertvoll!

Kommentar von Clemens Helfmeier am 22.01.2002 um 11:01

Hallo, Wie kann ich denn die Threads eines Processes auflisten?

Kommentar von PhilippVB am 02.12.2001 um 18:36

An jan henning:
Du übergibst die Prozess-ID an OpenProcess und beendest das Handle dann mit ExitProcess.

Kommentar von Frithjof Moritzen am 29.10.2001 um 13:36

Nicht alle Prozesse lassen sich wie in 5.) mit OpenProcess öffnen. Z.B. solche, die unter einem anderen User laufen. Wie bekomme ich da die Exe heraus?
Gruß,
Frithjof

Kommentar von jan hennig am 28.09.2001 um 10:50

Wie kann ich nun einzelne Programme beenden

Kommentar von Steffen Mende am 26.04.2001 um 12:34

Microsoft hat dafür eine gute Lösung.
http://support.microsoft.com/support/kb/articles/Q187/9/13.asp

Kommentar von Konrad Danner am 23.02.2001 um 09:19

Lösung für NT:
Ermittlung unter NT / W2K, ob ein Task läuft anhand des Names der EXE-Datei
Vorgaben: Dateiname des Programmes z.B. XY.EXE
Es kann auch zusätzlich der exakte Pfad angegeben werden
z.B. C:\TEMP\XY.EXE
Sub SucheExe
Dim WinVers$, locProcessID&, locTaskID&
Filename$ = "XY.EXE"
If GetProcessNT(Filename$, locProcessID&, locTaskID&) = False Then
Exit Sub
End If
'Wenn ProcessID 0 dann erfolgreich
If locProcessID& 0 Then
Msgbox Filename$ + "is running"
End If
End Sub
Function GetProcessNT(Name$, ProcessId&, TaskID&) As Long
Dim cProcesses As Long
Dim lProcessIDs() As Long
Dim lRet&
Dim cbNeeded As Long
Dim hEXE As Long
Dim hProcess As Long
'Dim sEXENames() As String
Dim sFQEXENames() As String
'Dim lPriority As Long
'Dim sPriorityClass() As String
'Voreinstellung
GetProcessNT = False
'geratene Voreinstellung
cProcesses& = 25
'Array mit den Prozessen füllen
'Arraygröße versuchsweise annähern
Do
'Array mit best. Größe einrichten
ReDim lProcessIDs(1 To cProcesses&)
'Prozesse auflisten
lRet& = EnumProcesses(lProcessIDs(1), cProcesses& * 4, cbNeeded&)
If lRet& = 0 Then
'Fehlerbehandlung
RaiseApiError Err.LastDllError
Exit Function
End If
'Compare needed bytes with array size in bytes.
'If less, then we got them all.
If cbNeeded&
0 Then
' Now get the handle of the first module
' in this process, since first module is EXE
hEXE& = 0
lRet& = EnumProcessModules(hProcess&, hEXE&, 4&, cbNeeded&)
If hEXE& 0 Then
' ' Get the name of the module
' sEXENames(i) = String$(MAX_PATH, 0)
' lret = GetModuleBaseName(hProcess, hEXE, sEXENames(i), Len(sEXENames(i)))
' sEXENames(i) = Trim0(sEXENames(i))
' Get full path name
sFQEXENames(i) = String$(MAX_PATH, 0)
lRet = GetModuleFileNameEx(hProcess, hEXE, sFQEXENames(i), Len(sFQEXENames(i)))
sFQEXENames(i) = Trim0(sFQEXENames(i))
'Vergleich, ob Name übereinstimmt
If InStr(1, sFQEXENames(i), Name$, vbTextCompare) 0 Then
ProcessId& = lProcessIDs(i)
TaskID& = hProcess&
GetProcessNT = True
Exit Function
End If
' ' Get priority
' lPriority = GetPriorityClass(hProcess)
' Select Case lPriority
' Case IDLE_PRIORITY_CLASS
' sPriorityClass(i) = "idle"
' Case NORMAL_PRIORITY_CLASS
' sPriorityClass(i) = "normal"
' Case HIGH_PRIORITY_CLASS
' sPriorityClass(i) = "high"
' Case REALTIME_PRIORITY_CLASS
' sPriorityClass(i) = "real"
' Case Else
' sPriorityClass(i) = "???"
' End Select
'
End If ' EXE 0
End If ' hProcess 0
'Close handle
lRet& = CloseHandle(hProcess)
Next i%
End Function
Private Sub RaiseApiError(ByVal e As Long)
Err.Raise vbObjectError + 29000 + e, App.EXEName & ".Windows", GetAPIErrorText(e)
End Sub
Private Function Trim0(sName As String) As String
'Keep left portion of string sName up to first 0. Useful with Win API null terminated strings.
Dim x As Integer
x = InStr(sName, Chr$(0))
If x 0 Then Trim0 = Left$(sName, x - 1) Else Trim0 = sName
End Function
Private Function GetAPIErrorText(ByVal lError As Long) As String
Dim sOut As String
Dim sMsg As String
Dim lRet As Long
GetAPIErrorText = ""
sMsg = String$(256, 0)
lRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
FORMAT_MESSAGE_IGNORE_INSERTS, _
0&, lError, 0&, sMsg, Len(sMsg), 0&)
sOut = "Error: " & lError & "(&H" & Hex(lError) & "): "
If lRet 0 Then
'Check for ending vbcrlf
sMsg = Trim0(sMsg)
If Right$(sMsg, 2) = vbCrLf Then sMsg = Left$(sMsg, Len(sMsg) - 2)
sOut = sOut & Trim0(sMsg)
Else
sOut = sOut & ""
End If
GetAPIErrorText = sOut
End Function
***********************
*** Definitionen
************************
Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
idProcess As Long, _
ByVal cBytes As Long, _
cbNeeded As Long _
) As Long
Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long _
) As Long
Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, _
hModule As Long, _
ByVal cb As Long, _
cbNeeded As Long _
) As Long
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
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Kommentar von Eike Dombrowski am 13.02.2001 um 15:09

Hallo,
wie funktioniert das denn unter NT??
mfg
EIKE D

Kommentar von Ruben Sanchez am 13.12.2000 um 15:35

Unter NT4 funktioniert es nicht, weil in Kernel32 der DLL-Einsprungpunkt nicht gefunden wird. Weiß jemand, wie in NT4 die ExeNamen der laufenden Prozesse zu ermitteln sind? Vielen Dank

Kommentar von Helmut Fuchs am 28.11.2000 um 13:47

wie geht man unter NT4 vor? Vielen Dank

Kommentar von Gerd Gabriel am 20.11.2000 um 03:18

Unter Win98 funktioniert's prächtig.
Unter NT4 überhaupt nicht, weil die "Kernel32.DLL" die erforderlichen Entries nicht enthält.