delphi版内存搜索工具
主form源代码：
--------------------------------------------------------------------------------------------
unit UnitMemorySearch;
interface
uses
tlhelp32,strutils,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls;
type
TFrmMemory = class(TForm)
ListAdress: TListBox;
BtnFirst: TButton;
BtnNext: TButton;
Label1: TLabel;
Edvalue1: TEdit;
Label2: TLabel;
ComMod: TComboBox;
Label3: TLabel;
Edvalue2: TEdit;
Label4: TLabel;
Edname: TEdit;
Label5: TLabel;
ComTypes: TComboBox;
Label6: TLabel;
stList: TListBox;
Button1: TButton;
ProgressBar1: TProgressBar;
Edit1: TEdit;
Label7: TLabel;
BitBtn1: TBitBtn;
Labpro: TLabel;
Label8: TLabel;
Listgetadr: TListBox;
BtnAdd: TButton;
Label9: TLabel;
Edread: TEdit;
Label10: TLabel;
Edwrite: TEdit;
Label11: TLabel;
BtnWrite: TButton;
BtnRead: TButton;
Label12: TLabel;
LabTime: TLabel;
BtnSave: TButton;
ListVal: TListBox;
BtnAddVal1: TButton;
BtnAddval2: TButton;
BtnDelete: TButton;
BtnSaveVal: TButton;
BtnRAdd: TButton;
Timer1: TTimer;
CheckBox1: TCheckBox;
BtnProset: TButton;
labDebug: TLabel;
ListTask: TListBox;
BtnDelTask: TButton;
BtnAddTask: TButton;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
ComTask: TComboBox;
EdTaskAdr: TEdit;
EdTaskVal: TEdit;
Label17: TLabel;
BtnResume: TButton;
BtnRun: TButton;
BtnTaskSave: TButton;
Label18: TLabel;
procedure BtnFirstClick(Sender: TObject);
function GetmemoryValue(i,vsize:integer):integer;
function FindAdress(trvalue,olvalue:integer):boolean;
function FindAdress1(trvalue,olvalue:integer):boolean;
procedure BtnNextClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure ComModChange(Sender: TObject);
procedure ListAdressDblClick(Sender: TObject);
procedure BtnAddClick(Sender: TObject);
procedure BtnReadClick(Sender: TObject);
procedure BtnWriteClick(Sender: TObject);
procedure ListAdressClick(Sender: TObject);
procedure ListgetadrClick(Sender: TObject);
procedure BtnSaveClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtnAddVal1Click(Sender: TObject);
procedure BtnDeleteClick(Sender: TObject);
procedure BtnSaveValClick(Sender: TObject);
procedure BtnAddval2Click(Sender: TObject);
procedure ListValClick(Sender: TObject);
procedure ListValDblClick(Sender: TObject);
procedure BtnRAddClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure BtnProsetClick(Sender: TObject);
procedure SetCase;
procedure BtnDelTaskClick(Sender: TObject);
procedure BtnAddTaskClick(Sender: TObject);
procedure BtnRunClick(Sender: TObject);
procedure BtnResumeClick(Sender: TObject);
procedure BtnTaskSaveClick(Sender: TObject);
Private
{ Private declarations }
public
prohand,ProID:HWND;
SmodSize:integer;
minadr,maxadr:int64;
{ Public declarations }
end;
var
searchTime:integer=0;
mb,p:^char;
FrmMemory: TFrmMemory;
BaseAdr:int64=$00400000;
oldvalue,value,value2,Casei:integer;
implementation
uses unitprolist,UnitSet;
{$R *.dfm}
procedure RunPro;
var
i:integer;
begin
for i:=2 to 10 do
begin
frmmemory.ProgressBar1.Position:=i*10;
sleep(5);
end;
frmmemory.ProgressBar1.Position:=0;
end;
{//////////////////////GetmemoryValue}
function TFrmMemory.GetmemoryValue(i,vsize:integer):integer;
var
byte1,byte2,byte3,byte4:char;
TrueValue:integer;
begin
if vsize=1 then
begin
p:=mb;
inc(p,i);
result:=integer(P^);
end
else if vsize=2 then
begin
p:=mb;
inc(p,i);
byte1:=p^;
inc(p);
byte2:=p^;
TrueValue:=integer(byte1)+integer(byte2)*16*16;
result:=TrueValue ;
end
else if vsize=4 then
begin
p:=mb;
inc(p,i);
byte1:=p^;
inc(p);
byte2:=p^;
inc(p);
byte3:=p^;
inc(p);
byte4:=p^;
TrueValue:=integer(byte1)+integer(byte2)*16*16;
TrueValue:=TrueValue+integer(byte3)*16*16*16*16;
TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16;
result:=TrueValue;
end;
end;
/////////////////////////////////////////////////////////////
procedure TFrmMemory.SetCase;
begin
if commod.Text ='精确值'then
begin
Casei:=1;
end
else if commod.Text ='大于'then
begin
Casei:=2;
end
else if commod.Text ='小于'then
begin
Casei:=3;
end
else if commod.Text ='增加'then
begin
Casei:=4;
end
else if commod.Text ='减少'then
begin
Casei:=5;
end
else if commod.Text ='increased by'then
begin
Casei:=6;
end
else if commod.Text ='decreased by'then
begin
Casei:=7;
end
else if commod.Text ='between'then
begin
Casei:=8;
end ;
end;
function TFrmMemory.FindAdress(Trvalue,Olvalue:integer):boolean;{findadress}
begin
result:=false;
case Casei of
1:
begin
if trvalue=value then
result:=true;
end ;
2:
begin
if trvalue>value then
result:=true;
end;
3:
begin
if trvalue<value then
result:=true;
end;
4:
begin
if trvalue>olvalue then
result:=true;
end;
5:
begin
if trvalue<olvalue then
result:=true;
end;
6:
begin
if trvalue>olvalue then
result:=true;
end ;
7:
begin
if trvalue<olvalue then
result:=true;
end ;
8:
begin
if (trvalue>=value) and (trvalue<=value2) then
result:=true;
end ;
end;
end;{end findadress}
function TFrmMemory.FindAdress1(Trvalue,Olvalue:integer):boolean;{findadress}
begin
result:=false;
case Casei of
1:
begin
if trvalue=value then
result:=true;
end ;
2:
begin
if trvalue>value then
result:=true;
end;
3:
begin
if trvalue<value then
result:=true;
end;
4:
begin
if trvalue>olvalue then
result:=true;
end;
5:
begin
if trvalue<olvalue then
result:=true;
end;
6:
begin
if trvalue>olvalue then
result:=true;
end ;
7:
begin
if trvalue<olvalue then
result:=true;
end ;
8:
begin
if (trvalue>=value) and (trvalue<=value2) then
result:=true;
end ;
end;
end;{end findadress}
//////////////////////////////////////////////////////////////////
//通过EXE文件名获得指定可执行文件的进程ID
function FindProcessID(sName:string):THandle;
var
csH:THandle;
ps:TProcessEntry32;
iFlag:byte;
b:boolean;
begin
iFlag := 0;
result := 0;
csH := tlHelp32.CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
ps.dwSize := sizeof(TProcessEntry32);
try
b := tlHelp32.Process32First(csh,ps);
if b then
begin
while tlHelp32.Process32Next(csH,ps) do
begin
if pos(sName,strpas(ps.szExeFile)) > 0 then
begin
result := ps.th32ProcessID;
//showmessage(inttostr(result)+' '+inttostr(ps.th32ParentProcessID )+' '+inttostr(ps.cntThreads) ) ;
exit;
end;
end;
end;
finally
closeHandle(csH);
end;
end;{end function FindProcessID}
procedure TFrmMemory.BtnFirstClick(Sender: TObject);
var
Fname,isv:string;
ass,i,valsize:integer;
siz:Cardinal;
byte1,byte2,byte3,byte4:char;
TrueValue:integer;
begin
isv:=edvalue1.Text;
trim(isv);
if isv='' then exit;
value:=strtoint(edvalue1.Text );
value2:=strtoint(edvalue2.Text );
// showmessage(inttostr(value));
Fname:=edname.Text ;
BaseAdr:=minadr;
//////////// ///////////////////////////////
if btnfirst.Caption ='BtnFirst' then
begin
if value=0 then exit;
btnfirst.Caption :='NewSet';
btnnext.Enabled :=True;
progressbar1.Position:=20;
valsize:=strtoint(comtypes.Text);
comtypes.Enabled:=false;
end
else
begin
listadress.Clear ;
btnnext.Enabled :=False;
btnfirst.Caption :='BtnFirst';
comtypes.Enabled:=true;
labtime.Caption:='搜索次数：0' ;
exit;
end;
//////////////////////////////// /////////////
//BaseAdr:=$00400000; 2143289344
prohand:=openprocess($1F0FFF,false,proID);
if Prohand=0 then exit;
setcase;//设置全局变量 搜索类型
try
listadress.Clear ;
btnfirst.Enabled :=false;
mb:=AllocMem(SmodSize);
while BaseAdr<maxadr do
begin
readProcessMemory(prohand, pointer(Baseadr),mb,SmodSize,siz);
if siz>0 then
begin
p:=mb;
// inc(p,89990);
// listadress.Items.Add(inttohex(baseadr,8)+'--'+inttostr(byte(p^)));
byte1:=p^;
inc(p);
byte2:=p^;
inc(p);
byte3:=p^;
inc(p);
byte4:=p^;
case valsize of
4:begin
TrueValue:=integer(byte1)+integer(byte2)*16*16;
TrueValue:=TrueValue+integer(byte3)*16*16*16*16;
TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16;
end;
2: TrueValue:=integer(byte1)+integer(byte2)*16*16;
1: TrueValue:=integer(byte1);
end;
if findadress(truevalue,oldvalue) then listadress.Items.Add(inttohex(baseadr,8)+' '+inttostr(Truevalue));
// findadress(siz); truevalue=value
for i:=1 to siz-1 do
begin
byte1:=byte2;
byte2:=byte3;
byte3:=byte4;
inc(p);
byte4:=p^;
case valsize of
4:begin
TrueValue:=integer(byte1)+integer(byte2)*16*16;
TrueValue:=TrueValue+integer(byte3)*16*16*16*16;
TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16;
end;
2: TrueValue:=integer(byte1)+integer(byte2)*16*16;
1: TrueValue:=integer(byte1);
end;{end case}
if findadress(truevalue,oldvalue) then listadress.Items.Add(inttohex(baseadr+i,8)+' '+inttostr(Truevalue));
end;{end for}
end;
BaseAdr:=BaseAdr+SmodSize;
{ inc(p,88888);
ass:=byte(p^);
listadress.Items.Add(inttostr(ass));
listadress.Items.Add(inttohex(baseadr,8)+'_____ '+inttostr(siz));}
end;
finally
freemem(mb,SmodSize);
closehandle(Prohand);
label7.Caption:='搜索到记录：'+inttostr(listadress.Count);
runpro;
oldvalue:=value;
btnfirst.Enabled:=True;
searchtime:=1;
labtime.Caption:='搜索次数：'+inttostr(searchtime)+'次';
end;
end;
//////NEXT 查找事件代码！！！！！！！！！！！！！
procedure TFrmMemory.BtnNextClick(Sender: TObject);
var
Fname,isv:string;
oldadress,fi:int64;
TrueValue,i,value1,i2,i3,valsize:integer;
byte1,byte2,byte3,byte4:char;
siz:Cardinal;
begin
isv:=edvalue1.Text;
trim(isv);
if isv='' then exit;
value1:=strtoint(edvalue1.Text );
//showmessage(inttostr(value1));
Fname:=edname.Text ;
stlist.Items.Clear;
BaseAdr:=minadr;// 2143289344
prohand:=openprocess($1F0FFF,false,proID);
if Prohand=0 then exit;
setcase;
value:=strtoint(edvalue1.Text );
value2:=strtoint(edvalue2.Text );
progressbar1.Position:=20;
valsize:=strtoint(comtypes.Text);
try
btnfirst.Enabled :=false;
mb:=AllocMem(SmodSize);
i3:=listadress.Count-1;
readProcessMemory(prohand, pointer(Baseadr),mb,SmodSize,siz);
for i:=0 to i3 do
// while BaseAdr<$7FFFFFFF do
begin{for begin}
oldadress:=strtoint('$'+leftstr(listadress.Items.Strings[i],8));
oldvalue:=strtoint(midstr(listadress.Items.Strings[i],11,8 ));
fi:= oldadress-baseadr;
if fi>=(Smodsize-3) then
begin
while fi>=(Smodsize-3) do
begin
baseadr :=baseadr+SmodSize;
fi:=oldadress-baseadr;
end;
readProcessMemory(prohand, pointer(Baseadr),mb,SmodSize,siz);
end; {if fi>=89997 begin}
i2:=fi;
if siz>0 then
begin
p:=mb;
inc(p,i2);
byte1:=p^;
inc(p);
byte2:=p^;
inc(p);
byte3:=p^;
inc(p);
byte4:=p^;
case valsize of
4:begin
TrueValue:=integer(byte1)+integer(byte2)*16*16;
TrueValue:=TrueValue+integer(byte3)*16*16*16*16;
TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16;
end;
2: TrueValue:=integer(byte1)+integer(byte2)*16*16;
1: TrueValue:=integer(byte1);
end;
if findadress(truevalue,oldvalue) then stlist.Items.Add(leftstr(listadress.Items.Strings[i],8)+' '+inttostr(Truevalue));
// if truevalue=value1 then stlist.Items.Add(inttohex(oldadress,8)+' '+inttostr(Truevalue));
end; {if siz end}
end;{for end}
listadress.Items.Clear ;
i:= stlist.Items.Count-1;
for i3:=0 to i do
begin
Fname:= stlist.Items.Strings[i3];
listadress.Items.Add(Fname);
end;
finally
// lnowindex:=0;
freemem(mb,SmodSize);
closehandle(Prohand);
runpro;
label7.Caption:='搜索到记录：'+inttostr(listadress.Count);
btnfirst.Enabled:=True;
searchtime:=searchtime+1;
labtime.Caption:='搜索次数：'+inttostr(searchtime)+'次';
end;
end;
procedure TFrmMemory.Button1Click(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
begin
listgetadr.DeleteSelected;
//edit1.Text :=inttostr( listadress.SelCount) ;
//selvalue:=listadress.ItemIndex;
// listadress.Items.Delete(selvalue);
// listadress.Selected[1]:=true;
//selvalue:= listadress.Count;
//selstr:='$'+listadress.Items.Strings [selvalue];
// ffa:= strtoint('$'+listadress.Items.Strings [selvalue]);
//edit1.Text :=inttostr(ffa)
//edit1.Text :=listadress.Items.Strings [selvalue];
// edit1.Text := inttostr(selvalue);
end;
procedure TFrmMemory.BitBtn1Click(Sender: TObject);
begin
frmprolist.Show;
end;
procedure TFrmMemory.ComModChange(Sender: TObject);
begin
if commod.text='between' then
edvalue2.Enabled:=True
else
edvalue2.Enabled:=false;
end;
procedure TFrmMemory.ListAdressDblClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
begin
selvalue:=listadress.ItemIndex;
edit1.Text :=leftstr(listadress.Items.Strings [selvalue],8);
listgetadr.Items.Add(edit1.Text);
end;
procedure TFrmMemory.BtnAddClick(Sender: TObject);
var
st1:string;
ad1:int64;
begin
st1:=inputbox('添加地址','输入十六进制要加符号：$','$');
if (trim(st1)='') or (trim(st1)='$') then exit;
try
ad1:=strtoint(st1);
listgetadr.Items.Add(inttohex(ad1,8));
except
end;
end;
procedure TFrmMemory.BtnReadClick(Sender: TObject);
var
Readadr:int64;
Rvalue,size:integer;
siz:Cardinal;
begin
if trim(edit1.Text )='' then begin edname.Text:='失败!';exit; end;
if trim(edit1.Text )='' then begin edname.Text:='失败!';exit; end;
Rvalue:=0;
size:=strtoint(comtypes.Text);
Readadr:=strtoint('$'+edit1.Text);
prohand:=openprocess($1F0FFF,false,proID);
if Prohand=0 then if Prohand=0 then begin edname.Text:='失败!';exit; end;
try
readProcessMemory(prohand, pointer(Readadr),@Rvalue,size,siz);
edname.Text:='读取成功！';
finally
closehandle(prohand);
edread.Text :=inttostr(rvalue);
end;
end;
procedure TFrmMemory.BtnWriteClick(Sender: TObject);
var
Writeadr:int64;
Wvalue,size:integer;
siz:Cardinal;
begin
if trim(edWrite.Text )='' then begin edname.Text:='失败!';exit; end;
Wvalue:=strtoint(edwrite.Text);
size:=strtoint(comtypes.Text);
Writeadr:=strtoint('$'+edit1.Text);
prohand:=openprocess($1F0FFF,false,proID);
if Prohand=0 then begin edname.Text:='失败!';exit; end;
try
writeProcessMemory(prohand, pointer(Writeadr),@Wvalue,size,siz);
edname.Text:='修改成功';
finally
closehandle(prohand);
end;
end;
procedure TFrmMemory.ListAdressClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
begin
selvalue:=listadress.ItemIndex;
edit1.Text :=leftstr(listadress.Items.Strings [selvalue],8);
end;
procedure TFrmMemory.ListgetadrClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
begin
selvalue:=listgetadr.ItemIndex;
edit1.Text :=leftstr(listgetadr.Items.Strings [selvalue],8);
edtaskadr.Text:=edit1.text;
end;
procedure TFrmMemory.BtnSaveClick(Sender: TObject);
begin
listgetadr.Items.SaveToFile('SaveAdress.txt');
showmessage('保存成功!');
end;
procedure TFrmMemory.FormCreate(Sender: TObject);
begin
if fileexists('SaveAdress.txt')=True then
listgetadr.Items.LoadFromFile('SaveAdress.txt') ;
if fileexists('listval.txt')=True then
listval.Items.LoadFromFile('listval.txt') ;
if fileexists('listtask.txt')=True then
listtask.Items.LoadFromFile('listtask.txt') ;
Smodsize:=900000;
minadr:=$00400000;
maxadr:=$7DFFFFFF;
end;
procedure TFrmMemory.BtnAddVal1Click(Sender: TObject);
begin
listval.Items.Add(edwrite.Text );
end;
procedure TFrmMemory.BtnDeleteClick(Sender: TObject);
begin
listval.DeleteSelected;
end;
procedure TFrmMemory.BtnSaveValClick(Sender: TObject);
begin
listval.Items.SaveToFile('Listval.txt');
showmessage('保存成功！');
end;
procedure TFrmMemory.BtnAddval2Click(Sender: TObject);
var
st1:string;
ad1:int64;
begin
st1:=inputbox('添加地址','输入十六进制要加符号：$','$');
if (trim(st1)='') or (trim(st1)='$') then exit;
try
ad1:=strtoint(st1);
listval.Items.Add(inttostr(ad1));
except
end;
end;
procedure TFrmMemory.ListValClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
begin
selvalue:=listval.ItemIndex;
edname.Text :=listval.Items.Strings [selvalue];
edtaskval.Text:=edname.Text ;
end;
procedure TFrmMemory.ListValDblClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
begin
selvalue:=listval.ItemIndex;
edwrite.Text :=listval.Items.Strings [selvalue];
end;
procedure TFrmMemory.BtnRAddClick(Sender: TObject);
begin
listval.Items.Add(edread.Text );
end;
procedure TFrmMemory.Timer1Timer(Sender: TObject);
begin
try
BtnRunClick(Sender);
except
checkbox1.Checked :=false;
timer1.Enabled:=false;
end;
end;
procedure TFrmMemory.CheckBox1Click(Sender: TObject);
begin
if checkbox1.Checked =true then
begin
timer1.Enabled:=True;
end
else
begin
timer1.Enabled:=false;
end;
end;
procedure TFrmMemory.BtnProsetClick(Sender: TObject);
begin
frmset.Show;
end;
procedure TFrmMemory.BtnDelTaskClick(Sender: TObject);
begin
listtask.DeleteSelected;
end;
procedure TFrmMemory.BtnAddTaskClick(Sender: TObject);
var
Readadr:int64;
Rvalue,Wvalue,size:integer;
siz:Cardinal;
begin
if (Trim(edtaskadr.Text )='') or (Trim(edtaskval.Text)='') then exit;
Rvalue:=0;
size:=strtoint(comtask.Text);
wvalue:=strtoint(edtaskval.Text);
Readadr:=strtoint('$'+edtaskadr.Text);
prohand:=openprocess($1F0FFF,false,proID);
if Prohand=0 then
begin
listtask.Items.Add(inttohex(wvalue,8) +'--'+comtask.Text +'--'+format('%8d',[wvalue])+'--失败' );
exit;
end;
try
readProcessMemory(prohand, pointer(Readadr),@Rvalue,size,siz);
edname.Text:='读取成功！';
finally
closehandle(prohand);
listtask.Items.Add(inttohex(wvalue,8) +'--'+comtask.Text +'--'+format('%8d',[wvalue])+'--'+inttostr(rvalue) );
end;
end;
procedure TFrmMemory.BtnRunClick(Sender: TObject);
var
Writeadr:int64;
Wvalue,Flag,size,count:integer;
siz:Cardinal;
begin
prohand:=openprocess($1F0FFF,false,proID);
if Prohand=0 then begin edname.Text:='批量失败!';exit; end;
try
for count:=0 to listtask.Items.Count-1 do
begin
writeadr:=strtoint('$'+leftstr(listtask.Items.Strings[count],8));
size:= strtoint(midstr(listtask.Items.Strings[count],11,1));
wvalue:=strtoint(midstr(listtask.Items.Strings[count],14,8));
writeProcessMemory(prohand, pointer(Writeadr),@Wvalue,size,siz);
end;
finally
closehandle(prohand);
edname.Text:='批量修改成功';
end;{end try}
end;
procedure TFrmMemory.BtnResumeClick(Sender: TObject);
var
Writeadr:int64;
Wvalue,Flag,size,count:integer;
Loststr:string;
siz:Cardinal;
begin
prohand:=openprocess($1F0FFF,false,proID);
if Prohand=0 then begin edname.Text:='批量恢复失败!';exit; end;
try
for count:=0 to listtask.Items.Count-1 do
begin
writeadr:=strtoint('$'+leftstr(listtask.Items.Strings[count],8));
size:= strtoint(midstr(listtask.Items.Strings[count],11,1));
Loststr:=trim(midstr(listtask.Items.Strings[count],24,8));
if loststr<>'失败' then
begin
wvalue:=strtoint(loststr);
writeProcessMemory(prohand, pointer(Writeadr),@Wvalue,size,siz);
end;
end;
finally
closehandle(prohand);
edname.Text:='批量恢复成功';
end;{end try}
end;
procedure TFrmMemory.BtnTaskSaveClick(Sender: TObject);
begin
listtask.Items.SaveToFile('ListTask.txt');
showmessage('保存成功！');
end;
end.