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;