//original übernommen
procedure FreePidl(pidl: PItemIDList);
var
allocator: IMalloc;
begin
if Succeeded(SHGetMalloc(allocator)) then begin
allocator.Free(pidl);
{$IFDEF VER100}
allocator.Release;
{$ENDIF}
end;
end;
procedure TFTermin.GenIEFavourites(const favpath: string; var m : TMenuItem);
const
mxcaplen = 80;
var
searchrec: TSearchRec;
link, lcap, // link capture
path, dir, FileName: string;
Buffer: array[0..2047] of Char;
i,
found: Integer;
NewItem: TMenuItem;
begin
// Get all file names in the favourites path
path := IncludeTrailingBackslash(FavPath);
dir := ExtractFilepath(path);
found := FindFirst(path + '*.url', faAnyFile, searchrec);
while found = 0 do begin
// Get now URLs from files in variable files
Setstring(FileName, Buffer, GetPrivateProfilestring('InternetShortcut',
PChar('
URL'), nil, Buffer, SizeOf(Buffer), PChar(dir + searchrec.Name)));
link := FileName;
lcap := searchrec.Name;
//.url .de entfernen
i := pos('.', lcap);
if i > 0 then lcap := copy(lcap, 1, i-1);
NewItem := TMenuItem.Create(m);
NewItem.Bitmap.LoadFromFile(Execpath + 'FavoFile.BMP');
NewItem.Caption := lcap;
//Länge kürzen
if length(NewItem.Caption) > mxcaplen
then NewItem.Caption := copy(NewItem.Caption, 1, mxcaplen-3) + ' ...';
// mit einem Click auf den Eintrag wird die angewählte Seite geladen
NewItem.OnClick := LadeWebPageausFavoriten1Click;
m.Add(NewItem);
found := FindNext(searchrec);
end;
// Unterverzeichnisse einbeziehen
found := FindFirst(dir + '*.*', faAnyFile, searchrec);
while found = 0 do begin
if ((searchrec.Attr and faDirectory) > 0) and (searchrec.Name[1] <> '.') then begin
NewItem := TMenuItem.Create(m);
NewItem.Bitmap.LoadFromFile(Execpath + 'Ordner.BMP');
NewItem.Caption := SearchRec.Name;
if length(NewItem.Caption) > mxcaplen
then NewItem.Caption := copy(NewItem.Caption, 1, mxcaplen-3) + ' ...';
m.Add(NewItem);
GenIEFavourites(dir + searchrec.Name, NewItem);
end;
found := FindNext(searchrec);
end;
FindClose(searchrec);
end;
procedure TFTermin.FavoritenMenerzeugen1Click(Sender: TObject);
var
pidl: PItemIDList;
FavPath: array[0..MAX_PATH] of Char;
NewItem: TMenuItem;
begin
if Succeeded(ShGetSpecialFolderLocation(
Handle, CSIDL_FAVORITES, pidl)) then begin
if ShGetPathfromIDList(pidl, FavPath) then begin
{ zuerst Trennlinie erzeugen }
NewItem := TMenuItem.Create(Self);
NewItem.Caption := '-';
Favoriten1.Add(NewItem); //Favoriten1 : TMenuItem im
OI definiert
{ neuen Eintrag in Menü FENSTER einfügen }
GenIEFavourites(StrPas(FavPath), Favoriten1);
end;
FreePIDL(pidl);
end;
end;
procedure TFTermin.LadeWebPageausFavoriten1Click(Sender: TObject);
begin
if (Sender is TMenuItem )then begin
s := (Sender as TMenuItem).Hint;
if s <> '' then begin
cbWeb.Text := s;
sbGoWeb.Click;
end;
end;
end;