vmqueryimpl.pas

《参透Delphi Kylix》通过131个事例

    if PVMI <> nil then
    begin
      PVMI^.BlockBaseAddress := MBI.BaseAddress;
      PVMI^.BlocksCount := 0;
      PVMI^.BlocksCountWithPageGuard := 0;
      PVMI^.BlockSize := MBI.RegionSize;
      PVMI^.BlockProtect := MBI.Protect;
      PVMI^.BlockState := MEM_COMMIT;
      PVMI^.BlockType := MBI.Type_9;

      PVMI^.RegionBaseAddress := MBI.AllocationBase;
      PVMI^.RegionAllocationBase := MBI.AllocationBase;
      PVMI^.RegionAllocationProtect := MBI.AllocationProtect;
      PVMI^.RegionSize := 0;
      PVMI^.RegionProtect := MBI.Protect;
      PVMI^.RegionState := MBI.State;
      PVMI^.RegionType := MBI.Type_9;

      LRegionAllocationBase := PVMI^.RegionAllocationBase;
      LBlockAddress := LRegionAllocationBase;
      while True do
      begin
        FillChar(MBI, SizeOf(MBI), 0);
        LSentinal := VirtualQuery(LBlockAddress, MBI, SizeOf(MBI)) > 0;
        if not LSentinal then break;
        if not (MBI.AllocationBase = LRegionAllocationBase) then break;
        Inc(PVMI^.BlocksCount);
        Inc(PVMI^.RegionSize, MBI.RegionSize);
        if MBI.Protect and PAGE_GUARD = PAGE_GUARD then
          Inc(PVMI^.BlocksCountWithPageGuard);
        if PVMI^.RegionType = MEM_PRIVATE then
          PVMI^.RegionType := MBI.Type_9;
        LBlockAddress := Pointer(DWORD(LBlockAddress) + MBI.RegionSize);
      end;
    end;
  end;

  procedure DoFreeMemoryQuery(PVMI: PVirtualMemoryInformation; MBI: TMemoryBasicInformation);
  begin
    if PVMI <> nil then
    begin
      PVMI^.BlockBaseAddress := MBI.BaseAddress;
      PVMI^.BlocksCount := 1;
      PVMI^.BlocksCountWithPageGuard := 0;
      PVMI^.BlockSize := MBI.RegionSize;
      PVMI^.BlockProtect := 0;
      PVMI^.BlockState := MEM_FREE;
      PVMI^.BlockType := MBI.Type_9;

      PVMI^.RegionBaseAddress := MBI.BaseAddress;
      PVMI^.RegionAllocationBase := MBI.AllocationBase;
      PVMI^.RegionAllocationProtect := MBI.AllocationProtect;
      PVMI^.RegionSize := MBI.RegionSize;
      PVMI^.RegionState := MBI.State;
      PVMI^.RegionProtect := MBI.Protect;
      PVMI^.RegionType := MBI.Type_9;
    end;
  end;

  procedure DoReservedMemoryQuery(PVMI: PVirtualMemoryInformation; MBI: TMemoryBasicInformation);
  var
    LRegionAllocationBase: Pointer;
    LBlockAddress: Pointer;
    LSentinal: Boolean;
  begin
    if PVMI <> nil then
    begin
      PVMI^.BlockBaseAddress := MBI.BaseAddress;
      PVMI^.BlocksCount := 0;
      PVMI^.BlocksCountWithPageGuard := 0;
      PVMI^.BlockSize := MBI.RegionSize;
      PVMI^.BlockProtect := MBI.AllocationProtect;
      PVMI^.BlockState := MEM_RESERVE;
      PVMI^.BlockType := MBI.Type_9;

      PVMI^.RegionBaseAddress := MBI.AllocationBase;
      PVMI^.RegionAllocationBase := MBI.AllocationBase;
      PVMI^.RegionAllocationProtect := MBI.AllocationProtect;
      PVMI^.RegionSize := 0;
      PVMI^.RegionProtect := MBI.AllocationProtect;
      PVMI^.RegionState := MBI.State;
      PVMI^.RegionType := MBI.Type_9;

      LRegionAllocationBase := PVMI^.RegionAllocationBase;
      LBlockAddress := LRegionAllocationBase;
      while True do
      begin
        FillChar(MBI, SizeOf(MBI), 0);
        LSentinal := VirtualQuery(LBlockAddress, MBI, SizeOf(MBI)) > 0;
        if not LSentinal then break;
        if not (MBI.AllocationBase = LRegionAllocationBase) then break;
        Inc(PVMI^.BlocksCount);
        Inc(PVMI^.RegionSize, MBI.RegionSize);
        if MBI.Protect and PAGE_GUARD = PAGE_GUARD then
          Inc(PVMI^.BlocksCountWithPageGuard);
        if PVMI^.RegionType = MEM_PRIVATE then
          PVMI^.RegionType := MBI.Type_9;
        LBlockAddress := Pointer(DWORD(LBlockAddress) + MBI.RegionSize);
      end;
    end;
  end;

var
  MBI: TMemoryBasicInformation;
