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;