Buy now, 799$, online ordering, delivery by email

Subfolder sample

The subfolder sample is one of the samples that come with the namespace extension library for Delphi.

The sample contains 2 files: the main file containing the namespace extension items and folders, and a separate file for the property sheet.

subfolderMain.pas

unit subfolderMain;

interface

uses
  Windows, ActiveX, Classes, ComObj, NamespaceExtension, ShlObj,
  uShellUIObject, NSEFactory, uNamespaceApp, ContextMenu, Menus;

type
  TtestsubNamespaceItem = class (TNamespaceItem)
  private
    FFolderName : string;
  protected
    function GetAttributes : cardinal; override;
    function GetInfoTip: string; override;
    function GetItemDetail(Col : integer) : string; override;
    function GetStorageType : string; override;
    function IsValidObject : boolean; override;
  public
    function CompareWith(iCol : cardinal; nsi : TNamespaceItem) : smallint; override;
    function GetDisplayName(uFlags : cardinal) : string; override;
    function GetFindData(var pFindData : WIN32_FIND_DATAW) : boolean; override;
    function GetIconIndex(uFlags : cardinal; var puiReturnFlags : cardinal) : integer; override;
    function SetItemName(aName : string) : boolean; override;
  published
    property FolderName : string read FFolderName write FFolderName;
  end;

  TtestsubNamespaceExtension = class(TNamespaceExtension)
  protected
    function CreateFolder(pID : TNamespaceItem) : TNamespaceExtension; override;

    // Override to return the attributes for the namespaces's root.
    function GetAttributes : cardinal; override;
    // Override to return the correct title for column Col.
    function GetColumnTitle(Col : integer) : string; override;
    // Override to provide the default column.
    function GetDefaultColumn(var pSort : cardinal; var pDisplay : cardinal) : boolean; override;
    // Override to return the display name for the namespace's root.
    function GetDisplayName : string; override;
    // Override to return the icon index that represents the namespace's root.
    function GetIconIndex : integer; override;
    // Override to return the infotip for the namespaces's root.
    function GetInfoTip : string; override;
    // Override to return the junction point for this namespace
    function GetJunctionPoint : TJunctionPoint; override;
    // Override to return true if the current version of the object is the same as explorers
    function IsValidObject : boolean; override;


    function GetWebPage : string; override;

    // Return number of property pages
    function GetPropertyPageCount: integer; override;
    function GetPropertyPageTitle(index: integer): string; override;
    function GetPropertySheetClass(index : integer): TPropertySheetClass; override;

  public
    function GetFirstId(var pData : TNamespaceItem; var Cookie : cardinal; FFlags : cardinal) : boolean; override;
    function GetNextId(pPrev : TNamespaceItem; var pData : TNamespaceItem; var Cookie : cardinal; FFlags : cardinal) : boolean; override;
    function GetMenuItems(mi : TExplorerMenuType; var DelphiMenu : TPopupMenu;
                          var FreeOnCompletion : boolean) : boolean; override;
  end;

  TtestsubUIObject = class(TShellUIobject)
    // There are no user overridable functions here.
  end;

const
  Class_testsubNamespaceExtension: TGUID = '{2846A266-69B1-4B41-AA1D-F09E4A7BBC13}';
  Class_testsubUIObject: TGUID = '{73E11B4C-62A0-4FC0-A253-56BDF68778E8}';

implementation

uses ComServ, SysUtils, ShellApi, CommCtrl, SubFolderpropSheet;

{ TtestsubNamespaceItem }

function TtestsubNamespaceItem.CompareWith(iCol: cardinal;
  nsi: TNamespaceItem): smallint;
begin
  // TODO: Replace the next line with code to compare two namespace items.
  // Return 1 if nsi should be higher up the list than self,  -1 is nsi
  // should be lower in the list than self or zero if both are equal.
  Result := AnsiCompareStr(GetDisplayName(0), nsi.GetDisplayName(0));
end;

function TtestsubNamespaceItem.GetAttributes: cardinal;
begin
  // Return the attributes of your namespace item.  Or one or more of the following:
  // SFGAO_CANCOPY - object can be copied.
  // SFGAO_CANMOVE - object can be moved.
  // SFGAO_CANLINK - object can be linked.
  // SFGAO_CANRENAME - object can be renamed.
  // SFGAO_CANDELETE - object can be deleted.
  // SFGAO_HASPROPSHEET - Object has property sheets.
  // SFGAO_DROPTARGET - Object is a drop target.
  // SFGAO_LINK - Object is a shortcut (link).
  // SFGAO_SHARE - Object is shared.
  // SFGAO_READONLY - Object is read only.
  // SFGAO_GHOSTED - Object is ghosted (cut).
  // SFGAO_HIDDEN - hidden object.
  // SFGAO_FILESYSANCESTOR - Object contains file system folder.
  // SFGAO_FOLDER - Object is a folder.
  // SFGAO_FILESYSTEM - Object is a file system thing (file/folder/root).
  // SFGAO_HASSUBFOLDER - Object is expandable in the tree view.
  // SFGAO_REMOVABLE - is this removeable media?
  // SFGAO_COMPRESSED - Object is compressed (use alt color).
  // SFGAO_BROWSABLE - Object is in-place browsable.
  // SFGAO_NONENUMERATED - Object is a non-enumerated object.
  // SFGAO_NEWCONTENT - Object should show bold in explorer tree.
  // TODO: Replace the next line.
  if Pos('tail',FFolderName) = 0 then
    Result := SFGAO_CANCOPY or SFGAO_CANMOVE or SFGAO_CANRENAME or SFGAO_CANDELETE
              or SFGAO_FOLDER or SFGAO_HASSUBFOLDER or SFGAO_BROWSABLE
  else
    Result := SFGAO_CANCOPY or SFGAO_CANMOVE or SFGAO_CANRENAME or SFGAO_CANDELETE;
