VB and VBA Users Source Code: Returning process timing information
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Returning process timing information
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, October 16, 2001
Hits:
1664
Category:
Windows API
Article:
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 'Author : Andrew Baker 'Date : 25/03/2000 '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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
