爱资料logo
主页 > 编程资料 > Delphi >

Delphi 动态内存查找法

发布时间：2015-09-22 作者：网络 阅读：99次

unit Unit1;

interface

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

type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
Memo1: TMemo;
sb1: TStatusBar;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Edit1: TEdit;
ck1: TCheckBox;
Label1: TLabel;
Ba1: TTrackBar;
Label3: TLabel;
Label4: TLabel;
Edit2: TEdit;
Label5: TLabel;
Label6: TLabel;
Timer1: TTimer;
Edit3: TEdit;
Timer2: TTimer;
Timer3: TTimer;
Timer4: TTimer;
Edit4: TEdit;
Label2: TLabel;
Edit5: TEdit;
Label7: TLabel;
Timer5: TTimer;
ck2: TCheckBox;
Timer6: TTimer;
Edit6: TEdit;
Label8: TLabel;
Edit7: TEdit;
Edit8: TEdit;
Button6: TButton;
SkinData1: TSkinData;
CoolTrayIcon1: TCoolTrayIcon;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
Label9: TLabel;
Timer7: TTimer;
ck3: TCheckBox;
Label10: TLabel;
Button7: TButton;
MainMenu1: TMainMenu;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
Edit9: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Ba1Change(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure Timer4Timer(Sender: TObject);
procedure Timer5Timer(Sender: TObject);
procedure Timer6Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure CoolTrayIcon1Click(Sender: TObject);
procedure Timer7Timer(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure ck3Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N10Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function KillTask(ExeFileName: string): Integer;
end;
const bSize=1024;
var
Form1: TForm1;
h_cal:hwnd;//窗口
hProc:dword;//进程id
s_proc:string;//进程id
first:boolean; //是否第一次查找
pc,pcbak:integer;//相符地址数组尾指针,//多次查找时做前者备份
found:array[1..65535] of pointer;//相符地址数组
fBak :array[1..65535] of pointer;//多次查找时做上述备份

sysinfo:SYSTEM_INFO;
m_add1,m_add2:string;
bb:boolean;
query_thread_handle1, query_thread_handle2, query_thread_handle3: THandle;
implementation

{$R *.dfm}
procedure jiant;//检测主窗口
var
aproc:dword;
begin
aproc:=0;
h_cal:=FindWindow(0,pchar('Element Client'));
if h_cal=0 then
begin
form1.Memo1.Lines.Add('没发现游戏窗口!');
end else
begin
GetWindowThreadProcessId(h_cal,aproc);
s_proc:='0x'+IntToHex(aproc,0);
if aproc<> 0 then
form1.Memo1.Lines.Add('发现游戏.请稍后...');
end;



end;

function dob(str1:string;str2:string):boolean;
begin

if (str2='0'+inttohex(StrToInt64('$'+str1)+24,0))then
begin
result:=true;
end else
begin
result:=false;
end;
end;
function doaddtoint(m_str1:string):integer;
var
ok:boolean;
LPDW:DWORD; //整数
Buffer:array[1..bSize] of byte;//用来装4KB的内存块
i,t:integer;
begin

ok:=readProcessMemory(hProc,pointer(strtoint('$'+m_str1)),pointer(@(buffer[1])),4,LPDW);
if ok then //读取成功 ^_^
begin

t:=(pint(@(buffer[1])))^;
result:=t;

end else
result:=0;
end;

function doaddtointdd(m_str1:string;m_str2:string):boolean;
var
ok:boolean;
LPDW:DWORD; //整数
Buffer:array[1..bSize] of byte;//用来装4KB的内存块
i,t:integer;
begin

ok:=readProcessMemory(hProc,pointer(strtoint('$'+m_str1)+4),pointer(@(buffer[1])),4,LPDW);
if ok then //读取成功 ^_^
begin

t:=(pint(@(buffer[1])))^;


end;
ok:=readProcessMemory(hProc,pointer(strtoint('$'+m_str2)+4),pointer(@(buffer[1])),4,LPDW);
if ok then //读取成功 ^_^
begin

i:=(pint(@(buffer[1])))^;


end;
if t=i then
begin
result:=true;

end else
begin
result:=false;
end;
end;
procedure Query(); stdcall;
var
i,t,test,V:integer;
j,e:Dword;
Buffer:array[1..bSize] of byte;//用来装4KB的内存块
ok:boolean;//装入内存块是否成功
LPDW:DWORD;
m_addl_temp:string;
begin
hProc:=OpenProcess(PROCESS_ALL_ACCESS,false,strtoint(s_proc)); //以读的方法打开进程
V:=StrToInt(form1.Edit2.Text ); //
if first then //是第一次查找
begin
pc:=0; //原来是要为findmemblock作准备的
first:=false;
j:=40*1024*1024;
e:=1*1024*1024;
e:=e*500;


while true do
begin
if j>e then break;
ok:=ReadProcessMemory(hProc,pointer(j),pointer(@(buffer[1])),bSize,Lpdw);
if ok then //读取成功 ^_^
begin
form1.sb1.SimpleText:='取游戏资料成功 稍等1分钟..'+inttostr(pc);
for i:=1 to bSize do
begin
t:=(pint(@(buffer)))^;

if t=V then//找到
begin
pc:=pc+1;
found[pc]:=pointer(dword(pointer(j))+i-1); //保存地址
if(doaddtointdd(IntTohex(DWORD(found[pc-1]),8),IntTohex(DWORD(found[pc]),8))=true) then
begin


if dob(IntTohex(DWORD(found[pc-1]),8),IntTohex(DWORD(found[pc]),8))=true then
begin

m_add1:=IntTohex(DWORD(found[pc-1]),8);

form1.Label5.Caption :=inttostr(doaddtoint(m_add1));
form1.Label5.Font.Color:=clred;
form1.Label6.Font.Color:=clred;
form1.Ba1.Max:=doaddtoint(m_add1);
form1.Ba1.Position:=Trunc(doaddtoint(m_add1) / 2);
form1.Memo1.Lines.Add('初始化血量成功!');
m_add2:='0'+inttohex(StrToInt64('$'+m_add1)+4,0);
form1.Label6.Caption :=inttostr(doaddtoint(m_add2));
form1.Memo1.Lines.Add('初始化蓝量成功!');
form1.sb1.SimpleText:='初始化完成! 点-->启动-->开启外挂';
form1.button1.Enabled :=false;
form1.button2.Enabled :=true;

form1.button4.Enabled :=true;
form1. button5.Enabled :=true;
exit;
end;
end;
end;
end;


end else
begin

form1.sb1.SimpleText:='读取......不到...请稍等...';
end;
j:=j+bSize;
end;

end;

form1.sb1.SimpleText:='完成。。。开启失败~!';
TerminateThread(query_thread_handle1, 0);

end;
procedure TForm1.Button1Click(Sender: TObject);
var
query_thread_id: Cardinal;
ix: integer;
begin
jiant;
query_thread_handle1 := CreateThread(nil, 0, @Query, nil, 0, query_thread_id);

end;

procedure TForm1.Button4Click(Sender: TObject);
begin
first:=true;
button1.Enabled :=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
first:=true;
bb:=true;
ba1.Position:=1;
form1.sb1.SimpleText:='说明:检测前确保角色的 红和 蓝值是满的.';
button2.Enabled :=false;
button3.Enabled :=false;
button4.Enabled :=false;
button5.Enabled :=false;

end;

procedure TForm1.Ba1Change(Sender: TObject);
begin
edit2.Text:=inttostr(ba1.Position);
end;

procedure TForm1.Timer3Timer(Sender: TObject);
begin
timer2.Enabled :=false;
SendMessage(h_cal,WM_KEYDOWN,vk_f5,0);
SendMessage(h_cal,WM_KEYUP,vk_f5,0);
sleep(1500);
timer2.Enabled :=true;
end;

procedure TForm1.Timer4Timer(Sender: TObject);
begin
if ck1.Checked=true then
begin
SendMessage(h_cal,WM_KEYDOWN,vk_tab,0);
SendMessage(h_cal,WM_KEYUP,vk_tab,0);
end;
end;

procedure TForm1.Timer5Timer(Sender: TObject);
begin
SendMessage(h_cal,WM_KEYDOWN,vk_f6,0);
SendMessage(h_cal,WM_KEYUP,vk_f6,0);
end;

procedure TForm1.Timer6Timer(Sender: TObject);
begin
SendMessage(h_cal,WM_KEYDOWN,vk_f7,0);
SendMessage(h_cal,WM_KEYUP,vk_f7,0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
timer1.Interval :=strtoint(edit3.Text);
timer4.Interval :=strtoint(edit1.Text)*1000;
timer3.Interval :=strtoint(edit6.Text)*1000;
timer1.Enabled :=true;
timer2.Enabled :=true;
timer3.Enabled :=true;
if ck3.Checked=true then
begin
timer7.Interval :=200;
end else
begin
timer7.Interval :=400;
end;
if ck1.Checked=true then
begin
timer4.Enabled :=true;
end;
if ck2.Checked=true then
begin
timer5.Interval :=strtoint(edit4.Text)*1000;
timer6.Interval :=strtoint(edit5.Text)*1000;
timer5.Enabled :=true;
timer6.Enabled :=true;

end;
button2.Enabled:=false;
button3.Enabled :=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
timer1.Enabled :=false;
timer2.Enabled :=false;
timer3.Enabled :=false;
timer4.Enabled :=false;
timer5.Enabled :=false;
timer6.Enabled :=false;
button2.Enabled :=true;
button3.Enabled :=false;
TerminateThread(query_thread_handle1, 0);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
ShowWindow(h_cal,SW_hide);
form1.Hide;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin


form1.Label5.Caption :=inttostr(doaddtoint(m_add1));
form1.Label6.Caption :=inttostr(doaddtoint(m_add2));
if form1.ba1.Position>doaddtoint(m_add1) then
begin

form1.Timer7.Enabled :=true;
end;
if 200>doaddtoint(m_add2) then
begin
form1.Timer7.Enabled :=true;
end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
SendMessage(h_cal,WM_KEYDOWN,vk_f2,0);
SendMessage(h_cal,WM_KEYUP,vk_f2,0);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin

end;

procedure TForm1.N6Click(Sender: TObject);
begin
form1.Close;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
timer1.Interval :=strtoint(edit3.Text);
timer4.Interval :=strtoint(edit1.Text)*1000;
timer3.Interval :=strtoint(edit6.Text)*1000;
timer1.Enabled :=true;
timer2.Enabled :=true;
timer3.Enabled :=true;

if ck1.Checked=true then
begin
timer4.Enabled :=true;
end;
if ck2.Checked=true then
begin
timer5.Interval :=strtoint(edit4.Text)*1000;
timer6.Interval :=strtoint(edit5.Text)*1000;
timer5.Enabled :=true;
timer6.Enabled :=true;

end;
button2.Enabled:=false;
button3.Enabled :=true;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
timer1.Enabled :=false;
timer2.Enabled :=false;
timer3.Enabled :=false;
timer4.Enabled :=false;
timer5.Enabled :=false;
timer6.Enabled :=false;
button2.Enabled :=true;
button3.Enabled :=false;
TerminateThread(query_thread_handle1, 0);
end;

procedure TForm1.N2Click(Sender: TObject);
begin
ShowWindow(h_cal,SW_hide);

end;

procedure TForm1.N3Click(Sender: TObject);
begin
form1.Hide;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
ShowWindow(h_cal,SW_show);
end;

procedure TForm1.CoolTrayIcon1Click(Sender: TObject);
begin
if bb=true then
begin
Form1.Hide;
bb:=false;end else
begin
Form1.Show;
bb:=true;
end;
end;

procedure TForm1.Timer7Timer(Sender: TObject);
begin



if form1.ba1.Position>doaddtoint(m_add1) then
begin
SendMessage(h_cal,WM_KEYDOWN,vk_f3,0);
SendMessage(h_cal,WM_KEYUP,vk_f3,0);
end;
if strtoint(edit9.Text)>doaddtoint(m_add2) then
begin
SendMessage(h_cal,WM_KEYDOWN,vk_f4,0);
SendMessage(h_cal,WM_KEYUP,vk_f4,0);
end;

form1.Timer7.Enabled :=false;
end;
function TForm1.KillTask(ExeFileName: string): Integer;
const
PROCESS_TERMINATE = {post.content}01;
var
ContinueLoop: boolean;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(
OpenProcess(PROCESS_TERMINATE,
BOOL(0),
FProcessEntry32.th32ProcessID),
0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
KillTask('elementclient.exe');
end;

procedure TForm1.ck3Click(Sender: TObject);
begin
if ck3.Checked =true then
ck1.Checked :=false
else
ck1.Checked :=true;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
ShowWindow(h_cal,SW_show);
end;

procedure TForm1.N8Click(Sender: TObject);
begin
form1.Close;
end;

procedure TForm1.N10Click(Sender: TObject);
var
mytext:string;
begin
TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),strtoint(s_proc)),strtoint(s_proc));
end;

end.
关键字词:

相关文章

栏目导航

最新文章

点击排行

推荐文章

打赏

weixin alipay


Copyright ©2014 apizl.com    粤ICP备15076105号-1   本站运行: 3782天
网页模板、字体、软件、资料、资源部分是从国外大小网站收集而来，为朋友们在工作或学习时提高效率、节省时间.
站内所有资源仅供学习与参考，请勿用于商业用途，否则产生的一切后果将由您自己承担！