タブ式ブラウザーでポップアップの［閉じる］ボタンを使うとエラー。回避方法は？
解決環境はWindows７ Delphi６Personalです。
EmbeddedWBコンポーネントを使ってタブブラウザを作成しています。
下記はテストしている最小限のコードです。
実験：ポップアップ画面に「閉じる」ボタンのある適当なサイトを開く。
下記の例では
画面最下部の「NEXT」→「ログイン」→「ログアウト」→「閉じる」ボタン。
こののち、タブを削除すると
「 OLEコントロールのウィンドウハンドルの取得に失敗しました。」
というエラーででます。これを回避したいのですが
NeweWindow3でいろいろトライしましたが能力不足で解決できません。
WebBrowserでもほぼ同様の現象が出ます。よろしくご指導ください。<(_ _)>
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls, OleCtrls, EmbeddedWB;
type
TIETabSheet = class(TTabSheet)
private
procedure EmbeddedWB1NewWindow2(Sender: TObject;var ppDisp: IDispatch; var Cancel: WordBool);
public
EmbeddedWB1 : TEmbeddedWB;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TForm1 = class(TForm)
PageControl1: TPageControl;
Panel1: TPanel;
Button1: TButton;//タブ作成ナビゲート
Button2: TButton;//タブ削除
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//--------------------TIETabSheetクラス イベント--------
{IETabSheet}
procedure TIETabSheet.EmbeddedWB1NewWindow2(Sender: TObject;var ppDisp: IDispatch; var Cancel: WordBool);
var
IETab:TIETabSheet;
begin
IETab := TIETabSheet.Create(Form1.PageControl1);
IETab.Parent := Form1.PageControl1;
IETab.PageControl := Form1.PageControl1;
Form1.PageControl1.ActivePage := TTabSheet(IETab);
ppDisp := IETab.EmbeddedWB1.Application;
end;
constructor TIETabSheet.Create(AOwner: TComponent);
begin
inherited;
EmbeddedWB1 := TEmbeddedWB.Create(self);
TOleControl(EmbeddedWB1).Parent := Self;
EmbeddedWB1.Align := alClient;
EmbeddedWB1.OnNewWindow2 := EmbeddedWB1NewWindow2;
end;
destructor TIETabSheet.Destroy;
begin
EmbeddedWB1.Free;
inherited;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);//新規タブ作成＆ナビゲート
var
IETab:TIETabSheet;
begin
IETab := TIETabSheet.Create(PageControl1);
IETab.Parent := PageControl1;
IETab.PageControl := PageControl1;
PageControl1.ActivePage := TTabSheet(IETab);
IETab.EmbeddedWB1.Navigate('http://www.ntt-east.co.jp/line-info/consent.html');
end;
procedure TForm1.Button2Click(Sender: TObject);//タブの削除
begin
TIETabSheet(Form1.PageControl1.Pages[PageControl1.ActivePageIndex]).Free;
end;
武田さん、指導は出来ないですよ〜。「ご相談」ということでお願いしまッス。
EmbeddedWBをWebBrowserに置き換えてテストしてみたところ、再現しました。
CloseされるとWebBrowserコントロールの中にあるIEコンポーネントの実体というべき存在の
ウインドウが消滅しちゃうのでしょう。
その状態では正常にDestroyできない、そんな仕組みかと想像します。
参考：[TWebBrowser] Scriptで閉じるとエラーになる
https://www.petitmonte.com/bbs/answers?question_id=7139
OnWindowClosingでCancel:=True;して閉じられるのを阻止すれば、その後でいく通りかの
お好みの対処が出来るのではないかと思います。
1. そのまま無かったことにしてスルー。
2. Navigate('about:blank'); とかで、何もない白画面にする。
3. 自身にPostMessageとかOnIdleで遅延後にタブを破棄する。
4. 上記と同様にして、WebBrowserだけを破棄する。
などなど、どうでしょうか？
前に同じようなことを回答したような気がしていましたが、やっぱりあり
ましたね。
私も自分専用のブラウザを作成しており、この問題は、次のようにして対応しています。
（定義部）
procedure OnMyMsg1(var Msg: TMessage);
message WM_MyMsg1;
procedure TForm1.Browser1WindowClosing(Sender: TObject;
IsChildWindow: WordBool; var Cancel: WordBool);
begin
Cancel := True; // 勝手に閉じられそうになったら閉じるのをやめる。
PostMessage(Form1.Handle, WM_MyMsg1, i, 0); // 処理を抜けた後、アクティブタブを閉じるよう、メッセージを投げておく。
// なお、iは、WindowClosingを起こしたWebBrowserに対応するTabControlのインデックス。
end;
// ↓メッセージを処理する部分。
procedure TForm1.OnMyMsg1(var Msg: TMessage);
begin
CloseTab(Msg.WParam); // CloseTab()という関数は、指定されたタブを閉じる自作関数。
end;
実際にやっていることは、Harryさんが指摘されているとおりです。
ソースが汚くて申し訳ありませんが、雰囲気は感じとっていただけるのでは
ないかと思います。
ちなみに、メッセージは他と被らないよう、独自に定義したものを使用
しています。WM_Userを検索していただけると、この意味は分かると
思います。
【定義】
WM_MyMsg1 = WM_User + 1;
Harryさん、あさん ありがとうございます。
にわかに、理解できませんのでテスト＆トライの
しばし 時間をください。
webbrowserの場合
過去ログにある
procedure TTabSheetEx.WebBrowser1DocumentComplete(Sender: TObject;const pDisp: IDispatch; var URL: OleVariant);
var
window : IHTMLWindow2 ;
document :IHTMLDocument2;
web : IWebBrowser ;
begin
//**Closeメソッドの無効化
try
web:= pDisp as Iwebbrowser;
document := web.document as IHTMLDocument2;
window := IHTMLWindow2(Document.parentWindow);
window.execScript('function close() {}','JavaScript' ) ;
except end ;
end;
で閉じるボタンを無効にすれば
タブで閉じるほかないようにすれば、この問題は開示できました。
このようなことなんでしょうか。
ところがEmbeddedではこれが通用しないのです。
web : IWebBrowser ;の定義する方法がわかりません。
定義できれば、同様な方法でもいいと思います。
今回はEmbeddedでやりたいのでこのような質問をしました。
あさんの、方法は試していませんが、挑戦してみます。
もしかしてEmbeddedWBでもできるかもしれませんので。
小生のレベルが低いので少々時間がかかります。
ありがとうございました。
あさん、すみません教えてください。
（定義部）
TForm1側に書くでいいですか。
procedure OnMyMsg1(var Msg: TMessage);
このような書き方がわかりませんがどこに書いたらいいのでしょうか
message WM_MyMsg1;
これはTIETabSheetクラスに書くのですね。
procedure TForm1.Browser1WindowClosing(Sender: TObject;
IsChildWindow: WordBool; var Cancel: WordBool);
begin
Cancel := True; // 勝手に閉じられそうになったら閉じるのをやめる。
PostMessage(Form1.Handle, WM_MyMsg1, i, 0); // 処理を抜けた後、アクティブタブを閉じるよう、メッセージを投げておく。
// なお、iは、WindowClosingを起こしたWebBrowserに対応するTabControlのインデックス。
end;
iはアクティブページのindexでいいですか。
CloseTab関数が理解できませんでした。
どのような内容がかかれているのでしょうか？
// ↓メッセージを処理する部分。
procedure TForm1.OnMyMsg1(var Msg: TMessage);
begin
CloseTab(Msg.WParam); // CloseTab()という関数は、指定されたタブを閉じる自作関数。
end;
これは、typeのまえにconstで書けばいいのですか。
【定義】
WM_MyMsg1 = WM_User + 1;
すみません、レベルが低くて。
動かせませんでした。
全体像が分かるよう、貼っておきます。（実際にはエラーチェックや付随
する処理など、様々なことをやっています。ここで貼ったのは、肝の部分
を抽出したものです。）
なお、自分ではWM_Userを使っていましたが、実際には、ここの部分は
WM_Appの方を使う方がいいかもしれません。
uses
…
const
WM_MyMsg1 = WM_User + 1;
…
type
TForm1 = class(TForm)
private
procedure OnMyMsg1(var Msg: TMessage);
message WM_MyMsg1;
procedure CloseTab(Index: Integer);
procedure BrowserWindowClosing(Sender: TObject;
IsChildWindow: WordBool; var Cancel: WordBool);
end;
…
procedure TForm1.OnMyMsg1(var Msg: TMessage);
begin
CloseTab(Msg.WParam, True);
end;
procedure TForm1.CloseTab(Index: Integer; RestoreLastIndex: Boolean);
var
Browser: TWebBrowser;
begin
Browser := TWebBrowser(TabControl1.Tabs.Objects[Index]);
Browser.Free;
TabControl1.Tabs.Delete(Index);
end;
procedure TForm1.BrowserWindowClosing(Sender: TObject;
IsChildWindow: WordBool; var Cancel: WordBool);
var
i: Integer;
begin
Cancel := True;
i := TabControl1.Tabs.IndexOfObject(Sender);
PostMessage(Form1.Handle, WM_MyMsg1, i, 0);
end;
CloseTabの引数が多すぎるところが一か所ありますね。
確認不足ですみません。
引数は定義部のとおり、１つのみとしてください。
＞webbrowserの場合 過去ログにある
＞｛ window.execScript を使ってJavaScriptの window.close の動作を上書きクリア ｝
＞で閉じるボタンを無効にすれば …この問題は開示できました。
＞このようなことなんでしょうか。
えーと、ぜんぜん違うメカニズムですね。
OnWindowClosing は、元から TWebBrowser（＝IEコンポーネント）に用意されている専用のイベントです。
WebBrowserが閉じようとしている時に発生し、閉じるのをキャンセルすることも出来ます。
一方、OnDocumentComplete で window.execScript を使う方法は、Documentを読み込み次第JavaScriptの
動作に干渉し、「Webページに書かれているスクリプト中の window.close を無効化する」ことによって
WebBrowserが閉じられないようにするというものです。これはかなり苦しいやり方のように思えます。
＞ところがEmbeddedではこれが通用しないのです。
＞web : IWebBrowser ;の定義する方法がわかりません。
Delphi6 Personalに、EmbeddedWB（EmbeddedWB_D2005_Version_14.61.zip）を入れて調べてみました。
※EmbeddedWebBrowser_D6.dpkのvclieをコメントアウトしてインストール、ライブラリパスに
EmbeddedWB_D2005\Source\Lib、ブラウザ検索パスにEmbeddedWB_D2005\Source でOkでした。
試してみましたが、単に uses が足りなかった、という状況だと思います。
それで、武田さんのソースに下記のコードを追加したところ、普通に動作（close阻止）されました。
type
TIETabSheet = class(TTabSheet)
private
procedure EmbeddedWB1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
（中略）
implementation
{$R *.dfm}
uses
// それぞれEmbeddedWBに付属してる版。TWebBrowser用なら_Ewbを付けないか、_TLBに書き換える。
Mshtml_Ewb, // IHTMLWindow2、IHTMLDocument2
SHDocVw_EWB; // IWebBrowser
constructor TIETabSheet.Create(AOwner: TComponent);
begin
（中略）
EmbeddedWB1.OnDocumentComplete := EmbeddedWB1DocumentComplete; // 追加
end;
procedure TIETabSheet.EmbeddedWB1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
window: IHTMLWindow2;
document: IHTMLDocument2;
web: IWebBrowser;
begin
//**Closeメソッドの無効化
// try // try〜except〜end; は問題を隠してしまうので、とりあえず除去。
web:=pDisp as IWebBrowser;
document:=web.document as IHTMLDocument2;
window:=IHTMLWindow2(Document.parentWindow);
window.execScript('function close() {}','JavaScript');
// except end;
end;
ただし…
「WebBrowserの閉じられ防止」には window.execScript を使用する方法でなく、OnWindowClosing を
使うのが最も適切だと思います。ですから、必ず あ さんの方法を試してください。
あさん、Harryさん 連続もせず、とりあえず非礼をお詫びします。
日曜日、我が家の貸与されているモデムが破損し
６日ようやく交換してもらい回復したかに見えたら、今度は
バッファローのスイッチングハブ（８ポートX２台）が
熱帯日の連続で破壊しかかっていて
連鎖熱死しているのに気づき今度はヨドバシカメラに走り
ロジテックの８ポートＸ２台 ギガ対応高耐熱対応にしました。
まさか３機器が同時ダウンするとは切り分けに苦労しました。
やっと修復しました。
いままでメールもみられませんでした。
今夜からお返事の内容をテストしてみます。しばし時間の余裕を。
すみませんでした。
ありがとうございました。
あさん、Harryさん 誠にありがとうございました。
両方とも、うまく作動しました。
感謝の念に堪えません。
これが解決できなくて、小生の自作ブラウザは
完成しなかったのです。
ありがとうございました。
では。
| ツイート |  |