How do I make TWebBrowser keep running JavaScript after an error? （转）

转自 ： http://stackoverflow.com/questions/8566659/how-do-i-make-twebbrowser-keep-running-javascript-after-an-error

 

'm having some troubles with javascript error handling in WebBrowser on Delphi 2010.

I'm using WebBrowser with enabled silent property. Seems OK, but there is one issue on sites with buggy scripts: it seems like part of script after error doesn't executes. Results of some script slightly differs from IE.

Do you have any idea how this issue can be solved?

 

You can use the IOleCommandTarget and in its IOleCommandTarget.Exec method catch the OLECMDID_SHOWSCRIPTERROR command.

In the following example I've used the interposed class so if you put this code into your unit, only those web browsers on the form or those created in this unit dynamically will get this behavior.

 

+ View Code?

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;

 

 

+ View Code?

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;