Вычислить загрузку ЦП конкретного запущенного процесса на VB

' Вычислить загрузку ЦП конкретного запущенного процесса
Public Function GetProcessUsage(Optional pid As Long) As Single
    Dim buf() As Byte
    Dim ret As Long
    Dim getpid As Long
    Dim Offset As Long
    Dim deltaOffset As Long
    Dim UserTime As Currency
    Dim KernelTime As Currency
    Dim UserTimeRet As Currency
    Dim KernelTimeRet As Currency
    Dim GetProcessUsageRet As Currency
    Static OldUserTime As Currency
    Static OldKernelTime As Currency
    Static FirstRun As Boolean
    Dim SInfo As SYSTEM_INFO
    
    If pid = 0 Then pid = GetCurrentProcessId
    
    If NtQuerySystemInformation(SystemProcessInformation, ByVal 0&, 0&, ret) = STATUS_INFO_LENGTH_MISMATCH Then
        ReDim buf(ret - 1)
        
        If NtQuerySystemInformation(SystemProcessInformation, buf(0), ret, ret) = STATUS_SUCCESS Then
            Do
                GetMem4 buf(Offset + &H44), getpid
                If getpid = pid Then ' Эти значения ни чем не отличаются от полученных с помощью GetProcessTimes
                    GetMem8 buf(Offset + &H28), UserTime
                    GetMem8 buf(Offset + &H30), KernelTime
                    Exit Do
                End If
                
                GetMem4 buf(Offset), deltaOffset
                Offset = Offset + deltaOffset
            Loop While deltaOffset
        End If
    End If
    
    If UserTime > 0 And KernelTime > 0 Then
        If FirstRun = False Then
            FirstRun = True
            
            OldUserTime = UserTime
            OldKernelTime = KernelTime
            GetProcessUsage = "0"
            Exit Function
        Else
            GetSystemInfo SInfo
            
            UserTimeRet = (UserTime - OldUserTime)
            KernelTimeRet = (KernelTime - OldKernelTime)
            
            GetProcessUsageRet = (UserTimeRet + KernelTimeRet) / 10 / SInfo.dwNumberOfProcessors
            If GetProcessUsageRet > 100 Then GetProcessUsageRet = 100
            
            GetProcessUsage = Round(GetProcessUsageRet, 2)
            
            OldUserTime = UserTime
            OldKernelTime = KernelTime
        End If
    Else
        GetProcessUsage = "0" ' Иногда UserTime или KernelTime почему-то может быть сразу нулём
    End If
End Function
 
' Вычислить загрузку ЦП конкретного запущенного процесса для Windows Vista и выше
Public Function GetProcessUsageByCycleTime(Optional pid As Long) As Single
    Dim hProc As Long
    Dim CycleTime As Currency
    Dim CyclesDelta As Currency
    Dim ProcessCycles As Currency
    Dim ProcessCycleDelta As Currency
    Dim SInfo As SYSTEM_INFO
    Dim ProcessUsagePercent As Single
    Static OldProcessCycles As Currency
    Static OldCycleTime As Currency
    Static FirstRun As Boolean
    
    If pid = 0 Then
        hProc = GetCurrentProcess()
    Else
        hProc = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, 0, pid)
    End If
    
    If hProc <> 0 Then
        QueryProcessCycleTime hProc, ProcessCycles
        
        If ProcessCycles > 0 Then
            GetSystemInfo SInfo
            
            If FirstRun = False Then
                FirstRun = True
                
                OldProcessCycles = ProcessCycles
                QueryPerformanceCounter OldCycleTime ' Здесь оказывается важно ещё запоминать QueryPerformanceCounter
                
                GetProcessUsageByCycleTime = 0
                Exit Function
            Else
                QueryPerformanceCounter CycleTime
                CyclesDelta = CycleTime - OldCycleTime
                
                ProcessCycleDelta = ProcessCycles - OldProcessCycles
                ProcessUsagePercent = ProcessCycleDelta / CyclesDelta / SInfo.dwNumberOfProcessors / 10
                GetProcessUsageByCycleTime = Round(ProcessUsagePercent, 2)
                
                OldProcessCycles = ProcessCycles
                OldCycleTime = CycleTime
            End If
        End If
        
        If pid <> 0 Then CloseHandle hProc
    End If
End Function

' Вычислить загрузку ЦП конкретного запущенного процесса для Windows Vista и выше
Public Function GetProcessUsageByCycleTime(Optional pid As Long) As Single
    Dim hProc As Long
    Dim CycleTime As Currency
    Dim CyclesDelta As Currency
    Dim ProcessCycles As Currency
    Dim ProcessCycleDelta As Currency
    Dim SInfo As SYSTEM_INFO
    Dim ProcessUsagePercent As Single
    Static OldProcessCycles As Currency
    Static OldCycleTime As Currency
    Static FirstRun As Boolean
    
    If pid = 0 Then
        hProc = GetCurrentProcess()
    Else
        hProc = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, 0, pid)
    End If
    
    If hProc <> 0 Then
        QueryProcessCycleTime hProc, ProcessCycles
        
        If ProcessCycles > 0 Then
            GetSystemInfo SInfo
            
            If FirstRun = False Then
                FirstRun = True
                
                OldProcessCycles = ProcessCycles
                QueryPerformanceCounter OldCycleTime ' Здесь оказывается важно ещё запоминать QueryPerformanceCounter
                
                GetProcessUsageByCycleTime = 0
                Exit Function
            Else
                QueryPerformanceCounter CycleTime
                CyclesDelta = CycleTime - OldCycleTime
                
                ProcessCycleDelta = ProcessCycles - OldProcessCycles
                ProcessUsagePercent = ProcessCycleDelta / CyclesDelta / SInfo.dwNumberOfProcessors / 10
                
                If ProcessUsagePercent > 100 Then ProcessUsagePercent = 100
                
                GetProcessUsageByCycleTime = Round(ProcessUsagePercent, 2)
                
                OldProcessCycles = ProcessCycles
                OldCycleTime = CycleTime
            End If
        End If
        
        If pid <> 0 Then CloseHandle hProc
    End If
End Function