main.pas

datacnie多页面浏览器datacnie 原程序

begin
  if closeapp then
  begin
    askform := Taskform.create(self);
    with askform do
    try
      askform.Caption := '关闭浏览器';
      askform.lbask.Caption := '这样做回关闭浏览器，你确定吗？';
      askform.cbask.Caption := '最近有点烦，以后别问了！';
      if showmodal = mrok then
      begin
        fini := GetCurrentDir + '/option.ini';
        opini := Tinifile.create(fini);
        opini.WriteBool('hintform', 'closeapp', not cbask.Checked);
        if mainform.WindowState = wsMaximized then
          opini.writebool('formstate', 'max', true)
        else
          opini.writebool('formstate', 'max', false);
        canclose := true;
      end //
      else
        canclose := false;
    except
      free;
    end;
  end;
end;

procedure TmainForm.TimTimer(Sender: TObject);
begin
  if delindex <> 33333 then
  begin
    weblist.Delete(delindex);
    Nebweb.Pages.Delete(delindex);
    backlist.Delete(delindex);
    forwardlist.Delete(delindex);
    delindex := 0;
    Timer1.ontimer := nil;
    delindex := 33333;
  end;
end;

procedure TmainForm.pmeuforwardClick(Sender: TObject);
var I: integer;
begin
  try
    i := weblist.indexofObject(web);
    web.GoForward;
    tbback.Enabled := stob(backlist[i]);
    tbforward.Enabled := stob(forwardlist[i]);
  except
  end;
end;

procedure TmainForm.pmeubackClick(Sender: TObject);
var I: integer;
begin
  try
    web.GoBack;
    i := weblist.indexofObject(web);
    tbback.Enabled := stob(backlist[i]);
    tbforward.Enabled := stob(forwardlist[i]);
  except
  end;
end;

procedure TmainForm.pmeurefreshClick(Sender: TObject);
var j: integer;
begin
  j := Tbcweb.tabindex;
  Tembeddedwb(weblist.Objects[j]).Refresh;
end;

procedure TmainForm.pmeustopClick(Sender: TObject);
var i: integer;
begin
  if meuoffline.Checked = false then
  begin
    for i := 0 to weblist.Count - 1 do
      Tembeddedwb(weblist.Objects[i]).offline := true;
  end
  else
  begin
    for i := 0 to weblist.Count - 1 do
      Tembeddedwb(weblist.Objects[i]).offline := false;
  end;
end;

procedure TmainForm.N2Click(Sender: TObject);
var urlsf, ltext: string;
  i: integer;
  opini: Tinifile;
  askform: Thackform;
begin
  i := Tbcweb.TabIndex;
  urlsf := Tembeddedwb(weblist.Objects[i]).locationurl;

  if length(urlsf) > 40 then
    ltext := copy(urlsf, 1, 35) + '...';
  askform := Thackform.create(self);
  with askform do
  try
    Caption := '加入黑名单';
    label1.caption := '你要把';
    label2.caption := ltext;
    label3.caption := '加入黑名单,你确定吗?';
    if showmodal = mrok then
    begin
      filterlist.add(urlsf);
      opini := Tinifile.create(GetCurrentDir + '/option.ini');
      for i := 0 to filterlist.Count - 1 do
        opini.WriteString(filtername, inttostr(i), filterlist[i]);
      opini.Free;
    end;
  finally
    free;
  end;
end;

procedure TmainForm.pmeucloseClick(Sender: TObject);
begin
  if tbcweb.IndexOfTabAt(dx,dy)<>tbcweb.tabindex then
  deletewb(tbcweb.IndexOfTabAt(dx,dy))
  else
  deleteweb;
end;

procedure TmainForm.pmeucloseallClick(Sender: TObject);
begin
  if meuaddress.checked = true then
  begin
    cbaddress.Visible := false;
    meuaddress.checked := false;
  end
  else
  begin
    cbaddress.Visible := true;
    meuaddress.checked := true;
  end;
end;

procedure TmainForm.TbfavClick(Sender: TObject);
begin
  if (Tbfav.tag=0) then
  begin
  panell.Visible := true;
  Tbfav.tag:=1;
  Tbfav.down:=true;
  Tbhistory.Down:=false;
  Tbhistory.tag:=0;
  Tbsearch.Down:=false;
  Tbsearch.tag:=0;
   splitter1.Visible := true;
   panell.Visible := true;
  panel2.Caption := ' 收藏夹';
  SeSkinPageControl1.TabIndex:=0;
  end
  else 
  begin
   panell.Visible:=false;
   Tbfav.tag:=0;
  Tbfav.down:=false;
  Tbhistory.Tag:=0;
  Tbhistory.Down:=false;
  Tbsearch.tag:=0;
  Tbsearch.Down:=false;
  
  end;
