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.

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