favoritestree.pas

Delphi VCL Component Pack

destructor TCustomFavoritesTree.Destroy;
begin
   FFavoritesMonitor.Terminate;
   inherited;
end;

procedure TCustomFavoritesTree.DoFavoritesChanged(Sender: TObject);
begin
   if Assigned(OnFavoritesChanged) then
      OnFavoritesChanged(Self);
end;

function TCustomFavoritesTree.NodeURL(const aNode: TTreeNode): string;
var
   Filename: string;
   FName: array[0..MAX_PATH] of WideChar;
   P: Pchar;
   IUrl: IUniformResourceLocator;
   PersistFile: IPersistFile;
begin
   Filename := GetFilename(aNode);
   IUrl := CreateComObject(CLSID_InternetShortCut) as IUniformResourceLocator;
   Persistfile := IUrl as IPersistFile;
   StringToWideChar(FileName, FName, MAX_PATH);
   PersistFile.Load(Fname, STGM_READ);
   IUrl.geturl(@P);
   Result := P;
end;

function TCustomFavoritesTree.GetFilename(const aNode: TTreeNode): string;
begin
   if (aNode = nil) or ((aNode = Items[FavIndex]) {and  (foShowRoot in Options)}) then
      Result := FPath
   else
      begin
         case TNodeType(aNode.Data) of
            ntItem: Result := GetFilename(aNode.Parent) + aNode.Text + '.url';
            ntFolder: Result := GetFilename(aNode.Parent) + aNode.Text + '\';
            ntEmptyFolder: Result := GetFilename(aNode.Parent) + aNode.Text + '\';
            ntTools: Result := GetFilename(aNode.Parent) + aNode.Text + '\';
         end;
      end;
end;

procedure TCustomFavoritesTree.RefreshFolder(const aFolder: TTreeNode);
var
   CurrentPath: string;
   SR: TSearchRec;
   Found: Integer;