end;

procedure TmainForm.TbhistoryClick(Sender: TObject);
begin

if  (Tbhistory.tag=0) then
  begin
 panell.Visible := true;
  Tbfav.tag:=0;
  Tbfav.down:=false;
  Tbhistory.Down:=true;
  Tbhistory.tag:=1;
  Tbsearch.Down:=false;
  Tbsearch.tag:=0;

    splitter1.Visible := true;
    panell.Visible := true;
    panel2.Caption := ' 历史记录';
    SeSkinPageControl1.TabIndex := 1;

  end
  else
  begin
    panell.Visible:=false;
   Tbfav.tag:=0;
  Tbfav.down:=false;
  Tbhistory.Tag:=0;
  Tbhistory.Down:=false;
  Tbsearch.tag:=0;
  Tbsearch.Down:=false;
  end;
end;

procedure TmainForm.TbsearchClick(Sender: TObject);
var urlleft:string;
begin
  if  (Tbsearch.tag=0) then
  begin
 panell.Visible := true;
  Tbfav.tag:=0;
  Tbfav.down:=false;
  Tbhistory.Down:=false;
  Tbhistory.tag:=0;
  Tbsearch.Down:=true;
  Tbsearch.tag:=1;
  panel2.Caption := ' 搜索';
    SeSkinPageControl1.TabIndex := 2;
    urlleft:=getCurPath+'search.htm';
    leftwindow.go(urlleft);
  end
  else
  begin
     panell.Visible:=false;
   Tbfav.tag:=0;
  Tbfav.down:=false;
  Tbhistory.Tag:=0;
  Tbhistory.Down:=false;
  Tbsearch.tag:=0;
  Tbsearch.Down:=false;
  end
end;

procedure TmainForm.TbfullsenceeClick(Sender: TObject);
begin
  if not formfull then
  begin
    old := GetWindowLong(mainform.Handle, GWL_STYLE);
    SetWindowLong(mainform.Handle, GWL_STYLE, GetWindowLong(mainform.Handle, GWL_STYLE) and not WS_CAPTION);
    oldh := mainform.height;
    oldw := mainform.width;
    oldx := mainform.left;
    oldy := mainform.top;
    mainform.windowstate := wsmaximized;
    mainform.clientHeight := screen.Height;
    StatusBarmain.Visible := true;
    mainform.Refresh;
    formfull := true;
  end
  else
  begin
    SetWindowLong(mainform.Handle, GWL_STYLE, old);
    mainform.height := oldh;
    mainform.width := oldw;
    mainform.left := oldx;
    mainform.top := oldy;
    Tbcweb.Visible := false;
    StatusBarmain.Visible := true;
    Tbcweb.Visible := true;
    screen.Realign;
    mainform.Refresh;
    formfull := false;
  end;
end;



procedure TmainForm.TbbackClick(Sender: TObject);
var I: integer;
begin
  try
    web.GoBack;
    i := weblist.indexofObject(web);
    tbback.Enabled := stob(backlist[i]);
    tbforward.Enabled := stob(forwardlist[i]);
  except
  end;
end;

procedure TmainForm.TbforwardClick(Sender: TObject);
var I: integer;
begin
  try
    i := weblist.indexofObject(web);
    web.GoForward;
    tbback.Enabled := stob(backlist[i]);
    tbforward.Enabled := stob(forwardlist[i]);
  except
  end;
end;


procedure TmainForm.tbstopClick(Sender: TObject);
var j: integer;
begin
  j := Tbcweb.tabindex;
  Tembeddedwb(weblist.Objects[j]).Stop;
end;

procedure TmainForm.tbrefreshClick(Sender: TObject);
var j: integer;
begin
  j := Tbcweb.tabindex;
  Tembeddedwb(weblist.Objects[j]).Refresh;
end;

procedure TmainForm.TbhomeClick(Sender: TObject);
var j: integer;
begin
  j := Tbcweb.tabindex;
  Tembeddedwb(weblist.Objects[j]).GoHome;