begin
  Result := False;
  try
    FillChar(MBI, SizeOf(MBI), 0);
    if VirtualQuery(Address, MBI, SizeOf(MBI)) > 0 then
    begin
      case MBI.State of
        MEM_COMMIT: DoCommittedMemoryQuery(PVMI, MBI);
        MEM_FREE: DoFreeMemoryQuery(PVMI, MBI);
        MEM_RESERVE: DoReservedMemoryQuery(PVMI, MBI);
      end;
      Result := True;
    end;
  except
    on E: Exception do
      MessageDlg('Error when calling VirtualMemoryQuery.', mtError, [mbOk], 0);
  end;
end;

function VirtualMemoryWalk(VirtualMemoryWalker: TVirtualMemoryWalkerCallback; Detailed: Boolean): BOOL; stdcall;
var
  LAddress: Pointer;
  LVMI: TVirtualMemoryInformation;
  LBuffer: PChar;
  LBufferSize: DWORD;
  LSentinal: Boolean;
  I: DWORD;
begin
  Result := False;
  try
    LSentinal := True;
    LAddress := Pointer($00000000);
    while LSentinal do
    begin
      // Get memory information of the region.
      FillChar(LVMI, SizeOf(LVMI), 0);
      LSentinal := VirtualMemoryQuery(LAddress, @LVMI, SizeOf(TVirtualMemoryInformation));
      if not LSentinal then break;
      if Assigned(VirtualMemoryWalker) then
      begin
        GetMemoryInformation(LVMI, LBuffer, LBufferSize, False);
        VirtualMemoryWalker(LBuffer, LBufferSize);
      end;
      // Get memory information of all blocks.
      if (LVMI.BlocksCount > 1) and Detailed then
      begin
        for I := 0 to LVMI.BlocksCount - 1 do
        begin
          if Assigned(VirtualMemoryWalker) then
          begin
            GetMemoryInformation(LVMI, LBuffer, LBufferSize, True);
            VirtualMemoryWalker(LBuffer, LBufferSize);
          end;
          // Get the base address of the next block.
          LAddress := Pointer(DWORD(LAddress) + LVMI.BlockSize);
          // Do not query the address after the last block of the region, which belongs to the next region.
          if I < LVMI.BlocksCount - 1 then
          begin
            FillChar(LVMI, SizeOf(LVMI), 0);
            LSentinal := VirtualMemoryQuery(LAddress, @LVMI, SizeOf(TVirtualMemoryInformation));
            if not LSentinal then break;
          end;
        end;
      end;
      // Get the base address of the next region.
      LAddress := Pointer(DWORD(LVMI.RegionBaseAddress) + LVMI.RegionSize);
    end;
    Result := True;
  except
    on E: Exception do
      MessageDlg('Error when calling VirtualMemoryWalk.', mtError, [mbOk], 0);
  end;
end;

function VMWalk(Detailed: Boolean = True): BOOL; stdcall;
var
  LAddress: Pointer;
  LVMI: TVirtualMemoryInformation;
  LBuffer: PChar;
  LBufferSize: DWORD;
  LSentinal: Boolean;
  I: DWORD;
  ReturnedInfoMemMapping: TJuMemMapping;
  ReturnedInfo: PReturnedInfo;
  LStartPos: Cardinal;
begin
  Result := False;
  try
    ReturnedInfoMemMapping := TJuMemMapping.Create(True, SReturnedInfoMemMapping, 64 * 1024);
    ReturnedInfo := PReturnedInfo(ReturnedInfoMemMapping.Read());
    LSentinal := True;
    LAddress := Pointer($00000000);
    LStartPos := 4;
    while LSentinal do
    begin
      // Get memory information of the region.
      FillChar(LVMI, SizeOf(LVMI), 0);
      LSentinal := VirtualMemoryQuery(LAddress, @LVMI, SizeOf(TVirtualMemoryInformation));
      if not LSentinal then break;

      GetMemoryInformation(LVMI, LBuffer, LBufferSize, False);
      ReturnedInfoMemMapping.Write(LBuffer, LBufferSize, LStartPos);
      Inc(LStartPos, LBufferSize);
//      ReturnedInfoMemMapping.Write(@0, 1, StartPos);

      // Get memory information of all blocks.
      if (LVMI.BlocksCount > 1) and Detailed then
      begin
        for I := 0 to LVMI.BlocksCount - 1 do
        begin
          GetMemoryInformation(LVMI, LBuffer, LBufferSize, True);
          ReturnedInfoMemMapping.Write(LBuffer, LBufferSize, LStartPos);
          Inc(LStartPos, LBufferSize);

          // Get the base address of the next block.
          LAddress := Pointer(DWORD(LAddress) + LVMI.BlockSize);
          // Do not query the address after the last block of the region, which belongs to the next region.
          if I < LVMI.BlocksCount - 1 then
          begin
            FillChar(LVMI, SizeOf(LVMI), 0);
            LSentinal := VirtualMemoryQuery(LAddress, @LVMI, SizeOf(TVirtualMemoryInformation));
            if not LSentinal then break;
          end;
        end;
      end;
      // Get the base address of the next region.
      LAddress := Pointer(DWORD(LVMI.RegionBaseAddress) + LVMI.RegionSize);
    end;
    ReturnedInfo^.Size := LStartPos - 3;
    Result := True;
    if Assigned(ReturnedInfoMemMapping) then FreeAndNil(ReturnedInfoMemMapping);
  except
    on E: Exception do
      MessageDlg('Error when calling VirtualMemoryWalk.', mtError, [mbOk], 0);
  end;
end;

end.