在 TWebBrowser 中加载字符串（HTML 代码）的最佳方式是什么？

Question

我有一个包含 HTML 代码的字符串变量 'HTMLCode'。我想将此代码加载到浏览器中。

这是 Embarcadero 的代码：

procedure THTMLEdit.EditText(CONST HTMLCode: string);
{VAR
   Doc: IHTMLDocument2;
   TempFile: string; }
begin
 TempFile := GetTempFile('.html');  
 StringToFile(TempFile, HTMLCode);
 wbBrowser.Navigate(TempFile);

 Doc := GetDocument;
 if Doc <> NIL
 then Doc.Body.SetAttribute('contentEditable', 'true', 0);  //crash here when I load complex html files

 DeleteFile(TempFile);
end;

它有一些 problems 所以我用这个替换它：

procedure THTMLEdit.EditText(CONST HTMLCode: string);
VAR
   TSL: TStringList;
   MemStream: TMemoryStream;
begin
 wbBrowser.Navigate('about:blank');
 WHILE wbBrowser.ReadyState < READYSTATE_INTERACTIVE
  DO Application.ProcessMessages;

 GetDocument.DesignMode := 'On';

 if Assigned(wbBrowser.Document) then
  begin
    TSL := TStringList.Create;
    TRY
      MemStream := TMemoryStream.Create;
      TRY
        TSL.Text := HTMLCode;
        TSL.SaveToStream(MemStream);
        MemStream.Seek(0, 0);
        (wbBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(MemStream));
      FINALLY
        MemStream.Free;
      end;
    FINALLY
      TSL.Free;
    end;
  end;
end;

但是这个也有问题。首先，当我将链接 (...) 插入 HTML 代码时，浏览器将更改代码，appending 'about:' 在我的 URL 前面。第二：它比第一个过程（带有临时文件的那个）慢。

我可以在浏览器中加载 HTML 代码而不先导航到 'about:blank' 吗？

Answer 1

您可以加载您的 HTML 代码如下

procedure THTMLEdit.EditText(CONST HTMLCode: string);
var
  Doc: Variant;
begin
  if NOT Assigned(wbBrowser.Document) then
    wbBrowser.Navigate('about:blank');

  Doc := wbBrowser.Document;
  Doc.Clear;
  Doc.Write(HTMLCode);
  Doc.Close;
end;

Answer 2

您的问题：

首先，当我在HTML代码中插入links(...)时，浏览器会修改代码，在前面追加'about:'我的 URLs.
其次：比第一个过程（有临时文件的那个）慢。
我可以在浏览器中加载 HTML 代码而不 先导航到 'about:blank' 吗？

答案：

是的，不改变 link!
不，它并不慢！
可以，不需要先导航到about:blank

我们从代码和第一个过程开始（只是为了说明 about: ... 的来源）。

{$R *.DFM}
var
Doc: IHTMLDocument2;
TempFile: string;
xBody   : IHTMLElement;
xLoaded : Boolean;
onlyOnce: Boolean;

procedure TForm1.WB_LoadHTML(HTMLCode: string);
var
  sl: TStringList;
  ms: TMemoryStream;
