VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5880
   ClientLeft      =   120
   ClientTop       =   450
   ClientWidth     =   8910
   LinkTopic       =   "Form1"
   ScaleHeight     =   5880
   ScaleWidth      =   8910
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   1215
      Left            =   2400
      TabIndex        =   0
      Top             =   1800
      Width           =   3135
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

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 Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

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 GetTickCount Lib "kernel32" () As Long

Function GetProcessTimesAPI(ByRef sStart$, ByRef lKT As Double, ByRef lUT As Double) As String
    ' Accepts variables by reference
    ' Determines Process Start Time, Kernel Mode Nanosecondsx100, User Mode Nanosecondsx100
    ' Returns a zero length string if successful, or an error description if not
    Dim ftCT As FILETIME, ftET As FILETIME, ftKT As FILETIME, ftUT As FILETIME, stCT As SYSTEMTIME
    Dim NanoCT As Double, NanoET As Double, NanoKT As Double, NanoUT As Double, s$, ret&
    Dim MyProcessThreadId&, MyAppProcessId&, MyAppProcessHandle&, r$

    MyProcessThreadId = GetWindowThreadProcessId(Form1.hwnd, MyAppProcessId)
    If MyAppProcessId = 0 Then GetProcessTimesAPI = "GetProcessTimesAPI - Error getting Application Process Id": Exit Function

    MyAppProcessHandle& = OpenProcess(PROCESS_ALL_ACCESS, 0&, MyAppProcessId)
    If MyAppProcessHandle = 0 Then GetProcessTimesAPI = "GetProcessTimesAPI - Error getting process handle": Exit Function
    
    ret = GetProcessTimes(MyAppProcessHandle, ftCT, ftET, ftKT, ftUT)
    If ret = 0 Then GetProcessTimesAPI = "GetProcessTimesAPI - Error getting Process Times": CloseHandle MyAppProcessHandle: Exit Function
    
    ' Filetime returns a 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601 (UTC).
    ' 1 millisec (thousandth of a sec), 1 microsecond (1 millionth of a sec), 1 nanosecond (1 billionth of a second)
    ' To convert the 64 bit number stored in 2 words into a VB double multiply high word by 2^32 then add low word
    NanoCT = ftCT.dwHighDateTime * 2 ^ 32 + ftCT.dwLowDateTime
    NanoET = ftET.dwHighDateTime * 2 ^ 32 + ftET.dwLowDateTime
    NanoKT = ftKT.dwHighDateTime * 2 ^ 32 + ftKT.dwLowDateTime
    NanoUT = ftUT.dwHighDateTime * 2 ^ 32 + ftUT.dwLowDateTime
    
    ' converts the creation time to local time then to system time to make it easily readable
    FileTimeToLocalFileTime ftCT, ftCT
    FileTimeToSystemTime ftCT, stCT
    sStart = stCT.wHour & "h:" & stCT.wMinute & "m:" & stCT.wSecond & "s"
    lKT = NanoKT
    lUT = NanoUT
End Function


Private Sub Command1_Click()
Dim sStart$, KT1#, UT1#, KT2#, UT2#, ret$, s$, GTC1&, GTC2&
GTC1 = GetTickCount
ret = GetProcessTimesAPI(sStart, KT1, UT1)
If Len(ret) Then MsgBox ret: Exit Sub ' there was an error calling the function

'code to time
Dim i&, j&
For i = 0 To 800000
    j = i + 1
    If i Mod 1000 = 0 Then DoEvents
Next i

ret = GetProcessTimesAPI(sStart, KT2, UT2)
If Len(ret) Then MsgBox ret: Exit Sub ' there was an error calling the function
GTC2 = GetTickCount

' Note x nanoseconds by 0.0000001 to get seconds, milliseconds x 0.001 to get seconds
s = s & "Kernel Mode NanoSecs: " & KT2 - KT1 & vbCrLf
s = s & "User Mode NanoSecs: " & UT2 - UT1 & vbCrLf
s = s & "Gettickcount: " & GTC2 - GTC1
Debug.Print s
End Sub