{.$DEFINE TINIFILE}
procedure TForm1.OnURLMenuItemClick(Sender: TObject);
begin
if(Sender
is TMenuItem)
and
((Sender
as TMenuItem).Hint <> '
')
then
ShellExecute(self.Handle,'
open',pchar((Sender
as TMenuItem).Hint),
nil,
nil,SW_SHOWNORMAL);
end;
procedure TForm1.LoadLocalFavorites;
procedure scanit(
const orgPath:
string; parentMI: TMenuItem);
var
path :
string;
res : integer;
ds : TSearchRec;
mii : TMenuItem;
{$IFDEF TINIFILE}
ini : TIniFile;
{$ENDIF}
begin
path := GetCurrentDir;
// zuerst alle Ordner, weil das Einträge für
// Untermenüs werden
res := FindFirst('
*.*',faAnyFile,ds);
while(res = 0)
do
begin
if(ds.Attr
and faDirectory <> 0)
and
(ds.Attr
and faHidden = 0)
and
((ds.
Name <> '
.')
and (ds.
Name <> '
..'))
then
begin
mii := TMenuItem.Create(parentMI);
mii.Caption := ds.
Name;
// rein ins Menü
parentMI.Add(mii);
if(SetCurrentDir(ds.
Name))
then
scanit(orgPath,mii);
end;
res := FindNext(ds); Application.ProcessMessages;
end;
FindClose(ds);
// und jetzt alle URL-Dateien suchen
res := FindFirst('
*.url',faAnyFile,ds);
while(res = 0)
do
begin
if(ds.
Name <> '
.')
and
(ds.
Name <> '
..')
and
(ds.Attr
and faDirectory = 0)
then
begin
mii := TMenuItem.Create(parentMI);
mii.Caption := ChangeFileExt(ds.
Name,'
');
{$IFDEF TINIFILE}
ini := TIniFile.Create(path + '
\' + ds.
Name);
if(ini <>
nil)
then
try
mii.Hint := ini.ReadString('
InternetShortcut','
URL','
');
finally
ini.Free;
end;
{$ELSE}
mii.Hint := '
"' + path + '
\' + ds.
Name + '
"';
{$ENDIF}
mii.ImageIndex := 11;
mii.OnClick := OnURLMenuItemClick;
// ab ins Menü damit
if(mii.Hint <> '
')
and
(mii.Caption <> '
')
then parentMI.Add(mii);
end;
res := FindNext(ds); Application.ProcessMessages;
end;
FindClose(ds);
// und wieder einen Ordner nach oben
if(path <> orgPath)
then ChDir('
..');
end;
var
cDummy,
xPath :
string;
begin
// aktuelles Verzeichnis ermitteln
cDummy := GetCurrentDir;
// Favoritenordner des aktuellen Benutzers
// ermitteln, ...
xPath := GetSpecialFolder(
Handle, CSIDL_FAVORITES);
// ... & scannen
if(xPath <> '
')
and
(SetCurrentDir(xPath))
then scanit(xPath,[b]Favs1[/b]);
// du kannst auch noch die Favoriten für
// alle Benutzer anhängen, wenn du nach
// "CSIDL_COMMON_FAVORITES" suchst
end;
function tform1.GetSpecialFolder(hWindow: HWND; Folder: Integer):
String;
var
pMalloc: IMalloc;
pidl: PItemIDList;
Path: PChar;
begin
// get IMalloc interface pointer
if (SHGetMalloc(pMalloc) <> S_OK)
then
begin
MessageBox(hWindow, '
Couldn''
t get pointer to IMalloc interface.',
'
SHGetMalloc(pMalloc)', 16);
Exit;
end;
// retrieve path
SHGetSpecialFolderLocation(hWindow, Folder, pidl);
GetMem(Path, MAX_PATH);
SHGetPathFromIDList(pidl, Path);
Result := Path;
FreeMem(Path);
// free memory allocated by SHGetSpecialFolderLocation
pMalloc.Free(pidl);
end;