begin
  xLoaded := False;
  WebBrowser.Navigate('about:blank');
  while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
   Application.ProcessMessages;

  if Assigned(WebBrowser.Document) then
  begin
    sl := TStringList.Create;
    try
      ms := TMemoryStream.Create;
      try
        sl.Text := HTMLCode;
        sl.SaveToStream(ms);
        ms.Seek(0, 0);
        (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
      finally
        ms.Free;
      end;
    finally
      sl.Free;
      Doc :=  WebBrowser.Document as IHTMLDocument2;
    end;
  end;
end;

procedure TForm1.LoadHTMLBtnClick(Sender: TObject);
begin
WB_LoadHTML(Memo1.Text);
end;

procedure TForm1.LoadFileBtnClick(Sender: TObject);
begin
Memo1.Lines.LoadFromFile('G:\Programme\Apache Group\Apache\htdocs\bearbeiten1.html');
end;

我们已经创建了 2 个文件（它们是相同的）只是脚本不同，以便在加载时获得警报。
bearbeiten1.html

<script type="text/javascript">
alert ("bearbeiten1.html");      
</script>

bearbeiten3.html

<script type="text/javascript">
alert ("bearbeiten3.html");      
</script>

单击 加载文件 我们加载“bearbeiten1.html”文件
并使用 WB_LoadHTML 将其加载到内存中。

我们得到 URL : about:blank

和警报

现在我们创建一个 link:
我们 select 蓝色部分然后单击 创建link

创建link

还有新的“Doc.body.innerHTML”

procedure TForm1.createlinkBtnClick(Sender: TObject);
begin
Doc.execCommand('createlink', false,'bearbeiten3.html');
Memo1.Text := Doc.body.innerHTML;
end;

到目前为止一切顺利！但是它会起作用吗...？没有

点击 link 之后，我们得到的只是一个空白网站 URL:

现在我们试试新的 EditText() 代码

procedure TForm1.EditText(CONST HTMLPath: string);
begin
 TempFile := HTMLPath;
 xLoaded := False;
 WebBrowser.Navigate(TempFile);
 Doc :=  WebBrowser.Document as IHTMLDocument2;
 if Doc <> nil then  xLoaded := True;
end;

procedure TForm1.EditTextBtnClick(Sender: TObject);
begin
  EditText('G:\Programme\Apache Group\Apache\htdocs\bearbeiten1.html');
end;

点击加载文件，我们再次加载“bearbeiten1.html”文件使用 EditTextBtnClick 我们直接加载它。看起来好多了！有用吗...？

让我们点击 link - 我们收到警报！！来自号码...3.html"

并且 .html 文件加载没有问题。

关于你的其他问题

 if Doc <> NIL
then Doc.Body.SetAttribute('contentEditable', 'true', 0);
//crash here when I load complex html files

您做错了地方，因为正文只有在网站加载后才可用！！

所以我把它放在事件WebBrowserNavigateComplete2

只有快速的解决方案才能得到改进

procedure TForm1.WebBrowserNavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
if xLoaded  = True then begin
    xBody := Doc.Get_body;
    if xBody <> nil then begin
       xBody.SetAttribute('contentEditable', 'true', 0);
       Memo1.Text := Doc.body.innerHTML;
       xLoaded := False;
    end;
end;
label2.Caption := URL;
end;

完整代码。

type
  TForm1 = class(TForm)
    WebBrowser: TWebBrowser;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    LoadHTMLBtn: TButton;
    LoadFileBtn: TButton;
    EditTextBtn: TButton;
    createlinkBtn: TButton;
    innerHTMLBtn: TButton;
    procedure LoadHTMLBtnClick(Sender: TObject);
    procedure LoadFileBtnClick(Sender: TObject);
    procedure EditTextBtnClick(Sender: TObject);
    procedure createlinkBtnClick(Sender: TObject);
    procedure WebBrowserNavigateComplete2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure innerHTMLBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure WB_LoadHTML(HTMLCode: string);
    procedure EditText(CONST HTMLPath: string);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
var
Doc: IHTMLDocument2;
TempFile: string;
xBody   : IHTMLElement;
xLoaded : Boolean;
onlyOnce: Boolean;

procedure TForm1.WB_LoadHTML(HTMLCode: string);
var
  sl: TStringList;
  ms: TMemoryStream;
begin
  xLoaded := False;
  WebBrowser.Navigate('about:blank');
  while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
   Application.ProcessMessages;

  if Assigned(WebBrowser.Document) then
  begin
    sl := TStringList.Create;
    try
      ms := TMemoryStream.Create;
      try
        sl.Text := HTMLCode;
        sl.SaveToStream(ms);
        ms.Seek(0, 0);
        (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
      finally
        ms.Free;
      end;
    finally
      sl.Free;
      Doc :=  WebBrowser.Document as IHTMLDocument2;
    end;
  end;
end;

procedure TForm1.LoadHTMLBtnClick(Sender: TObject);
begin
WB_LoadHTML(Memo1.Text);
end;

procedure TForm1.LoadFileBtnClick(Sender: TObject);
begin
Memo1.Lines.LoadFromFile('G:\Programme\Apache Group\Apache\htdocs\bearbeiten1.html');
end;

procedure TForm1.EditText(CONST HTMLPath: string);
begin
 TempFile := HTMLPath;
 xLoaded  := False;
 WebBrowser.Navigate(TempFile);
 if onlyOnce then WebBrowser.Navigate(TempFile);
 onlyOnce := False;
 Doc :=  WebBrowser.Document as IHTMLDocument2;
 if Doc <> nil then  xLoaded := True;
end;

procedure TForm1.EditTextBtnClick(Sender: TObject);
begin
  EditText('G:\Programme\Apache Group\Apache\htdocs\bearbeiten1.html');
end;

procedure TForm1.createlinkBtnClick(Sender: TObject);
begin
Doc.execCommand('createlink', false,'bearbeiten3.html');
Memo1.Text := Doc.body.innerHTML;
end;

procedure TForm1.WebBrowserNavigateComplete2(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
if xLoaded then begin
    xBody := Doc.Get_body;
    if xBody <> nil then begin
       xBody.SetAttribute('contentEditable', 'true', 0);
       Memo1.Text := Doc.body.innerHTML;
       xLoaded := False;
    end;
end;
label2.Caption := URL;
end;

procedure TForm1.innerHTMLBtnClick(Sender: TObject);
begin
Memo1.Text := Doc.body.innerHTML;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 onlyOnce := True;
end;
end.

更新：
我忘记在代码中设置临时文件路径（复制粘贴错误）。
还添加了 FormCreate。
并且只有一次加载 TempFile 两次！（见代码）

Important 临时文件的head标签必须是link

bearbeiten1.html和bearbeiten3.html一样，只是alert ("bearbeiten3.html");必须适配！！

bearbeiten1.html

<head>
<link href="file:///G:\Programme\Apache Group\Apache\htdocs\maor.css" rel="stylesheet" media="screen">
</head>
<body leftmargin="0" marginheight="0" marginwidth="0" topmargin="0" bgcolor="#1F2E53">
<script type="text/javascript">
  alert ("bearbeiten1.html");        
</script>
    <table width="100%" border="0" cellspacing="0" cellpadding="0" >
      <tr height="211">
        <td width="2%" height="211"></td>
        <td valign="top" width="36%" height="211">
            <table width="448" border="0" cellspacing="0" cellpadding="0">
             <tr height="21">
                <td width="8" height="21"></td>
                <td class="FormControlrechts" width="150" height="21"></td>
                <td width="23" height="21"></td>
                <td class="FormControl" width="213" height="21">
                <p unselectable="on">Select any portion of the following blue text</p>
                <p id="p1" style="color= #3366CC">My favorite Web site. Don't forget to click the button! createlink</p>
                </td>
             </tr>
            </table>
    </table>
</body>

maor.css

body {}
p {}
td {}
h1 { color: #f5c391; font-weight: normal; font-size: 20px; font-family: verdana, serif; margin-bottom: 0.2em }
h2 { color: #eaeaea; font-weight: normal; font-size: 16px; margin-top: 0; margin-bottom: 0 }
form { margin-top: 0px }
a:link { font-weight:bold; color:#36f; text-decoration:none; }
a:visited { font-weight:bold; color:silver; text-decoration:none; }
a:focus { font-weight:bold; color:#d4d4d4; text-decoration:underline; }
a:hover { font-weight:bold; color:#c0c0c0; text-decoration:none; }
a:active { font-weight:bold; color:lime; text-decoration:underline; }
textarea, input { font-size: 8pt }
select, option { font-size: 9pt }
td { color: #333; font-size: 9pt; font-family: verdana, sans-serif }
td.FormControl   { color: #ffe78b; font-size: small; padding-top: 5px; padding-bottom: 5px; border-right: 1px solid #5dafb0; border-bottom: 1px solid #5dafb0 }
td.FormControlrechts   { color: #a88664; font-size: 8pt; text-align: right; padding-top: 5px; padding-bottom: 5px; border-top: #5dafb0; border-right: #5dafb0; border-bottom: 1px solid #5dafb0; border-left: #5dafb0 }
.class { }

Answer 3

在Delphi中显示HTML代码的最简单方法：

WebBrowser1.Navigate('about:'+yourHTMLcode);

在 TWebBrowser 中加载字符串（HTML 代码）的最佳方式是什么？

Which is the best way to load a string (HTML code) in TWebBrowser?

delphi

internet-explorer

twebbrowser

delphi-xe7