SystemProcessesAndThreadsInformation
September 3rd, 2010
No comments
'---------------------------------------------------------------------------------------
' Module : mProcessInformation
' Author : Karcrack
' Now : 26/08/2010 15:00
' Purpose : Native Process Enumeration
' History : 26/08/2010 First cut .........................................................
'---------------------------------------------------------------------------------------
Option Explicit
Option Base 0
Public Type PROCESS
sName As String
lPID As Long
End Type
'NTDLL
Private Declare Function NtQuerySystemInformation Lib "NTDLL" (ByVal SystemInformationClass As Long, ByRef SystemInformation As Any, ByVal SystemInformationLength As Long, ByRef ReturnLength As Long) As Long
Private Declare Sub RtlMoveMemory Lib "NTDLL" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Const SystemProcessesAndThreadsInformation As Long = 5&
Private Const STATUS_INFO_LENGTH_MISMATCH As Long = &HC0000004
Public Function RetrieveProcesses() As PROCESS()
Dim bvSPI(17) As Long 'As SYSTEM_PROCESS_INFORMATION
Dim bvTmp() As PROCESS
Dim bvBuffer() As Byte
Dim cbBuffer As Long
Dim lRet As Long
Dim lPos As Long
Dim lSize As Long
ReDim bvTmp(0)
cbBuffer = 1
Do
cbBuffer = cbBuffer * 2
ReDim bvBuffer(cbBuffer)
lRet = NtQuerySystemInformation(SystemProcessesAndThreadsInformation, bvBuffer(0), cbBuffer, lSize)
Loop While lRet = STATUS_INFO_LENGTH_MISMATCH
If lRet < 0 Then Exit Function
lPos = VarPtr(bvBuffer(0))
Do
Call RtlMoveMemory(bvSPI(0), ByVal lPos, 18 * 4)
With bvTmp(UBound(bvTmp))
.lPID = bvSPI(17)
.sName = ReadUStr(bvSPI(15))
End With
lPos = lPos + bvSPI(0)
If bvSPI(0) = 0 Then Exit Do
ReDim Preserve bvTmp(UBound(bvTmp) + 1)
Loop
RetrieveProcesses = bvTmp
Erase bvBuffer
End Function
Private Function ReadUStr(ByVal lPtr As Long) As String
Dim i As Long
Dim uChar As Integer
If Not lPtr > 0 Then Exit Function
i = lPtr
Do
Call RtlMoveMemory(uChar, ByVal i, &H2)
If uChar = 0 Then Exit Do
ReadUStr = ReadUStr & ChrW$(uChar)
i = i + 2
Loop
End Function
Sample call:
Private Sub Form_Load()
Dim x() As PROCESS
Dim i As Long
x = RetrieveProcesses
For i = 0 To UBound(x)
Debug.Print x(i).lPID, "->", x(i).sName
Next i
End Sub
Recent Comments