webob_ie.pas

一个浏览器 比较简单的程序,适合处学者使用和学习.有意见联系我 .

unit webob_ie;

interface

uses
   Classes, Controls, Forms, OleCtrls, EmbeddedWB, ComCtrls, StdCtrls,
   IEAddress, ExtCtrls, Menus, ToolWin, ImgList, AdvMenus, AdvFontCombo,
  Buttons, SHDocVw_EWB, HistoryListView, FavoritesTree, FavoritesListView, DB,
  ADODB , Registry, shellapi, Dialogs;

type
   TForm1 = class(TForm)
      StatusBar1: TStatusBar;
    PanelWEB: TPanel;
    PanelTop: TPanel;
    Paneltxt: TPanel;
    ilToolBar: TImageList;
    MainToolBar: TToolBar;
    ToolbtnBack: TToolButton;
    ToolBtnForward: TToolButton;
    ToolBtnStop: TToolButton;
    ToolButton10: TToolButton;
    ToolBtnRefresh: TToolButton;
    ToolBtnHome: TToolButton;
    ToolButton11: TToolButton;
    ToolBtnSearch: TToolButton;
    ToolBtnAccesories: TToolButton;
    Spacer: TToolButton;
    ImageList2: TImageList;
    CoolBar3: TCoolBar;
    ToolBar1: TToolBar;
    IEAddress1: TIEAddress;
    Splitter1: TSplitter;
    Button1: TButton;
    Splitter2: TSplitter;
    cbNewTab: TCheckBox;
    PageControl1: TPageControl;
    AQList: TADOQuery;
    ADOConn: TADOConnection;
    Menu_dir: TPopupMenu;
    MiaddFile: TMenuItem;
    MiaddChlidFile: TMenuItem;
    N7: TMenuItem;
    Midelfile: TMenuItem;
    Mirenamefile: TMenuItem;
    N8: TMenuItem;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    SaveDialog_dir: TSaveDialog;
    ImageList1: TImageList;
    TV1: TTreeView;
    PgCtrlLib: TPageControl;
    tabIndexArticle: TTabSheet;
    TabSheet1: TTabSheet;
    FavoritesTree1: TFavoritesTree;
    PopupMenu1: TPopupMenu;
    N3: TMenuItem;
    MainMenu1: TMainMenu;
    MMFile: TMenuItem;
    MenuItem3: TMenuItem;
    Exit1: TMenuItem;
    MMEdit: TMenuItem;
    N5: TMenuItem;
    MMView: TMenuItem;
    ViewSourceHtml: TMenuItem;
    PageSourceText: TMenuItem;
    MMNavigation: TMenuItem;
    GoHome1: TMenuItem;
    GoBack1: TMenuItem;
    GoForward1: TMenuItem;
    GoAboutBlank1: TMenuItem;
    N9: TMenuItem;
    Stop1: TMenuItem;
    Refresh1: TMenuItem;
    N11: TMenuItem;
      procedure Button1Click(Sender: TObject);
      procedure FormShow(Sender: TObject);
    procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ToolBtnAccesoriesClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MiaddChlidFileClick(Sender: TObject);
    procedure MidelfileClick(Sender: TObject);
    procedure PageSourceTextClick(Sender: TObject);
    procedure ToolBtnStopClick(Sender: TObject);
    procedure ToolbtnBackClick(Sender: TObject);
    procedure ToolBtnForwardClick(Sender: TObject);
    procedure ToolBtnRefreshClick(Sender: TObject);
    procedure ToolBtnHomeClick(Sender: TObject);
    procedure ToolBtnSearchClick(Sender: TObject);
    procedure MiaddFileClick(Sender: TObject);
    procedure MirenamefileClick(Sender: TObject);
    procedure TV1DblClick(Sender: TObject);

   private
    { Private declarations }
      procedure DownloadCompleteEvent(Sender: TObject);
      function GetActiveEWB: TEmbeddedWB;
      procedure UpdateAddress;
      procedure UpdateTab;
      function CreateNewTabBrowser(Url: string): TTabSheet;
      procedure NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
      procedure NewWebStatusTextChange(Sender: TObject;
         const Text: WideString);
     procedure UpdateControls; //停止


   public
     idd:integer;
     node:TTreeNode;
     Procedure addDepartment;
     procedure AddWorker(var Node:TTreeNode);
    { Public declarations }
   end;

var
   Form1: TForm1;
   DesignTimeWB: TEmbeddedWB;
   NewTab: TTabSheet;
   i: integer;

implementation

uses  F_add, Z_add;


{$R *.dfm}

//--------Private Section---------------------------------------------

procedure TForm1.UpdateTab;
begin
   PageControl1.ActivePage := NewTab;
   UpdateAddress;
end;

procedure TForm1.UpdateAddress;
var
   TEWB: TEMbeddedWB;
