[Zorkov Igor]

Могу предложить только внешнюю 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;