在TWebBrowser中加载字符串（HTML代码）的最佳方法是哪种？

Question

我有一个包含HTML代码的字符串var'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：'。第二：它比第一个程序（具有临时文件的程序）慢。

我可以在浏览器中加载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代码时，浏览器将更改代码，在我的URL前面附加“about：”。
• 第二：它比第一个程序（具有临时文件的程序）慢。
• 我可以在浏览器中加载HTML代码而无需先导航到'about：blank'吗？

回答：

• 是的，没有改变链接是可能的！
• 不，它不慢！
• 是的，有可能，不需要先导航到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

和警报

现在我们创建一个链接： 我们选择蓝色部分并单击createlink

链接已创建

以及新的“Doc.body.innerHTML”

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

到现在为止还挺好 ！但它会起作用吗？没有

点击链接后，我们得到的是一个带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直接加载它。看起来好多了！它会起作用吗？

我们点击链接吧！我们得到警报！来自Nr。 ... 3.html”

和.html文件加载没有问题。

对你的另一个问题

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

你是在错误的地方做到的，身体只有在网站加载后才可用！

所以我把它放在事件WebBrowser NavigateComplete2中

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

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.

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

在TempFile的head标签中重要的必须是链接

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);