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 TrimWorkingSet;
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;

// Способ третий
procedure TrimAppMemorySize;
var
  MainHandle: THandle;
begin
  try
    MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);

    if MainHandle <> 0 then
    begin
      SetProcessWorkingSetSize(MainHandle, DWORD(-1), DWORD(-1));
      CloseHandle(MainHandle);
    end;
  except
  end;

  Application.ProcessMessages;
end;

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