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

Auto sample

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

It is also available for MFC.

This sample demonstrates the usage of stock objects that come with NSELib: Automatic namespace extensions (TAutoNameSpaceExtension), shortcut items (TShortcutNameSpaceItem) and action items (TActionNameSpaceItem).

Auto.pas

This class is derived from TAutoNameSpaceExtension, not from TNameSpaceExtension. It doesn't have the functions GetFirstRegularItem etc. Instead it has the function Populate.

In the function Populate, you see how a shortcut item and an action item can be added.

When the action item is invoked, the function OnCommand is called and a new item is added. 

unit auto;

interface

uses Windows, ActiveX, NSETypes, ShellUIObject, DelphiNamespaceItem, NamespaceItem,
     AutoNamespaceExtension,NamespaceExtension, DelphiUIObject, ActionNamespaceItem;

const
  AUTO_COLUMN_NAME	= 0;
  AUTO_COLUMN_SIZE	= 1;
  AUTO_COLUMN_TYPE	=	2;
  AUTO_COLUMN_MODIFIED = 3;
  SIG_AUTO = 'AUTO';
  COMMAND_AUTO_ADDITEM = 1;
  CFSTR_AUTOITEMS = 'ClipFormat_Auto_Items';
  AUTO_COMMAND_EDIT = 1;
  nAutoCommands = 1;

type
  TAutoItem = class (TDelphiNamespaceItem)
  private
    FName : string;
  public
	  constructor Create(Folder : TNameSpaceExtension; aName : string); overload;

    function GetDisplayName(uFlags : cardinal) : string; override;
    function GetInfoTip: string; override;
    function GetAttributes : cardinal; override;
    function GetItemDetail(Col : integer) : string; override;
    function GetStorageType : string; override;
    function CompareTo(iCol : cardinal; nsi : TNamespaceItem) : smallint; override;
  published
    property Name : string read FName write FName;
  end;

  TAutoExtension = class(TAutoNameSpaceExtension)
  public
  	function CreateFolder(Item : TNameSpaceItem) : TNamespaceExtension; override;
	  function CreateUIObject(cidl : integer; items : TNameSpaceItemArray; WndOwner : HWnd) : TShellUIObject; override;
    function GetWebPage : string; override;
    function GetDisplayName(flags : cardinal) : string; override;
    function GetAttributes : cardinal; override;
    function GetJunctionPoint : TJunctionPoint; override;
    procedure Populate; override;
	  function OnCommand(WndView : HWnd; Cmd : cardinal) : boolean; override;
  end;

  TAutoUIObject = class(TDelphiUIObject)
  public
    function GetFormatEtc(iIndex : ulong; var fetc : TFormatEtc) : boolean; override;
    function IsClipFormatSupported(cf : TClipFormat) : boolean; override;
    function GetData(cf : TClipFormat; Global : HGLOBAL) : boolean; override;
    function GetDataSize(cf : TClipFormat) : dword; override;
  end;

const
  Class_AutoExtension : TGUID = '{BCE7353E-22D1-4CC4-973E-CBF98DE7CAAB}';
  Class_AutoUIObject : TGUID = '{F88CC0F0-F4D5-4A93-A715-DE3537551027}';

implementation

uses Classes, ComObj, ComServ, NamespaceApp, SysUtils, ShlObj, ShlObj2,
     NamespaceFactory, ShortcutNamespaceItem;

const
  FileTimeBase      = -109205.0;
  FileTimeStep: Extended = 24.0 * 60.0 * 60.0 * 1000.0 * 1000.0 * 10.0; // 100 nSek per Day

function FileTimeToDateTime(const FileTime: TFileTime): TDateTime;
begin
  Result := Int64(FileTime) / FileTimeStep;
  Result := Result + FileTimeBase;
end;

{ TAutoItem }

function TAutoItem.CompareTo(iCol: cardinal;
  nsi: TNamespaceItem): smallint;
