Модуль из проекта
Вот эти 2 процедуры измеряют текущую память и пиковую
1 2 |
class function CurrentProcessMemoryKB: Extended; static; class function CurrentProcessMemoryPeakKB: Extended; static; |
Полный модуль
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 |
unit uRPMemory; interface uses System.SysUtils, System.Classes, IdContext, IdCustomHTTPServer; type TRPMemory = class(TDataModule) private { Private declarations } class function CurrentProcessMemoryKB: Extended; static; class function CurrentProcessMemoryPeakKB: Extended; static; public { Public declarations } class procedure GetMemory(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); static; end; implementation uses Winapi.PsAPI, Winapi.Windows, Math; {%CLASSGROUP 'Vcl.Controls.TControl'} {$R *.dfm} class function TRPMemory.CurrentProcessMemoryKB: Extended; var MemCounters: TProcessMemoryCounters; begin MemCounters.cb := SizeOf(MemCounters); if GetProcessMemoryInfo(GetCurrentProcess, @MemCounters, SizeOf(MemCounters)) then Result := trunc(MemCounters.WorkingSetSize / 1024) else RaiseLastOSError; end; class function TRPMemory.CurrentProcessMemoryPeakKB: Extended; var MemCounters: TProcessMemoryCounters; begin MemCounters.cb := SizeOf(MemCounters); if GetProcessMemoryInfo(GetCurrentProcess, @MemCounters, SizeOf(MemCounters)) then Result := trunc(MemCounters.PeakWorkingSetSize / 1024) else RaiseLastOSError; end; class procedure TRPMemory.GetMemory(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); var curr, peak: Extended; begin curr := Math.RoundTo(CurrentProcessMemoryKB / 1024, -2); peak := Math.RoundTo(CurrentProcessMemoryPeakKB / 1024, -2); AResponseInfo.ResponseNo := 200; AResponseInfo.ContentType := 'application/json'; AResponseInfo.CacheControl := 'no-cache'; AResponseInfo.CustomHeaders.Add('Access-Control-Allow-Origin: *'); AResponseInfo.ContentText := curr.ToString + ' / ' + peak.ToString + ' (MB)'; AResponseInfo.WriteContent; end; end. |