end;

function TtestsubNamespaceItem.GetDisplayName(uFlags: cardinal): string;
begin
  //TODO: Replace the next line with code to return the display name that
  // should show in explorer.
  Result := FFolderName;
end;

function TtestsubNamespaceItem.GetFindData(
  var pFindData: WIN32_FIND_DATAW): boolean;
begin
  // TODO: Replace next line with code to populate pFindData with things like
  // access time etc.
  Result := False;
end;

function TtestsubNamespaceItem.GetIconIndex(uFlags: cardinal;
  var puiReturnFlags: cardinal): integer;
begin
  // TODO: Replace next line with code to return the index in your resource that
  // holds the display icon for the object.
  Result := 0;
end;

function TtestsubNamespaceItem.GetInfoTip: string;
begin
  // TODO: Replace the next line with code to return the info tip for this object.
  Result := GetDisplayName(0);
end;

function TtestsubNamespaceItem.GetItemDetail(Col: integer): string;
begin
  // TODO: Replace the next line with code that for the column 'Col' returns
  // the text to display.
  Result := GetDisplayName(0);
end;

function TtestsubNamespaceItem.GetStorageType: string;
begin
  // TODO: Replace the next line with code to return the storage type for this object
  Result := '';
end;

function TtestsubNamespaceItem.IsValidObject: boolean;
begin
  // TODO: Replace the next line with code to return true if object still exists
  // and has not changed.
  Result := True;
end;

function TtestsubNamespaceItem.SetItemName(aName: string): boolean;
begin
  //TODO: Replace the next line with code to set the objects name to aName.
  FFolderName := aName;
  Result := true;
end;

{ TtestsubNamespaceExtension }


function TtestsubNamespaceExtension.CreateFolder(pID : TNamespaceItem) : TNamespaceExtension;
begin
  Result := TtestsubNamespaceExtension.Create;
  Result.Parent := self;
end;

function TtestsubNamespaceExtension.GetAttributes: cardinal;
begin
  // Return the attributes of your root namespace.  Or one or more of the following:
  // SFGAO_CANCOPY - object can be copied.
  // SFGAO_CANMOVE - object can be moved.
  // SFGAO_CANLINK - object can be linked.
  // SFGAO_CANRENAME - object can be renamed.
  // SFGAO_CANDELETE - object can be deleted.
  // SFGAO_HASPROPSHEET - Object has property sheets.
  // SFGAO_DROPTARGET - Object is a drop target.
  // SFGAO_LINK - Object is a shortcut (link).
  // SFGAO_SHARE - Object is shared.
  // SFGAO_READONLY - Object is read only.
  // SFGAO_GHOSTED - Object is ghosted (cut).
  // SFGAO_HIDDEN - hidden object.
  // SFGAO_FILESYSANCESTOR - Object contains file system folder.
  // SFGAO_FOLDER - Object is a folder.
  // SFGAO_FILESYSTEM - Object is a file system thing (file/folder/root).
  // SFGAO_HASSUBFOLDER - Object is expandable in the tree view.
  // SFGAO_REMOVABLE - is this removeable media?
  // SFGAO_COMPRESSED - Object is compressed (use alt color).
  // SFGAO_BROWSABLE - Object is in-place browsable.
  // SFGAO_NONENUMERATED - Object is a non-enumerated object.
  // SFGAO_NEWCONTENT - Object should show bold in explorer tree.
  // TODO: Replace the next line.
  Result := SFGAO_BROWSABLE or SFGAO_FOLDER or SFGAO_HASSUBFOLDER or SFGAO_HASPROPSHEET;
end;

function TtestsubNamespaceExtension.GetColumnTitle(Col: integer): string;
begin
  // TODO: Replace the following with code to return the column heading for
  // Column number Col. Return a null string when no more columns are to be
  // defined.
  if Col = 0 then Result := 'Name' else Result := '';
end;

function TtestsubNamespaceExtension.GetDefaultColumn(var pSort,
  pDisplay: cardinal): boolean;
begin
  // Replace this code when column 0 is not the default column
  pSort := 0;
  pDisplay := 0;
  Result := true;
end;

function TtestsubNamespaceExtension.GetDisplayName: string;
begin
  // Returns the display name for the root of your namespace.
  Result := 'Test sub folders';
end;

