Внешний вид сайта:

Как получить текст чужого окна

Здесь рассматривается, как можно получить текст чужого окна, когда курсор мыши находится над ним. Можно просматривать текст под звездочками в текстовом поле. Для этого поместите компоненты TTimer (Timer1), TEdit (Edit1) и TLabel (Label1) на форму и запишите следующий код:
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Edit1: TEdit;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Bo: boolean;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.PasswordChar := '*';
  Bo := False;
  Timer1.Interval := 250;
  Timer1.Enabled := True;
  Edit1.Text := '';
  Label1.Caption := '';
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
   p             : TPoint; 
   x,y,oldx,oldy : Integer; 
   s             : String; 
   b             : Array[0..255] of Char; 
   i,j,l         : Integer; 
   h,oldh, h1    : Thandle; 

begin 
  Timer1.Enabled := False;
  oldx := 0;
  oldy := 0;
  oldh := 0;
  Repeat
   Application.ProcessMessages;
   GetCursorPos(p); 
   x := p.x; 
   y := p.y; 
   h := WindowFromPoint(p); 
   h1 := ChildWindowFromPoint(h, p); 
   If h1 <> 0 then 
      h := h1;

   if (oldx <> x) or (oldy <> y) then 
      if h <> oldh then 
         Begin 
         FillChar(b, 255, #0); 
         b[0] := #255; 
         j := integer(@b);
         i := SendMessage(h,EM_GETPASSWORDCHAR, 0, 0); // убираем маску 
         l := SendMessage(h, EM_GETLINE, 0, j); // получаем строку 
         If l = 0 then
            SendMessage(h, WM_GETTEXT, sizeof(b), j);
         SendMessage(h, EM_SETPASSWORDCHAR, i, 0); // возвращаем маску 
         s := StrPas(b); 
         If s <> '' then
            Label1.Caption := s; // показываем строку 
         oldh := h; 
         oldx := x; 
         oldy := y; 
         End; 

  Until Bo;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin 
  Bo := True;
end;

Комментарии

Нет комментариев. Ваш будет первым!