unit1.pas

网络试验程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ToolWin, ComCtrls, ExtCtrls, OleCtrls, SHDocVw,
  StdCtrls;
const
   CM_HOMEPAGEREQUEST=WM_USER+$1000;
type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    ControlBar1: TControlBar;
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    StatusBar1: TStatusBar;
    ToolBar2: TToolBar;
    CoolBar1: TCoolBar;
    Label1: TLabel;
    CoolBar2: TCoolBar;
    edturl: TComboBox;
    SpeedButton5: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure EDTURLKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EDTURLClick(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure WebBrowser1BeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowser1DownloadBegin(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
 
  private
    { Private declarations }
    HistoryIndex:integer;
    HistoryList:TStringList;
    UpdateCombo:boolean;
    procedure findaddress;
    procedure homepagerequest(var message:tmessage);message CM_HOMEPAGEREQUEST;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Procedure tform1.findaddress;
var
  flags:olevariant;
begin
  flags:=0;
  updatecombo:=true;
  webbrowser1.Navigate(widestring(edturl.Text),flags,flags,flags,flags);
end;

procedure tform1.homepagerequest(var message:tmessage);
begin
edturl.Text:='http://www.126.com';
findaddress;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 historyindex:=-1;
 historylist:=tstringlist.Create;
 postmessage(handle,CM_HOMEPAGEREQUEST,0,0); //打开主页页面
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 historylist.Free;
end;

//停止
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  self.WebBrowser1.Stop;
end;

//打开页面
procedure TForm1.EDTURLKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key=VK_RETURN then
findaddress;
end;

//onclick事件
procedure TForm1.EDTURLClick(Sender: TObject);
begin
 findaddress;
end;

//刷新
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
 findaddress;
end;

//后退
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 IF (historylist.Count>0) and (historyindex>0) then
 begin
 edturl.Text:=historylist[historyindex-1];//访问历史纪录
 findaddress;
 end;
end;

//前进
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
IF (historylist.Count>0) and (historyindex<historylist.Count-1) then
 begin
  edturl.Text:=historylist[historyindex+1];
  findaddress;
 end;
end;

procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
   newindex:integer;
begin
  newindex:=historylist.IndexOf(url);
  if newindex=-1 then
  begin
    //清除历史纪录
    if (historyindex>=0) and (historyindex<historylist.Count-1) then
    while historylist.Count>historyindex do
    historylist.Delete(historyindex);
    historyindex:=historylist.Add(url);
  end
  else
   historyindex:=newindex;
   if updatecombo then
   begin
     updatecombo:=false;
     newindex:=edturl.items.indexof(url);
     if newindex=-1 then
     edturl.Items.Insert(0,url)
     else
     edturl.Items.Move(newindex,0);
   end;
   edturl.Text:=url;
   statusbar1.Panels[0].Text:=url;
end;

procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
begin
statusbar1.Panels[0].Text:='开始下载页面...';
end;

procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
begin
statusbar1.Panels[0].Text:='下载完成';
end;



procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
    Form1.Close ;
end;

end.