|
|
procedure TForm1.ToolButton1Click(Sender: TObject);
label
Write;
var
Favorites:String;
Search:TSearchRec;
begin
Favorites:=GetFavoritesPath;
if Favorites='' then
begin
MessageBox(Handle,'访问收藏夹主键错误！','提示信息',MB_OK);
exit;
end;
Memo1.Clear;
with Search,Memo1.Lines do
begin
if FindFirst(Favorites+'*.url',0,Search)=0 then
begin
Write:
Add(GetFavoritesUrl(Favorites+Name));
SetLength(Name,Length(Name)-4);
Add(Name);
if FindNext(Search)=0 then
goto Write;
end;
end;
end;
function TForm1.GetFavoritesPath:String;
var
reg:TRegistry;
begin
Result:='';
reg:=TRegistry.Create;
with reg do
begin
RootKey:=HKEY_USERS;
if OpenKey('.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders',false)=true then
Result:=ReadString('Favorites')+'\';
CloseKey;
Free;
end;
end;
{function TForm1.GetFavoritesUrl(FavoritesFile: String): String;
begin
with TIniFile.Create(FavoritesFile)do
begin
Result:=ReadString('InternetShortcut','URL','');
Free;
end;
end;}
function TForm1.GetFavoritesUrl(FavoritesFile: String): String;
var
i:integer;
begin
Result:='';
with TStringList.Create do
begin
LoadFromFile(FavoritesFile);
i:=IndexOf('[InternetShortcut]');
if i=-1 then
exit;
Result:=Strings[i+1];
System.Delete(Result,1,4);
Free;
end;
end;
|
|
