|
:: 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;
|
|
При использовании материала - ссылка на сайт обязательна
|
|