end;
procedure TmainForm.addfavfun;
var
ShellUIHelper: ISHellUIHelper;
wurl, wtitle: Olevariant;
begin
wTitle := Web.LocationName;
wUrl :=web.LocationUrl;
if wUrl <> '' then
//end
begin
ShellUIHelper :=CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;
ShellUIHelper.AddFavorite(wurl, wtitle);
end;
rebuildmenu;
end;

procedure TmainForm.meuaddfavClick(Sender: TObject);
begin
addfavfun ;
end;

procedure TmainForm.guofavfun;
var
  SpecialPath: array[0..MAX_PATH] of Char;
  H: HWnd;
  p: procedure(Handle: THandle; Path: PChar); stdcall;
  begin
  H := LoadLibrary(PChar('shdocvw.dll'));
  if H <> 0 then begin
    p := GetProcAddress(H, PChar('DoOrganizeFavDlg'));
    if Assigned(p) then
    begin
     p(Application.Handle, pchar(GetFavoritesPath));
    end;
  end;
  rebuildmenu;

end;

procedure TmainForm.meuguofavClick(Sender: TObject);
begin
guofavfun;
end;

procedure TmainForm.ToolButton30Click(Sender: TObject);
begin
FavoritesListView1.Loaded;
end;

procedure TmainForm.ToolButton32Click(Sender: TObject);
begin
addfavfun ;
end;

procedure TmainForm.ToolButton31Click(Sender: TObject);
begin
guofavfun;
end;

procedure TmainForm.FavoritesListView1URLSelected(Sender: TObject;
  Url: String);
begin
 addnewweb(url);
end;

procedure TmainForm.PanellResize(Sender: TObject);
begin
panel2.Width:=coolbar3.Width-18;
toolbar6.Left:=panel2.Width;
end;

procedure TmainForm.ToolBar6Click(Sender: TObject);
begin
panell.Visible:=false;
splitter1.Visible:=false;
end;

function TmainForm.leftwindowTranslateUrl(const dwTranslate: Cardinal;
  const pchURLIn: PWideChar; var ppchURLOut: PWideChar): HRESULT;
begin
tempurls:=(string(pchURLIn));
end;

procedure TmainForm.leftwindowNewWindow2(Sender: TObject;
  var ppDisp: IDispatch; var Cancel: WordBool);
begin
addnewweb(tempurls);
Cancel:= true;
end;

procedure TmainForm.HistoryListView1URLSelected(Sender: TObject;
  Url: String);
begin
 addnewweb(url);
end;

procedure TmainForm.TbsendemailClick(Sender: TObject);
var urlleft:string;
begin
    urlleft:=getCurPath+'/ziyuan/xinxiang.htm';
    addnewweb(urlleft);
    //leftwindow.go(urlleft);

end;

procedure TmainForm.FormResize(Sender: TObject);
begin
SeSkinControlBar1.Width := mainForm.width - 2;
  SeSkinMenuBar1.Width := mainForm.width - 2;
  SeSkinToolBar2.Width := mainForm.width - 2;
  Cbaddress.Width := mainForm.width - 2;
  SeSkinToolBar1.Width := mainForm.width - 2;
end;

procedure TmainForm.TbziyuanClick(Sender: TObject);
begin
      addnewweb(getCurPath+'/ziyuan/default.htm');
end;

procedure TmainForm.meuinteropClick(Sender: TObject);
 begin
    try
     web.Options;
    finally
    end;
  end;

procedure TmainForm.N18Click(Sender: TObject);
begin
web.ClearCache;
end;

procedure TmainForm.meuNetopClick(Sender: TObject);

begin

with Tformoption.Create(self) do
  begin
    ShowModal;
    free;
  end;

 
end;

procedure TmainForm.CustomItem2Click(Sender: TObject);//导出收藏
var
  Sh: ISHellUIHelper;
begin
  CoCreateInstance(CLSID_SHELLUIHELPER, nil, CLSCTX_INPROC_SERVER,
    IID_IShellUIHelper, Sh);
  sh.ImportExportFavorites(FALSE, '');
  //Rebuildmenu;
end;

procedure TmainForm.CustomItem5Click(Sender: TObject); //导入收藏
var
  Sh: ISHellUIHelper;
begin
  CoCreateInstance(CLSID_SHELLUIHELPER, nil, CLSCTX_INPROC_SERVER,
    IID_IShellUIHelper, Sh);
  sh.ImportExportFavorites(TRUE, '');
  //Rebuildmenu;
end;

initialization
  OleInitialize(nil);
finalization
  OleUninitialize;

end.