unit MemoryMap.Heaps;

Winapi.Windows,

Generics.Collections,

Winapi.TlHelp32;

THeapEntry = record

Address: ULONG_PTR;

Size: SIZE_T;

Flags: ULONG;

end;

THeapData = record

ID: DWORD;

Wow64: Boolean;

Entry: THeapEntry;

end;

THeap = class

private

FData: TList<THeapData>;

protected

procedure Update(PID: Cardinal; hProcess: THandle);

public

constructor Create; overload;

constructor Create(PID: Cardinal; hProcess: THandle); overload;

destructor Destroy; override;

property Data: TList<THeapData> read FData;

end;

MemoryMap.Core,

MemoryMap.NtDll;

constructor THeap.Create(PID: Cardinal; hProcess: THandle);

Create;

Update(PID, hProcess);

end;

constructor THeap.Create;

FData := TList<THeapData>.Create;

end;

destructor THeap.Destroy;

FData.Free;

inherited;

end;

procedure THeap.Update(PID: Cardinal; hProcess: THandle);

RTL_HEAP_BUSY = 1;

RTL_HEAP_SEGMENT = 2;

RTL_HEAP_SETTABLE_VALUE = $10;

RTL_HEAP_SETTABLE_FLAG1 = $20;

RTL_HEAP_SETTABLE_FLAG2 = $40;

RTL_HEAP_SETTABLE_FLAG3 = $80;

RTL_HEAP_SETTABLE_FLAGS = $E0;

RTL_HEAP_UNCOMMITTED_RANGE = $100;

RTL_HEAP_PROTECTED_ENTRY = $200;

RTL_HEAP_FIXED = (RTL_HEAP_BUSY or RTL_HEAP_SETTABLE_VALUE or

RTL_HEAP_SETTABLE_FLAG2 or RTL_HEAP_SETTABLE_FLAG3 or

RTL_HEAP_SETTABLE_FLAGS or RTL_HEAP_PROTECTED_ENTRY);

function CheckSmallBuff(Value: DWORD): Boolean;

const

STATUS_NO_MEMORY = $C0000017;

STATUS_BUFFER_TOO_SMALL = $C0000023;

begin

Result := (Value = STATUS_NO_MEMORY) or (Value = STATUS_BUFFER_TOO_SMALL);

end;

I, A: Integer;

pDbgBuffer: PRtlDebugInformation;

pHeapInformation: PRtlHeapInformation;

pHeapEntry: PRtrHeapEntry;

dwAddr, dwLastSize: ULONG_PTR;

hit_seg_count: Integer;

HeapData: THeapData;

BuffSize: NativeUInt;

// Ò.ê. ñâÿçêà Heap32ListFirst, Heap32ListNext, Heap32First, Heap32Next

// ðàáîòàåò äîñòàòî÷íî ìåäëåííî, èç-çà ïîñòîÿííîãî âûçîâà

// RtlQueryProcessDebugInformation íà êàæäîé èòåðàöèè, ìû çàìåíèì åå âûçîâ

// àíàëîãè÷íûì êîäîì áåç íåíóæíîãî äóáëÿæà

// Ñîçäàåì îòëàäî÷íûé áóôôåð

BuffSize := $400000;

pDbgBuffer := RtlCreateQueryDebugBuffer(BuffSize, False);

// Çàïðàøèâàåì èíôîðìàöèþ ïî ñïèñêó êó÷ ïðîöåññà

while CheckSmallBuff(RtlQueryProcessDebugInformation(PID,

RTL_QUERY_PROCESS_HEAP_SUMMARY or RTL_QUERY_PROCESS_HEAP_ENTRIES,

pDbgBuffer)) do

begin

// åñëè ðàçìåðà áóôåðà íå õâàòàåò, óâåëè÷èâàåì...

RtlDestroyQueryDebugBuffer(pDbgBuffer);

BuffSize := BuffSize shl 1;

