// Es werden die persönlichen Favoriten des Internetexplorers in ein
// TreeView eingelesen. Beim Doppelklick auf eine URL wird die
// zugehörige Adresse ermittelt und an den Standardbrowser übergeben.
// Man setzt dazu ein TTreeView und eine TImageList auf die Form. In
// die ImageList werden 3 Icons geladen:

0 1 2

// Der Rest geht aus dem folgenden Code hervor.


// Getestet mit D4 unter XP

uses shellapi, inifiles; 
 
var 
  pfd: string; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Treeview1.Images := Imagelist1; 
  // kann auch im Objektinspektor ausgewählt werden 
end; 
 
procedure GetFavs(tv: TTreeview); 
var 
  ttn: TTreenode; 
  function FavPath: string; 
  var 
    p: PChar; 
    pidl: PItemIdList; 
  begin 
    getmem(p, max_path); 
    SHGetSpecialFolderLocation(Application.Handle, CSIDL_FAVORITES, pidl); 
    SHGetPathFromIDList(pidl, p); 
    result := p; 
    freemem(p); 
    if ansilastchar(result) <> '\' then result := result + '\'; 
  end; 
  procedure findDatei(pfad: string; tn: TTreenode); 
  var 
    sr: TWin32FindData; 
    h: THandle; 
    tnn: TTreenode; 
  begin 
    h := FindFirstFile(PChar(pfad + '*'), sr); 
    if h <> INVALID_HANDLE_VALUE then repeat 
        if sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin 
          tnn := tv.Items.addchild(tn, sr.cFileName); 
          tnn.imageindex := 2; 
          tnn.selectedindex := 2; 
        end; 
      until Findnextfile(h, sr) = false; 
    windows.FindClose(h); 
  end; 
  procedure findDir(pfad: string; tn: TTreenode); 
  var 
    sr: TWin32FindData; 
    h: THandle; 
    tnn: TTreenode; 
  begin 
    h := FindFirstFile(PChar(pfad + '*'), sr); 
    if h <> INVALID_HANDLE_VALUE then 
      repeat 
        if (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0) 
          and (string(sr.cFileName) <> '.') and (string(sr.cFileName) <> '..') 
          then begin 
          tnn := tv.Items.addchild(tn, sr.cFileName); 
          tnn.imageindex := 1; 
          tnn.selectedindex := 1; 
          finddatei(pfad + sr.cFileName + '\', tnn); 
          findDir(pfad + sr.cFileName + '\', tnn); 
        end; 
      until Findnextfile(h, sr) = false; 
    windows.FindClose(h); 
  end; 
begin 
  tv.items.clear; 
  pfd := FavPath; 
  ttn := tv.Items.Add(nil, extractfilename(copy(pfd, 1, length(pfd) - 1))); 
  ttn.imageindex := 0; 
  ttn.selectedindex := 0; 
  finddir(pfd, ttn); 
  finddatei(pfd, ttn); 
  ttn.expand(false); 
end; 
 
procedure start(tv: TTreeview); 
  function findPfad(Node: TTreeNode): string; 
  begin 
    if Node.Parent <> nil then 
      result := findPfad(Node.Parent) + '\' + Node.Text 
  end; 
  function GetUrl(s: string): string; 
  var 
    ini: TInifile; 
  begin 
    ini := TIniFile.create(s); 
    try 
      result := ini.ReadString('InternetShortcut', 'URL', ''); 
    finally 
      ini.free; 
    end; 
  end; 
begin 
  with tv do begin 
    if (selected <> nil) and (selected.imageindex = 2) 
      then begin 
      shellexecute(application.handle, 'open', 
        pchar(geturl(pfd + copy(findpfad(selected), 2, maxint))), 
        nil, nil, sw_show); 
    end; 
  end; 
end; 
 
procedure TForm1.TreeView1DblClick(Sender: TObject); 
begin 
  start(TTreeview(Sender)); 
end; 
 
procedure TForm1.TreeView1KeyPress(Sender: TObject; var Key: Char); 
begin 
  if key = #13 then begin 
    key := #0; 
    start(TTreeview(Sender)); 
  end; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  GetFavs(Treeview1); 
  Treeview1.SetFocus; 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke