uses
TlHelp32;
type
NTSTATUS = System
.
LongInt
;
type
PLARGE_INTEGER = ^LARGE_INTEGER;
var
procmangpuLibrary: HMODULE = INVALID_HANDLE_VALUE;
ntdllLibrary: HMODULE = INVALID_HANDLE_VALUE;
type
TPmGPUInitialize =
function
():
Boolean
; cdecl;
TPmGPUGetProcessStatistics =
function
(
ProcessHandle: THandle;
SharedUsage: PULONGLONG;
DedicatedUsage: PULONGLONG;
BytesAllocated: PULONGLONG;
BytesReserved: PULONGLONG;
SmallAllocationBlocks: PULONGLONG;
LargeAllocationBlocks: PULONGLONG;
WriteCombinedBytesAllocated: PULONGLONG;
WriteCombinedBytesReserved: PULONGLONG;
CachedBytesAllocated: PULONGLONG;
CachedBytesReserved: PULONGLONG;
SectionBytesAllocated: PULONGLONG;
SectionBytesReserved: PULONGLONG;
RunningTime:
PInt64
):
Boolean
; cdecl;
TNtQueryPerformanceCounter =
function
(
PerformanceCounter: PLARGE_INTEGER;
PerformanceFrequency: PLARGE_INTEGER): NTSTATUS; stdcall;
var
PmGPUInitialize: TPmGPUInitialize =
nil
;
PmGPUGetProcessStatistics: TPmGPUGetProcessStatistics =
nil
;
NtQueryPerformanceCounter: TNtQueryPerformanceCounter =
nil
;
procedure
TForm1
.
FormCreate(Sender: TObject);
begin
procmangpuLibrary := LoadLibrary(
'procmangpu.dll'
);
@PmGPUInitialize := GetProcAddress(procmangpuLibrary,
'PmGPUInitialize'
);
@PmGPUGetProcessStatistics := GetProcAddress(procmangpuLibrary,
'PmGPUGetProcessStatistics'
);
ntdllLibrary := LoadLibrary(
'ntdll.dll'
);
@NtQueryPerformanceCounter := GetProcAddress(ntdllLibrary,
'NtQueryPerformanceCounter'
);
PmGPUInitialize;
end
;
function
PmGetPerformanceCounters(
var
PerformanceCounter: LARGE_INTEGER;
var
PerformanceFrequency: LARGE_INTEGER): NTSTATUS;
begin
Result := NtQueryPerformanceCounter(@PerformanceCounter, @PerformanceFrequency);
end
;
var
SharedUsage: ULONGLONG;
DedicatedUsage: ULONGLONG;
BytesAllocated: ULONGLONG;
BytesReserved: ULONGLONG;
SmallAllocationBlocks: ULONGLONG;
LargeAllocationBlocks: ULONGLONG;
WriteCombinedBytesAllocated: ULONGLONG;
WriteCombinedBytesReserved: ULONGLONG;
CachedBytesAllocated: ULONGLONG;
CachedBytesReserved: ULONGLONG;
SectionBytesAllocated: ULONGLONG;
SectionBytesReserved: ULONGLONG;
RunningTime: LONGLONG;
GPU_RunningTime, GPU_RunningTimeDelta: LONGLONG;
GPU_ElapsedTime:
Extended
;
GPU_PerformanceCounter, GPU_PerformanceCounterDelta: LONGLONG;
GPU_Usage:
Extended
;
procedure
TForm1
.
Timer1Timer(Sender: TObject);
var
ToolHelp32SnapShot: THandle;
ProcessEntry32: TProcessEntry32;
ProcessHandle: THandle;
PerformanceCounter, PerformanceFrequency: LARGE_INTEGER;
Status: NTSTATUS;
begin
ToolHelp32SnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,
0
);
if
ToolHelp32SnapShot <> INVALID_HANDLE_VALUE
then
begin
try
ProcessEntry32
.
dwSize := SizeOf(TProcessEntry32);
while
Process32Next(ToolHelp32SnapShot, ProcessEntry32) =
True
do
begin
if
ProcessEntry32
.
th32ProcessID = StrToIntDef(Edit1
.
Text,
0
)
then
begin
ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION,
True
, ProcessEntry32
.
th32ProcessID);
if
ProcessHandle <>
0
then
begin
try
PmGPUGetProcessStatistics(
ProcessHandle,
@SharedUsage,
@DedicatedUsage,
@BytesAllocated,
@BytesReserved,
@SmallAllocationBlocks,
@LargeAllocationBlocks,
@WriteCombinedBytesAllocated,
@WriteCombinedBytesReserved,
@CachedBytesAllocated,
@CachedBytesReserved,
@SectionBytesAllocated,
@SectionBytesReserved,
@RunningTime);
Status := PmGetPerformanceCounters(PerformanceCounter, PerformanceFrequency);
if
Status = ERROR_SUCCESS
then
begin
if
PerformanceCounter
.
QuadPart > GPU_PerformanceCounter
then
GPU_PerformanceCounterDelta := PerformanceCounter
.
QuadPart - GPU_PerformanceCounter;
GPU_PerformanceCounter := PerformanceCounter
.
QuadPart;
GPU_ElapsedTime := GPU_PerformanceCounterDelta *
100000
/ PerformanceFrequency
.
QuadPart;
GPU_RunningTimeDelta := RunningTime - GPU_RunningTime;
GPU_RunningTime := RunningTime;
GPU_Usage := GPU_RunningTimeDelta / GPU_ElapsedTime;
Caption := FormatFloat(
'0.00'
, GPU_Usage);
end
;
finally
CloseHandle(ProcessHandle);
end
;
end
;
end
;
end
;
finally
CloseHandle(ToolHelp32SnapShot);
end
;
end
;
end
;