Comment puis-je faire que TWebBrowser continue d'exécuter JavaScript après une erreur?

Vous pouvez utiliser IOleCommandTarget et dans sa méthode IOleCommandTarget.Exec , OLECMDID_SHOWSCRIPTERROR commande OLECMDID_SHOWSCRIPTERROR .

Dans l'exemple suivant, j'ai utilisé la classe interposée, donc, si vous mettez ce code dans votre unité, seuls les navigateurs Web sur le formulaire ou ceux créés dans cette unité dynamiquement obtiendront ce comportement.

 uses SHDocVw, ActiveX; type TWebBrowser = class(SHDocVw.TWebBrowser, IOleCommandTarget) private function QueryStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; stdcall; function Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD; const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall; end; implementation function TWebBrowser.QueryStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; stdcall; begin Result := S_OK; end; function TWebBrowser.Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD; const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall; begin // presume that all commands can be executed; for list of available commands // see SHDocVw.pas unit, using this event you can suppress or create custom // events for more than just script error dialogs, there are commands like // undo, redo, refresh, open, save, print etc. etc. // be careful, because not all command results are meaningful, like the one // with script error message boxes, I would expect that if you return S_OK, // the error dialog will be displayed, but it's vice-versa Result := S_OK; // there's a script error in the currently executed script, so if nCmdID = OLECMDID_SHOWSCRIPTERROR then begin // if you return S_FALSE, the script error dialog is shown Result := S_FALSE; // if you return S_OK, the script error dialog is suppressed Result := S_OK; end; end; 

Voici ma recommandation de mise en œuvre.

 uses SHDocVw, ActiveX; type TWebBrowser = class(SHDocVw.TWebBrowser, IOleCommandTarget) private function QueryStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; stdcall; function Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD; const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall; end; implementation function TWebBrowser.QueryStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; stdcall; begin // MSDN notes that a command target must implement this function; E_NOTIMPL is not a // valid return value. Be careful to return S_OK, because we notice that context menu // of Web page "Add to Favorites..." becomes disabled. Another MSDN document shows an // example with default return value OLECMDERR_E_NOTSUPPORTED. // http://msdn.microsoft.com/en-us/library/bb165923(v=vs.80).aspx Result := OLECMDERR_E_NOTSUPPORTED; end; function TWebBrowser.Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD; const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall; var ShowDialog, InterpretScript: Boolean; begin if CmdGroup = nil then begin Result := OLECMDERR_E_UNKNOWNGROUP; Exit; end; // MSDN notes that a command target must implement this function; E_NOTIMPL is not a // valid return value. Be careful to return S_OK, because we notice some unhandled // commands behave unexpected with S_OK. We assumed that a return value // OLECMDERR_E_NOTSUPPORTED means to use the default behavior. Result := OLECMDERR_E_NOTSUPPORTED; if IsEqualGUID(CmdGroup^, CGID_DocHostCommandHandler) then begin // there's a script error in the currently executed script, so if nCmdID = OLECMDID_SHOWSCRIPTERROR then begin ShowDialog := True; InterpretScript := False; // Implements an event if you want, so that your application is able to choose the way of handling script errors at runtime. if Assigned(OnNotifyScriptError) then OnNotifyScriptError(Self, ShowDialog, InterpretScript); if ShowDialog then Result := S_FALSE else Result := S_OK; vaOut := InterpretScript; // Without setting the variable to true, further script execution will be cancelled. end; end; end;