var
  LibPSApi: HMODULE;
  LibShlwAPI: HMODULE;
  StrFormatByteSizeW: function(ASize: Int64; szBuf: PWideChar; uiBufSize: UINT): PWideChar; stdcall;

procedure GetMemInfoApplication(out AAllocated, ARAM, APeakRAM, APrivate, APeakPrivate, AVirtual: UInt64);
type
  PtrUInt = {$IFDEF CPU64}UInt64{$ELSE}Cardinal{$ENDIF};

  TMemCounters = packed record
    cb: DWORD;
    PageFaultCount: DWORD;
    PeakWorkingSetSize: PtrUInt;
    WorkingSetSize: PtrUInt;
    QuotaPeakPagedPoolUsage: PtrUInt;
    QuotaPagedPoolUsage: PtrUInt;
    QuotaPeakNonPagedPoolUsage: PtrUInt;
    QuotaNonPagedPoolUsage: PtrUInt;
    PagefileUsage: PtrUInt;
    PeakPagefileUsage: PtrUInt;
  end;

  TMemoryStatusEx = packed record
    dwLength: DWord;
    dwMemoryLoad: DWord;
    ullTotalPhys: UInt64;
    ullAvailPhys: UInt64;
    ullTotalPageFile: UInt64;
    ullAvailPageFile: UInt64;
    ullTotalVirtual: UInt64;
    ullAvailVirtual: UInt64;
    ullAvailExtendedVirtual: UInt64;
  end;

var
  GetProcessMemoryInfo: function(Handle: THandle; var Counters: TMemCounters; cb: DWORD): BOOL; stdcall;
  GlobalMemoryStatusEx: function(var lpBuffer: TMemoryStatusEx): BOOL; stdcall;
  Stats: TMemCounters;
  MemEx: TMemoryStatusEx;
  Mem: TMemoryStatus;
begin
  ARAM := 0;
  APeakRAM := 0;
  APrivate := 0;
  APeakPrivate := 0;
  AVirtual := 0;

  {$WARNINGS OFF}
  AAllocated := AllocMemSize;
  {$WARNINGS ON}

  if LibPSApi = 0 then
  begin
    LibPSApi := LoadLibrary('PSApi.dll');
    if LibPSApi = 0 then
      LibPSApi := 1;
  end;
  if LibPSApi <> 1 then
  begin
    GetProcessMemoryInfo := GetProcAddress(LibPSApi, 'GetProcessMemoryInfo');
    if Assigned(GetProcessMemoryInfo) then
    begin
      FillChar(Stats, SizeOf(Stats), 0);
      Stats.cb := SizeOf(Stats);
      if GetProcessMemoryInfo(GetCurrentProcess, Stats, SizeOf(Stats)) then
      begin
        ARAM := Stats.WorkingSetSize;
        APeakRAM := Stats.PeakWorkingSetSize;
        APrivate := Stats.PagefileUsage;
        APeakPrivate := Stats.PeakPagefileUsage;
      end;
    end;
  end;

  GlobalMemoryStatusEx := GetProcAddress(GetModuleHandle('kernel32.dll'), 'GlobalMemoryStatusEx');
  if Assigned(GlobalMemoryStatusEx) then
  begin
    FillChar(MemEx, SizeOf(MemEx), 0);
    MemEx.dwLength := SizeOf(MemEx);
    if GlobalMemoryStatusEx(MemEx) then
    begin
      AVirtual := MemEx.ullTotalVirtual - MemEx.ullAvailVirtual;
      Exit;
    end;
  end;

  FillChar(Mem, SizeOf(Mem), 0);
  Mem.dwLength := SizeOf(Mem);
  GlobalMemoryStatus(Mem);
  AVirtual := Mem.dwTotalVirtual - Mem.dwAvailVirtual;
end;

function FmtSizeToStr(const ASize: Int64): String;
const
  _Kb: Int64 = 1024;
  _Mb: Int64 = 1024*1024;
  _Gb: Int64 = 1024*1024*1024;
  _Tb: Int64 = 1099511627776; // 1024*1024*1024*1024;
begin
  if ASize < _Kb then
    Result := Format('%s %s', [UIntToStr(UInt64(ASize)), 'b'])
  else
  if ASize < _Mb then
    Result := Format('%s %s', [FloatToStrF(ASize / _Kb, ffFixed, 18, 2), 'Kb'])
  else
  if ASize < _Gb then
    Result := Format('%s %s', [FloatToStrF(ASize / _Mb, ffFixed, 18, 2), 'Mb'])
  else
  if ASize < _Tb then
    Result := Format('%s %s', [FloatToStrF(ASize / _Gb, ffFixed, 18, 2), 'Gb'])
  else
    Result := Format('%s %s', [FloatToStrF(ASize / _Tb, ffFixed, 18, 2), 'Tb']);
end;

function StrFormatByteSizeDummy(ASize: Int64; szBuf: PWideChar; uiBufSize: UINT): PWideChar; stdcall;
var
  Buf: WideString;
  Sz: Integer;
begin
  Buf := FmtSizeToStr(ASize);

  if Cardinal(Length(Buf)) + 1 < uiBufSize then
    Sz := Length(Buf) + 1
  else
    Sz := uiBufSize;
  if Sz > 0 then
  begin
    Move(Buf[1], szBuf^, Sz * SizeOf(WideChar));
    szBuf[uiBufSize - 1] := #0;
  end;
  Result := szBuf;
end;

function FmtFormatSize(const ASize: Int64): String;
var
  Buf: WideString;
begin
  if LibShlwAPI = 0 then
  begin
    LibShlwAPI := LoadLibrary('shlwapi.dll');
    if LibShlwAPI = 0 then
      LibShlwAPI := 1;
  end;
  if not Assigned(StrFormatByteSizeW) then
  begin
    if LibShlwAPI = 1 then
      StrFormatByteSizeW := StrFormatByteSizeDummy
    else
    begin
      StrFormatByteSizeW := GetProcAddress(LibShlwAPI, 'StrFormatByteSizeW'); // Do Not Localize
      if not Assigned(StrFormatByteSizeW) then
        StrFormatByteSizeW := StrFormatByteSizeDummy;
    end;
  end;
  SetLength(Buf, 1024);
  if StrFormatByteSizeW(ASize, PWideChar(Buf), Length(Buf)) = nil then
    StrFormatByteSizeDummy(ASize, PWideChar(Buf), Length(Buf));
  Result := PWideChar(Buf);
end;

function FmtSize(const ASize: Int64): String;
var
  Sz: UInt64;
begin
  if ASize = 0 then
    Result := '0'
  else
  begin
    Sz := UInt64(ASize);
    Result := UIntToStr(Sz) + ' (' + FmtSizeToStr(ASize) +')';
  end;
end;

procedure TForm106.Timer1Timer(Sender: TObject);
var
  Allocated: UInt64;
  RAM: UInt64;
  PeakRAM: UInt64;
  PrivateMem: UInt64;
  PeakPrivate: UInt64;
  VirtualMem: UInt64;
begin
  GetMemInfoApplication(Allocated, RAM, PeakRAM, PrivateMem, PeakPrivate, VirtualMem);
  Label1.Caption := Format('Allocated: %s' + sLineBreak +
                           'RAM: %s; peak: %s' + sLineBreak +
                           'Private: %s; peak: %s' + sLineBreak +
                           'Virtual: %s',
    [FmtSize(Allocated), FmtSize(RAM), FmtSize(PeakRAM), FmtSize(PrivateMem), FmtSize(PeakPrivate), FmtSize(VirtualMem)]);
end;