Delphi 动态内存查找法作者:admin 来源:未知 日期:2010/5/9 13:51:53 人气:748 标签: | 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. |
|