前言:
用来改进程内容不定是游戏,不过有bug.在选则string方式时只能查一次.{由于mode 5的代码出错}
其他的方式无此影响而且可以连续查找间隔符为空格.如查byte型12 34 12.
[不愿改了,好几年的了--英雄无敌二时编写]
ding固定用.
Findproc只是一个查找用的库无其它用处,不贴了.下面出的4000 5000 ...等等为出错吗.
相关应用下载在. go.163.com/~pcbs/gb.zip
主叶已deltree了.hehe -(
下为原码.(太次了,非结构化)(大家随便用,改,删除)
/***********************************************************************************/
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,tlhelp32,Findproc, ExtCtrls, Grids;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
ComboBox1: TComboBox;
Button2: TButton;
Button4: TButton;
Edit2: TEdit;
Label3: TLabel;
ComboBox2: TComboBox;
Label4: TLabel;
Button3: TButton;
Button5: TButton;
Timer1: TTimer;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
Processlist : array[0..100] of Dword;
//100
buf : array[1..$1100] of byte;
Findaddr : Array[0..$5100] of DWORD;
//最多$5000个
Processbase : DWord;
Findnum : Dword;
index : integer;
mode : integer;
{ Private declarations }
procedure show;
function strtohex(str : string)
WORD;
function write(ptr : DWORD):boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
p :Thandle;
k :TPROCESSENTRY32;
processnum : integer;
begin
Listbox1.Clear ;
Processnum:=1;
k.dwSize :=sizeof(k);
p:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
if not PROCESS32First(p,k) then
begin
showmessage('error F');exit;
end;
Processlist[processnum]:=k.th32processid;
listbox1.Items.Add(k.szExefile+format(' [%x]',[k.th32ProcessID]));
while PROCESS32next(p,k)do
begin
listbox1.Items.Add(k.szExefile+format(' [%x]',[k.th32ProcessID]));
inc(Processnum);
Processlist[processnum]:=k.th32processid;
end;
closehandle(p);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
index:=500;
mode:=1;
Findnum:=0;
processbase:=0;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
T :Thandle;
m :TMemoryBasicInformation;
k
word;
tt
word;
kk
WORD;
tempptr : pointer;
temp : DWord;
i,j,n : Dword;
tempaddr : Array[0..$100] of DWORD;
enterlen : dword;
tempenter : array[0..100] of byte;
templen : dword;
begin
if index>100 then
exit;
button2.enabled:=false;
k:=processbase;
t:=openprocess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ or PROCESS_VM_WRITE
or PROCESS_VM_OPERATION or PROCESS_ALL_ACCESS,False,Processlist[index]);
if findnum>0 then
begin
templen:=0;
enterlen:=transfer(edit1.text,@tempenter[0],mode);
if (enterlen>250) or (enterlen<1) then
begin
showmessage('Enter error');closehandle(t);
button2.enabled:=true;exit;
end;
for i:=0 to findnum-1do
begin
tempptr:=pointer(findaddr
);
kk:=0;
if not readprocessmemory(t,tempptr,@buf[1],enterlen,kk) then
begin
{ showmessage('Error Read');
closehandle(t);
button2.enabled:=true;
exit;}
continue;
end;
for j:=0 to enterlen-1do
if buf[j+1]<>tempenter[j] then
break;
if j>=enterlen then
begin
tempaddr[templen]:=findaddr;
inc(templen);
end;
end;
for i:=0 to templendo
begin
findaddr:=tempaddr;
findnum:=templen;
end;
showmessage(inttostr(templen));
combobox1.Clear;
if findnum>0 then
show;
closehandle(t);
button2.enabled:=true;
exit;
end;
tempptr:=pointer(k);
while VirtualQueryEx(t,tempptr,m,sizeof(m))<>0do
begin
if ((m.State=MEM_COMMIT) and (m.Protect =PAGE_READWRITE)) then
begin
tt:=(m.RegionSize div $1000);
j:=0;
while j<ttdo
begin
n:=DWORD(m.BaseAddress)+j*$1000;
tempptr:=pointer
;
kk:=0;
if not readprocessmemory(t,tempptr,@buf[1],$1000,kk) then
begin
continue;
{showmessage('Error Read');
closehandle(t);
button2.enabled:=true;
exit;}
end;
temp:=searcharray(edit1.text,addr(buf[1]),$1000,addr(Findaddr[findnum]),mode);
if ((temp=$4000) or (temp=$5000) or (temp=$6000) or (temp=$7000)) then
begin
showmessage('Error Enter ...');closehandle(t);button2.enabled:=true;
exit;
end;
for i:=0 to tempdo
inc(findaddr[findnum+i],k+j*$1000);
if (findnum)>$4000 then
begin
showmessage('too much');closehandle(t);show;button2.enabled:=true;exit;
end;
if temp>$1000 then
begin
showmessage('Find too much');findnum:=$1001;closehandle(t);show;button2.enabled:=true;exit;
end;
if (findnum+temp)>$4000 then
findnum:=$4001
else
inc(findnum,temp);
inc(j);
end;
end;
k:=m.RegionSize +dword(m.baseaddress);
tempptr:=pointer(k);
end;
showmessage(inttostr(findnum));
if findnum>0 then
show;
closehandle(t);
button2.enabled:=true;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
str : string;
begin
str:='Find : Only can Find Numbers in Mem'+#13+#10+
'Write: Only can Write Number to Mem'+#13+#10+
'List : List All The Process in Mem'+#13+#10+
' Made by Pcb,演示如何读写内存'+#13+#10+
' E_Mail: pcb@eyou.com'+#13+#10+
'If you find Bug,Don''t crazy!.It Only is a 演示.'+#10+
'you can rewrite it.';
messagebox(self.handle,pchar(str),'Help',MB_OK);
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
case combobox2.ItemIndex of
0 :
mode:=1;
//byte
1 :
mode:=2;
//word
2 :
mode:=4;
//dword
3 :
mode:=5;
//String 也许此处出错.mode=3...
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
findnum:=0;
combobox1.Clear ;
button2.Enabled :=true;
end;
procedure TForm1.show;
var
i : integer;
begin
combobox1.clear;
for i:=0 to findnum-1do
combobox1.Items.Add(Format('%x',[findaddr]));
end;
procedure TForm1.Button4Click(Sender: TObject);
VAR
P : dword;
begin
P:=STRTOHEX(COMBOBOX1.TEXT);
IF(NOT WRITE(P)) then
begin
checkbox1.checked:=false;
SHOWMESSAGE('Write Error');
end;
end;
function TForm1.strtohex(str: string): DWORD;
var
i,j,m : integer;
temp,k : DWORD;
begin
i:=length(str);
j:=1;k:=0;
while(j<i+1)do
begin
case str[j] of
'0'..'9':
begin
temp:=1;
for m:=1 to (i-j)do
temp:=16*temp;
temp:=temp*DWORD(strtoint(str[j]));
k:=k+temp;
end;
'A'..'F':
begin
temp:=1;
for m:=1 to (i-j)do
temp:=16*temp;
temp:=temp*DWORD(ord(str[j])-ord('A')+10);
k:=k+temp;
end;
'a'..'f':
begin
temp:=1;
for m:=1 to (i-j)do
temp:=16*temp;
temp:=temp*DWORD(ord(str[j])-ord('a')+10);
k:=k+temp;
end;
else
begin
result:=0;
exit;
end;
end;
inc(j);
end;
result:=k;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
p : Thandle;
k : TMODULEENTRY32;
i : integer;
begin
if(index<>listbox1.itemindex+1) then
begin
index:=listbox1.ItemIndex+1;
combobox1.Clear;
k.dwSize :=sizeof(k);
p:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,processlist[index]);
if not MODULE32First(p,k) then
begin
showmessage('error M');exit;
end;
i:=strlen(k.szmodule);
i:=i-1;
if((k.szModule='E')and(k.szmodule[i-1]='X')and(k.szmodule[i-2]='E'))then
processbase:=k.hModule ;
while MODULE32next(p,k)do
begin
i:=strlen(k.szmodule);
i:=i-1;
if((k.szModule='E')and(k.szmodule[i-1]='X')and(k.szmodule[i-2]='E'))then
processbase:=k.hModule ;
end;
closehandle(p);
end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if(checkbox1.checked) then
begin
timer1.enabled:=true;
end
else
timer1.enabled:=false;
end;
function TForm1.write(ptr: DWORD): boolean;
var
T : Thandle;
d : array[1..100] of byte;
i : integer;
kk : Dword;
tempptr : pointer;
begin
i:=0;
result:=false;
if (mode<>5) then
i:=transfer(edit2.text,@d[1],mode);
if (mode=5) then
i:=trans(edit2.text,@d[1]);
if (i>255) or (i<1) then
exit;
t:=openprocess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ or PROCESS_VM_WRITE
or PROCESS_VM_OPERATION or PROCESS_ALL_ACCESS,False,Processlist[index]);
kk:=0;tempptr:=pointer(ptr);
if not writeprocessmemory(t,tempptr,@d[1],i,kk) then
begin
closehandle(t);
exit;
end;
closehandle(t);
result:=TRUE;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if(checkbox1.checked)then
button4click(nil);
end;
end.
