Jak sprawić, aby TWebBrowser nadal obsługiwał JavaScript po błędzie?

Question

Mam pewne problemy z obsługą błędów JavaScript w WebBrowser na Delphi 2010.

Używam przeglądarki WebBrowser z włączoną cichą usługą. Wydaje się OK, ale jest jeden problem na stronach z błędnymi skryptami: wygląda na to, że jest częścią skryptu po tym, jak błąd nie zostanie wykonany. Wyniki niektórych skryptów nieco różnią się od IE.

Czy masz pojęcie, w jaki sposób można rozwiązać ten problem?

Answer 1

Można użyć metody IOleCommandTarget, aw jej metodzie IOleCommandTarget.Exec można przechwycić polecenie OLECMDID_SHOWSCRIPTERROR.

W poniższym przykładzie użyłem klasy pośredniej, więc jeśli umieścisz ten kod w swoim urządzeniu, tylko te przeglądarki internetowe w formularzu lub te utworzone w tej jednostce dynamicznie uzyskają to zachowanie.

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; 

Answer 2

Oto moja rekomendacja wdrożenia.

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;