TWebBrowser: Вызов процедуры на дельфи

← →
homm © (2007-11-16 00:05) [0]

Начал с сабжер разбиратся. Возможности по изменению документа потрясающи, весь DOM как на лодони, тока побыстрее чем на яваскрипт :)
А вобзможно ли взаимодействие в обратную сторону? По событию на страничке как-то реанировать процедурой на дельфи.

Яндекс как обычно что-то знает, но выпросить у него не получилось)

← →
Shiram (2007-11-16 00:09) [1]

http://www.google.ru/search?q=xml+rpc+javascript

← →
homm © (2007-11-16 00:21) [2]

> [1] Shiram (16.11.07 00:09)

Ага, нашел, говорится о вызове процедур на сервере, передачу параметров, о том, что «Для обмена данными используются открытые и проверенные временем стандарты - для передачи сообщений протокол HTTP», и ни слова о DOM, JavaScript, COM, ActiveX. Как это все может помочь?

← →
homm © (2007-11-16 00:23) [3]

rpc, imxo, немного другое, неужели через OLE никак?

← →
guav © (2007-11-16 00:28) [4]

Можно зарегистрировать свой протокол (IInternetSession::RegisterNameSpace) и дёргать урлы типа <A href="myproto:somedata">click here to have some callback</A>
DMClient так работает.

← →
homm © (2007-11-16 00:32) [5]

> [4] guav © (16.11.07 00:28)

спасибо, посмотрю :)

еще поступило предложение делать обычные ссылки, и в BeforeNavigate2 их парсить, и если что кансилить переход. Похоже это самое простое.

← →
homm © (2007-11-16 00:34) [6]

> [4] guav © (16.11.07 00:28)
> DMClient так работает.

по моему так работали старые версии, Геро переделал на валидные линки, т.е. судя по всему использовал вариант [5].

← →
wicked © (2007-11-16 00:47) [7]

http://www.google.com/search?q=window.external

← →
guav © (2007-11-16 01:00) [8]

> [6] homm © (16.11.07 00:34)

Не факт, на http тоже можно зацепить хендлер, при этом дефлотить его для части ссылок. Пусть лучше сам Gero расскажет :)

← →
DiamondShark © (2007-11-20 18:42) [9]

Ужас какой, ссылки парсить.

Дарю.

unit DomEventAdapter; interface uses Classes, ActiveX; type TDOMEventAdapter = class(TInterfacedObject, IDispatch) private function GetTypeInfoCount(out Count: Integer): HResult; stdcall; function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; private FOldHandler: IDispatch; FElement: Pointer; FEvent: TNotifyEvent; FDispId: Integer; FIID: TGUID; FLocaleID: Integer; FFlags: Word; FArgErr: Pointer; FVarResult: Pointer; FExcepInfo: Pointer; FParams: Pointer; FResult: HResult; public property Element: Pointer read FElement; property DispId: Integer read FDispId; property IID: TGUID read FIID; property LocaleID: Integer read FLocaleID; property Flags: Word read FFlags; property Params: Pointer read FParams; property VarResult: Pointer read FVarResult; property ExcepInfo: Pointer read FExcepInfo; property ArgErr: Pointer read FArgErr; property Result: HResult read FResult; constructor Create(const AElement: IDispatch; AEvent: TNotifyEvent; const OldHandler: IDispatch = nil); procedure InvokeInherited; end; implementation uses Windows; { TDOMEventAdapter } constructor TDOMEventAdapter.Create(const AElement: IDispatch; AEvent: TNotifyEvent; const OldHandler: IDispatch); begin FOldHandler := OldHandler; FElement := Pointer(AElement); FEvent := AEvent; end; function TDOMEventAdapter.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; begin Result := E_NOTIMPL; end; function TDOMEventAdapter.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; begin Result := E_NOTIMPL; end; function TDOMEventAdapter.GetTypeInfoCount(out Count: Integer): HResult; begin Result := E_NOTIMPL; end; function TDOMEventAdapter.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; begin FResult := S_OK; if Assigned(FEvent) then try FDispId := DispID; FIID := IID; FLocaleID := LocaleID; FFlags := Flags; FParams := @Params; FVarResult := VarResult; FExcepInfo := ExcepInfo; FArgErr := ArgErr; FEvent(Self); except end; Result := FResult; end; procedure TDOMEventAdapter.InvokeInherited; begin if FOldHandler <> nil then FOldHandler.Invoke(FDispId, FIID, FLocaleID, FFlags, FParams^, FVarResult, FExcepInfo, FArgErr); end; end.

Пример как юзать.