begin
   TEWB := GetActiveEWB;

   if TEWB <> nil then
      begin
         IEAddress1.EmbeddedWB := TEWB;
         IEAddress1.Text := TEWB.LocationURL;
         if IEAddress1.Text = 'about:blank' then    ///如果地址是空的,那么新窗口的标题是''
         PageControl1.ActivePage.Caption := 'about:blank'
         else
          PageControl1.ActivePage.Caption := TEWB.LocationName;  //否则新窗口的标题是网站名称
      end;
end;

procedure TForm1.UpdateControls;
begin
  if GetActiveEWB.Busy then
  GetActiveEWB.Stop;
end;

function TForm1.GetActiveEWB: TEmbeddedWB;
var
   i: integer;
begin
   Result := nil;
   if PageControl1.ActivePage <> nil then
      for i := 0 to PageControl1.ActivePage.ControlCount - 1 do
         begin
            if PageControl1.ActivePage.Controls[i] is TEmbeddedWB then
               begin
                  Result := TEmbeddedWB(PageControl1.ActivePage.Controls[i]);
                  Exit;
               end;
         end;
end;

procedure TForm1.MiaddChlidFileClick(Sender: TObject);
begin
 if   TV1.Selected.Parent   <>   nil   then
  SHOWMESSAGE('不是父类')
 ELSE
  BEGIN
if TV1.Selected.Text <> '' then
   BEGIN
  Z_add.Form3.Edit1.Clear;
  Z_add.Form3.ComboBox1.Text := TV1.Selected.Text;
 // Z_add.Form3.ComboBox2.Clear;
  Z_add.Form3.SynMemo1.Clear;
  Z_add.Form3.Button2.Visible := FALSE;
  Z_add.Form3.Show;
   END
   ELSE
   SHOWMESSAGE('选择父类');
 END;
end;

procedure TForm1.MiaddFileClick(Sender: TObject);
begin
 if   TV1.Selected.Parent   <>   nil   then
 begin
 SHOWMESSAGE('不是根目录!');
 end
ELSE
FORM2.Button2.Visible := FALSE;
form2.Show   ;
end;

