Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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

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

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

Denis__ (2007-11-22 15:47:00) [1]

> DiamondShark © (22.11.07 12:39) [15]

+10 :)

DiamondShark (2007-11-22 12:39:00) [2]

> В почту.

В топку.

Вот смотри. Наш любитель простых решений в своём примере слегка прикинулся шлангом ради очковтирательского упрощения кода.
Если б он не сачковал со своим 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, наш герой решит, наконец, переступить через себя, и написать, как теперь принято выражаться, "всякого бреда", т.е. -- какую-никакую систему диспетчеризации команд.
Возможно, что он даже прочитает постановку задачи, и поймёт, что линками она не ограничивается, а под неё подпадают, к примеру, ещё и клики по кнопочкам.

boriskb (2007-11-22 09:15:00) [3]
> Ты просто не врубаешься в силу врождённой патологии мозга.

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

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

boriskb (2007-11-22 09:14:00) [4]
> Ты просто не врубаешься в силу врождённой патологии мозга.

DiamondShark (2007-11-22 09:07:00) [5]

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

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

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

homm (2007-11-20 21:22:00) [6]
> [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;

palva (2007-11-20 20:54:00) [7]
Событие в браузере может обрабатываться скриптом странички, который скажем, сформирует новую строку статуса с нужной сигнатурой. После этого достаточно задействовать OnStatusTextChange класса TWebBrowser, который будет реагировать на строки с данной сигнатурой.

DiamondShark (2007-11-20 18:42:00) [8]
Ужас какой, ссылки парсить.

Дарю.

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;

guav (2007-11-16 01:00:00) [9]
> [6] homm © (16.11.07 00:34)

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

wicked (2007-11-16 00:47:00) [10]
http://www.google.com/search?q=window.external

homm (2007-11-16 00:34:00) [11]
> [4] guav © (16.11.07 00:28)
> DMClient так работает.

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

homm (2007-11-16 00:32:00) [12]
> [4] guav © (16.11.07 00:28)

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

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

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

homm (2007-11-16 00:23:00) [14]
rpc, imxo, немного другое, неужели через OLE никак?

homm (2007-11-16 00:21:00) [15]

> [1] Shiram (16.11.07 00:09)

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

Shiram (2007-11-16 00:09:00) [16]
http://www.google.ru/search?q=xml+rpc+javascript

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »