unit2.pas

delphi内存修改控件

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Tlhelp32, ComCtrls;

type
  pint=^integer;
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    ListView1: TListView;
    Button3: TButton;
    Panel1: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    Button2: TButton;
    Edit3: TEdit;
    Button4: TButton;
    Label6: TLabel;
    Label7: TLabel;
    Edit4: TEdit;
    GroupBox2: TGroupBox;
    ListBox1: TListBox;
    Button5: TButton;
    Label1: TLabel;
    sb1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit4KeyPress(Sender: TObject; var Key: Char);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure Button5Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const bSize=1024;
var
  Form1: TForm1;
  pc,pcbak:integer;//相符地址数组尾指针,//多次查找时做前者备份
  found:array[1..65535] of pointer;//相符地址数组
  fBak :array[1..65535] of pointer;//多次查找时做上述备份

  first:boolean; //是否第一次查找？
  sysinfo:SYSTEM_INFO;
  hProc:dword;
implementation

{$R *.dfm}

procedure GetProc();
var
  sProc:PROCESSENTRY32;
  hSnap:dword;
  ok:bool;
begin
  Form1.ListView1.Clear;
  sProc.dwSize:=SizeOf(sProc);
  hSnap:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
  ok:=Process32First(hSnap,sProc);
  While ok do
    begin
      With Form1.ListView1.Items.Add do
        begin
          Caption:=sProc.szExeFile;
          SubItems.Add(IntToHex(sproc.th32ProcessID,0));
        end;
      ok:=Process32Next(hSnap,sProc);
    end;
  CloseHandle(hSnap);
  if Form1.ListView1.Items.Count<>0 then
    Form1.ListView1.Items.Item[0].Selected:=true;
end;

{//在4k内存中查找符合指定数值的内存单元地址，返回值说明读入内存块是否成功
function FindMemBlock(PH:Thandle;add:pointer;v:integer):boolean;
var                  //进程句柄，起始地址，需要查找的数值
  i,t:integer;//计数器
  Buffer:array[1..bSize] of byte;//用来装4KB的内存块
  ok:boolean;//装入内存块是否成功
  LPDW:DWORD;
begin
  ok:=ReadProcessMemory(PH,add,pointer(@(buffer[1])),bSize,Lpdw);
  if ok then //读取成功 ^_^
  begin
    for i:=1 to bSize do
    begin
      t:=(pint(@(buffer[i])))^;
      if t=V then//找到
      begin
        pc:=pc+1;
        found[pc]:=pointer(dword(add)+i-1);   //保存地址
      end;
    end;
    result:=true;
   end
   else //读取失败 :(
   begin
//     showmessage(inttohex(dword(add)+i-1,0));
     Result:=false;
   end;
end;}

function FindMemBlock(PH:Thandle;add:pointer;v:integer):boolean;
var                  //进程句柄，起始地址，需要查找的数值
  i:integer;//计数器
  Buffer:array[1..bSize] of byte;//用来装4KB的内存块
  p: PInteger; // (beta)
  ok:boolean;//装入内存块是否成功
  LPDW:DWORD;
begin
  ok:=ReadProcessMemory(PH,add,pointer(@(buffer[1])),bSize,Lpdw);
  if ok then //读取成功 ^_^
  begin
    p := @Buffer[1]; // (beta)
    for i:= 1 to bSize div 4 do // 每次递增 4 个字节，可以少找很多次(beta)
    begin
      if p^ = V then//找到
      begin
        pc:=pc+1;
        found[pc]:= Pointer(Integer(p) - Integer(@Buffer[1]) + Integer(add));
      end;
      Inc(p); // 每次递增 4 个字节，因为变量几乎肯定是 4 字节对齐的(beta)
    end;
    result:=true;
   end
   else //读取失败 :(
   begin
//     showmessage(inttohex(dword(add)+i-1,0));
     Result:=false;
   end;
end;

//将V写到指定进程指定位置，返回值代表写入是否成功
function writeMemory(PH:Thandle;Add:pointer;V:integer):boolean;
var
  ok:boolean;
  LPDW:DWORD;