begin
   CurrentPath := GetFilename(aFolder);
   Found := FindFirst(CurrentPath + '*.*', faDirectory, SR);
   while Found = 0 do
      begin
         if (SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
            InternalAdd(aFolder, SR.Name, ntEmptyFolder);
         Found := FindNext(SR);
      end;
   FindClose(SR);
   if foShowItems in Options then
      begin
         Found := FindFirst(CurrentPath + '*.url', faAnyFile, SR);
         while Found = 0 do
            begin
               if (SR.Attr and faDirectory = 0) then
                  begin
                     InternalAdd(aFolder, copy(SR.Name, 1, Length(SR.Name) - 4), ntItem);
                  end;
               Found := FindNext(SR);
            end;
         FindClose(SR);
      end;
   if aFolder <> nil then
      if TNodeType(aFolder.Data) = ntEmptyFolder then
         aFolder.Data := Pointer(ntFolder);
   if aFolder <> nil then
      if TNodeType(aFolder.Data) = ntFolder then
         begin
            aFolder.HasChildren := true;
            aFolder.Data := Pointer(ntFolder);
            aFolder.Expand(true);
         end;
end;

function TCustomFavoritesTree.InternalAdd(const aParent: TTreeNode;
   const aCaption: string;
   const aNodeType: TNodeType): TTreeNode;
begin
   Result := Items.AddChild(aParent, aCaption);
   Result.Data := Pointer(aNodeType);
   if Assigned(OnNodeAdded) then
      begin
         OnNodeAdded(Self, Result, aNodeType);

      end;
end;

procedure TCustomFavoritesTree.Refresh;
var
   RootNode, RootNode2: TTreeNode;
 // IE5                 : Boolean;
begin
   try
      Items.BeginUpdate;
      while Items.Count > 0 do
         Items[0].Delete;

      if foShowRoot in Options then
         begin
            RootNode := InternalAdd(nil, 'Tools', ntTools);
         end
      else
         RootNode := nil;
      if foShowOrganize in Options then
         InternalAdd(RootNode, 'Organize favorites', ntOrganizeFavorites);
      if (foShowAdd in Options) then
         InternalAdd(RootNode, 'Add To favorites', ntAddToFavorites);
      if (foShowImport in Options) then
         InternalAdd(RootNode, 'Import favorites', ntImportFavorites);
      if (foShowExport in Options) then
         InternalAdd(RootNode, 'Export favorites', ntExportFavorites);
      if (RootNode <> nil) then
         RootNode.Expanded := True;
      if (pos('Links', RootNode.Text) > 0) or (pos('Imported', RootNode.Text) > 0)
         then
         begin
            RootNode.HasChildren := true;
         end;
      RootNode2 := InternalAdd(nil, 'Favorites', ntRoot);

      FavIndex := RootNode.Count + 1;
      RefreshFolder(RootNode2);
      RootNode2.Expand(true);
   finally
      Items.EndUpdate;
   end;
end;

procedure TCustomFavoritesTree.SetOption(const Value: TFavoriteOptions);
begin
   FOptions := Value;
end;

procedure TCustomFavoritesTree.ExportTheFavorites;
begin
   if Assigned(ExportFavorites) then
      fExportFavorites.ExportFavorites;
end;

procedure TCustomFavoritesTree.ImportTheFavorites;

begin
   if Assigned(ImportFavorites) then
      fImportFavorites.ImportFavorites;
   Refresh;
end;

procedure TCustomFavoritesTree.OrganizeFavorites;
var
   H: HWnd;
   p: procedure(Handle: THandle; Path: PChar); stdcall;
begin
   H := LoadLibrary(PChar('shdocvw.dll'));
   if H <> 0 then
      begin
         p := GetProcAddress(H, PChar('DoOrganizeFavDlg'));
         if Assigned(p) then
            p(Application.Handle, PChar(FPath));
      end;
   FreeLibrary(h);
   Refresh;
end;

procedure AddToFav(URL, Title: string);
const
   CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';
var
   ShellUIHelper: ISHellUIHelper;
   Url1, Title1: OleVariant;
begin
   Title1 := Title;
   Url1 := Url;
   CoCreateInstance(CLSID_SHELLUIHELPER, nil, CLSCTX_INPROC_SERVER, IID_IShellUIHelper, ShellUIHelper);
   ShellUIHelper.AddFavorite(URL1, Title1);
end;


procedure TCustomFavoritesTree.AddToFavorites;
begin
   if Assigned(EmbeddedWB) then
      begin
        AddToFav(EmbeddedWB.LocationURL, EmbeddedWB.LocationName);
      end;
   Refresh;
end;

function URLFromShortcut(const dotURL: string): string;
begin
   with TIniFile.Create(dotURL) do
      try
         try
            Result := ReadString('InternetShortcut', 'URL', '');
         except;
            Result := '';
         end;
      finally
         Free;
      end;
end;

procedure TCustomFavoritesTree.DblClick;
var
   URLPath: widestring;
//  ID      : PItemIDList;
   x: Olevariant;
   URL: string;
begin
   inherited;
   if Selected = nil then
      exit;

   case TNodeType(Selected.Data) of
      ntFolder, ntEmptyFolder:
         if not DirectoryExists(GetFilename(Selected)) then
            begin
               if Assigned(OnNodeMissing) then
                  OnNodeMissing(Self, Selected, TNodeType(Selected.Data));
               Selected.Delete;
               exit;
            end;

      ntItem:
         if not FileExists(GetFilename(Selected)) then
            begin
               if Assigned(OnNodeMissing) then
                  OnNodeMissing(Self, Selected, TNodeType(Selected.Data));
               Selected.Delete;
               exit;
            end;
   end;

   case TNodeType(Selected.Data) of
      ntAddToFavorites: AddToFavorites;
      ntOrganizeFavorites: OrganizeFavorites;
      ntImportFavorites: ImportTheFavorites;
      ntExportFavorites: ExportTheFavorites;
      ntTools: Selected.Expand(True);
      ntEmptyFolder:
         begin
            RefreshFolder(Selected);
            Selected.Expand(False);
         end;
      ntItem:
         begin
            if Assigned(OnNavigate) then
               FOnNavigate(Self, NodeURL(Selected));
            if Assigned(EmbeddedWB) then
               begin
                  URLPath := GetFilename(Selected);
                  URL := URLFromShortcut(URLPath);
                  EmbeddedWB.Navigate(Url, X, X, X, X);
               end;
         end;
   end;
end;

end.