var
  data : TWin32FindDataW;
  Size1, Size2 : cardinal;
  dt1,dt2 : TDateTime;
  str1,str2 : string;
begin
	case iCol of
		AUTO_COLUMN_NAME:
			Result := AnsiCompareStr(Name,nsi.GetDisplayName(SHGDN_NORMAL));

		AUTO_COLUMN_SIZE: begin
			FillChar(data, sizeof(TWin32FindDataW),#0);
			GetFindData(data);
			Size1 := data.nFileSizeLow;
			FillChar(data, sizeof(TWin32FindDataW),#0);
			nsi.GetFindData(data);
			Size2 := data.nFileSizeLow;

			if (Size1 = Size2) then
				Result := 0
			else if (Size1 > Size2) then
				Result := 1
			else
				Result := -1;
		end;

		AUTO_COLUMN_MODIFIED: begin
			FillChar(data, sizeof(TWin32FindDataW),#0);
			GetFindData(data);
			dt1 := FileTimeToDateTime(data.ftLastWriteTime);

			FillChar(data, sizeof(TWin32FindDataW),#0);
			nsi.GetFindData(data);
			dt2 := FileTimeToDateTime(data.ftLastWriteTime);

			if dt1 = dt2 then
				Result := 0
			else if (dt1 > dt2) then
				Result := 1
			else
				Result := -1;
		end
  else
		str1 := GetItemDetail(iCol);
    str2 := GetItemDetail(iCol);
  	Result := AnsiCompareStr(str1,str2);
  end;
end;

constructor TAutoItem.Create(Folder: TNameSpaceExtension; aName: string);
begin
  inherited Create(nil,Folder);
	FName := aName;
end;

function TAutoItem.GetAttributes: cardinal;
begin
	Result := SFGAO_CANDELETE or SFGAO_CANLINK or
            SFGAO_CANRENAME or SFGAO_DROPTARGET or
            SFGAO_BROWSABLE or SFGAO_CANCOPY or SFGAO_CANMOVE ;
end;

function TAutoItem.GetDisplayName(uFlags: cardinal): string;
begin
	Result := FName;
end;

function TAutoItem.GetInfoTip: string;
begin
	Result := GetDisplayName(0);
end;

function TAutoItem.GetItemDetail(Col: integer): string;
begin
	if Col = 0 then
		Result := GetDisplayName(0)
	else
	  Result := '';
end;

function TAutoItem.GetStorageType: string;
begin
	Result := 'StorageType';
end;

{ TAutoExtension }

function TAutoExtension.CreateFolder(
  Item: TNameSpaceItem): TNamespaceExtension;
begin
	Result := TAutoExtension.Create(self);
end;

function TAutoExtension.CreateUIObject(cidl: integer;
  items: TNameSpaceItemArray; WndOwner: HWnd): TShellUIObject;
begin
	Result := TAutoUIObject.Create(self, cidl, TComponentArray(Items), GetPidl, WndOwner);
end;

function TAutoExtension.GetAttributes: cardinal;
begin
	if not Assigned(FParent) then
		Result := SFGAO_CANLINK or SFGAO_CANRENAME or
              SFGAO_DROPTARGET or SFGAO_HASSUBFOLDER or
				      SFGAO_BROWSABLE or SFGAO_FILESYSTEM or
              SFGAO_FILESYSANCESTOR or SFGAO_FOLDER
	else
	  Result := inherited GetAttributes;
end;

function TAutoExtension.GetDisplayName(flags: cardinal): string;
begin
	if not Assigned(FParent) then
		Result := 'Auto NSE'
	else
	  Result := inherited GetDisplayName(Flags);
end;

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

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

function TAutoExtension.OnCommand(WndView: HWnd; Cmd: cardinal): boolean;
var
  Item : TAutoItem;
begin
	if Cmd = COMMAND_AUTO_ADDITEM then begin
		Item := TAutoItem.Create(self, 'Item');
    try
  		AddItem(Item);
		  UpdateAddedItem(Item);
    finally
     Item.Free;
	  end;
  end;
	Result := TRUE;
end;

procedure TAutoExtension.Populate;
var
  NewItem : TNamespaceItem;
	pidlControlPanel : PItemIdList;
begin
	NewItem := TActionNameSpaceItem.Create(self, 'Add Item', 'Run Wizard', 'Execute to add a new item to this folder.', 0, COMMAND_AUTO_ADDITEM);
  try
  	AddItem(NewItem);
  finally
	  NewItem.Free;
  end;
	SHGetSpecialFolderLocation(0, CSIDL_CONTROLS, pidlControlPanel);
  try
  	NewItem := TShortcutNameSpaceItem.Create(self, 'Shortcut to control panel', pidlControlPanel);
    try
    	AddItem(NewItem);
    finally
    	NewItem.Free;
    end;
  finally
  	ILFree(pidlControlPanel);
  end;
end;

{ TAutoUIObject }

function TAutoUIObject.GetData(cf: TClipFormat; Global: HGLOBAL): boolean;
var
  data : PByteArray;
  i, iSize : integer;
begin
	if cf = NSEGetApp.GetClipboardFormat(CFSTR_AUTOITEMS) then begin
		Data := GlobalLock(Global);
		PCardinal(Data)^ := fcidl;
		Integer(Data) := Integer(Data) + SizeOf(integer);
		iSize := ILGetSize(FBasePidl);
		Move(FBasePidl^,Data^, iSize);
		Integer(Data) := Integer(Data) + iSize;
		PInteger(Data)^ := 0;
		Integer(Data) := Integer(Data) + 4;
		for i := 0 to fcidl - 1 do begin
			iSize := ILGetSize(Fpidls[i]);
  		Move(FPidls[i]^, Data^, iSize);
  		Integer(Data) := Integer(Data) + iSize;
  		PInteger(Data)^ := 0;
  		Integer(Data) := Integer(Data) + 4;
		end;
		Result := TRUE;
	end else
	  Result := inherited GetData(cf, Global);
end;

function TAutoUIObject.GetDataSize(cf: TClipFormat): dword;
var
  i : integer;
begin
	Result := sizeof(integer);
	Result := Result + ILGetSize(FBasePidl) + 4;
	for i := 0 to fcidl - 1 do
		Result := Result + ILGetSize(fpidls[i]) + 4;
end;

function TAutoUIObject.GetFormatEtc(iIndex: ulong;
  var fetc: TFormatEtc): boolean;
begin
	if iIndex = 0 then begin
		fetc.cfFormat := NSEGetApp.GetClipboardFormat(CFSTR_AUTOITEMS);
		fetc.dwAspect := DVASPECT_CONTENT;
		fetc.lindex := -1;
		fetc.ptd := nil;
		fetc.tymed := TYMED_HGLOBAL;
		Result := true;
	end else
		Result := inherited GetFormatEtc(iIndex-1, fetc);
end;

function TAutoUIObject.IsClipFormatSupported(cf: TClipFormat): boolean;
begin
	if (cf = NSEGetApp.GetClipboardFormat(CFSTR_AUTOITEMS)) then
		Result := TRUE
	else
	  Result := inherited IsClipFormatSupported(cf);
end;

initialization
  RegisterClass(TAutoItem);
  TNamespaceExtensionFactory.Create(ComServer, TAutoExtension,
                                    Class_AutoExtension,
                                    Class_AutoUIObject, 'AutoExtension',
                                    'Auto NSE',
                                    ciMultiInstance, tmApartment);

  TUIClassFactory.Create(ComServer, TAutoUIObject, Class_AutoUIObject,
    'AutoUIObject', 'Auto NSE - UI Object', ciMultiInstance, tmApartment);

  NSEGetApp.AddClipboardFormat(CFSTR_AUTOITEMS);
end.