begin
  ok:=WriteProcessMemory(PH,Add,pointer(@V),4,LPDW);
  if ok then Result:=True
  else Result:=False;
end;
//取得指定进程指定位置处数值
function getAddressV(PH:Thandle;Add:pointer;var V:integer):boolean;
var
  ok:boolean;
  LPDW:DWORD;
begin
  ok:=readProcessMemory(PH,add,pointer(@V),4,LPDW);
  if ok then Result:=True
  else Result:=False;
end;

procedure showlist();
var
  i:Integer;
begin
  Form1.ListBox1.Clear;
  for i:=1 to pc do
  begin
    Form1.ListBox1.Items.Add(IntTohex(DWORD(found[i]),8));
  end;
  if Form1.ListBox1.Count<>0 then
    begin
      form1.Label1.Caption:=inttostr(form1.listbox1.Count);
      Form1.ListBox1.Selected[0]:=true;
      Form1.edit2.Text:='0x'+Form1.Listbox1.Items.Strings[0];
    end
  else
    begin
      form1.Label1.Caption:='';
      Form1.edit2.Text:='';
    end;
end;

procedure TForm1.Button1Click(Sender:TObject);
var
i,test,V:integer;
j,e:Dword;

begin
   //只是简单考虑非法输入啊！！请不要输入太大的数值！！！
  if edit1.Text='' then
  begin
    showmessage('不可为空！');
    exit;
  end;
  if edit3.Text='' then exit;
    hProc:=OpenProcess(PROCESS_ALL_ACCESS,false,strtoint(edit3.text));

//  GetSystemInfo(sysinfo);

  V:=StrToInt(Edit1.Text);
  if first then //是第一次查找
  begin
    pc:=0;
    first:=false;
//查找从4M至2G的地址空间
  //for i:=4M to 2G do
    j:=4*1024*1024;
    {e:=2*1024*1024;
    e:=e*1024;}
    e:=6*1024*1024; // 不要找得太远，一个 exe 能映射多大？(beta)
//    j:=dword(sysinfo.lpMinimumApplicationAddress);
//    e:=dword(sysinfo.lpMaximumApplicationAddress);
    while true do
    begin
      if j>e then break;
      if FindMemBlock(hProc,pointer(j),V) then
        sb1.SimpleText:='读入成功'
      else
        sb1.SimpleText:='读入失败';
      j:=j+bSize;  //下一个4KB
    end;
  end
  else   //第n次查找
  begin
   //先备份
    pcbak:=pc;
    for i:=1 to pc do
    begin
      fBak[i]:=found[i];
    end;
    //再比较
    pc:=0;
    for i:=1 to pcbak do
      if GetAddressV(hProc,fBak[i],Test) then //读取成功
      begin
        if test=V then //相符
        begin
          pc:=pc+1;
          found[pc]:=fBak[i];
        end;
      end;
  end;
  showlist();//显示地址列表到listBox1中

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
     //只是简单考虑非法输入啊！！请不要输入太大的数值！！！
  if edit4.Text='' then
  begin
    showmessage('不可为空！');
    exit;
  end;
  if edit2.text='' then exit;
      if MessageDlg('真的修改？',MtWarning,MbOKCancel,0)=MrCancel then exit;
  if WriteMemory(hProc,pointer(strtoint(edit2.text)),strtoint(Edit4.Text))
  then  sb1.SimpleText:='修改成功！'
  else  sb1.SimpleText:='修改失败！';
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if (key>'9')or(key<'0') then key:=#0;
end;
procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
  if (key>'9')or(key<'0') then key:=#0;
end;
procedure TForm1.FormCreate(Sender:TObject);
begin
first:=true;
GetProc;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
  first:=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  GetProc;
end;

procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  Edit3.Text:='0x'+Item.SubItems.Strings[0];
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  edit2.Text:='0x'+Listbox1.Items.Strings[listbox1.itemindex];
end;

end.