本文主要讲的是如何使用delphi编程来记录QQ的聊天记录,下面是主要代码,供参考:
function Process_ReadRichEditText(AHandle: THandle): WideString; var vGetTextEx: GETTEXTEX; vGetTextLengthEx: GETTEXTLENGTHEX; L: Integer; vProcessId: DWORD; vProcess: THandle; vPointer: Pointer; vNumberOfBytesRead: Cardinal; begin Result := ''; if not IsWindow(AHandle) then Exit; GetWindowThreadProcessId(AHandle, @vProcessId); vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, False, vProcessId); try vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE); vGetTextLengthEx.flags := GTL_DEFAULT; vGetTextLengthEx.codepage := 1200; // Unicode WriteProcessMemory(vProcess, vPointer, @vGetTextLengthEx, SizeOf(vGetTextLengthEx), vNumberOfBytesRead); L := SendMessage(AHandle, EM_GETTEXTLENGTHEX, Integer(vPointer), 0); VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE); if L <= 0 then Exit; vPointer := VirtualAllocEx(vProcess, nil, SizeOf(vGetTextEx) + L * 2 + 2, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE); SetLength(Result, L); vGetTextEx.cb := L * 2 + 2; vGetTextEx.flags := GT_DEFAULT; vGetTextEx.codepage := 1200; // Unicode vGetTextEx.lpDefaultChar := nil; vGetTextEx.lpUsedDefChar := nil; WriteProcessMemory(vProcess, vPointer, @vGetTextEx, SizeOf(vGetTextEx), vNumberOfBytesRead); SendMessage(AHandle, EM_GETTEXTEX, Integer(vPointer), Integer(vPointer) + SizeOf(vGetTextEx)); ReadProcessMemory(vProcess, Pointer(Integer(vPointer) + SizeOf(vGetTextEx)), @Result[1], L * 2, vNumberOfBytesRead); VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE); finally CloseHandle(vProcess); end; end; { Process_ReadRichEditText } function GetProcessName(AProcessID: THandle): string; var vBuffer: array[0..MAX_PATH] of Char; vProcess: THandle; begin vProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, AProcessID); try if GetModuleBaseName(vProcess, 0, vBuffer, SizeOf(vBuffer)) > 0 then Result := vBuffer else Result := ''; finally CloseHandle(vProcess); end; end; { GetProcessName } function EnumChild(hwnd: HWND; lParam: LPARAM): BOOL; stdcall; var vBuffer: array[0..255] of Char; begin Result := True; if not IsWindowVisible(hwnd) then Exit; // 不可见 GetClassName(hwnd, vBuffer, SizeOf(vBuffer)); if SameText(vBuffer, 'RichEdit20A') then begin if GetWindowLong(hwnd, GWL_STYLE) and ES_READONLY <> ES_READONLY then // 非只读 begin PInteger(lParam)^ := hwnd; Result := False; end; end; end;
{ EnumChild }
function EnumFunc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall; var vBuffer: array[0..255] of Char; vProcessId: THandle; begin Result := True; if not IsWindowVisible(hwnd) then Exit; // 不可见 GetClassName(hwnd, vBuffer, SizeOf(vBuffer)); if SameText(vBuffer, '#32770') then begin GetWindowThreadProcessId(hwnd, vProcessId); if SameText(GetProcessName(vProcessId), 'qq.exe') then begin GetWindowText(hwnd, vBuffer, SizeOf(vBuffer)); if Pos('交谈中', vBuffer) > 0 then // 标题中含"聊天中" begin EnumChildWindows(hwnd, @EnumChild, lParam); Result := False; end; end; end; end; procedure TForm1.Button1Click(Sender: TObject); var vHandle: THandle; begin vHandle := 0; EnumWindows(@EnumFunc, Integer(@vHandle)); if vHandle = 0 then Exit; Memo1.Text := Process_ReadRichEditText(vHandle); end;
|
请发表评论