<< Вернуться к Содержанию  
TWebBrowser.Document включает в себя IPersistStreamInit который содержит метод Save(). Всё, что нам нужно знать, это как использовать данный метод с объектом, который включён в IStream. Для этого просто воспользуемся TStreamAdapter.

Обратите внимание, что интерфейсы IPersistStreamInit и IStream объявлены внутри ActiveX

unit main;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, OleCtrls,
  SHDocVw, ExtCtrls;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure WebBrowser1NavigateComplete2(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure WebBrowser1BeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure WebBrowser1StatusTextChange(Sender: TObject;
      const Text: WideString);
    procedure WebBrowser1TitleChange(Sender: TObject;
      const Text: WideString);
    procedure Button1Click(Sender: TObject);
  private
    procedure DoNavigateURL(const URLString: string);
    procedure SaveHTMLSourceToFile(const FileName: string; WB: TWebBrowser);
  end;

var
  Form1: TForm1;

implementation

uses ActiveX;

{$R *.DFM}

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

procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
  Button1.Enabled := False;
end;

procedure TForm1.WebBrowser1StatusTextChange(Sender: TObject;
  const Text: WideString);
begin
  Label1.Caption := Text;
end;

procedure TForm1.WebBrowser1TitleChange(Sender: TObject;
  const Text: WideString);
begin
  Caption := Text;
end;

procedure TForm1.DoNavigateURL(const URLString: string);
var
  VUrl: OleVariant;
begin
  if URLString = '' then
    Exit;
  VUrl := URLString;
  WebBrowser1.Navigate2(VUrl);
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
  begin
    Key := 0;
    TEdit(Sender).SelectAll;
    DoNavigateURL(TEdit(Sender).Text);
  end;
end;

procedure TForm1.SaveHTMLSourceToFile(const FileName: string; WB: TWebBrowser);
var
  PersistStream: IPersistStreamInit;
  FileStream: TFileStream;
  Stream: IStream;
  SaveResult: HRESULT;
begin
  PersistStream := WB.Document as IPersistStreamInit;
  FileStream := TFileStream.Create(FileName, fmCreate);
  try
    Stream := TStreamAdapter.Create(FileStream, soReference) as IStream;
    SaveResult := PersistStream.Save(Stream, True);
    if FAILED(SaveResult) then
      MessageBox(Handle, 'Fail to save HTML source', 'Error', 0);
  finally
    { we are passing soReference to TStreamAdapter contructor parameter,
      it is our reponsibility to destroy the stream object. }
    FileStream.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    SaveHTMLSourceToFile(SaveDialog1.FileName, WebBrowser1);
end;
end.

Сохранение вместе с исходником всех файлов (.CSS, JPG, GIF Etc..):

try
       WebBrowser1.ExecWB(4, 0);
     except
       on E: Exception do  msError:=true;
     end;

  << Вернуться к Содержанию