main.pas

datacnie多页面浏览器datacnie 原程序

    repeat
      if (search.Name <> '.') and (search.Name <> '..') then
      begin
        newmitem := Tmenuitem.Create(Self);
        if (search.Attr and fadirectory) = fadirectory then
        begin
          newmitem.Caption := ShortCaption(search.Name, 40);
          item.add(newmitem);
          newmitem.ImageIndex := 0;

        end;
        newmitem.ImageIndex := 0;
        newmitem.Caption := ShortCaption(search.Name, 40);
        addfavoritesmenu(newmitem, favoritespath + '\' + search.Name);
      end;
    until findnext(search) <> 0;
  findclose(search);

//生成url文件
  if findfirst(favoritespath + '\*.*', faArchive, src) = 0 then
    repeat
      newmitem := Tmenuitem.Create(Self);
      i := Pos('.LNK', uppercase(src.Name));
      j := Pos('.URL', UpperCase(src.Name));
      favoritefilename := favoritespath + '\' + src.Name;

      if (i <> 0) then
        newmitem.Caption := Copy(src.Name, 0, i - 1);
      if (j <> 0) then
        newmitem.Caption := Copy(src.Name, 0, j - 1);
      item.add(newmitem);
      newmitem.ImageIndex := 1;
      newmitem.Hint := GetFavoritesUrl(favoritefilename);
      newmitem.onclick := newmenuClick;
    until findnext(src) <> 0;
  findclose(src);
end; //end addfavoritesmenu  }

procedure Tmainform.addweb(urls: string); //加页面过程；
var webindex: integer;
 begin
      webindex:=Tbcweb.tabs.Add('空白页');
      Tbcweb.tabindex:=webindex ;
      nebweb.PageIndex:=webindex;
      Nebweb.PageS.Add('notename');
      Pi :=Nebweb.Pages.Objects[webindex];
      panel:=TPanel.create(pi);
      panel.Align:=alclient;
      panel.parent:=pi;
      panel.BevelOuter:=bvNone;
      wb:=TEmbeddedWB.Create(panel);
      backlist.Add('false');
      forwardlist.Add('false');
      wb.RegisterAsDropTarget:=true;
      weblist.addobject('wb',wb);
      panel.Insertcontrol(wb);
      wb.Align:=alclient;
      wb.UserInterfaceOptions:=[DIALOG,OPENNEWWIN,FLAT_SCROLLBAR,URL_ENCODING_ENABLE_UTF8,ENABLE_FORMS_AUTOCOMPLETE,ENABLE_INPLACE_NAVIGATION,IME_ENABLE_RECONVERSION];
      wb.onBeforeNavigate2:=WbBeforeNavigate2;
      wb.onStatusTextChange:=WebStatusTextChange;
      Wb.onNewWindow2:=WbNewWindow2;
      wb.onNavigateComplete2:=webNavigateComplete2;
      wb.OnDocumentComplete:=webDocumentComplete  ;
      wb.onCommandStateChange:=WebbCommandStateChange;
        wb.OnDocumentComplete:=webDocumentComplete  ;
      web:=Tembeddedwb(weblist.Objects[webindex]);
      web.Go(urls);
      if urls=blankde then
        begin
        tbcweb.tabs[WEBINDEX]:='空白页';
         end
      else
       tbcweb.tabs[webindex]:='正在加载...';
      tbback.Enabled:=stob(backlist[webindex]);
      tbforward.Enabled:=stob(forwardlist[webindex]);

end;

procedure TmainForm.WebbCommandStateChange(Sender: TObject;
  Command: Integer; Enable: WordBool);
var I, j: integer;
begin
  I := weblist.IndexOfObject(Tembeddedwb(sender));
  begin
    case Command of
      CSC_NAVIGATEBACK:
        begin
          backlist[i] := btos(Enable);

        end;
      CSC_NAVIGATEFORWARD:
        begin
          forwardlist[i] := btos(Enable);
        end;
    end;
    j := weblist.IndexOfObject(Tembeddedwb(web));
    tbback.Enabled := stob(backlist[j]);
    tbforward.Enabled := stob(forwardlist[j]);
  end;
end;

function TmainForm.ShortCaption(LongCaption: string; ShortLength: Integer): string;
begin
  if Length(LongCaption) > ShortLength then
    Result := Copy(LongCaption, 1, ShortLength) + '...'
  else
    Result := LongCaption;
end; //end ShortCaption

procedure Tmainform.buildfanmenu;
begin
  Favorites := GetFavoritesPath;
  if Favorites = '' then
  begin
    SeSkinMessage1.MessageDlg('访问收藏夹主键错误！', mtInformation,
      [mbOk], 0);

    exit;
  end;
  //addfavoritesmenu(meuFav, favorites);
end;

procedure Tmainform.deleteweb;

var i, maxcount: integer;
begin
  maxcount := Tbcweb.Tabs.Count;
  i := Tbcweb.tabindex;
  if (i < maxcount - 1) and (i <> 0) then
  begin
    Tbcweb.Tabs.Delete(i);
    Nebweb.pages.Delete(i);
    weblist.Delete(i);
    backlist.Delete(i);
    forwardlist.Delete(i);
    web := Tembeddedwb(weblist.Objects[i]);
    Tbcweb.tabindex := i;
    Nebweb.pageindex := i;
    tbback.Enabled := stob(backlist[i]);
    tbforward.Enabled := stob(forwardlist[i]);
  end;
//
  if (i < maxcount - 2) and (i = 0) then
  begin
    Tbcweb.Tabs.Delete(0);
    Nebweb.pages.Delete(0);
    weblist.Delete(0);
    backlist.Delete(0);
    forwardlist.Delete(0);
    Nebweb.PageIndex := Nebweb.Pages.Count - 1;
    web := Tembeddedwb(weblist.Objects[0]);
    Tbcweb.tabindex := 0;
    Nebweb.pageindex := 0;
    tbback.Enabled := stob(backlist[0]);
    tbforward.Enabled := stob(forwardlist[0]);
  end;
  if (maxcount = 2) and (i = 0) then
  begin
    Tbcweb.Tabs.Delete(0);
    Nebweb.pages.Delete(0);
    weblist.Delete(0);
    backlist.Delete(0);
    forwardlist.Delete(0);
    Nebweb.Pages.Add('new');
    Nebweb.PageIndex := Nebweb.Pages.Count - 1;
    Nebweb.PageIndex := 0;
    Nebweb.pages.delete(1);
    web := Tembeddedwb(weblist.Objects[0]);
    Tbcweb.tabindex := 0;
    tbback.Enabled := stob(backlist[0]);
    tbforward.Enabled := stob(forwardlist[0]);
  end;

  if (i = maxcount - 1) and (i <> 0) then
  begin
    Tbcweb.Tabs.Delete(i);
    Nebweb.pages.Delete(i);
    weblist.Delete(i);
    backlist.Delete(i);
    forwardlist.Delete(i);
    i := Tbcweb.Tabs.Count - 1;
    web := Tembeddedwb(weblist.Objects[i]);
    tbback.Enabled := stob(backlist[i]);
    tbforward.Enabled := stob(forwardlist[i]);
    Tbcweb.tabindex := i;
    Nebweb.pageindex := i;
  end;
  if (i = 0) and (maxcount = 1) then
  begin
    web := Tembeddedwb(weblist.Objects[0]);
    web.Navigate(blankde);
    urls.Text := '';
    backlist[0] := 'false';
    forwardlist[0] := 'false';
  end;
end;

procedure Tmainform.deletewb(i: integer);
var a: integer;
begin
  Tembeddedwb(weblist.Objects[i]).free;
  Tbcweb.Tabs.Delete(i);
  Nebweb.pages.Delete(i);
  weblist.Delete(i);
  backlist.Delete(i);
  forwardlist.Delete(i);
  if i = 0 then
  begin
    a := tbcweb.TabIndex;
    tbcweb.tabindex := 1;
    tbcweb.TabIndex := a;
  end;
end;

procedure TmainForm.newmenuClick(Sender: TObject); //back,forward按钮
var
  hinturls: string;
begin
  hinturls := trim(TMenuItem(Sender).hint);
  addnewweb(hinturls);
end;

function  Tmainform.stob(sb: string): boolean;
begin
  if sb = 'true' then
    Result := true
  else
    result := false;
end;

function Tmainform.btos(sb: boolean): string;
begin
  if sb = true then
    result := 'true'
  else
    result := 'false';
end;


procedure TmainForm.FormCreate(Sender: TObject);
var
  reg, rego: TRegistry;
  start, fini, username: string;
  opini: Tinifile;
  i, scount: integer;
  slist, startlist: Tstringlist;

begin
//初始化收藏，历史，搜索，状态
  Initpifu;
  panell.Visible := false;
  splitter1.Visible := false;
  lg := 0;
//end
  blankde := GetCurrentDir + '/blank.htm';
//

//初始化变量
  start := 'startgroup';
  filtername := 'filter';
  formfull := false;
  fini := GetCurrentDir + '/option.ini';
  opini := Tinifile.create(fini);
  try
    startlist := Tstringlist.create;
    slist := Tstringlist.Create;
    opini.ReadSection(start, slist);
    for i := 0 to slist.Count - 1 do
      startlist.add(opini.ReadString(start, inttostr(i), ''));
    filterlist := Tstringlist.Create;
    slist.Clear;
    opini.ReadSection(filtername, slist);
    for i := 0 to slist.Count - 1 do
      filterlist.Add(opini.ReadString(filtername, inttostr(i), ''));
    slist.Free;
    ctrlf := opini.readString('keyoption', 'ctrlf', '');
    ctrlb := opini.readString('keyoption', 'ctrl', '');
    shiftf := opini.readString('keyoption', 'shiftf', '');
    shiftb := opini.readString('keyoption', 'shift', '');
    closeapp := opini.ReadBool('hintform', 'closeapp', true);
    closeall := opini.ReadBool('hintform', 'closeall', true);
    currentapp := opini.ReadBool('hintform', 'currentapp', true);
    if opini.readbool('formstate', 'max', true) then
      mainform.WindowState := wsMaximized;
  finally
    opini.Free;
  end;
//end
  Reg := TRegistry.Create; //读取注册表开始地址
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('Software\Microsoft\Internet Explorer\Main', false);
  s := Reg.readString('Start Page');
  Reg.CloseKey;
  Reg.Free;
//
  weblist := Tstringlist.create;
  buildfanmenu; //创建收藏夹菜单
  if startlist.Count > 0 then
    s := startlist.Strings[0];
  backlist := Tstringlist.Create; //初始胡窗口状态
  forwardlist := Tstringlist.Create;
  backlist.Clear;
  forwardlist.Clear;
  Pi := Nebweb.Pages.Objects[0];
  i := Nebweb.PageIndex;
  panel := TPanel.create(pi);
  panel.Align := alclient;
  panel.parent := pi;
  wb := TEmbeddedWB.Create(panel);
  backlist.Add('false');
  forwardlist.Add('false');
  panel.Insertcontrol(wb);
  panel.BevelOuter := bvNone;
  weblist.Clear;
  weblist.addobject('wb', wb);
  wb.Align := alclient;
  wb.RegisterAsDropTarget := true;
  wb.onStatusTextChange := WebStatusTextChange;
  wb.onCommandStateChange := WebbCommandStateChange;
  wb.Silent := true;
  wb.UserInterfaceOptions := [DIALOG, OPENNEWWIN, FLAT_SCROLLBAR, URL_ENCODING_ENABLE_UTF8, ENABLE_FORMS_AUTOCOMPLETE, ENABLE_INPLACE_NAVIGATION, IME_ENABLE_RECONVERSION];
  Wb.onNewWindow2 := WbNewWindow2;
  wb.onBeforeNavigate2 := WbBeforeNavigate2;
  wb.OnNavigateComplete2 := webNavigateComplete2;
  wb.OnDocumentComplete := webDocumentComplete;
  web := wb;
  web.go(s);
  Tbback.Enabled := stob(backlist[i]);
  Tbforward.Enabled := stob(forwardlist[i]);
  scount := startlist.Count;
  if startlist.count > 1 then
  begin
    if startlist.count > 9 then
      scount := 10;
    begin
      for i := 1 to scount - 1 do
        addweb(startlist.Strings[i]);
    end;
    startlist.Free;
  end;
end;



procedure TmainForm.CustomItem1Click(Sender: TObject);
var
  ftpinputfile: TextFile;
begin
  { Load Skin }
  OpenDialog1.InitialDir := GetCurpath + 'Skins';

  if OpenDialog1.Execute then
    SeSkinEngine1.SkinFile := OpenDialog1.FileName;
  mainForm.SeSkinEngine1.SkinFile := OpenDialog1.FileName;
  AssignFile(ftpinputfile, GetCurpath + 'pifu.dat');
  rewrite(ftpinputfile);
  writeln(ftpinputfile, OpenDialog1.FileName);
  closefile(ftpinputfile);

end;

procedure TmainForm.CustomItem11Click(Sender: TObject);
var
  ftpinputfile: TextFile;

begin
  { Load Skin }
  OpenDialog1.InitialDir := GetCurpath + 'Skins';

  if OpenDialog1.Execute then
    SeSkinEngine1.SkinFile := OpenDialog1.FileName;
  mainForm.SeSkinEngine1.SkinFile := OpenDialog1.FileName;
  pifufile:=OpenDialog1.FileName;
  AssignFile(ftpinputfile, GetCurpath + 'pifu.dat');
  rewrite(ftpinputfile);
  writeln(ftpinputfile, StrAfter(GetCurpath,OpenDialog1.FileName));
  closefile(ftpinputfile);

end;

procedure TmainForm.ApplicationEvents2Message(var Msg: tagMSG;
  var Handled: Boolean);
const
  StdKeys = [VK_TAB, VK_RETURN];
  ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT];
  fExtended = $01000000;
