Visual Basic > API and Miscellaneous

Returning process timing information

Returning process timing information

The following code returns timing information for a specified process id.

Option Explicit
Public Enum eTimeType
    eUserTime
    eCreationTime
    eExitTime
    eKernelTime
End Enum

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Declare Function GetProcessTimes Lib "kernel32" (ByVal hProcess As Long, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long


'Purpose   :    Returns timing information on a process.
'Inputs    :    [lProcessID]                    The process ID to return information on. If not specified, returns
'                                               information on the current process.
'               [eType]                         The type of timing information to return:
'                                               eCreationTime   -   The creation time of the process.
'                                               eExitTime       -   The exit time of the process. If the process has not exited will return False.
'                                               eKernelTime     -   The amount of time that the process has executed in kernel mode. The time that
'                                                                   each of the threads of the process has executed in kernel mode is determined, and then all
'                                                                   of those times are summed together to obtain this value.
'                                               eUserTime       -   The amount of time that the process has executed in user mode. The time that each of the
'                                                                   threads of the process has executed in user mode is determined, and then all of those times
'                                                                   are summed together to obtain this value.
'Outputs   :    Returns a date/time or False if invalid
'Notes     :    Use of InstrRev would be quicker for VB programmers

Function ProcessGetTimes(Optional lProcessID As Long, Optional eType As eTimeType = eCreationTime) As Variant
    Dim bContainsDate As Boolean
    Dim tCreationTime As FILETIME, tExitTime As FILETIME
    Dim tUserTime As FILETIME, tKernelTime As FILETIME
    Dim tSystemTime As SYSTEMTIME
    
    If lProcessID = 0 Then
        'Get information on current process
        lProcessID = GetCurrentProcess
    End If
    
    If GetProcessTimes(lProcessID, tCreationTime, tExitTime, tKernelTime, tUserTime) Then
        Select Case eType
        Case eCreationTime
            FileTimeToLocalFileTime tCreationTime, tCreationTime
            FileTimeToSystemTime tCreationTime, tSystemTime
        
        Case eExitTime
            If tExitTime.dwHighDateTime + tExitTime.dwLowDateTime = 0 Then
                'Process has not exited
                ProcessGetTimes = False
                Exit Function
            End If
            FileTimeToLocalFileTime tExitTime, tExitTime
            FileTimeToSystemTime tExitTime, tSystemTime
        
        Case eKernelTime
            FileTimeToLocalFileTime tKernelTime, tKernelTime
            FileTimeToSystemTime tKernelTime, tSystemTime
            bContainsDate = False
            
        Case Else
            FileTimeToLocalFileTime tUserTime, tUserTime
            FileTimeToSystemTime tUserTime, tSystemTime
            bContainsDate = False
        End Select
        
        If bContainsDate Then
            'Date contains time and date part
            ProcessGetTimes = DateSerial(tSystemTime.wYear, tSystemTime.wMonth, tSystemTime.wDay) + TimeSerial(tSystemTime.wHour, tSystemTime.wMinute, tSystemTime.wSecond)
        Else
            'Date only contains a time part
            ProcessGetTimes = TimeSerial(tSystemTime.wHour, tSystemTime.wMinute, tSystemTime.wSecond)
        End If
    Else
        'Invalid process ID
        ProcessGetTimes = False
    End If
End Function


Sub Test()
    Debug.Print "-------------------------------------------"
    Debug.Print "Process Creation Time: " & ProcessGetTimes(, eCreationTime)
    Debug.Print "Process Exit Time: " & ProcessGetTimes(, eExitTime)
    Debug.Print "Process Kernel Time: " & ProcessGetTimes(, eKernelTime)
    Debug.Print "Process User Time: " & ProcessGetTimes(, eUserTime)
End Sub