Как вычислить координаты ссылки в TWebBrowser?

[Vedaslav]

Здравствуйте, уважаемые форумчане. Может, кто знает, как вычислить координаты (x,y) ссылки или определённого слова, которые имеются на загруженной веб странице в TWebBrowser?

[SamBellamy]

это вам нужно найти объект нужной ссылки и посмотреть его свойства, найти что-то похожее на left и top
всё что вы видите на странице в браузере описано в объектной модели, называется DOM, она имеет структуру дерева, основное это IHtmlDocument2 - документ, хранит объекты IHTMLElementCollection


ниже пример не по теме но всё же показывает как находить объекты по имени, полю value, тегу, умеет имитировать событие клика

function TAutoBoi.submit(web: TWebBrowser; name, value, tag: string;
  const bClick: bool = false; skip: byte = 0; ValueSearch: bool = false): bool;
var
  doc: IHtmlDocument2;
  tSkip: shortint;

  function action(doc: IHtmlDocument2; name, value: string; button: bool): bool;
  var
    i: Integer;
    collection: IHTMLElementCollection;
    obj: variant;
  begin
    result := false;
    collection := doc.all.tags(Tag) as IHTMLElementCollection;
    if collection = nil then exit;
    //перебор объектов ввода на странице
    for i := 0 to collection.length - 1 do begin
      obj := collection.item(i, 0);
      if (LowerCase(tag) = 'a') then begin
        //если ValueSearch = true то ссылку можно нажать имея только часть имени
        if (obj.href = name) or
           ((Pos(name, obj.href) <> 0) and (ValueSearch)) then begin
          obj.Click;
          exit
        end;
      end else
        if ((not ValueSearch) and (obj.name = name)) or
           ((ValueSearch) and (obj.value = value)) then begin
          dec(tSkip);
          if tSkip <> -1 then continue;
          result := true;
          //кнопку нажать или значение подставить
          if button then obj.Click else obj.value := value;
          exit;
        end;
    end;
  end;

  function recursion(var doc: IHtmlDocument2): bool;
  var
    f: Integer;
    frame: IDispatch;
    t: IHtmlDocument2;
  begin
    result := false;
    if (doc = nil) or (tSkip = -1) then exit;
    //просмотр фрейма
    if action(doc, name, value, bClick) = true then result := true;
    //перебор фреймов
    for f := 0 to doc.frames.length - 1 do begin
      frame := doc.frames.item(f).Document;
      t := frame as IHTMLDocument2;
      if recursion(t) = true then result := true;
    end;
  end;

begin
  doc := Web.Document as IHtmlDocument2;
  tSkip := skip;
  result := recursion(doc);
end;

следующим образом можно найти тег A у которого ссылка будет начинаться с 'leave_combat.php?rnd=' и выполнить событие click

submit(WebBrowser, 'leave_combat.php?rnd=', '', 'a', false, 0, true)

[Vedaslav]

Благодарю, но мне надо было решить немного другую задачу:

1) Допустим в TWebBrowser уже загружена какая-нибудь веб страница,

2) с помощью специальных функций мы узнаем все имеющиеся ссылки на этой странице,

3) далее вычисляем координаты (x,y) той ссылки, которая нас интересуют,

4) программно перемещаем курсор к этой ссылке по тем координатам, которые нам уже известны и делаем клик.

Фактически, всё это нужно было для бота, который бы автоматически посещал через прокси определённые интернет ресурсы и имитировал действия юзера.

Вот нашёл решение, но привести код в работоспособное состояние не смог

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, ExtCtrls, StdCtrls, ComCtrls;

type
TfrmMain = class(TForm)
SB: TStatusBar;
LB: TListBox;
SPL: TSplitter;
WB: TWebBrowser;
procedure FormCreate(Sender: TObject);
procedure WBDocumentComplete(Sender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
procedure LBClick(Sender: TObject);
procedure WBBeforeNavigate2(Sender: TObject; const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
var Cancel: WordBool);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
WB.Navigate("http://www.site.ru/");
end;

function ElementTop(elem: OleVariant): integer;
var
top, height: integer;
begin
top := 0;
height := elem.offsetHeight;
repeat
top := top + elem.offsetTop;
elem := elem.offsetParent;
until elem.tagName = "BODY";
result := top + height div 2;
end;

function ElementLeft(elem: OleVariant): integer;
var
left, width: integer;
begin
left := 0;
width := elem.offsetWidth;
repeat
left := left + elem.offsetLeft;
elem := elem.offsetParent;
until elem.tagName = "BODY";
result := left + width div 2;
end;

procedure TfrmMain.WBDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
i: integer;
allA: OleVariant;
p: TPoint;
begin
allA := WB.OleObject.document.all.tags("A") ;
for i := 0 to allA.length - 1 do begin
p := point(ElementLeft(allA.item(i)), ElementTop(allA.item(i)));
LB.Items.Add(inttostr(p.X) + " : " + inttostr(p.Y) + " -> " + allA.item(i).innerText);
end;
end;

procedure TfrmMain.LBClick(Sender: TObject);
var
p: TPoint;
bodyTop, bodyLeft: integer;
allA: OleVariant;
begin
allA := WB.OleObject.document.all.tags("A") ;
with LB do
p := point(ElementLeft(allA.item(ItemInd ex)), ElementTop(allA.item(ItemIndex)));
WB.OleObject.document.parentWindow. scrollTo(p.X - WB.Width div 2, p.Y - wb.Height div 2);
p := WB.ClientToScreen(p);
bodyTop := WB.OleObject.document.body.scrollTo p;
bodyLeft := WB.OleObject.document.body.scrollLe ft;
setcursorpos(p.X - bodyLeft, p.Y - bodyTop);
end;

procedure TfrmMain.WBBeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
begin
LB.Clear;
end;

end.

[eval]

этот код для бота не подходит

[Vedaslav]

Сообщение от eval

этот код для бота не подходит

почему не подходит?

[eval]

потому что боты не работают с браузерами

[Vedaslav]

Сообщение от eval

потому что боты не работают с браузерами

Интересно,, а вы слышали что-нибудь про боты автокликеры, eval?
Или про программу типа Userator? Я думаю вы глубоко ошибаетесь.

[eval]

ни грамма не ошибаюсь
автокилеры это те что авто киляют?

[Vedaslav]

Сообщение от eval

ни грамма не ошибаюсь
автокилеры это те что авто киляют?

Да, правильно, автоматически кликают и могут выполнять ещё кое-какие действия.

А если вы спорите со мной на счёт этимологии самого слова "автокликер", то многие Seo-оптимизаторы, да и вебмастера поймут о чём я.

[eval]

да не я не спорю, делать мне чтоль нечего ...
просто покажите какойнибудь автокилер, вот и весь спор