begin
  Handled := False;
  with Msg do
    if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
      ((wParam in StdKeys) or (GetKeyState(VK_CONTROL) < 0) or
      (wParam in ExtKeys) and ((lParam and fExtended) = fExtended)) then try
      if IsChild(Web.Handle, hWnd) then

      begin
        with Web.Application as IOleInPlaceActiveObject do
          Handled := TranslateAccelerator(Msg) = S_OK;
        if not Handled then
        begin
          Handled := True;
          TranslateMessage(Msg);
          DispatchMessage(Msg);
        end;
      end;
    except
    end;
end; // IEMessageHandler

procedure TmainForm.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  if (((Msg.message = WM_CLOSE) and (Msg.hwnd = Web.Handle)) or ((Msg.message = WM_LBUTTONDBLCLK) and (Msg.hwnd = Tbcweb.Handle)))  then
  begin
    handled := true;
    deleteweb;
  end
  else
    inherited;
end;

procedure TmainForm.urlsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_return then
    web.Go(urls.text);
  if (shift = [ssCtrl]) and (key = VK_return) then
  begin
    urls.text := ctrlf + urls.text + ctrlb;
    web.Go(urls.text);
  end;
  if (shift = [ssShift]) and (key = vk_return) then
  begin
    urls.text := shiftf + urls.text + shiftb;
    web.Go(urls.text)
  end;
end;

procedure TmainForm.urlsUrlSelected(Sender: TObject; Url: string);
begin
  web.Go(trim(urls.text));
end;

procedure TmainForm.SeSkinSpeedButton8Click(Sender: TObject);
begin
  deleteweb;
end;

procedure TmainForm.TbcwebChange(Sender: TObject);
var i: integer;
begin
  i := Tbcweb.tabIndex;
  Nebweb.PAGEINDEX := i;
  web := TEmbeddedWB(weblist.Objects[i]);
  if Tbcweb.tabs[i] = '空白页' then
    urls.text := ''
  else
  begin
    urls.text := web.Locationurl;
  end;
  tbback.Enabled := stob(backlist[i]);
  tbforward.Enabled := stob(forwardlist[i]);
      //注意:i始终纪录tab,page,wb的焦点
end;

procedure TmainForm.TbcwebMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  dx := x;
  dy := y;
end;

procedure TmainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  filterlist.Free;
  weblist.Free;
  backlist.Free;
  forwardlist.Free;
end;

procedure TmainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  opini: Tinifile;
  fini: string;
  askform: Taskform;