WebBrowser1NewWindow2でURLを取得できますか。
解決よろしくお願いします。
TWebBrowserを貼り付けてブラウザを作成しています。
画面のリンクをクリックするとNewWindow2イベントが発生するようですが
prodedure TForm1.WebBrowser1NewWindow2(Sender: TObject;var ppDisp: IDispatch; var Cancel: WordBool);
のppDispはリンクのURLを持っていないのでしょうか。
もし、これから開くURLを取得できれば
任意のURLを開かないようにしたいのですが。
よろしくお願いします。
自己レスです。追加説明です。
リンクをクリックしたとき、そのURLを知れば、
ポップアップをブロックしたいのです。
具体例は http://rinnai.jp/top の画面中程のリンク
「バスルームでリビングの愉しさを！ 」
はポップアップですが、ほかのリンクはポップアップではありません。
ポップアップの時だけ、別の処理をするようにしたいです。
画面のソースを分析してどのURLがポップアップリンクURLかは判るように
なったのですが、いまリンククリックしてNewWindow2(が発生したURLが判ればと思います。
BeforeNavigate2はポップアップのURLを発生しませんので困っています。
よろしくお願いします。
NewWindow2ではURLを取得することができません。
NewWindow2が発生する前にURLを知るためには、
IDocHostUIHandlerを実装してTranslateUrlイベントで、
URLを保存しておけばできると思います。
ただし、目的がポップアップブロックで、
対象がIE6 SP2以降でよいのであれば、
EvaluateNewWindow、または、NewWindow3を使った方が簡単です。
IE6 SP2以降がインストールされている環境で、
タイプライブラリを取り込めば使えるようになると思います。
ねぶそくさんありがとうございました。
XP SP3、ＩＥ７です。
「NewWindow2が発生する前にURLを知るためには」です。
ポップアップをブロックするのが目的です。
ポップアップブロックはすべてのポップアップをブロックするので困っています。
それで表示しているページのソースを見ると「openPopup」を使っている
URLがありますから、このURLをリストしていて
クリックされたURLがこれを含んでいるとブロックすればと
素人考えで思ったわけです。
もっと簡単にブロックできるのでしたらそれでいいんですが、
できましたらもう少し具体例か、参考サイトをご紹介頂けないでしょうか。
まだ、新米なので、googleでさがすとＶＢ、やＣ言語の例を見るのですが
判りません。
「IDocHostUIHandlerを実装してTranslateUrlイベントで、」
よろしくお願いします。
ｃ
すみません。自己レスです。
記述不足でした。、
「IDocHostUIHandlerを実装してTranslateUrlイベントで、」
で限定したような書き方になりましたので訂正します。
「ただし、目的がポップアップブロックで、
対象がIE6 SP2以降でよいのであれば、
EvaluateNewWindow、または、NewWindow3を使った方が簡単です。」
でもいいのでした。
お詫びします。
ねぶそくさんありがとうございました。
だめもとでいろいろやりましたら
WebBrowser1NewWindow3イベントの
bstrUrlで事前にクリックしたリンクのURLを取得できました。
記述されたURLの頭の部分にhttpと一階層か二階層違いますが
何か工夫してみます。
ありがとうございました。
勝爺：「そうですか、では、また次の機会にお待ちしてますから」
真琴：「また予約キャンセルの電話なの？ おじいちゃん」
勝爺：「そうだよ、台風で週末はサーフィンが無理だからって」
真琴：「仕方ないよね、コッチに向かって来るみたいだから、今度の台風は」
勝爺：「オレが若い頃は、この位の台風なら喜んで沖にボードを進めたモンだよ、いい波が来るからな」
真琴：「おじいちゃん、やっぱりそんな危ないコトやってたんだ、昔から…」
勝爺：「"昔"じゃないぞ、マコト、ホンのチョット前のコトだろぅ」
真琴：「そぅかな？^^; でも、もうサーフィンは卒業したんだよね？ おじいちゃん」
勝爺：「卒業？ オレはまだ現役のサーファー、このところチョット休んでるけどな」
真琴：「ずいぶん長い"チョット"だけど^^; その休みズッと長く延ばしてネ、お願い」
勝爺：「まぁ、その気になりゃぁ、また何時だって出来るからな」
春子：「おっはよう〜、はい、今朝の野菜、…台風はコッチ来ちゃうみたいね」
真琴：「そうなの、ねぇ、ハルコさん、また教えて欲しいンだけど」
春子：「いいよ、ナニ？」
真琴：「"NewWindow3"が使えない環境でも、そのURLが簡単に分かる方法はナイの？」
春子：「ん？ "NewWindow2"でも、開こうとしてるURLが分かればイイな〜ってコト？」
真琴：「そう、Win2000では"NewWindow3"が使えないし、IDocHostUIHandlerなんかでは面倒すぎるみたいだし…」
春子：「マコト、出来るよ簡単に、…チョットしたトリックで」
const
WM_NAVIREDIRECT = WM_APP + 10;
......
private
procedure RedirectHandler(var Msg: TMessage); message WM_NAVIREDIRECT;
......
var
OpenNewWindow: Boolean;
TheURL: string;
TempWB: TWebBrowser;
procedure TForm1.RedirectHandler(var Msg: TMessage);
begin
//WebBrowser1.Navigate(TheURL);
WebBrowser1.Navigate(PChar(Msg.WParam));
end;
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
OpenNewWindow := True;
if not Assigned(TempWB) then begin
TempWB := TWebBrowser.Create(Self);
// TempWB.Visible := False; TempWB.Width := 0; TempWB.Height := 0;
TempWB.OnBeforeNavigate2 := WebBrowser1BeforeNavigate2;
end;
ppDisp := TempWB.ControlInterface.Application;
end;
procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
begin
if OpenNewWindow then begin
OpenNewWindow := False;
ShowMessageFmt('新窓をキャンセルして、'#13#10'%s を同じ窓で開くヨ', [URL]);
Cancel := True;
TheURL := URL;
PostMessage(Handle, WM_NAVIREDIRECT, WParam(PChar(TheURL)), 0);
end else
.......
end;
真琴：「こんな方法があったの？ ホントにトリックみたい」
春子：「一つ余計にWebBrowserが必要だけどね」
真琴：「ハルコさん、別のIDocHostUIHandlerを実装する方法は、やっぱり大変？」
春子：「まぁ、そうだけど、こんなカンジ…」
const
DOCHOSTUIDBLCLK_DEFAULT = $0;
DOCHOSTUIFLAG_THEME = $40000;
type
_DOCHOSTUIINFO = packed record
cbSize: UINT;
dwFlags: UINT;
dwDoubleClick: UINT;
pchHostCss: POLESTR;
pchHostNS: POLESTR;
end;
IDocHostUIHandler = interface(IUnknown)
['{BD3F23C0-D43E-11CF-893B-00AA00BDCE1A}']
function ShowContextMenu(dwID: UINT; ppt: PPOINT; const pcmdtReserved: IUnknown;
const pdispReserved: IDispatch): HResult; stdcall;
function GetHostInfo(var pInfo: _DOCHOSTUIINFO): HResult; stdcall;
function ShowUI(dwID: UINT; const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HResult; stdcall;
function HideUI: HResult; stdcall;
function UpdateUI: HResult; stdcall;
function EnableModeless(fEnable: Integer): HResult; stdcall;
function OnDocWindowActivate(fActivate: Integer): HResult; stdcall;
function OnFrameWindowActivate(fActivate: Integer): HResult; stdcall;
function ResizeBorder(var prcBorder: tagRECT; const pUIWindow: IOleInPlaceUIWindow;
fRameWindow: Integer): HResult; stdcall;
function TranslateAccelerator(var lpmsg: tagMSG; var pguidCmdGroup: TGUID; nCmdID: UINT): HResult; stdcall;
function GetOptionKeyPath(out pchKey: PWideChar; dw: UINT): HResult; stdcall;
function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HResult; stdcall;
function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
function TranslateUrl(dwTranslate: UINT; pchURLIn: PWideChar; out ppchURLOut: PWideChar): HResult; stdcall;
function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HResult; stdcall;
end;
TWebBrowser = class(SHDocVw_TLB.TWebBrowser, IDocHostUIHandler)
protected
function EnableModeless(fEnable: Integer): HResult; stdcall;
function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HResult; stdcall;
function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HResult; stdcall;
function GetExternal(out ppDispatch: IDispatch): HResult; stdcall;
function GetHostInfo(var pInfo: _DOCHOSTUIINFO): HResult; stdcall;
function GetOptionKeyPath(out pchKey: PWideChar; dw: UINT): HResult; stdcall;
function HideUI: HResult; stdcall;
function OnDocWindowActivate(fActivate: Integer): HResult; stdcall;
function OnFrameWindowActivate(fActivate: Integer): HResult; stdcall;
function ResizeBorder(var prcBorder: tagRECT; const pUIWindow: IOleInPlaceUIWindow;
fRameWindow: Integer): HResult; stdcall;
function ShowContextMenu(dwID: UINT; ppt: PPOINT; const pcmdtReserved: IUnknown;
const pdispReserved: IDispatch): HResult; stdcall;
function ShowUI(dwID: UINT; const pActiveObject: IOleInPlaceActiveObject;
const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
const pDoc: IOleInPlaceUIWindow): HResult; stdcall;
function TranslateAccelerator(var lpmsg: tagMSG; var pguidCmdGroup: TGUID; nCmdID: UINT): HResult; stdcall;
function TranslateUrl(dwTranslate: UINT; pchURLIn: PWideChar; out ppchURLOut: PWideChar): HResult; stdcall;
function UpdateUI: HResult; stdcall;
end;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
.......
implementation
{$R *.dfm}
var
TransURL: string;
{TWebBrowser}
function TWebBrowser.TranslateUrl(dwTranslate: UINT; pchURLIn: PWideChar;
out ppchURLOut: PWideChar): HResult;
begin
TransURL := pchURLIn;
ppchURLOut := nil;
Result := S_FALSE;
end;
function TWebBrowser.GetHostInfo(var pInfo: _DOCHOSTUIINFO): HResult;
begin
FillChar(pInfo, SizeOf(_DOCHOSTUIINFO), #0);
pInfo.cbSize := SizeOf(pInfo);
pInfo.dwFlags := DOCHOSTUIFLAG_THEME;
pInfo.dwDoubleClick := DOCHOSTUIDBLCLK_DEFAULT;
Result := S_OK;
end;
function TWebBrowser.EnableModeless;
begin Result := E_NOTIMPL; end;
function TWebBrowser.FilterDataObject;
begin Result := E_NOTIMPL; end;
function TWebBrowser.GetDropTarget(const pDropTarget: IDropTarget;
out ppDropTarget: IDropTarget): HResult;
begin Result := E_NOTIMPL; end;
function TWebBrowser.GetExternal;
begin Result := S_FALSE; end;
function TWebBrowser.GetOptionKeyPath;
begin Result := E_NOTIMPL; end;
function TWebBrowser.HideUI: HResult;
begin Result := E_NOTIMPL; end;
function TWebBrowser.OnDocWindowActivate;
begin Result := E_NOTIMPL; end;
function TWebBrowser.OnFrameWindowActivate;
begin Result := E_NOTIMPL; end;
function TWebBrowser.ResizeBorder;
begin Result := S_OK; end;
function TWebBrowser.ShowContextMenu;
begin Result := E_NOTIMPL; end;
function TWebBrowser.ShowUI;
begin Result := S_FALSE; end;
function TWebBrowser.TranslateAccelerator;
begin Result := E_NOTIMPL; end;
function TWebBrowser.UpdateUI;
begin Result := S_FALSE; end;
{TForm1}
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
ShowMessageFmt('URL = %s'#13#10'※POPUPウィンドウをキャンセルして同じ窓で開くヨ', [TransURL]);
Cancel := True;
//PostMessage(Handle, WM_NAVIREDIRECT, WParam(PChar(TransURL)), 0);
WebBrowser1.Navigate(TransURL);
end;
真琴：「ホントに面倒ってカンジだよね^^;」
春子：「でもネ、こっちは別のオマケが付いてるから」
真琴：「どんなオマケ？ 実行して見れば分かるかな？」
春子：「そぅ、…マコト、窓の外も見てごらん、今は上級者のサーファーには絶好の波が来てるよ」
真琴：「ハルコさん…、ちょうど１年後なの、おじいちゃんが海で死んじゃうのは」
春子：「え？ ナンで？ それホントなの？」
真琴：「今みたいに台風が近づいた日の朝早く、おじいちゃんはサーフィンをして…」
春子：「そんな、イヤだよ、マサルさんが居なくなるなんて」
真琴：「アタシだって…だからハルコさんも協力してね、おじいちゃんを助けるのを」
春子：「でも、ナンでマサルさんが今更またサーフィンを始めるの？」
真琴：「年寄りの冷や水、鬼のカクランというか…」
春子：「それはチョットたとえが違うンじゃない？ マコト」
訂正です。
タイプライブラリの取り込みで使えるのはNewWindow3だけでした。
EvaluateNewWindowを使うためには、
INewWindowManagerを実装する必要がありますね。
解決されたようですので、ここからは蛇足ですが、
EvaluateNewWindowこそがマイクロソフトが用意した
ポップアップブロックのためのメソッドです。
http://msdn.microsoft.com/en-us/library/bb775416(VS.85).aspx
ご参考までに。
とりっく さん、ねぶそくさん、有り難うございました。
一応解決したのですが、確実性に欠けるのと（私のコードが芋だから）
処理時間がかかる欠点があります。
もう一度、ここをのぞいたら、トリックのようなすばらしい回答をいただき
有り難うございました。
いろいろ応用もできそうです。
また教えてください。
| ツイート |  |