Mirror

Capture text from another non-Delphi application window (Views: 570)


Problem/Question/Abstract:

I need to capture the text from a scrolling text window in another program that I don't have access to only through a window handle. Can I use SendMEssage or something to ge the text with WM_GETTEXT type message. I know there are programs like spell checkers that can do this. Any help would be appreciated.

Answer:

Solve 1:

The example runs 'chkdsk.exe c:\' and displays the output to Memo1. Put a TMemo (Memo1) and a TButton (Button1) on your form. Put this code in the OnCLick of Button1:

procedure TForm1.Button1Click(Sender: TObject);

  procedure RunDosInMemo(DosApp: string; AMemo: TMemo);
  const
    ReadBuffer = 2400;
  var
    Security: TSecurityAttributes;
    ReadPipe, WritePipe: THandle;
    start: TStartUpInfo;
    ProcessInfo: TProcessInformation;
    Buffer: Pchar;
    BytesRead: DWord;
    Apprunning: DWord;
  begin
    with Security do
    begin
      nlength := SizeOf(TSecurityAttributes);
      binherithandle := true;
      lpsecuritydescriptor := nil;
    end;
    if Createpipe(ReadPipe, WritePipe, @Security, 0) then
    begin
      Buffer := AllocMem(ReadBuffer + 1);
      FillChar(Start, Sizeof(Start), #0);
      start.cb := SizeOf(start);
      start.hStdOutput := WritePipe;
      start.hStdInput := ReadPipe;
      start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
      start.wShowWindow := SW_HIDE;
      if CreateProcess(nil, PChar(DosApp), @Security, @Security, true,
        NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then
      begin
        repeat
          Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
          Application.ProcessMessages;
        until
          (Apprunning <> WAIT_TIMEOUT);
        repeat
          BytesRead := 0;
          ReadFile(ReadPipe, Buffer[0],
            ReadBuffer, BytesRead, nil);
          Buffer[BytesRead] := #0;
          OemToAnsi(Buffer, Buffer);
          AMemo.Text := AMemo.text + string(Buffer);
        until
          (BytesRead < ReadBuffer);
      end;
      FreeMem(Buffer);
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
      CloseHandle(ReadPipe);
      CloseHandle(WritePipe);
    end;
  end;

begin {Button1 code}
  RunDosInMemo('chkdsk.exe c:\', Memo1);
end;

Unfortunaly that will only work with applications that send output to stdout. A Windows application usually doesn't do this.


Solve 2:

The usually use different techiques, like OCR on a screen bitmap. There is simply no generic method to get text from other windows. What you can try, however, is this:

function GetTextFromWindow(wnd: HWND): string;
var
  count: Cardinal;
begin
  result := '';
  if SendMessageTimeout(wnd, WM_GETTEXTLENGTH, 0, 0,
    SMTO_ABORTIFHUNG, 1000, count) <> 0 then
  begin
    if count = 0 then
      Exit;
    SetLength(result, count);
    if SendMessageTimeout(wnd, WM_GETTEXT, count + 1, lparam(@result[1]),
      SMTO_ABORTIFHUNG, 1000, count) = 0 then
      result := '';
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  wnd: HWND;
begin
  wnd := FindWindow('notepad', nil);
  if wnd <> 0 then
  begin
    wnd := GetWindow(wnd, GW_CHILD);
    if wnd <> 0 then
      memo1.text := GetTextfromwindow(wnd);
  end
  else
    memo1.text := 'Notepad not running.';
end;

<< Back to main page