1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

function CalculateVirtualMemoryUsed: Int64;
var
  loc_mem : TMemoryStatus;
begin
  {Set the structure size}
  loc_mem.dwLength := SizeOf(loc_mem);
  {Get the memory status}
  GlobalMemoryStatus(loc_mem);
  {The result is the total address space less the free address space}
  Result := (loc_mem.dwTotalVirtual - loc_mem.dwAvailVirtual);
end;                    

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:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:

  SystemProcessInformation = 5;
  STATUS_INFO_LENGTH_MISMATCH = Integer($C0000004);

type
  UNICODE_STRING = record
    Length: Word;
    MaximumLength: Word;
    Buffer: PWideChar;
  end;
  PUNICODE_STRING = ^UNICODE_STRING;
  TUNICODE_STRING = UNICODE_STRING;

  _SYSTEM_PROCESS_INFORMATION = record
    NextEntryOffset: ULONG;
    NumberOfThreads: ULONG;
    SpareLi1, SpareLi2, SpareLi3: TLargeInteger;
    CreateTime, UserTime, KernelTime: TLargeInteger;
    ImageName: UNICODE_STRING;
    BasePriority: ULONG;
    UniqueProcessId: THandle;
    InheritedFromUniqueProcessId: THandle;
    HandleCount: ULONG;
    SessionId: ULONG;
    SpareUl3: ULONG;
    PeekVirtualSize: ULONG;
    VirtualSize: ULONG;
    PageFaultCount: ULONG;
    PeakWorkingSetSize: ULONG;
    WorkingSetSize: ULONG;
    QuotaPeakPagedPoolUsage: ULONG;
    QuotaPagedPoolUsage: ULONG;
    QuotaPeakNonPagedPoolUsage: ULONG;
    QuotaNonPagedPoolUsage: ULONG;
    PagefileUsage: ULONG;
    PeakPagefileUsage: ULONG;
    PrivatePageCount: ULONG;
  end;
  TSystem_Process_Information = _SYSTEM_PROCESS_INFORMATION;
  PSystem_Process_Information = ^TSystem_Process_Information;

{
********************************************************************************
*                        Internal Helper Functions                             *
********************************************************************************
}
function NtQuerySystemInformation(SystemInformationClass: Cardinal;
                                  SystemInformation: Pointer;
                                  Length: ULONG;
                                  ResultLength: PULONG): Integer; stdcall; external 'ntdll.dll';

function GetProcessVirtualMemorySize(const aProcessId: Cardinal) : Int64;
const
  BUF_SIZE = $10000;
var
  ProcListBuffer: PChar;
  ProcessInfo: PSYSTEM_PROCESS_INFORMATION;
  ProcOffset: ULONG;
  BufSize: Cardinal;
  Status: Integer;
  loc_found: Boolean;
begin
  Result := 0;

  ProcListBuffer := nil;
  try
    // capture the process list
    BufSize := BUF_SIZE;
    repeat
      GetMem(ProcListBuffer, BufSize);
      if ProcListBuffer = nil then begin
        Exit;
      end;

      Status := NtQuerySystemInformation(
                                         SystemProcessInformation,
                                         ProcListBuffer,
                                         BufSize,
                                         nil
                                        );
      if Status = STATUS_INFO_LENGTH_MISMATCH then begin
        // Buffer was too small, increase the buffer size and try again
        FreeMem(ProcListBuffer);
        Inc(BufSize, BUF_SIZE);
      end
      else if Status < 0 then begin
        // Another error occured
        Exit;
      end;
    until Status >= 0;

    loc_found := False;
    // we got the entire process list now, extract all PIDs
    ProcOffset := 0;
    ProcessInfo := PSYSTEM_PROCESS_INFORMATION(ProcListBuffer);
    repeat
      ProcessInfo := PSYSTEM_PROCESS_INFORMATION(Cardinal(ProcessInfo) + ProcOffset);
      ProcOffset := ProcessInfo^.NextEntryOffset;

      if ProcessInfo^.UniqueProcessId = aProcessId then begin
        Result := ProcessInfo^.VirtualSize;
        loc_found := True;
      end;
    until (ProcOffset = 0) or loc_found;
  finally
    if Assigned(ProcListBuffer) then
      FreeMem(ProcListBuffer);
  end;
end;