Enumerating processes without enumerating flaws of the API

Question

This arose out of the incident where it was realized that WMI could not be expected to be reliable across all various computers. The next thing I looked at was API which was positively awful to work with. Based on a suggestion, I decided to try and use tasklist. Note that efforts was made to ensure there are no disk I/Os, which avoids getting into the messy realms of file management. The only annoyance is that the WshExec will pop open a window but that can be managed and is beyond the scope of the question.

The question is - can we make the process more reliable and failsafe? The idea is that it must be consistent across several computer systems, Windows versions, and so on. This makes uses of Windows Host Scripting Model and ADODB recordset. The application already requires ADODB anyway and the code can be updated to be late-bound as well. For testing/development, I left this in early-bound state.

Public Function EnumProcesses() As ADODB.Recordset
    Dim WshShell As IWshRuntimeLibrary.WshShell
    Dim WshExec As IWshRuntimeLibrary.WshExec
    Dim StdOut As IWshRuntimeLibrary.TextStream
    Dim Data As ADODB.Recordset
    Dim Output As String
    Dim ColumnLengths() As Long

    Set Data = New ADODB.Recordset
    Data.Fields.Append "ImageName", adVarChar, 255
    Data.Fields.Append "PID", adInteger, , adFldKeyColumn
    Data.Open

    Set WshShell = CreateObject("WScript.Shell")
    Set WshExec = WshShell.Exec("tasklist")
    Set StdOut = WshExec.StdOut

    Do While WshExec.Status = WshRunning
        If Not StdOut.AtEndOfStream Then
            Output = StdOut.ReadLine
            Select Case True
                Case Len(Output) = 0, _
                     Output Like "Image Name*"
                    'Skip
                Case Output Like "====*"
                    Dim SplitColumns As Variant
                    SplitColumns = Split(Output, " ")
                    ReDim ColumnLengths(UBound(SplitColumns))

                    Dim i As Long
                    For i = 0 To UBound(SplitColumns)
                        ColumnLengths(i) = Len(SplitColumns(i))
                    Next
                Case Else
                    Data.AddNew
                    Data.Fields("ImageName").Value = Mid$(Output, 1, ColumnLengths(0))
                    Data.Fields("PID").Value = Trim$(Mid$(Output, ColumnLengths(0) + 2, ColumnLengths(1)))
                    Data.Update
            End Select
        End If
    Loop

    Set EnumProcesses = Data
End Function

Answer 1

Apart from a performance question regarding ADODB recordsets, I only made one real change to your code. Since there are several fields that are output by the tasklist utility, I would want to capture all of that data just in case I need to expand my database at a later time. So I created a class called OSTask which accepts a single line from the tasklist output and parses it into its component parameters. (This means I could also skip the case you have to calculate column widths.)

Class OSTask

Option Explicit

Private Type InternalData
    ImageName As String
    PID As Long
    SessionName As String  'could also be an Enum: Console, Services
    SessionNumber As Long
    MemUsage As Long
End Type
Private this As InternalData

Public Property Get ImageName() As String
    ImageName = this.ImageName
End Property

Public Property Get PID() As Long
    PID = this.PID
End Property

Public Property Get SessionName() As String
    SessionName = this.SessionName
End Property

Public Property Get SessionNumber() As Long
    SessionNumber = this.SessionNumber
End Property

Public Property Get MemUsage() As Long
    MemUsage = this.MemUsage
End Property

Public Sub Init(ByVal taskData As String)
    '--- converts a single line output from the Windows command
    '    shell utility 'tasklist' and parses the data into the
    '    class properties
    Dim pos1 As Long
    Dim pos2 As Long

    '--- find the end of the task name, looking for double-space
    pos1 = InStr(1, taskData, "  ", vbTextCompare)
    this.ImageName = Trim$(Left$(taskData, pos1))

    '--- the next value is a number followed by a single space
    Dim i As Long
    For i = pos1 To Len(taskData)
        If Not Mid$(taskData, i, 1) = " " Then
            pos2 = InStr(i, taskData, " ", vbTextCompare)
            this.PID = CLng(Mid$(taskData, i, pos2 - i))
            Exit For
        End If
    Next i

    '--- next value is the session name
    pos1 = pos2 + 1
    pos2 = InStr(pos1, taskData, " ", vbTextCompare)
    this.SessionName = Trim$(Mid$(taskData, pos1, pos2 - pos1))

    '--- the next value is a number followed by a single space
    For i = pos2 To Len(taskData)
        If Not Mid$(taskData, i, 1) = " " Then
            pos2 = InStr(i, taskData, " ", vbTextCompare)
            this.SessionNumber = CLng(Mid$(taskData, i, pos2 - i))
            Exit For
        End If
    Next i

    '--- next value is the memory usage, a large number in thousands
    pos1 = pos2
    pos2 = InStr(pos1, taskData, "K", vbTextCompare)
    Dim memUsageText As String
    memUsageText = Mid$(taskData, pos1, pos2 - pos1)
    memUsageText = Replace$(memUsageText, ",", vbNullString)
    this.MemUsage = CLng(memUsageText) * 1000
End Sub

All of the properties are read-only in this case by design.

For my example, I converted your function to return a Collection rather than an ADODB.Recordset just to make my own testing simpler. So the only real change is in the Else case of the Select statement.

For my own learning purposes, I reviewed this answer's detailed review of the command shell interactions. Since you specifically stated that you are avoiding disk I/O, the option to pipe the output to a windows temp file is no good. To really prevent the command shell pop-up, you'd have to go with running a cscript under a wscript shell as the poster there indicates. Additionally, I couldn't find any historical information that the tasklist output has changed over time, so I believe your approach should remain viable across different Windows versions.

Here is my main module with my minor edits for testing:

Option Explicit

Sub test()
    Dim taskList As Collection
    Set taskList = EnumProcesses

    Dim task As Variant
    For Each task In taskList
        Debug.Print task.ImageName & ", " & task.MemUsage
    Next task
End Sub

Public Function EnumProcesses() As Collection
    Dim WshShell As IWshRuntimeLibrary.WshShell
    Dim WshExec As IWshRuntimeLibrary.WshExec
    Dim StdOut As IWshRuntimeLibrary.TextStream
    Dim Data As Collection
    Dim Output As String
    Dim ColumnLengths() As Long

    Set WshShell = CreateObject("WScript.Shell")
    Set WshExec = WshShell.Exec("tasklist")
    Set StdOut = WshExec.StdOut

    Set Data = New Collection

    Do While WshExec.Status = WshRunning
        If Not StdOut.AtEndOfStream Then
            Output = StdOut.ReadLine
            Select Case True
                Case Len(Output) = 0, _
                     Output Like "Image Name*"
                    'Skip
                Case Output Like "====*"
                    'Skip
                Case Else
                    Dim thisTask As OSTask
                    Set thisTask = New OSTask
                    thisTask.Init Output
                    Data.Add thisTask
            End Select
        End If
    Loop

    Set EnumProcesses = Data
End Function