TWebBrowserでスクリプトエラーダイアログのみを消す方法
いつもお世話になります。以下の質問をさせていただきますので、
どうぞよろしくお願いいたします。
1 やりたいこと
・TWebBrowserで簡単なブラウザを作成しています。
・そのブラウザで巡回していると、IEと比べ、頻繁にJavaScriptの
エラーメッセージが表示されます。ですので、JavaScriptのメッ
セージを抑止したいと考えています。
(ひどいときには、MSNのポータルサイトでもメッセージが出ます。)
2 これまでの対応
・SilentプロパティをTrueにしました。
その結果、エラーメッセージ等は確かに表示されなくなったので
すが、他のベーシック認証用ダイアログ等も表示されなくなって
しまいました。
例えばこのページです。 http://www.chama.ne.jp/access/
(ページ中ほどの「サンプルはこちら」というリンクで確認)
・他の手法を探しましたが、うまく見つけられませんでした。
3 質問事項
・どうすればJavaScriptのエラーメッセージのみを消せるでしょうか。
自分で実装する場合も、ソースを解析すれば参考になるかと。
せっかく回答をいただいていたのに、答えが遅れてしまい、申し訳ありません。（少しの期間、地震で難儀してました。）
TEmbeddedWBコンポーネント、確認させていただきました。
そうしたところ、そのコンポーネントでは、このようなことをやっているようでした。以下、TEmbeddedWB.pasからの引用です。
↓ParentForm（TForm）のWindowProcと入れ替えてサブクラス化
procedure TEmbeddedWB.FormWndProc(var AMsg: Messages.TMessage);
begin
if AMsg.Msg = WM_ACTIVATE then begin
HandleDialogBoxes(AMsg);
end;
if AMsg.Msg <> 45062 then FOldWindowProc(AMsg);
end;
procedure TEmbeddedWB.HandleDialogBoxes(var AMsg: Messages.TMessage);
var
PopHandle: Integer;
DlgCaption, DlgClss: string;
Msg: TWMActivate;
WI: TWindowInfo;
begin
Msg := TWMActivate(AMsg);
if Msg.Active = 0 then
begin
PopHandle := Msg.ActiveWindow;
DlgClss := GetWinClass(PopHandle);
FillChar(WI, SizeOf(WI), 0);
if PopHandle <> 0 then
begin
WI.dwStyle := Abs(GetWindowLong(PopHandle, GWL_STYLE));
WI.dwExStyle := Abs(GetWindowLong(PopHandle, GWL_EXSTYLE));
end;
if (DlgClss = '#32770') or (DlgClss = 'Internet Explorer_TridentDlgFrame') then
begin
DlgCaption := GetWinText(PopHandle);
if (PopHandle <> 0) and Assigned(FOnShowDialog) then
FOnShowDialog(Self, PopHandle, WI.dwExStyle, DlgCaption, FDialogBoxes.FNewCaption, FDialogBoxes.FDisableAll);
if FDisableErrors.FScriptErrorsSuppressed then
begin
if (AnsiPos('SCRIPT', AnsiUpperCase(DlgCaption)) <> 0) then
begin
PostMessage(PopHandle, WM_LBUTTONDOWN, 0, 0);
PostMessage(PopHandle, WM_LBUTTONUP, 0, 0);
SendMessage(PopHandle, WM_CLOSE, 0, 0);
Forms.Application.ProcessMessages;
Exit;
end;
if (AnsiPos('ERROR', AnsiUpperCase(DlgCaption)) <> 0) or (WI.dwExStyle = 4260097) then
begin
DestroyWindow(PopHandle);
Exit;
end;
end;
end;
end;
end;
引用終わり。
(続きます。)
上記について、簡単に申し上げますと、
１ WebBrowserに飛んでくるメッセージを監視し続け、
２ WM_Activateが来たとき、新しくアクティブになったダイアログのキャプションを取得、
３ そのダイアログがエラーメッセージダイアログのキャプションと一致したら、WM_Closeを送って閉じる
ということをやっているようでした。それを踏まえ、当方では次のように処理をしようと考えました。
private
{ Private 宣言 }
OriginProc: TWndMethod; //元のウィンドウ関数保持用
procedure SubClassProc(var AMsg: TMessage); //入れ替え用手続き
procedure TForm1.FormShow(Sender: TObject);
begin
OriginProc := Self.WindowProc;
Self.WindowProc := SubClassProc;
end;
procedure TForm1.SubClassProc(var AMsg: TMessage);
var
S: String;
Wnd: HWND;
I: Integer;
Msg: TWMActivate;
begin
if AMsg.Msg = WM_Activate then begin
Msg := TWMActivate(AMsg);
If Msg.Active = 0 then begin
Wnd := Msg.ActiveWindow;
I := GetWindowTextLength(Wnd);
SetLength(S, I + 1);
GetWindowText(Wnd, PChar(S), I + 1);
If AnsiPos('Internet Explorer スクリプト', S) > 0 then begin
SendMessage(Wnd, WM_CLOSE, 0, 0);
end;
end;
end;
OriginProc(AMsg);
end;
これで、基本的に抑止には成功しました。ですが、1つ新たな問題が発生してしまいました。
それは、上でダイアログを閉じると、本来Form1のキャプションの色がアクティブな色に戻るところ、
非アクティブな色のまま、元に戻らないのです。
無理やりSetForeGroundWindow等を使ってアクティブ状態に戻してみましたが、
キャプションの色が「非アクティブ」→「アクティブ」とちらついてしまい、見栄えが悪くなってしまっています。(TEmbeddedWBでは、このようなちらつきが全く出ておらず、不思議でした。)
このようなちらつきをなんとかなくしたいと思っています。どなたか、よい
お知恵をお持ちの方、どうぞよろしくお願いいたします。
すみません。参考URLについて追記させてください。
スクリプトエラーを発生させるページはいくつかあるのですが、
このスクリプトエラーのサンプルページでしたら、確実にエラーが発生します。
http://www.ajaxtower.jp/js/error/sample_err.html
（このページは、http://www.ajaxtower.jp/js/error/index1.html から
リンクされている、JavaScript学習用のページです。）
EmbeddedWBの実装を見た感じ
スクリプトエラー処理のキモはIOleCommandTargetを実装してExecメソッド内でOLECMDID_SHOWSCRIPTERRORを処理する事だと思います。（TCustomEmbeddedWB.CommandTarget_Exec）
ご回答、どうもありがとうございます。
ただ、せっかく教えていただいて恐縮なのですが、おっしゃっていることが
理解できておりません。
単語を拾ってみると、単純に1つの関数として定義しているのは読み取れるの
ですが、なぜこれがスクリプトエラーを抑止する効果があるのか、よく分かり
ませんでした。
あつかましいお願いで恐縮なのですが、もう少し詳細な解説をお願いできませ
んでしょうか。お手数ですが、どうぞよろしくお願いいたします。
IOleCommandTargetインターフェースのExecを実装することで、スクリプトエラーが発生した時に呼び出される事になります。
http://support.microsoft.com/kb/261003/en-us
私もそんなに深く理解してる訳じゃ無いんで上手く説明出来ません。
一応、下の定義をFormの定義の上でやればスクリプトエラー出なくなります。
const
CGID_DocHostCommandHandler: TGUID = (D1: $F38BC242; D2: $B950; D3: $11D1; D4:
($89, $18, $00, $C0, $4F, $C2, $C8, $36));
type
TWebBrowser = class(SHDocVw.TWebBrowser, IOleCommandTarget)
protected
{IOleCommandTarget interface}
function IOleCommandTarget.QueryStatus = CommandTarget_QueryStatus;
function CommandTarget_QueryStatus(CmdGroup: PGUID; cCmds: Cardinal;
prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; stdcall;
function IOleCommandTarget.Exec = CommandTarget_Exec;
function CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall;
end;
{ TWebBrowser }
function TWebBrowser.CommandTarget_Exec(CmdGroup: PGUID; nCmdID,
nCmdexecopt: DWORD; const vaIn: OleVariant; var vaOut: OleVariant): HRESULT;
begin
Result := OLECMDERR_E_NOTSUPPORTED;
if CmdGroup <> nil then
begin
if IsEqualGuid(cmdGroup^, CGID_DocHostCommandHandler) then
begin
case nCmdID of
(* ID_IE_F5_REFRESH {nCmdID 6041, F5},
ID_IE_CONTEXTMENU_REFRESH {nCmdID 6042, Refresh by ContextMenu},
IDM_REFRESH {nCmdID 2300}:
begin
if Assigned(FOnRefresh) then
begin
tmpCancel := False;
FOnRefresh(Self, nCmdID, tmpCancel);
if tmpCancel then
Result := S_OK; //FIXME is it true? Why not OLECMDERR_E_CANCELED
end;
Exit;
end;
*)
OLECMDID_SHOWSCRIPTERROR:
begin
vaOut := True;
Result := S_OK;
Exit;
end;
end;
end;
end;
end;
function TWebBrowser.CommandTarget_QueryStatus(CmdGroup: PGUID; cCmds: Cardinal;
prgCmds: POleCmd; CmdText: POleCmdText): HRESULT;
begin
prgCmds.cmdf := OLECMDF_ENABLED;
Result := S_OK;
end;
au様
お忙しいところ、該当箇所をお示しいただきまして、本当にありがとうございます。
今、適用してしばらく使っていたのですが、エラーが全く出ません。この問題は、かなりの難問で、自分では全く解決できなかったものですから、本当にうれしいです。感謝しても感謝しきれません。本当にありがとうございます。
ただ、コードの内容はぜんぜん理解できていません…
class(SHDocVw.TWebBrowser, IOleCommandTarget)
というように、２つのクラスを引き継いだ？クラスの作成などはやったことが
ありませんし、インターフェースも、なぜこのコードを書くと自動的に処理
がされるのか、全く分からない状況です。
ただ、内容の理解は、ご提示いただいたページを見たり、コードをいろいろ
改変していじってみたりしてもう少し勉強してみようと思います。
(ブラウザの作成の勉強は今後も続くと思いますので。)
とりあえず、もう少しだけプログラムをいろいろいじってみて、自分の理解に
一定の決着がついた時点で、あらためて解決マークをつけたいと思います。
今回は、本当にどうもありがとうございました。本当に助かりました。
| ツイート |  |