unit1.pas

在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}
function DisplayProtections(ProtectFlag: DWORD):string;
begin
  case ProtectFlag of
    PAGE_READONLY:          result:='PAGE_READONLY';
    PAGE_READWRITE:         result:='PAGE_READWRITE';
    PAGE_WRITECOPY:         result:='PAGE_WRITECOPY';
    PAGE_EXECUTE:           result:='PAGE_EXECUTE';
    PAGE_EXECUTE_READ:      result:='PAGE_EXECUTE_READ';
    PAGE_EXECUTE_READWRITE: result:='PAGE_EXECUTE_READWRITE';
    PAGE_EXECUTE_WRITECOPY: result:='PAGE_EXECUTE_WRITECOPY';
    PAGE_GUARD:             result:='PAGE_GAURD';
    PAGE_NOACCESS:          result:='PAGE_NOACCESS';
    PAGE_NOCACHE:           result:='PAGE_NOCACHE';
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
type
  ArrayType = array[0..6000] of integer;
var
  Arrayptr: ^ArrayType;
  k: integer;
  MemInfo: TMemoryBasicInformation;
  OldProt: Integer;
  s:string;
begin
  Arrayptr := VirtualAlloc(NIL,SizeOf(ArrayType),
                MEM_RESERVE or MEM_COMMIT, PAGE_READONLY);
  if Arrayptr = nil then
  begin
    ShowMessage('分配内存失败');
    Exit;
  end;
  VirtualQuery(Arrayptr, MemInfo, SizeOf(TMemoryBasicInformation));
  ListBox1.Items.Add('基地址: '+IntToHex(Longint(MemInfo.BaseAddress),8));
  ListBox1.Items.Add('分配地址: '+IntToHex(Longint(
                      MemInfo.AllocationBase),8));
  ListBox1.Items.Add('区域大小: '+IntToStr(MemInfo.RegionSize)+' bytes');
  ListBox1.Items.Add('所分配保护属性: '+DisplayProtections(MemInfo.AllocationProtect));
  ListBox1.Items.Add('访问的保护属性: '+DisplayProtections(MemInfo.Protect));
  case MemInfo.State of
    MEM_COMMIT:  ListBox1.Items.Add('内存状态: MEM_COMMIT');
    MEM_FREE:    ListBox1.Items.Add('内存状态: MEM_FREE');
    MEM_RESERVE: ListBox1.Items.Add('内存状态: MEM_RESERVE');
  end;
  case MemInfo.Type_9 of
    MEM_IMAGE:   ListBox1.Items.Add('内存类型: MEM_IMAGE');
    MEM_MAPPED:  ListBox1.Items.Add('内存类型: MEM_MAPPED');
    MEM_PRIVATE: ListBox1.Items.Add('内存类型: MEM_PRIVATE');
  end;
  stringGrid1.RowCount:=(SizeOf(ArrayType)div sizeof(integer) +15) div 16;
  try
     for k:=0 to SizeOf(ArrayType)div sizeof(integer) -1 do
     begin
        Arrayptr^[k] := 1;
        StringGrid1.Cells[k mod 16,k div 16] := IntToStr(Arrayptr^[k]);
     end;
  except
     on E:Exception do
     begin
        s:='访问的保护属性是'+DisplayProtections(MemInfo.Protect)+'时写内存出错:'+E.Message;
        Showmessage(s);
        ListBox1.Items.Add(s);
     end;
  end;
  if not VirtualProtect(Arrayptr,SizeOf(ArrayType),
                        PAGE_READWRITE,@OldProt)
      then ShowMessage('修改保护属性出错!');
  VirtualQuery(Arrayptr, MemInfo, SizeOf(TMemoryBasicInformation));
  ListBox1.Items.Add('');
  ListBox1.Items.Add('新的访问保护属性: '+DisplayProtections(MemInfo.Protect));
  try
     for k:=0 to SizeOf(ArrayType)div sizeof(integer) -1 do
     begin
        Arrayptr^[k] := 2;
        StringGrid1.Cells[k mod 16,k div 16] := IntToStr(Arrayptr^[k]);
     end;
  except
     on E:Exception do
     begin
        s:='访问的保护属性是'+DisplayProtections(MemInfo.Protect)+'时写内存出错:'+E.Message;
        Showmessage(s);
        ListBox1.Items.Add(s);
     end;
  end;
  if not VirtualFree(Arrayptr, SizeOf(ArrayType), MEM_DECOMMIT)
    then ShowMessage('释放已提交的内存出错');
  if not VirtualFree(Arrayptr, 0, MEM_RELEASE)
    then ShowMessage('释放内存出错');
end;

end.