delphi编程来记录QQ的聊天记录

本文主要讲的是如何使用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;