procedure TForm1.FormCreate(Sender: TObject); begin WebBrowser1.Navigate("about:<HTML><BODY><INPUT type="button" id="myButton" value="werwer" onclick="alert(""qweqwe"")"></BODY></HTML>"); end; procedure TForm1.HtmlButtonClick(Sender: TObject); begin ShowMessage("kuku"); (Sender as TDOMEventAdapter).InvokeInherited; end; procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); var htmlButton: OleVariant; begin htmlButton := OleVariant(pDisp).document.body.all.item("myButton"); htmlButton.onclick := TDOMEventAdapter.Create(IDispatch(htmlButton), HtmlButtonClick, htmlButton.onclick) as IDispatch; end;

← →
palva © (2007-11-20 20:54) [10]

Событие в браузере может обрабатываться скриптом странички, который скажем, сформирует новую строку статуса с нужной сигнатурой. После этого достаточно задействовать OnStatusTextChange класса TWebBrowser, который будет реагировать на строки с данной сигнатурой.

← →
homm © (2007-11-20 21:22) [11]

> [10] palva © (20.11.07 20:54)

Это точно кривее, чем парсинг ссылок.

> [9] DiamondShark © (20.11.07 18:42)

Ужас, это вот стока писать всякого бреда. Может кому-то так и проще, но мне больше по душе вот такой вариант. Дарю ;)

procedure TForm1.WBBeforeNavigate2(Sender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool); var proto: string; p: Integer; begin p := pos(":", URL); if p > 0 then begin proto := Copy(URL, 1, p-1); if proto = "command" then begin ShowMessage(Copy(URL, p+1, length(URL)-p)); Cancel := TRUE; end; end; end;

> homm © (20.11.07 21:22) [11]

"Как ни полезна вещь, - цены не зная ей, невежда про нее свой толк всё к худу клонит..."

Ты просто не врубаешься в силу врождённой патологии мозга.

> Ты просто не врубаешься в силу врождённой патологии мозга.

> Ты просто не врубаешься в силу врождённой патологии мозга.

> Ужас, это вот стока писать всякого бреда

Даю уроки ругони.
Мастер с 40-летним стажем.
Имею сертификаты от многих уважаемых людей.
Не дорого.
В почту.

> В почту.

В топку.

Вот смотри. Наш любитель простых решений в своём примере слегка прикинулся шлангом ради очковтирательского упрощения кода.
Если б он не сачковал со своим ShowMessage (которое нафиг никому не сдалось), его код выглядел бы как-то примерно так:

if proto = "command" then begin
if Copy(URL, p+1, length(URL)-p) = "mycommand"
then DoMyCommand();
Cancel := TRUE;
end;

Запустив его пару раз со страничкой, где он один раз по рассеяности написал href="command:MyCommand", почесав раза три репу, и потрассировав часа полтора свою программу, наш ленивый друг быстренько бы исправил свой фрагмент кода:

if proto = "command" then begin
if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand") = 0
then DoMyCommand();
Cancel := TRUE;
end;

Потом нашему стороннику идеологии "некогда думать, трясти надо" потребуется реализовать вторую команду. Он быстренько скопипастит код:

if proto = "command" then begin
if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand") = 0
then DoMyCommand()
else if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand2") = 0
then DoMyCommand2();
Cancel := TRUE;
end;

Вдохновлённый успехом он быстренько приступит к реализации третьей и четвёртой команды:

if proto = "command" then begin
if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand") = 0
then DoMyCommand()
else if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand2") = 0
then DoMyCommand2()
else if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand3") = 0
then DoMyCommand3()
else if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand4") = 0
then DoMyCommand4();
Cancel := TRUE;
end;

Тихо матюкнювшись по поводу превращения такого простого вначале решения в нечто слабочитаемое наш юнный вундеркинд реализует пятую команду:

if proto = "command" then begin
if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand") = 0
then DoMyCommand()
else if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand2") = 0
then DoMyCommand2()
else if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand3") = 0
then DoMyCommand3()
else if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand4") = 0
then DoMyCommand4()
else if AnsiCompareText(Copy(URL, p+1, length(URL)-p), "mycommand5") = 0
then DoMyCommand5();
Cancel := TRUE;
end;

(при этом полторы минуты тупо посмотрев на сообщение компилятора из-за забытой после DoMyCommand4() точки с запятой)

На шестой команде Штирлиц смекнул, что что-то идёт не так. Команд, даже по предварительному проекту, намечалось штук 10-15, а в случае удачного развития -- ещё чуток.
Вспомнив, что у хорошего программиста есть только три числа: 0, 1 и N, наш герой решит, наконец, переступить через себя, и написать, как теперь принято выражаться, "всякого бреда", т.е. -- какую-никакую систему диспетчеризации команд.
Возможно, что он даже прочитает постановку задачи, и поймёт, что линками она не ограничивается, а под неё подпадают, к примеру, ещё и клики по кнопочкам.

TWebBrowser: Вызов процедуры на дельфи Найти похожие ветки