收藏夹里的那些东西是什么类型的文件，怎样得到它们正真的URL?(50分)

通上

子目录和Internet快捷方式

好象有一个函数可以得到，记不清了。

{
Component : TFavoritesMenu
Description: VCL component show a Menu with all your favorites internet
link present in your favorite Directory. (Internet Explorer only).
Version: 1.00 (Delphi 5)
Date: 06/28/2001

Autor: Roberto Cardentey Ruiz
Email: robe@lighteam.com

Company: Lighteam - ERKA S.L.
Copyrights...
FREEWARE
you can freely use or distribute files included to this archive.
The authors grant you the right to modify/change the source code as long as the
original authors are mentionned. Please let us know if you make any improvements,
so that we can keep an up to date version. We also welcome all comments,
preferably by email.
These components are supplied with no guarantees of any kind and must be used at
your own risk.
Help:
}
unit FavoritesMenu;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus;

type
TUrlNotifyEvent = procedure(Sender: TObject; Url: string) of object;

TFavoritesMenu = class(TComponent)
private
{ Private declarations }
FMenuItem: TMenuItem;
FMaxLength: integer;
FOnUrlClick: TUrlNotifyEvent;
FImageFolder: integer;
FImageUrl: integer;
procedure FillFavorites(Directory: string; AMenuItem: TMenuItem);
function CreateMenuOption(AFileName: string; AMenuItem: TMenuItem):
TMenuItem;
function CreateMenuOptionDir(AFileName: string;
AMenuItem: TMenuItem): TMenuItem;
procedure DoClickUrl(Sender: TObject);
function ReadUrl(AFileName: string): string;
protected
{ Protected declarations }
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure Refresh;
published
{ Published declarations }
property MenuItem: TMenuItem read FMenuItem write FMenuItem;
property MaxLength: integer read FMaxLength write FMaxLength default 30;
property ImageFolder: integer read FImageFolder write FImageFolder default
0;
property ImageUrl: integer read FImageUrl write FImageUrl default 1;
property OnUrlClick: TUrlNotifyEvent read FOnUrlClick write FOnUrlClick;
end;

procedure Register;

implementation

uses Registry, Inifiles;

procedure Register;
begin
RegisterComponents('Lighteam', [TFavoritesMenu]);
end;

{ TFavoritesMenu }

constructor TFavoritesMenu.Create(AOwner: TComponent);
begin
inherited;
FMaxLength := 30;
FImageFolder := 0;
FImageUrl := 1;
end;

procedure TFavoritesMenu.DoClickUrl(Sender: TObject);
begin
if Assigned(FOnUrlClick) then FOnUrlClick(Sender, TMenuItem(Sender).Hint);
end;

function TFavoritesMenu.ReadUrl(AFileName: string): string;
var
Reg: TIniFile;
begin
Reg := TIniFile.Create(AFileName);
result := Reg.ReadString('InternetShortcut', 'URL', 'non url');
Reg.Free;
end;

function TFavoritesMenu.CreateMenuOption(AFileName: string; AMenuItem:
TMenuItem): TMenuItem;
var
Item: TMenuItem;
Cap: string;
Url: string;
begin
Item := TMenuItem.Create(AMenuItem);
Cap := Copy(ExtractFileName(AFileName), 1,
Length(ExtractFileName(AFileName)) - 4);
if Length(Cap) > FMaxLength then
Cap := Copy(Cap, 1, FMaxLength) + '..';
Item.ImageIndex := FImageUrl;
Item.Caption := Cap;
Item.Hint := ReadUrl(AFileName);
Item.OnClick := DoClickUrl;
AMenuItem.Add(Item);
result := Item;
end;

function PosRight(sub: char; s: string): integer;
var
i: integer;
begin
result := -1;
for i := Length(s) downto 1 do
if s = sub then
begin
result := i;
break;
end;
end;

function TFavoritesMenu.CreateMenuOptionDir(AFileName: string; AMenuItem:
TMenuItem): TMenuItem;
var
Item: TMenuItem;
p: integer;
begin
Item := TMenuItem.Create(AMenuItem);
p := PosRight('/', AFileName);
Item.Caption := Copy(AFileName, p + 1, Length(AfileName));
Item.ImageIndex := FImageFolder;
AMenuItem.Add(Item);
result := Item;
end;

procedure TFavoritesMenu.FillFavorites(Directory: string;
AMenuItem: TMenuItem);
var
search: TSearchRec;
Item: TMenuItem;
begin
if Directory[length(Directory)] <> '/' then Directory := Directory + '/';
if FindFirst(Directory + '*.*', faArchive + fadirectory, search) = 0 then
begin
repeat
if ((search.Attr and fadirectory) = fadirectory) and (search.name[1] <>
'.') then
begin
Item := CreateMenuOptionDir(Directory + search.Name, AMenuItem);
FillFavorites(Directory + search.Name, Item);
end
else if ((search.Attr and faArchive) = faArchive) then
CreateMenuOption(Directory + search.Name, AMenuItem);
until FindNext(search) <> 0;
FindClose(search);
end;
end;

procedure TFavoritesMenu.Refresh;
var
Reg: TRegistry;
InitDir: string;
begin
Reg := TRegistry.Create;
Reg.OpenKey('Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders', false);
InitDir := Reg.ReadString('Favorites');
Reg.Free;
FillFavorites(InitDir, FMenuItem);
end;

procedure TFavoritesMenu.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and (AComponent = FMenuItem) then FMenuItem := nil;
end;

end.

关注。

其实是一个INI文件,类似:
[InternetShortcut]
URL=http://www.delphibbs.com/delphibbs/listq.asp
Modified=006726CF0D35BE015D

下面那一段不用理.

到C:/Windows/Favorites看看。

chemer
有编译好的吗，给我发一个，先谢了.
rightly@163.com

发过去了

谢谢，结账！！！