如何在出错后让TWebBrowser继续运行JavaScript?

时间:2011-12-19 19:49:30

标签: javascript delphi browser

我在Delphi 2010上的WebBrowser中遇到了一些javascript错误处理问题。

我正在使用启用了静默属性的WebBrowser。似乎没问题,但是在有错误脚本的站点上存在一个问题:在错误未执行后,它似乎是脚本的一部分。某些脚本的结果与IE略有不同。

您是否知道如何解决此问题?

2 个答案:

答案 0 :(得分:12)

您可以使用IOleCommandTarget并在其IOleCommandTarget.Exec方法中捕获OLECMDID_SHOWSCRIPTERROR命令。

在下面的示例中,我使用了插入的类,因此如果您将此代码放入您的单元中,则只有表单上的Web浏览器或在此单元中动态创建的那些Web浏览器才会出现此行为。

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;

答案 1 :(得分:4)

以下是我的实施建议。

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;