Блог программистов

procedure FreeMemoryHeapCount(ProcessID,HeapID:DWORD; var fixed,free,moveable:DWORD);
var entry:THeapEntry32;
begin
  fixed:=0;
  free:=0;
  moveable:=0;
  entry.dwSize:=sizeof(entry);
  if Heap32First(entry,ProcessID,HeapID) then
  begin
    if entry.dwFlags=LF32_FIXED then
      fixed:=fixed+entry.dwBlockSize;
    if entry.dwFlags=LF32_FREE then
      free:=free+entry.dwBlockSize;
    if entry.dwFlags=LF32_MOVEABLE then
      moveable:=moveable+entry.dwBlockSize;
    entry.dwSize:=sizeof(entry);
    while Heap32Next(entry) do
    begin
      if entry.dwFlags=LF32_FIXED then
        fixed:=fixed+entry.dwBlockSize;
      if entry.dwFlags=LF32_FREE then
        free:=free+entry.dwBlockSize;
      if entry.dwFlags=LF32_MOVEABLE then
        moveable:=moveable+entry.dwBlockSize;
      entry.dwSize:=sizeof(entry);
    end
  end
end;

procedure FreeMemoryCount(snap:THandle; ID:DWORD; var fixed_mem,free_mem,moveable_mem:DWORD);
var fixed,free,moveable:DWORD;
    entry:THeapList32;
begin
  fixed_mem:=0;
  free_mem:=0;
  moveable_mem:=0;
  entry.dwSize:=sizeof(entry);
  if Heap32ListFirst(snap,entry) then
  begin
    if entry.th32ProcessID=ID then
    begin
      FreeMemoryHeapCount(ID,entry.th32HeapID,fixed,free,moveable);
      fixed_mem:=fixed_mem+fixed;
      free_mem:=free_mem+free;
      moveable_mem:=moveable_mem+moveable
    end;
    entry.dwSize:=sizeof(entry);
    while Heap32ListNext(snap,entry) do
    begin
      if entry.th32ProcessID=ID then
      begin
        FreeMemoryHeapCount(ID,entry.th32HeapID,fixed,free,moveable);
        fixed_mem:=fixed_mem+fixed;
        free_mem:=free_mem+free;
        moveable_mem:=moveable_mem+moveable
      end;
      entry.dwSize:=sizeof(entry)
    end
  end
end;

procedure TForm1.Button1Click(Sender: TObject);
var snap:THandle;
    entry:TProcessEntry32;
    fixed,free,moveable:DWORD;
begin
  snap:=CreateToolHelp32SnapShot(TH32CS_SNAPALL,0);
  entry.dwSize:=sizeof(entry);
  if Process32First(snap,entry) then
  begin
    FreeMemoryCount(snap,entry.th32ProcessID,fixed,free,moveable);
    StringGrid1.Cells[0,StringGrid1.RowCount-1]:=string(entry.szExeFile);
    StringGrid1.Cells[1,StringGrid1.RowCount-1]:=IntToStr(fixed);
    StringGrid1.Cells[2,StringGrid1.RowCount-1]:=IntToStr(free);
    StringGrid1.Cells[3,StringGrid1.RowCount-1]:=IntToStr(moveable);
    StringGrid1.RowCount:=StringGrid1.RowCount+1;
    entry.dwSize:=sizeof(entry);
    while Process32Next(snap,entry) do
    begin
      FreeMemoryCount(snap,entry.th32ProcessID,fixed,free,moveable);
      StringGrid1.Cells[0,StringGrid1.RowCount-1]:=string(entry.szExeFile);
      StringGrid1.Cells[1,StringGrid1.RowCount-1]:=IntToStr(fixed);
      StringGrid1.Cells[2,StringGrid1.RowCount-1]:=IntToStr(free);
      StringGrid1.Cells[3,StringGrid1.RowCount-1]:=IntToStr(moveable);
      StringGrid1.RowCount:=StringGrid1.RowCount+1;
      entry.dwSize:=sizeof(entry)
    end;
    CloseHandle(snap)
  end;
end;