⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 mainunit.pas

📁 将ie的收藏夹导出成html格式
💻 PAS
字号:
🔍 
unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,ShlObj,shellapi,Registry;

type
  TMainForm = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    function GetIEFavourites(const favpath: string): TStrings;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

function TMainForm.GetIEFavourites(const favpath: string): TStrings;
var
  searchrec: TSearchrec;
  str: TStrings;
  path, dir, filename: string;
  Buffer: array[0..2047] of char;
  found: integer; 
begin 
  str := TStringList.Create;
  path := FavPath + '\*.url';
  dir := ExtractFilepath(path);
  found := FindFirst(path, faAnyFile, searchrec);
  while found = 0 do
  begin
    SetString(filename, Buffer, GetPrivateProfileString('InternetShortcut',PChar('URL'), nil, Buffer, SizeOf(Buffer), PChar(dir + searchrec.Name)));
    str.Add('<a href="'+filename+'">'+copy(searchrec.Name,1,length(searchrec.Name)-4)+'</a>'+'<BR>');
    found := FindNext(searchrec);
  end;
  found := FindFirst(dir + '\*.*', faAnyFile, searchrec);
  while found = 0 do
  begin
    if ((searchrec.Attr and faDirectory) > 0) and (searchrec.Name[1] <> '.') then
    begin
      str.add('<BR>');
      str.add(searchrec.name+'<BR>');
      str.AddStrings(GetIEFavourites(dir + '\' + searchrec.Name));
    end;
    found := FindNext(searchrec);
  end;
  FindClose(searchrec);
  Result := str;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  pidl: PItemIDList;
  FavPath: array[0..MAX_PATH] of char;
begin
  SHGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl);
  SHGetPathFromIDList(pidl, favpath);
  memo1.Lines.Add('<html>');
  memo1.Lines.Add('<head><Title>我的收藏夹</Title></head>');
  memo1.Lines.Add('<Body bgcolor="white">');
  memo1.Lines.Add('<Center><H1>我的收藏夹</h1></Center>');
  memo1.Lines.Add('<Hr width="80%"><BR><BR>');
  memo1.Lines.add(GetIEFavourites(StrPas(FavPath)).gettext);
  memo1.Lines.Add('</BODY></HTML>');
  button2.Enabled:=true;
  showmessage('代码生成完成！');
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
  Reg: TRegistry;
  deskpath:string;
begin
  //取得桌面路径
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', false) then
    deskpath:=Reg.readString('Desktop');
  finally
    Reg.CloseKey;
    Reg.Free;
  inherited;
  end;
  //设为首页
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('Software\Microsoft\Internet Explorer\Main', false) then
    Reg.writeString('Start Page',deskpath+'\我的收藏夹.htm');
  finally
    Reg.CloseKey;
    Reg.Free;
  inherited;
  end;
  memo1.Lines.SaveToFile(deskpath+'\我的收藏夹.htm');
  showmessage('文件导出完成！');
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -