GetWindowText / WM_GETTEXT test

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin;

type
  TfmMain = class(TForm)
    lbThisWndHandle: TLabel;
    btSpawnAnotherInstance: TButton;
    btSetCaptionForThisWnd: TButton;
    edCaption: TEdit;
    btGetWindowText: TButton;
    btHangThisApp: TButton;
    btGetText: TButton;
    seTargetWndHandle: TSpinEdit;
    cbOverloadWMGetText: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure btSpawnAnotherInstanceClick(Sender: TObject);
    procedure btSetCaptionForThisWndClick(Sender: TObject);
    procedure btGetWindowTextClick(Sender: TObject);
    procedure btHangThisAppClick(Sender: TObject);
    procedure btGetTextClick(Sender: TObject);
  public
    procedure DefaultHandler(var Message); override;
  end;

var
  fmMain: TfmMain;

implementation

uses
  ShellAPI;

{$R *.dfm}

const
  OverrideCaption = '!override!';
  CaptionLen      = Length(OverrideCaption);

procedure TfmMain.FormCreate(Sender: TObject);
const
  Let: String = '0123456789QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm';
var
  S: String;
  X: Integer;
begin
  lbThisWndHandle.Caption := Format('Handle: %d', [Handle]);

  seTargetWndHandle.Value := Integer(Handle);

  SetLength(S, CaptionLen);
  Randomize;
  for X := 1 to Length(S) do
    S[X] := Let[Random(Length(Let))];

  edCaption.Text := S;
  btSetCaptionForThisWndClick(nil);
end;

procedure TfmMain.btSpawnAnotherInstanceClick(Sender: TObject);
begin
  ShellExecute(Handle, nil, PChar(ParamStr(0)), nil, nil, SW_NORMAL);
end;

procedure TfmMain.btHangThisAppClick(Sender: TObject);
begin
  Sleep(60000);
end;

procedure TfmMain.btSetCaptionForThisWndClick(Sender: TObject);
begin
  edCaption.Text := Copy(edCaption.Text, 1, CaptionLen);
  SetWindowText(Handle, PChar(edCaption.Text));
end;

procedure TfmMain.btGetWindowTextClick(Sender: TObject);
var
  S: String;
  T: DWORD;
begin
  SetLength(S, CaptionLen + 1);
  FillChar(Pointer(S)^, Length(S), 0);
  T := GetTickCount;
  GetWindowText(THandle(seTargetWndHandle.Value), PChar(S), Length(S));
  SetLength(S, StrLen(PChar(S)));
  T := GetTickCount - T;

  if T > 3000 then
    ShowMessage(Format('TIMEOUT!' + sLineBreak + 'Caption: "%s"', [S]))
  else
    ShowMessage(Format('OK!' + sLineBreak + 'Caption: "%s"', [S]));
end;

procedure TfmMain.btGetTextClick(Sender: TObject);
var
  S: String;
  T: DWORD;
begin
  SetLength(S, CaptionLen + 1);
  FillChar(Pointer(S)^, Length(S), 0);
  T := GetTickCount;
  SendMessage(THandle(seTargetWndHandle.Value), WM_GETTEXT, Length(S), LPARAM(PChar(S)));
  SetLength(S, StrLen(PChar(S)));
  T := GetTickCount - T;

  if T > 3000 then
    ShowMessage(Format('TIMEOUT!' + sLineBreak + 'Caption: "%s"', [S]))
  else
    ShowMessage(Format('OK!' + sLineBreak + 'Caption: "%s"', [S]));
end;

procedure TfmMain.DefaultHandler(var Message);
begin
  if (
       (TMessage(Message).Msg <> WM_GETTEXT) and
       (TMessage(Message).Msg <> WM_GETTEXTLENGTH)
     ) or
     (cbOverloadWMGetText = nil) or
     (not cbOverloadWMGetText.Checked) then
  begin
    inherited DefaultHandler(Message);
    Exit;
  end;

  if TMessage(Message).Msg = WM_GETTEXT then
  begin
    StrLCopy(PChar(TMessage(Message).lParam), OverrideCaption, TMessage(Message).wParam);
    TMessage(Message).Result := Length(OverrideCaption);
    if TMessage(Message).Result > TMessage(Message).wParam then
      TMessage(Message).Result := TMessage(Message).wParam;
  end
  else
  // TMessage(Message).Msg = WM_GETTEXTLENGTH
  begin
    TMessage(Message).Result := Length(OverrideCaption);
  end;
end;

end.