5

这是我的代码：

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

implementation
uses ActiveX;

procedure TForm1.Button1Click(Sender: TObject); // method 1
var
  HtmlFile: string;
begin
  HtmlFile := ExtractFilePath(Application.ExeName) + 'test.html';
  WebBrowser1.Navigate(HtmlFile);
end;

procedure LoadHtml(wb: TWebBrowser; HTMLStr: string);
var
  aStream: TMemoryStream;
begin
  wb.Navigate('about:blank'); // reset the webbrowser
  while wb.ReadyState < READYSTATE_INTERACTIVE do // wait to load the empty page
    Application.ProcessMessages;
  if Assigned(wb.Document) then
  begin
    aStream := TMemoryStream.Create;
    try
      aStream.WriteBuffer(Pointer(HTMLStr)^, Length(HTMLStr));
      aStream.Seek(0, soFromBeginning);
      (wb.Document as IPersistStreamInit).Load(TStreamAdapter.Create(aStream));
    finally
      aStream.Free;
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject); // method 2
begin
  LoadHtml(WebBrowser1,
    '<html><head></head><body>'+
    '  <object width="640" height="390"> '+
    '  <param name="movie" value="http://www.youtube.com/v/L7NWdxFAHdY&hl=en_US&feature=player_embedded&version=3"> '+
    '  </param><param name="allowFullScreen" value="true"> '+
    '  </param><param name="allowScriptAccess" value="always"> '+
    '  </param><embed src="http://www.youtube.com/v/L7NWdxFAHdY&hl=en_US&feature=player_embedded&version=3" type="application/x-shockwave-flash" allowfullscreen="true" allowScriptAccess="always" width="640" height="390"> '+
    '  </embed></object> '+
    '</body></html>'
    );
end;

测试.html

<object width="425" height="349">
<param name="movie" value="http://www.youtube.com/v/1hPxGmTGarM?version=3&amp;hl=iw_IL">
</param><param name="allowFullScreen" value="true"></param>
<param name="allowscriptaccess" value="always"></param>
<embed src="http://www.youtube.com/v/1hPxGmTGarM?version=3&amp;hl=iw_IL" type="application/x-shockwave-flash" width="425" height="349" allowscriptaccess="always" allowfullscreen="true">
</embed></object>

我的应用程序在这两种方法中都崩溃了。我得到一个未处理的 win32 异常（由 Flash player 引起Exception EInvalidOp in module Flash10u.ocx at 00108657. Invalid floating point operation）。

  • 我在 D5、D7、D9 上尝试了此代码。
  • 我试图重新导入 SHDocVw.dll。
  • 我还尝试使用 EmbeddedWB 控件而不是 TWebBroser ...
  • Internet Explorer/Avant/Maxthon 对这个 HTML 没有任何问题（都基于 IE ActiveX）。

有什么建议或修复吗？

我怎样才能捕捉到这个错误，甚至抑制它？

有没有办法通过 TWebBrowser 事件即时操作或更改 HTML，这样我就可以显示图像而不是 Flash 播放器，就像 Ad-Blockers 的工作原理一样？（我的客户通过 Internet 在他们的站点中拥有该代码，我的 Delphi 应用程序提供了快速预览）

更新

我使用 TTimer 来启用/禁用 FPU（基于 Arjen 的想法）：

function Get8087CW: Word; // for D5
asm
        PUSH    0
        FNSTCW  [ESP].Word
        POP     EAX
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := False;
  Timer1.Interval := 5000; // 5 sec
  Saved8087CW := Get8087CW;
end;

procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  Timer1.Enabled := False;
  System.Set8087CW($133F); // Disable all fpu exceptions
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
   Timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  Set8087CW(Saved8087CW);
end;

更新 (2)

我最终在应用程序启动时屏蔽了 FPU 异常。从那以后，对我的申请没有（已知的）影响。

4

2 回答 2

5

更漂亮的解决方案：

Math.SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow,
  exUnderflow, exPrecision]);

如果我正确阅读了文档，则会消除提到的Math.SetExceptionMask每个异常。

但是，它只是@Arjen 方法的更清洁、更漂亮的版本。

于 2011-11-20T14:45:55.787 回答
4

尝试使用 Set8087CW(0x133f) 暂时禁用 FPU 异常； 信息

于 2011-11-20T10:38:33.157 回答