unit1.pas

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

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ComboBox1: TComboBox;
    MaskEdit1: TMaskEdit;
    Label1: TLabel;
    Label2: TLabel;
    MaskEdit2: TMaskEdit;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    IsLoad: boolean;
    FSnapshotHandle: THandle;
    function GetProcessID(var List: TStringList; FileName: string = ''): TProcessEntry32;
  end;

var
  Form1: TForm1;
implementation

{$R *.DFM}

function HexToInt(HexStr: string): Int64;
var RetVar: Int64;
  i: byte;
begin
  HexStr := UpperCase(HexStr);
  if HexStr[length(HexStr)] = 'H' then
    Delete(HexStr, length(HexStr), 1);
  RetVar := 0;
  for i := 1 to length(HexStr) do begin
    RetVar := RetVar shl 4;
    if HexStr[i] in ['0'..'9'] then
      RetVar := RetVar + (byte(HexStr[i]) - 48)
    else
      if HexStr[i] in ['A'..'F'] then
        RetVar := RetVar + (byte(HexStr[i]) - 55)
      else begin
        Retvar := 0;
        break;
      end;
  end;

  Result := RetVar;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FProcessEntry32: TProcessEntry32;
  ProcessID: integer;
  ProcessHandle: THandle;
  lpBuffer: pchar;
  nSize: DWORD;
  lpNumberOfBytes: DWORD;
  i: integer;
  addr:dword;
  s: string;
  List: TStringList;
  mbi_thunk:TMemoryBasicInformation;
  dwOldProtect:dword;  
begin
  if Combobox1.itemindex = -1 then exit;
  List := TStringList.Create;
  FProcessEntry32 := GetProcessID(List, Combobox1.text);
  if FProcessEntry32.th32ProcessID=0 then exit;
  ProcessID := FProcessEntry32.th32ProcessID;
  Memo1.Lines.Clear;
  memo1.lines.add('Process ID ' + IntToHex(FProcessEntry32.th32ProcessID, 8));
  memo1.lines.Add('File name ' + FProcessEntry32.szExeFile);

  ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessID);
  memo1.Lines.Add('Process Handle ' + intTohex(ProcessHandle, 8));
  Memo1.Lines.Add('虚拟内存中的数据:');
  addr:=HexToInt(MaskEdit1.text);
  nSize:=HexToInt(MaskEdit2.text)-addr+1;
  if HexToInt(MaskEdit2.text)>addr then
  begin
     lpBuffer := AllocMem(nSize);
     if(not ReadProcessMemory(ProcessHandle, Pointer(addr), lpBuffer, nSize, lpNumberOfBytes))
        or(nSize<>lpNumberOfBytes) then
     begin
        showmessage('读数据出错，可能是指定的地址不存在.');
        exit;
     end;
     s:='';
     for i :=0  to nSize-1 do
     begin
       s := s + format('%.2X ',[ord(lpBuffer[i])]);
       {读取内容}
       if ((i mod 16 ) = 15)or(i=nSize-1) then
       begin
          Memo1.Lines.Add(s);
          s := '';
       end;
     end;
     VirtualQueryEx(ProcessHandle,Pointer(addr),mbi_thunk, sizeof(TMemoryBasicInformation));
     VirtualProtectEx(ProcessHandle,Pointer(addr),nSize,PAGE_EXECUTE_READWRITE,mbi_thunk.Protect);
     if(not WriteProcessMemory(ProcessHandle, Pointer(addr), lpBuffer, nSize, lpNumberOfBytes))
         then
     begin
        showmessage('写数据出错，可能是该地址不允许写。如果该处不是Rom，可以通过Ring0或其它特权写该内存。');
     end;
     VirtualProtectEx(ProcessHandle,Pointer(addr), nSize, mbi_thunk.Protect,dwOldProtect);
     FreeMem(lpBuffer, nSize);
  end;
  CloseHandle(ProcessHandle);
  List.free;
end;

function Tform1.GetProcessID(var List: TStringList; FileName: string = ''): TProcessEntry32;
var
  Ret: BOOL;
  s: string;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  Ret := Process32First(FSnapshotHandle, FProcessEntry32);
  while Ret do
  begin
    s := ExtractFileName(FProcessEntry32.szExeFile);
    if (FileName = '') then
    begin
      List.Add(Pchar(s));
    end
    else if (AnsiCompareText(Trim(s),Trim(FileName))=0) and (FileName <> '') then
    begin
      List.Add(Pchar(s));
      result := FProcessEntry32;
      break;
    end;
    Ret := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  List: TStringList;
  i: integer;
begin
  Combobox1.clear;
  List := TStringList.Create;
  GetProcessID(List);
  for i := 0 to List.Count - 1 do
  begin
    Combobox1.items.add(Trim(List.strings[i]));
  end;
  List.Free;
  Combobox1.itemindex := 0;
end;

end.