pDbgBuffer := RtlCreateQueryDebugBuffer(BuffSize, False);

end;

if pDbgBuffer <> nil then

try

// Çàïðàøèâàåì èíôîðìàöèþ ïî ñïèñêó êó÷ ïðîöåññà

if RtlQueryProcessDebugInformation(PID,

RTL_QUERY_PROCESS_HEAP_SUMMARY or RTL_QUERY_PROCESS_HEAP_ENTRIES,

pDbgBuffer) = STATUS_SUCCESS then

begin

// Ïîëó÷àåì óêàçàòåëü íà êó÷ó ïî óìîë÷àíèþ

pHeapInformation := @pDbgBuffer^.Heaps^.Heaps[0];

// ïåðå÷èñëÿåì âñå åå áëîêè...

for I := 0 to pDbgBuffer^.Heaps^.NumberOfHeaps - 1 do

begin

HeapData.ID := I;

// íà÷èíàÿ ñ ñàìîãî ïåðâîãî

pHeapEntry := pHeapInformation^.Entries;

dwAddr := DWORD(pHeapEntry^.u.s2.FirstBlock) +

pHeapInformation^.EntryOverhead;

dwLastSize := 0;

A := 0;

while A < Integer(pHeapInformation^.NumberOfEntries) do

try

hit_seg_count := 0;

while (pHeapEntry^.Flags and RTL_HEAP_SEGMENT) = RTL_HEAP_SEGMENT do

begin

// Åñëè áëîê îòìå÷åí ôëàãîì RTL_HEAP_SEGMENT,

// òî ðàññ÷èòûâàåì íîâûé àäðåñ íà îñíîâå EntryOverhead

dwAddr := DWORD(pHeapEntry^.u.s2.FirstBlock) +

pHeapInformation^.EntryOverhead;

Inc(pHeapEntry);

Inc(A);

Inc(hit_seg_count);

// ïðîâåðêà âûõîäà çà ãðàíèöû áëîêîâ

if A + hit_seg_count >=

Integer(pHeapInformation^.NumberOfEntries - 1) then

Break;

end;

// Åñëè áëîê íå ñàìûé ïåðâûé â ñåãìåíòå, òî òåêóùèé àäðåñ áëîêà ðàâåí,

// àäðåñó ïðåäûäóùåãî áëîêà + ðàçìåð ïðåäûäóùåãî áëîêà

if hit_seg_count = 0 then

Inc(dwAddr, dwLastSize);

// Âûñòàâëÿåì ôëàãè

if pHeapEntry^.Flags and RTL_HEAP_FIXED <> 0 then

pHeapEntry^.Flags := LF32_FIXED

else

if pHeapEntry^.Flags and RTL_HEAP_SETTABLE_FLAG1 <> 0 then

pHeapEntry^.Flags := LF32_MOVEABLE

else

if pHeapEntry^.Flags and RTL_HEAP_UNCOMMITTED_RANGE <> 0 then

pHeapEntry^.Flags := LF32_FREE;

if pHeapEntry^.Flags = 0 then

pHeapEntry^.Flags := LF32_FIXED;

// Äîáàâëÿåì ðåçóëüòàò ê ñïèñêó

HeapData.Entry.Address := dwAddr;

HeapData.Entry.Size := pHeapEntry^.Size;

HeapData.Entry.Flags := pHeapEntry^.Flags;

HeapData.Wow64 := False;

FData.Add(HeapData);

// Çàïîìèíàåì àäðåñ ïîñëåäíåãî áëîêà

dwLastSize := pHeapEntry^.Size;

// Ïåðåõîäèì ê ñëåäóþùåìó áëîêó

Inc(pHeapEntry);

finally

Inc(A);

end;

// Ïåðåõîäèì ê ñëåäóþùåé êó÷å

Inc(pHeapInformation);

end;

end;

finally

RtlDestroyQueryDebugBuffer(pDbgBuffer);

end;

end;

end.