获取虚拟分配地址的更快方法

Question

我想处理（保存）分配给当前进程的虚拟内存块。这是我使用的代码：

program Project38;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  Winapi.Windows;

procedure DoProcess(aStart: Pointer; aSize: Cardinal);
begin
  // process it
end;

procedure ProcessVirtualMemory;
var
  addr: Pointer;
  i: Integer;
  p: Pointer;
  systemInfo: SYSTEM_INFO;
  startAddress, stopAddress: Pointer;
  size: size_t;
  memInfo: MEMORY_BASIC_INFORMATION;
begin
  GetSystemInfo(systemInfo);
  startAddress := systemInfo.lpMinimumApplicationAddress;
  stopAddress := systemInfo.lpMaximumApplicationAddress;

  addr := startAddress;

  while NativeUInt(addr) < NativeUInt(stopAddress) do begin
    size:= VirtualQuery(Pointer(addr), memInfo, SizeOf(MEMORY_BASIC_INFORMATION));
    if (size = SizeOf(MEMORY_BASIC_INFORMATION)) and
       (memInfo.State = MEM_COMMIT) and
       (memInfo.Type_9 = MEM_PRIVATE) and
       (memInfo.RegionSize > 0) and
       (memInfo.Protect = PAGE_READWRITE) then
    begin
      DoProcess(memInfo.BaseAddress, memInfo.RegionSize);
      addr := Pointer(NativeUInt(addr) + memInfo.RegionSize);
    end
    else
      addr := Pointer(NativeUInt(addr) + systemInfo.dwPageSize);
  end;
end;

begin
  ProcessVirtualMemory;
end.

此代码运行具有庞大的应用程序，收集此信息而不进行处理需要 10-12 秒。有没有更快的方法获取虚拟内存块的地址？

Answer 1

你的程序确实有错误。如果内存块与您的搜索条件不匹配，您只会增加页面大小而不是区域大小。你的循环应该看起来像这样：

while NativeUInt(addr) < NativeUInt(stopAddress) do begin
  size := VirtualQuery(Pointer(addr), memInfo, SizeOf(MEMORY_BASIC_INFORMATION));

  if size = 0 then begin
    // handle error
    break
  end;

  if (size = SizeOf(MEMORY_BASIC_INFORMATION)) and
     (memInfo.State = MEM_COMMIT) and
     (memInfo.Type_9 = MEM_PRIVATE) and
     (memInfo.RegionSize > 0) and
     (memInfo.Protect = PAGE_READWRITE) then begin
    DoProcess(memInfo.BaseAddress, memInfo.RegionSize);
  end;

  addr := Pointer(NativeUInt(addr) + memInfo.RegionSize);
end;

您的版本的问题在于，当虚拟地址 space 中存在间隙时，您的代码会一次一页地遍历它们，而不是跳过整个区域。

即使没有那个改变，我也不认为枚举是瓶颈。我对您的原始程序进行了以下更改，以报告所花费的时间：

var
  Stopwatch: TStopwatch;

begin
  Stopwatch := TStopwatch.StartNew;
  ProcessVirtualMemory;
  Writeln(Stopwatch.ElapsedMilliseconds);

  Readln;
end.

在我的机器上，对于 32 位版本构建，这报告了大约 500 毫秒。

然后我分配了一些内存：

var
  i: Integer;
  Stopwatch: TStopwatch;

begin
  for i := 1 to 100000 do begin
    HeapAlloc(GetProcessHeap, 0, Random(100000));
  end;

  Stopwatch := TStopwatch.StartNew;
  ProcessVirtualMemory;
  Writeln(Stopwatch.ElapsedMilliseconds);

  Readln;
end.

无论我做什么，摆弄常量，程序仍然报告大约 500 毫秒。如果您按照本答案开头所述修复不匹配的增量代码，则时间会下降到 100 毫秒左右。

当然，对于 64 位进程，情况略有不同。您的代码中的缺陷意味着该程序有效地卡住了，一次遍历巨大的 64 位地址 space 一页，为地址 space 中的每一页调用 VirtualQuery。我什至没有等到那个过程完成。

因此，我的结论是您程序中的主要瓶颈不是您当前的代码，即查找虚拟内存块的代码。那是 DoProcess 中的代码，您拥有我们没有的代码。因此，即使您修复了我在开始时描述的缺陷，您仍然会在该功能上花费大量时间。您应该期望虚拟内存 space 枚举在 100 毫秒左右。

获取虚拟分配地址的更快方法

Faster way to get virtual allocation addresses

delphi

virtual-memory