獲取聊天窗口的內容（修正）

{
原文地址在代碼中有保留。

閒話少說，直接給出代碼——別問是做什麼用、也別問我要注解。
說明：別拿來做壞事！否則，就別說是我（們）告訴你的。
}

unit qq_chat_input_box;

interface
uses windows, SysUtils, testFrm;
function EnumFunc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
function Process_ReadRichEditText(AHandle: THandle): WideString;

implementation

//http://blog.csdn.net/zswang/archive/2008/01/02/2009868.aspx

uses PsAPI, RichEdit;

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, length(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, length(vBuffer));
      if  (Pos('RICHEDIT',vBuffer)>0) 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, length(vBuffer));
    if SameText(vBuffer, '#32770') then begin
        GetWindowThreadProcessId(hwnd, vProcessId);
        if SameText(GetProcessName(vProcessId), 'qq.exe') then begin
              GetWindowText(hwnd, vBuffer, length(vBuffer));
              Form1.Memo1.Lines.Add(String(vBuffer)+':'+intToStr(hwnd));
              if (Pos('對話中', vBuffer)>0)or(pos('聊天中', vBuffer)>0) then begin
                EnumChildWindows(hwnd, @EnumChild, lParam);
                Result := False;
              end;
        end;
      end;
end; { EnumFunc }

{
//Testing:
//add 1 TButton and 1 TMemo to a Form
procedure TForm1.Button1Click(Sender: TObject);
var vHandle: THandle;
begin
    Memo1.Clear();
      vHandle := 0;
      EnumWindows(@EnumFunc, Integer(@vHandle));
      if vHandle = 0 then Exit;
      Memo1.Lines.Add(Process_ReadRichEditText(vHandle) );
end;
}

end.
 



{在D7+繁體版中實際測試通過}