FAQ VCL
Железо\Память

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как получить информацию о состоянии памяти?

// Способ первый
procedure TForm1.Timer1Timer(Sender: TObject);
var
  Mem: TMemoryStatus;
begin
   Mem.dwLength := SizeOf( Mem );
   GlobalMemoryStatus( Mem );
   with Mem do
   begin
      label1.caption := Format( 'Загруженность памяти - %d%%', [dwMemoryLoad] );
      label2.caption := Format( 'Свободно памяти - %d%%' ,[100-dwMemoryLoad] );
      label3.caption := Format( 'Всего физической памяти - %d байт', [dwTotalPhys] );
      label4.caption := Format( 'Свободно физической памяти - %d байт', [dwAvailPhys] );
      label5.caption := Format( 'Всего страничной памяти - %d байт', [dwTotalPageFile] );
      label6.caption := Format( 'Свободно страничной памяти - %d байт', [dwAvailPageFile] );
      label7.caption := Format( 'Всего выиртуальной памяти - %d байт', [dwTotalVirtual] );
      label8.caption := Format( 'Свободно виртуальной памяти - %d байт', [dwAvailVirtual] );
   end;
end;

// Способ второй
type
  TGetProcessMemoryInfo = function (Process: THandle; out Counters; cb: DWORD): BOOL stdcall;

  PROCESS_MEMORY_COUNTERS_EX = packed record
    cb: DWORD;
    PageFaultCount: DWORD;
    PeakWorkingSetSize: DWORD;
    WorkingSetSize: DWORD;
    QuotaPeakPagedPoolUsage: DWORD;
    QuotaPagedPoolUsage: DWORD;
    QuotaPeakNonPagedPoolUsage: DWORD;
    QuotaNonPagedPoolUsage: DWORD;
    PageFileUsage: DWORD;
    PeakPageFileUsage: DWORD;
    PrivateUsage: DWORD;
  end;

var
  hPSAPI: THandle;
  _GetProcessMemoryInfo: TGetProcessMemoryInfo;

implementation

procedure TForm1.Button1Click(Sender: TObject);

  function GetProcessMemoryInfo(Process: THandle; out Counters; cb: DWORD): BOOL;
  begin
     Result := _GetProcessMemoryInfo(Process, Counters, cb)
  end;

var
  Result: PROCESS_MEMORY_COUNTERS_EX;
begin
   Assert(GetProcessMemoryInfo(GetCurrentProcess, Result, SizeOf(Result)));

   with Result do
      ShowMessage('PageFaultCount: ' + IntToStr(PageFaultCount) + #13 +
                  'PeakWorkingSetSize: ' + IntToStr(PeakWorkingSetSize) + #13 +
                  'WorkingSetSize: ' + IntToStr(WorkingSetSize) + #13 +
                  'QuotaPeakPagedPoolUsage: ' + IntToStr(QuotaPeakPagedPoolUsage) + #13 +
                  'QuotaPagedPoolUsage: ' + IntToStr(QuotaPagedPoolUsage) + #13 +
                  'QuotaPeakNonPagedPoolUsage: ' + IntToStr(QuotaPeakNonPagedPoolUsage) + #13 +
                  'QuotaNonPagedPoolUsage: ' + IntToStr(QuotaNonPagedPoolUsage) + #13 +
                  'PageFileUsage: ' + IntToStr(PageFileUsage) + #13 +
                  'PeakPageFileUsage: ' + IntToStr(PeakPageFileUsage) + #13 +
                  'PrivateUsage: ' + IntToStr(PrivateUsage));
end;

initialization
  hPSAPI := LoadLibrary('PSAPI.dll');
  Assert(hPSAPI >= 32);
  @_GetProcessMemoryInfo := GetProcAddress(hPSAPI, 'GetProcessMemoryInfo');


Как минимизировать размер памяти, занимаемой приложением?

// Способ первый
procedure TrimWorkingSet1;
begin
   if Win32Platform = VER_PLATFORM_WIN32_NT then
      SetProcessWorkingSetSize( GetCurrentProcess, $FFFFFFFF, $FFFFFFFF );
end;

// Способ второй
procedure TrimWorkingSet;
var
  MainHandle: THandle;
begin
   if Win32Platform = VER_PLATFORM_WIN32_NT then
   begin
      MainHandle := OpenProcess( PROCESS_ALL_ACCESS, false, GetCurrentProcessID );
      SetProcessWorkingSetSize( MainHandle, DWORD( -1 ), DWORD( -1 ) );
      CloseHandle( MainHandle );
   end;
end;

При использовании материала - ссылка на сайт обязательна