function TtestsubNamespaceExtension.GetFirstId(var pData: TNamespaceItem;
  var Cookie: cardinal; FFlags: cardinal): boolean;
begin
  // TODO: Replace the next line with code to create your folder item enumerator
  // and pass back the first item and a cookie that refers to the enumerator.
  Cookie := 0;
  Result := GetNextId(nil, pData, Cookie, FFlags);
end;

function TtestsubNamespaceExtension.GetIconIndex: integer;
begin
  // TODO: Replace the next line with code to return the icon index to use for
  // the namespace root.
  Result := 0;
end;

function TtestsubNamespaceExtension.GetInfoTip: string;
begin
  // TODO: Replace the next line with code to return the info tip to use for the
  // namespace root
  Result := GetDisplayName;
end;

function TtestsubNamespaceExtension.GetJunctionPoint: TJunctionPoint;
begin
  Result := jpMyComputer;
end;

function TtestsubNamespaceExtension.GetNextId(pPrev: TNamespaceItem;
  var pData: TNamespaceItem; var Cookie: cardinal;
  FFlags: cardinal): boolean;
var
  FolderItem : TTestSubNamespaceItem;
begin
  // TODO: Replace the next line with code to return the item after pPrev from
  // the enumerator.  When there are no more items, return false.
  Result := false;
  if (Cookie < 5) and (FFlags and SHCONTF_FOLDERS <> 0) then
  begin
    FolderItem := TTestSubNamespaceItem.Create(nil);
    FolderItem.FolderName := 'Folder' + IntToStr(cookie);
    pData := FolderItem;
    Result := True;
    Cookie := Cookie+1;
  end else if (Cookie < 10) and (FFlags and SHCONTF_NONFOLDERS <> 0) then begin
    FolderItem := TTestSubNamespaceItem.Create(nil);
    FolderItem.FolderName := 'tail' + IntToStr(cookie);
    pData := FolderItem;
    Result := True;
    Cookie := Cookie+1;
  end;
end;

function TtestsubNamespaceExtension.IsValidObject: boolean;
begin
  //TODO: replace the next line to return true if the namespace object has not
  //changed.
  Result := True;
end;

function TtestsubNamespaceExtension.GetMenuItems(mi : TExplorerMenuType;
              var DelphiMenu : TPopupMenu; var FreeOnCompletion : boolean) : boolean;
begin
  // Todo - Replace the following lines with code to build a delphi menu and
  // return it.  This menu could be a static one from a data module or a
  // dynamic one you build yourself.  If you want NSELib to destroy the menu
  // after use,  set the FreeOnCompletion flag to true.
  // Example:
  // Delphimenu := TPopupMenu.Create(nil);
  // item := TMenuItem.Create(nil);
  // case mi of
  //   miBackground : item.Caption := 'Added Background';
  //   miForeground : item.Caption := 'Added Foreground';
  //   miTreeview : item.Caption := 'Added Treeview';
  //   miFilemenu : item.Caption := 'Added Filemenu';
  // end;
  // item.OnClick := MenuClick;
  // DelphiMenu.Items.Add(item);
  // FreeOnCompletion := true;
  // Result := true;
  Result := False;
end;




function TtestsubNameSpaceExtension.GetWebPage: string;
begin
  Result := 'folder.htt';
end;



function TtestsubNamespaceExtension.GetPropertyPageCount: integer;
begin
  Result := 1;
end;

function TtestsubNamespaceExtension.GetPropertyPageTitle(
  index: integer): string;
begin
  Result := 'Test it';
end;

function TtestsubNamespaceExtension.GetPropertySheetClass(
  index: integer): TPropertySheetClass;
begin
  Result := TPropSheetForm1;
end;

initialization
  RegisterClass(TtestsubNamespaceItem);
  TNamespaceExtensionFactory.Create(ComServer, TtestsubNamespaceExtension,
                                    Class_testsubNamespaceExtension,
                                    Class_testsubUIObject, 'testsubNamespaceExtension',
                                    'Test sub folders',
                                    ciMultiInstance, tmApartment);

  TUIClassFactory.Create(ComServer, TShellUIObject, Class_testsubUIObject,
    'testsubUIObject', 'Test sub folders - UI Object', ciMultiInstance, tmApartment);
end.

SubFolderPropSheet.pas

unit SubFolderPropSheet;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, PropSheet;

type
  TPropSheetForm1 = class(TPropSheetForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure InitializeFromData; override;
    procedure SaveChanges; override;
    procedure ApplyChanges; override;
    procedure DiscardChanges; override;
    procedure ShowHelp; override;
    function Valid : boolean; override;
  end;

implementation

{$R *.dfm}

procedure TPropSheetForm1.InitializeFromData;
begin
  if Assigned(Data) then
    MessageDlg('It Works',mtInformation,[mbOK],0);
end;

procedure TPropSheetForm1.SaveChanges;
begin
end;

procedure TPropSheetForm1.ApplyChanges;
begin
end;

procedure TPropSheetForm1.DiscardChanges;
begin
end;

procedure TPropSheetForm1.ShowHelp;
begin
end;

function TPropSheetForm1.Valid : boolean;
begin
  Result := True;
end;


end.