procedure TForm1.MidelfileClick(Sender: TObject);
begin
 if   TV1.Selected.HasChildren     then   //判断是否是子接点,是则执行下步
   BEGIN
     SHOWMESSAGE('存在子文件,不能删除');
   END
  ELSE
  begin
  AQList.SQL.Clear;
  if   TV1.Selected.Parent   <>   nil   then
  BEGIN
  AQList.SQL.Add('Delete From ZL Where TITLE=' + #39 + TV1.Selected.Text + #39) ;
  END
  ELSE
  BEGIN
    AQList.SQL.Add('Delete From FL Where FTITLE=' + #39 + TV1.Selected.Text + #39);
  END;
  try
    AQList.ExecSQL;
    TV1.Items.Clear;
    addDepartment;
  except
    ShowMessage('Error');
  END;
  end;
end;

procedure TForm1.MirenamefileClick(Sender: TObject);
begin
{   if TV1.Selected.Parent  <>   nil  then
   begin
      showmessage('zl');
   end
   else
   begin }
     form2.Caption := '重命名';
     form2.Label2.Caption := '新名称';
     form2.Edit2.Text := tv1.Selected.Text;
     form2.Button1.Visible:=FALSE;
     form2.Show;
  // end;

end;

procedure TForm1.DownloadCompleteEvent(Sender: TObject);
begin
   UpdateAddress;
end;
//建立新窗口
function TForm1.CreateNewTabBrowser(Url: string): TTabSheet;
begin  
   NewTab := TTabSheet.Create(PageControl1);
   with NewTab do
      begin
         PageControl := PageControl1;
         Parent := PageControl1;
         Visible := true;
         PageIndex := PageControl1.ActivePageIndex;
      end;
   DesignTimeWB := TEmbeddedWB.Create(NewTab);
   TControl(DesignTimeWB).Parent := NewTab;
   with DesignTimeWB do
      begin
         EnableMessageHandler;
         Align := alClient;
         OnStatusTextChange := NewWebStatusTextChange;
         OnNewWindow2 := NewWindowEvent;
         OnDownloadComplete := DownloadCompleteEvent;
         if (URL) <> '' then
            DesignTimeWB.Navigate(URL);
         DesignTimeWB.Wait;
      end;
   PageControl1.ActivePage := NewTab;
   Result := NewTab;
end;

procedure TForm1.NewWindowEvent(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
begin
   CreateNewTabBrowser(DesignTimeWB.LocationURL);
   PageControl1.ActivePage := NewTab;
   ppdisp := DesignTimeWB.Application;
   UpdateTab;
end;



//-双击关闭
procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Index: Integer;
  TEWB: TEMbeddedWB;
begin
   TEWB := GetActiveEWB;
   if TEWB <> nil then
      begin
         if (Button = mbLeft) and (ssDouble in Shift) then
           begin
            Index := PageControl1.IndexOfTabAt(X, Y);
            if Index > 0 then
            PageControl1.Pages[Index].Free;
       end;
      end;
end;


procedure TForm1.PageSourceTextClick(Sender: TObject);
begin
     //GetActiveEWB.RightClickMenu :=;
    // Z_add.Form3.Show;
end;

procedure TForm1.ToolBtnAccesoriesClick(Sender: TObject);
begin
 if ToolBtnAccesories.Down then
    begin
    Paneltxt.Visible := true ;
    end
 else
 paneltxt.Visible := false;

end;
//返回
 procedure TForm1.ToolbtnBackClick(Sender: TObject);
begin
  UpdateControls;
  GetActiveEWB.GoBack;
end;
//前进
procedure TForm1.ToolBtnForwardClick(Sender: TObject);
begin
  UpdateControls;
  GetActiveEWB.GoForward;
end;
 //主页
procedure TForm1.ToolBtnHomeClick(Sender: TObject);
begin
   UpdateControls;
   GetActiveEWB.GoHome;
end;
//刷新
procedure TForm1.ToolBtnRefreshClick(Sender: TObject);
begin
   UpdateControls;
   GetActiveEWB.Refresh;
end;
//搜索
procedure TForm1.ToolBtnSearchClick(Sender: TObject);
begin
  GetActiveEWB.ShowFindDialog;
end;

procedure TForm1.ToolBtnStopClick(Sender: TObject);
begin
UpdateControls;
end;

//资料打开
procedure TForm1.TV1DblClick(Sender: TObject);
begin
   if TV1.Selected.Parent   <>   nil  then
  begin
  Z_ADD.Form3.SynMemo1.Clear;
              With AQlist do
                     begin
                     Close;
                     sql.Clear;
                     Sql.Add('select * from ZL');
                     Sql.Add('where TITLE =' + #39 + TV1.Selected.Text + #39);
                      open;
                       While not Eof do
                       begin

                        Z_ADD.Form3.Edit1.Text := TV1.Selected.Text;
                        Z_ADD.Form3.SynMemo1.Lines.Add(Fieldbyname('CONTER').AsString);
                       // Z_ADD.Form3.ComboBox1.Text := Fieldbyname('FTITLE').AsString;
                       // Z_ADD.Form3.ComboBox2.Text := Fieldbyname('TITLE').AsString;
                        Z_ADD.Form3.Caption := '编辑';
                         NEXT;
                        end;
                     end;
          Z_ADD.Form3.Button1.Visible := FALSE;
          Z_ADD.Form3.Show;
  end;
end;

procedure TForm1.NewWebStatusTextChange(Sender: TObject;
   const Text: WideString);
begin
   StatusBar1.SimpleText := Text;
end;

//--------End Of Private Section---------------------------------------------


//////资料馆 开始
procedure TForm1.FormCreate(Sender: TObject);
begin
    AQList.SQL.Clear;
    AQList.SQL.Add('Select * From ZL ');
    AQList.Open;
    AQList.First;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 /////
  addDepartment;
/////
   CreateNewTabBrowser(DesignTimeWB.GetIEHomePage); //
   UpdateTab;

end;

procedure TForm1.addDepartment;    ///显示父类
var
  node:TTreeNode;
begin
  With AQlist do
  begin
    Close;
    sql.Clear;
    Sql.Add('select * from FL');
    open;
    While not Eof do
    begin
      node:=TTreeNode.Create(nil);
      node:=TV1.Items.Add(nil,Fieldbyname('FTITLE').AsString);
      AddWorker(node);
      next;
    end;

  end;

end;

procedure TForm1.AddWorker(var Node: TTreeNode);   ///显示子类
var
  List:TADOQuery;
begin
  List:=TAdoQuery.Create(nil);
  List.Connection:=ADOConn;
  with List do
  begin
    Close;
    Sql.Clear;
    Sql.Add('select * from ZL where FTITLE=:FTITLE');
    parameters.ParamByName('FTITLE').Value:=Node.text;
    open;
    While not Eof do
    begin
      TV1.Items.AddChild(node,FieldbyName('TITLE').AsString);
      next;
    end;
    //TV1.Items.AddChild(node,FieldbyName('i').AsString);
  end;
  List.Free;

end;
///////////////////////////////////  资料馆结束
procedure TForm1.Button1Click(Sender: TObject);
begin
   if cbNewtab.Checked then    //如果新窗口打开选中
      begin
         CreateNewTabBrowser(IEAddress1.Text);  //建立新的页面
         UpdateTab;
      end
   else
      begin
         DesignTimeWB.Go(IEAddress1.Text);  //否则在旧窗口打开
         UpdateTab;
      end;
end;



end.