27.03.2017, 11:32
|
Новичок
|
|
Регистрация: 28.07.2009
Сообщения: 85
Репутация: 50
|
|
Могу предложить только внешнюю dll 32/64 бит
32 бит - http://www.delphisources.ru/forum/at...d=149060318 3
64 бит http://www.delphisources.ru/forum/at...d=149060322 5
и код для ее пользования
Код:
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;
|