delphi实现自制IE浏览器

个人认为 做 IE  外壳  用 VB 比较好....

delphi 的代码如下: 请根据 需要 向窗体内 添加相应的 组件...

 

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ComCtrls, ImgList, ToolWin, OleCtrls, SHDocVw, ExtCtrls, Menus,  StdCtrls, MSHTML;type  TForm1  =   class (TForm)    Panel2: TPanel;    ImageList1: TImageList;    StatusBar1: TStatusBar;    Panel3: TPanel;    ComboBox1: TComboBox;    Button1: TButton;    Label1: TLabel;    OpenDialog1: TOpenDialog;    ToolBar1: TToolBar;    ToolButton1: TToolButton;    ToolButton2: TToolButton;    ToolButton3: TToolButton;    ToolButton4: TToolButton;    ToolButton5: TToolButton;    ToolButton6: TToolButton;    ToolButton8: TToolButton;    ToolButton9: TToolButton;    ToolButton10: TToolButton;    ToolButton7: TToolButton;    PageControl1: TPageControl;    TabSheet1: TTabSheet;    WebBrowser1: TWebBrowser;    PopupMenu1: TPopupMenu;    Nclose: TMenuItem;    N2: TMenuItem;    procedure ToolButton1Click(Sender: TObject);    procedure ToolButton2Click(Sender: TObject);    procedure ToolButton3Click(Sender: TObject);    procedure ToolButton4Click(Sender: TObject);    procedure ToolButton5Click(Sender: TObject);    procedure Button1Click(Sender: TObject);    procedure WebBrowser1DownloadBegin(Sender: TObject);    procedure WebBrowser1DownloadComplete(Sender: TObject);    procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;      var Cancel: WordBool);    procedure FormResize(Sender: TObject);    procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;      Shift: TShiftState);    procedure ToolButton9Click(Sender: TObject);    procedure ToolButton10Click(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure ToolButton6Click(Sender: TObject);    procedure FormClose(Sender: TObject; var Action: TCloseAction);    procedure WebBrowser1DocumentComplete(Sender: TObject;       const  pDisp: IDispatch; var URL: OleVariant);    procedure NcloseClick(Sender: TObject);    procedure TabSheet1Exit(Sender: TObject);   private    first:integer;    /**/ ///tabID  :  integer;//在这里定义全局变量       ... { Private declarations }    public      ... { Public declarations }   end;var  Form1: TForm1;implementation ... {$R *.dfm} procedure TForm1.ToolButton1Click(Sender: TObject);begin  Try    WebBrowser1.GoBack;  except    showmessage( ' 不能再后退了 ' );    exit;  end;end;procedure TForm1.ToolButton2Click(Sender: TObject);begin   Try     WebBrowser1.GoForward;   except     showmessage( ' 不能再前进了 ' );     exit;   end;end;procedure TForm1.ToolButton3Click(Sender: TObject);beginwebbrowser1.Stop;end;procedure TForm1.ToolButton4Click(Sender: TObject);beginwebbrowser1.GoHome;end;procedure TForm1.ToolButton5Click(Sender: TObject);beginwebbrowser1.Refresh;end;procedure TForm1.Button1Click(Sender: TObject);begin webbrowser1.Navigate(combobox1.Text,EmptyParam,EmptyParam,EmptyParam,EmptyParam); first: = 1 ; end;procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);beginstatusbar1.Panels[ 0 ].Text : =   ' 正在下载... ' ;end;procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);beginstatusbar1.Panels[ 0 ].Text : =   ' 完成 ' ;combobox1.Text : =  webbrowser1.LocationURL;end;procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;  var ppDisp: IDispatch; var Cancel: WordBool); // 第一种方法 ... {var   newForm: TForm1;  begin    newForm := TForm1.Create(nil);//Application);    //newForm.Close := TForm1FormClose;    newForm.Caption:='MDIForm';    WebBrowser1.OnNewWindow2:=webbrowser1NewWindow2;    //newform.BorderIcons := [bisystemmenu,bimaximize];    //newform.WindowState := wsMaximized;    newForm.Visible:=true;    ppDisp :=  newform.WebBrowser1.ControlInterface;    Cancel:=false;end;} // 第二种方法 ... {var        tab:TTabSheet;        subweb:TWebBrowser;  begin        if first=0 then Exit;                tab:=TTabSheet.Create(self);                tab.Parent:=self.PageControl1;                tab.PageControl:=self.PageControl1;                Self.PageControl1.ActivePage:=tab;                tab.Align:=alClient;                tab.Visible:=True;                tab.Caption := '正在加载...';                //tabID  :=  Longint(tab);                subweb:=TWebBrowser.Create(tab);                subweb.ParentWindow := tab.Handle;                TOleControl(subweb).Parent :=tab;                subweb.OnNewWindow2:=self.WebBrowser1NewWindow2;                subweb.OnDocumentComplete:=self.WebBrowser1DocumentComplete;                subweb.Align:=alClient;                subweb.Visible:=True;                ppDisp := subweb.DefaultDispatch;                Self.WebBrowser1:=subweb;    //ppDisp :=  newtab.WebBrowser1.ControlInterface;    //Cancel:=false;end;} var        tab:TTabSheet;         // subweb:TWebBrowser;   begin         if  first = 0  then Exit;                tab: = TTabSheet.Create(nil);                tab.Parent: = self.PageControl1;                tab.PageControl: = self.PageControl1;                Self.PageControl1.ActivePage: = tab;                tab.Align: = alClient;                tab.Visible: = True;                tab.Caption : =   ' 正在加载... ' ;                 // tabID  :=  Longint(tab);                 WebBrowser1: = TWebBrowser.Create(tab);                WebBrowser1.ParentWindow : =  tab.Handle;                TOleControl(WebBrowser1).Parent : = tab;                WebBrowser1.OnNewWindow2: = self.WebBrowser1NewWindow2;                WebBrowser1.OnDocumentComplete: = self.WebBrowser1DocumentComplete;                WebBrowser1.Align: = alClient;                WebBrowser1.Visible: = True;                ppDisp : =  WebBrowser1.DefaultDispatch;                 // Self.WebBrowser1:=WebBrowser1;     // ppDisp :=  newtab.WebBrowser1.ControlInterface;     // Cancel:=false; end;procedure TForm1.FormResize(Sender: TObject);begin         try panel2.Left : =   0  ;panel2.Align : =  alClient;webbrowser1.Left : =   0 ;webbrowser1.Top : =   0 ;webbrowser1.Align : =  alClient;pagecontrol1.align: = alclient;        except                exit;        end;end;procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;  Shift: TShiftState);begin if  Key = 13  thenbeginself.webbrowser1.Navigate(self.ComboBox1.Text,EmptyParam,EmptyParam,EmptyParam,EmptyParam);end;end;procedure TForm1.ToolButton9Click(Sender: TObject);begin   try webbrowser1.ExecWB(olecmdid_saveas, 2 );  except  exit;  end;end;procedure TForm1.ToolButton10Click(Sender: TObject);begin if  opendialog1.Execute thenwebbrowser1.Navigate(opendialog1.filename);end;procedure TForm1.FormShow(Sender: TObject);beginform1.Resize;end;procedure TForm1.ToolButton6Click(Sender: TObject);begincombobox1.Text : =   ' view-source: ' +  combobox1.text;self.Button1.Click;end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);begin Action : =  caFree; //  form1 :=  nil; end;procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;   const  pDisp: IDispatch; var URL: OleVariant);varhd : iHTMLDocument2;beginhd : =  TWebBrowser(Sender).Document  as  IHTMLDocument2;TTabSheet(TOleControl(Sender).Parent).Caption : =  hd.title;end;procedure TForm1.NcloseClick(Sender: TObject);var  i: Integer;   // j: integer;   ts: TTabSheet;begin   ... {for i := PageControl1.PageCount - 1 downto 0 do  begin    ts := PageControl1.Pages[i];    ts.PageControl := nil;    ts.Free;  end;}    try       i : =  pagecontrol1.ActivePageIndex;       // j := i -1;      ts : =  pagecontrol1.Pages[i];      // ts.PageControl:=nil;      // ts.Destroy;      // ts.Free;      ts.Parent : =  nil;     ts.Free();     except     exit;     end;end;procedure TForm1.TabSheet1Exit(Sender: TObject);beginself.Free;end;end.

 

以上代码在  Window2000  delphi 6  上编译通过...

图如下..