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;

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

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

var
  Stopwatch: TStopwatch;

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

  Readln;
end.

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

然后我分配了一些记忆：

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位地址空间，为地址空间中的每个页面调用VirtualQuery。我甚至都没等过这个过程。

因此，我的结论是，程序中的主要瓶颈不是您现在的代码，即找到虚拟内存块的代码。那是DoProcess中的代码，你拥有的代码我们没有。因此，即使您在修复我在开始时描述的缺陷，您仍将花费大量时间在该功能上。您应该期望虚拟内存空间枚举占用100毫秒的范围。

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

1 个答案: