Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0769: Prozesse inklusive vollem Pfad und Commandline anzeigen

VB 5/6-Tipp 0769: Prozesse inklusive vollem Pfad und Commandline anzeigen

 von Frank Schüler

Schwierigkeitsgrad:

Verwendete API-Aufrufe: AdjustTokenPrivileges, CloseHandle, CreateToolhelp32Snapshot, GetCurrentProcess, LookupPrivilegeValueA (LookupPrivilegeValue), NtQueryInformationProcess, OpenProcess, OpenProcessToken, Process32First, Process32Next, ReadProcessMemory

Download: Download des Beispielprojektes [5.79 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 -------------
' Die Komponente 'Microsoft Windows Common Controls 6.0 (MSCOMCTL.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Listenanzeigesteuerungselement "lvProcess"
Option Explicit

Private Type ProcessInfo
    ProcessName As String
    ProcessID As Long
    ProcessThreads As Long
    ProcessImagePathName As String
    ProcessCommandLine As String
End Type

Private tPI() As ProcessInfo
Private lngCurPocessCount As Long
Private lngOldPocessCount As Long

Private Sub Form_Load()

    Dim xColumn As ColumnHeader
    
    Me.ScaleMode = vbPixels
    
    ' diverse Einstellungen für die ListView
    With lvProcess
    
        .View = lvwReport
        .FullRowSelect = True
        
        Set xColumn = .ColumnHeaders.Add(, , "ExeName")
        xColumn.Width = 100
        
        Set xColumn = .ColumnHeaders.Add(, , "PID")
        xColumn.Width = 60
        xColumn.Alignment = lvwColumnRight
        
        Set xColumn = .ColumnHeaders.Add(, , "Threads")
        xColumn.Width = 60
        xColumn.Alignment = lvwColumnRight
        
        Set xColumn = .ColumnHeaders.Add(, , "ExePath")
        xColumn.Width = 200
        
        Set xColumn = .ColumnHeaders.Add(, , "CommandLine")
        xColumn.Width = 600
        
    End With
    
    ' Unser Programm benötigt Debug Privilegien um auf alle Prozesse
    ' zugreifen zu können
    If Not EnableDebugPrivilege Then
    
        MsgBox "DebugPrivilege konnte nicht aktiviert werden. Bei einigen " & _
            "Prozessen" & vbNewLine & "kann so der Pfad der Exe-Datei und die " & _
            "CommandLine nicht ausgelesen werden.", vbOKOnly Or vbInformation, _
            "EnableDebugPrivilege"
            
    End If
    
    ' Timer starten
    Timer1.Interval = 100
    
    Call Timer1_Timer
    
End Sub

' Basiert auf "VB 5/6-Tipp 0273: Prozessliste als Exenamen anzeigen lassen"
' auf http://www.activevb.de/tipps/vb6tipps/tipp0273.html
Private Function SnapProcessList() As Long

    Dim lngRet As Long
    Dim lngCount As Long
    Dim strProcessName As String
    Dim strImagePathName As String
    Dim hSnapShot As Long
    Dim tEI As ExeInfo
    Dim tPE32 As PROCESSENTRY32
    
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
    
    If hSnapShot <> 0 Then
    
        tPE32.dwSize = Len(tPE32)
        
        lngRet = Process32First(hSnapShot, tPE32)
        
        Do While lngRet
        
            ReDim Preserve tPI(lngCount)
            
            ' String bei vbNullChar abtrennen
            strProcessName = Left$(tPE32.szExeFile, InStr(1, tPE32.szExeFile, _
                vbNullChar) - 1)
                
            ' Pfadnamen und CommandLine von Prozess-ID ermitteln
            tEI = GetProcessParameter(tPE32.th32ProcessID)
            
            ' Einen anderen Weg um den vollen Pfadnamen unter Windows NT
            ' basierenden Systemen
            ' auszulesen, siehe
            ' http://support.microsoft.com/support/kb/articles/Q187/9/13.asp.
            
            strImagePathName = tEI.ImagePathName
            
            ' ist ein String vorhanden
            If Len(strImagePathName) > 0 Then
            
                ' "\??\" vom String entfernen
                If Left$(strImagePathName, 4) = "\??\" Then
                
                    strImagePathName = Mid$(strImagePathName, 5)
                    
                End If
                
                ' "\SystemRoot" vom String ersetzen
                If Left$(strImagePathName, 11) = "\SystemRoot" Then
                
                    strImagePathName = Environ$("SystemRoot") & Mid$( _
                        strImagePathName, 12)
                        
                End If
                
            End If
            
            ' Daten speichern
            tPI(lngCount).ProcessName = strProcessName
            tPI(lngCount).ProcessID = tPE32.th32ProcessID
            tPI(lngCount).ProcessThreads = tPE32.cntThreads
            tPI(lngCount).ProcessImagePathName = strImagePathName
            tPI(lngCount).ProcessCommandLine = tEI.CommandLine
            
            ' Zähler erhöhen
            lngCount = lngCount + 1
            
            lngRet = Process32Next(hSnapShot, tPE32)
            
        Loop
        
        Call CloseHandle(hSnapShot)
        
    End If
    
    ' Anzahl der aktuellen Prozesse zurück geben
    SnapProcessList = lngCount
    
End Function

Private Sub Timer1_Timer()

    Dim xList As ListItem
    Dim lngItem As Long
    
    ' Timer stoppen
    Timer1.Enabled = False
    
    ' Anzahl der aktuellen Prozesse
    lngCurPocessCount = SnapProcessList
    
    ' ist die Anzahl der aktuellen Prozesse <> der letzten ermittelten Anzahl
    If lngCurPocessCount <> lngOldPocessCount Then
    
        ' dann neuen Wert speichern
        lngOldPocessCount = lngCurPocessCount
        
        ' Anzahl der laufenden Prozesse anzeigen
        Me.Caption = "Prozesse: " & CStr(lngCurPocessCount)
        
        ' Inhalt vom ListView löschen
        lvProcess.ListItems.Clear
        
        ' alle aktuellen Prozesse in der ListView auflisten
        For lngItem = 0 To lngCurPocessCount - 1
        
            Set xList = lvProcess.ListItems.Add(, , tPI(lngItem).ProcessName)
            xList.SubItems(1) = CStr(tPI(lngItem).ProcessID)
            xList.SubItems(2) = CStr(tPI(lngItem).ProcessThreads)
            xList.SubItems(3) = tPI(lngItem).ProcessImagePathName
            xList.SubItems(4) = tPI(lngItem).ProcessCommandLine
            
        Next lngItem
        
    End If
    
    ' Timer starten
    Timer1.Enabled = True
    
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------
Option Explicit

' ---=== Const ===---
Private Const ANYSIZE_ARRAY As Long = 1
Private Const MAX_PATH As Long = 260
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_VM_READ As Long = &H10
Private Const ProcessBasicInformation As Long = 0
Private Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
Private Const SE_PRIVILEGE_ENABLED As Long = &H2
Private Const STATUS_SUCCESS As Long = 0
Public Const TH32CS_SNAPPROCESS As Long = &H2
Private Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Private Const TOKEN_QUERY As Long = &H8

' ---=== Type ===---
Public Type ExeInfo
    ImagePathName As String
    CommandLine As String
End Type

Private Type LUID
    LowPart As Long
    HighPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Private Type PEB
    Reserved1(1) As Byte
    BeingDebugged As Byte
    Reserved2 As Byte
    Reserved3(1) As Long
    Ldr As Long
    ProcessParameters As Long
    Reserved4(103) As Byte
    Reserved5(51) As Long
    PostProcessInitRoutine As Long
    Reserved6(127) As Byte
    Reserved7 As Long
    SessionId As Long
End Type

Public 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 Type PROCESS_BASIC_INFORMATION
    Reserved1 As Long
    PebBaseAddress As Long
    Reserved2(1) As Long
    UniqueProcessId As Long
    Reserved3 As Long
End Type

Private Type UNICODE_STRING
    Length As Integer
    MaximumLength As Integer
    Buffer As Long
End Type

Private Type RTL_USER_PROCESS_PARAMETERS
    Reserved1(15) As Byte
    Reserved2(9) As Long
    ImagePathName As UNICODE_STRING
    CommandLine As UNICODE_STRING
End Type

' ---=== ADVAPI32 ===---
Private Declare Function OpenProcessToken Lib "ADVAPI32.dll" ( _
                         ByVal ProcessHandle As Long, _
                         ByVal DesiredAccess As Long, _
                         ByRef TokenHandle As Long) As Long
                         
Private Declare Function LookupPrivilegeValue Lib "ADVAPI32.dll" _
                         Alias "LookupPrivilegeValueA" ( _
                         ByVal lpSystemName As String, _
                         ByVal lpName As String, _
                         ByRef lpLuid As LUID) As Long
                         
Private Declare Function AdjustTokenPrivileges Lib "ADVAPI32.dll" ( _
                         ByVal TokenHandle As Long, _
                         ByVal DisableAllPrivileges As Long, _
                         ByRef NewState As TOKEN_PRIVILEGES, _
                         ByVal BufferLength As Long, _
                         ByRef PreviousState As Any, _
                         ByRef ReturnLength As Any) As Long
                         
' ---=== KERNEL32 ===---
Public Declare Function CloseHandle Lib "Kernel32.dll" ( _
                        ByVal hObject As Long) As Long
                         
Public Declare Function CreateToolhelp32Snapshot Lib "Kernel32.dll" ( _
                        ByVal lFlags As Long, _
                        ByVal lProcessID As Long) As Long
                         
Private Declare Function GetCurrentProcess Lib "Kernel32" () As Long

Private Declare Function OpenProcess Lib "Kernel32.dll" ( _
                         ByVal dwDesiredAccess As Long, _
                         ByVal bInheritHandle As Long, _
                         ByVal dwProcessId As Long) As Long
                         
Private Declare Function ReadProcessMemory Lib "Kernel32.dll" ( _
                         ByVal hProcess As Long, _
                         ByVal lpBaseAddress As Long, _
                         ByRef lpBuffer As Any, _
                         ByVal nSize As Long, _
                         ByRef lpNumberOfBytesWritten As Long) As Long
                         
Public Declare Function Process32First Lib "Kernel32.dll" ( _
                        ByVal hSnapShot As Long, _
                        ByRef uProcess As PROCESSENTRY32) As Long
                         
Public Declare Function Process32Next Lib "Kernel32.dll" ( _
                        ByVal hSnapShot As Long, _
                        ByRef uProcess As PROCESSENTRY32) As Long
                         
' ---=== NTDLL ===---
Private Declare Function NtQueryInformationProcess Lib "NTDLL.dll" ( _
                         ByVal ProcessHandle As Long, _
                         ByVal processInformationClass As Long, _
                         ByRef processInformation As Any, _
                         ByVal processInformationLength As Long, _
                         ByRef ReturnLength As Long) As Long

' Basiert auf "Use the SeDebugPrivilege to Acquire Any Process Handle"
' auf http://support.microsoft.com/?kbid=185215
Public Function EnableDebugPrivilege() As Boolean

    Dim hToken As Long
    Dim lngRet As Long
    Dim tLUID As LUID
    Dim tTP As TOKEN_PRIVILEGES
    
    ' Token für diesen Prozess öffnen
    lngRet = OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES Or _
        TOKEN_QUERY, hToken)
        
    If lngRet <> 0 Then
    
        ' LUID für das angeforderte Privileg holen
        lngRet = LookupPrivilegeValue(vbNullString, SE_DEBUG_NAME, tLUID)
        
        If lngRet <> 0 Then
        
            ' neue Privilegien setzen
            tTP.PrivilegeCount = 1
            tTP.Privileges(0).pLuid = tLUID
            tTP.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
            
            ' Privilegien für diesen Token setzen
            lngRet = AdjustTokenPrivileges(hToken, False, tTP, 0, ByVal 0&, 0)
            
            If lngRet <> 0 Then
            
                EnableDebugPrivilege = True
                
            End If
        End If
    End If
    
End Function

' Basiert auf "GetCommandLine für fremde Anwendung"
' auf http://www.delphipraxis.net/topic128285.html
Public Function GetProcessParameter(ByVal PID As Long) As ExeInfo

    Dim hProcess As Long
    Dim lngRetLen As Long
    Dim bytCommandLine() As Byte
    Dim bytImagePathName() As Byte
    Dim tEI As ExeInfo
    Dim tPEB As PEB
    Dim tPBI As PROCESS_BASIC_INFORMATION
    Dim tRPP As RTL_USER_PROCESS_PARAMETERS
    
    ' Schritt 1: Prozess öffnen um Informationen auszulesen
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, _
        False, PID)
        
    ' ist ein Handle vorhanden
    If hProcess <> 0 Then
    
        ' Schritt 2: Wir holen uns die PROCESS_BASIC_INFORMATION um den
        ' PEB zu lokalisieren
        If (NtQueryInformationProcess(hProcess, ProcessBasicInformation, _
            tPBI, Len(tPBI), lngRetLen) = STATUS_SUCCESS) And (lngRetLen _
            = Len(tPBI)) Then
            
            ' Schritt 3: Wir lesen den PEB aus
            If ReadProcessMemory(hProcess, tPBI.PebBaseAddress, tPEB, _
                Len(tPEB), lngRetLen) And (lngRetLen = Len(tPEB)) Then
                
                ' Schritt 4: Wir lesen die ProcessParameters aus
                If ReadProcessMemory(hProcess, tPEB.ProcessParameters, _
                    tRPP, Len(tRPP), lngRetLen) And (lngRetLen = Len( _
                    tRPP)) Then
                    
                    ' ByteArray zur Aufnahme des Strings dimensionieren
                    ReDim bytImagePathName(tRPP.ImagePathName.Length - 1)
                    
                    ' Schritt 5: Wir lesen den ImagePathName aus
                    If ReadProcessMemory(hProcess, _
                        tRPP.ImagePathName.Buffer, bytImagePathName(0), _
                        tRPP.ImagePathName.Length, lngRetLen) Then
                        
                        ' ByteArray zu String konvertieren
                        tEI.ImagePathName = CStr(bytImagePathName)
                        
                    End If
                    
                    ' ByteArray zur Aufnahme des Strings dimensionieren
                    ReDim bytCommandLine(tRPP.CommandLine.Length - 1)
                    
                    ' Schritt 6: Wir lesen die CommandLine aus
                    If ReadProcessMemory(hProcess, _
                        tRPP.CommandLine.Buffer, bytCommandLine(0), _
                        tRPP.CommandLine.Length, lngRetLen) Then
                        
                        ' ByteArray zu String konvertieren
                        tEI.CommandLine = CStr(bytCommandLine)
                        
                    End If
                End If
            End If
        End If
        
        ' Handle schließen
        Call CloseHandle(hProcess)
        
    End If
    
    ' Sruktur zurück geben
    GetProcessParameter = tEI
    
End Function
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------