virtualallocu.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit VirtualAllocu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids;

type
  TForm1 = class(TForm)
    Button1: TButton;
    StringGrid1: TStringGrid;
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  procedure DisplayProtections(ProtectFlag: DWORD);

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
type
  ArrayType = array[0..6000] of integer;
var
  Arrayptr: ^ArrayType;              // pointer to buffer
  iLoop: integer;                    // loop counter
  MemInfo: TMemoryBasicInformation;  // query structure
  OldProt: Integer;
begin
  {allocate memory from the virtual address space for this array}
  Arrayptr := VirtualAlloc(nil,SizeOf(ArrayType),
         MEM_RESERVE or MEM_COMMIT,
         PAGE_READONLY);

  {check for errors}
  if Arrayptr = nil then
  begin
    ShowMessage('Error allocating array');
    Exit;
  end;

  {Examine the memory attributes}
  VirtualQuery(Arrayptr, MemInfo, SizeOf(TMemoryBasicInformation));

  {display information on the memory region}
  ListBox1.Items.Add('Base Address: '+IntToHex(Longint(MemInfo.BaseAddress),8));
  ListBox1.Items.Add('Allocation Base: '+IntToHex(Longint(MemInfo.AllocationBase),8));
  ListBox1.Items.Add('Region Size: '+IntToStr(MemInfo.RegionSize)+' bytes');
  ListBox1.Items.Add('Allocation Protection:');
  DisplayProtections(MemInfo.AllocationProtect);

  ListBox1.Items.Add('Access Protection:');
  DisplayProtections(MemInfo.Protect);

  case MemInfo.State of
    MEM_COMMIT:  ListBox1.Items.Add('State: MEM_COMMIT');
    MEM_FREE:    ListBox1.Items.Add('State: MEM_FREE');
    MEM_RESERVE: ListBox1.Items.Add('State: MEM_RESERVE');
  end;

  case MemInfo.Type_9 of
    MEM_IMAGE:   ListBox1.Items.Add('Type: MEM_IMAGE');
    MEM_MAPPED:  ListBox1.Items.Add('Type: MEM_MAPPED');
    MEM_PRIVATE: ListBox1.Items.Add('Type: MEM_PRIVATE');
  end;

  {Change the protection attributes on the memory block}
  if not VirtualProtect(Arrayptr,SizeOf(ArrayType),
              PAGE_READWRITE,@OldProt)
      then ShowMessage('Error modifying protection');

  {Re-examine the memory attributes}
  VirtualQuery(Arrayptr, MemInfo, SizeOf(TMemoryBasicInformation));

  {display new access protection}
  ListBox1.Items.Add('New Access Protection:');
  DisplayProtections(MemInfo.Protect);

  {do something with the address space}
  for iLoop := 0 to 6000 do
  begin
    Arrayptr^[iLoop] := iLoop;
    StringGrid1.Cells[iLoop,0] := IntToStr(Arrayptr^[iLoop]);
  end;

  {decommit the memory and release the memory block}
  if not VirtualFree(Arrayptr, SizeOf(ArrayType), MEM_DECOMMIT)
    then ShowMessage('Error decommitting memory');

  if not VirtualFree(Arrayptr, 0, MEM_RELEASE)
    then ShowMessage('Error releasing memory');
end;

procedure DisplayProtections(ProtectFlag: DWORD);
begin
  case ProtectFlag of
    PAGE_READONLY:          Form1.ListBox1.Items.Add(' PAGE_READONLY');
    PAGE_READWRITE:         Form1.ListBox1.Items.Add(' PAGE_READWRITE');
    PAGE_WRITECOPY:         Form1.ListBox1.Items.Add(' PAGE_WRITECOPY');
    PAGE_EXECUTE:           Form1.ListBox1.Items.Add(' PAGE_EXECUTE');
    PAGE_EXECUTE_READ:      Form1.ListBox1.Items.Add(' PAGE_EXECUTE_READ');
    PAGE_EXECUTE_READWRITE: Form1.ListBox1.Items.Add(' PAGE_EXECUTE_READWRITE');
    PAGE_EXECUTE_WRITECOPY: Form1.ListBox1.Items.Add(' PAGE_EXECUTE_WRITECOPY');
    PAGE_GUARD:             Form1.ListBox1.Items.Add(' PAGE_GAURD');
    PAGE_NOACCESS:          Form1.ListBox1.Items.Add(' PAGE_NOACCESS');
    PAGE_NOCACHE:           Form1.ListBox1.Items.Add(' PAGE_NOCACHE');
  end;
end;

end.