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代码中插入链接（...）时，浏览器会更改代码，附加＆＃39; about：＆＃39;在我的网址前面。
第二：它比第一个程序（带有临时文件的程序）慢。
我是否可以在浏览器中加载HTML代码而不使用首先导航到＆＃39;关于：空白＆＃39;？

<强>数目：

是的，可以不改变链接！
不，它不慢！
是的，有可能，无需先导航到关于：空白

我们从代码和第一个程序（仅显示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>

点击加载文件，我们加载＆＃34; bearbeiten1.html＆＃34;文件
并使用 WB_LoadHTML 将它们加载到内存中。

我们获得网址：about：blank

和警报

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

创建链接

以及新的＆＃34; Doc.body.innerHTML＆＃34;

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

到目前为止一切顺利！但它会起作用吗？否

点击链接后，我们得到的是一个包含网址的空白网站：

现在我们尝试新的 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;

点击加载文件，我们加载＆＃34; bearbeiten1.html＆＃34;再次归档并使用EditTextBtnClick直接加载它。看起来好多了！它会起作用吗？？

让我们点击链接！我们得到警报！来自Nr。 ... 3.html＆＃34;

并且.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.

<强>更新
我忘了在代码中设置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);

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

3 个答案: