Solved

Shell NameSpace Extension

Posted on 2000-03-29
25
991 Views
Last Modified: 2013-11-19
Is it possible to create a Shell NameSpace Extension project using Delphi-5.

Let me describe in detail what I want.
I want a new drive to be shown in windows explorer. When ever I click this drive, it connects to an ftp server and shows me the contents of the server. It allows me to drag drop, cut/copy/paste files from my computer to ftp server. Basically it will be an ftp client in windows explorer and will be using its interface.
I think it is possible using in-process server. but how to do that???
In other words I want to create a project like xDrive or NetDrive. You can find more details from www.xdrive.com or www.netdrive.com

If it is possible in Delphi-5 then I'll increase points to 100+ to know how to do.
0
Comment
Question by:m_adil
  • 9
  • 7
  • 5
  • +2
25 Comments
 
LVL 17

Expert Comment

by:inthe
Comment Utility
hi ,
the answer is yes and you can find some stuff here:

http://members.tripod.com/~delphipower/winshell.htm

it was for d3 but it shouldnt be far from working in d5.

Regards Barry
0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
0
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Actually, I wrote a name space extension myself (a virtual folder to access Interbase databases, D4+). So if you have questions, just ask (after you increased the points :-)).

Ciao, Mike
0
 
LVL 1

Author Comment

by:m_adil
Comment Utility
Adjusted points from 10 to 120
0
 
LVL 1

Author Comment

by:m_adil
Comment Utility
ok Mike. I've incresed points to 120.
Now can u give me a sample code that connects me to an ftp server when I click on the folder, and allows me to upload/download files from/to the server.

Thanks

Adil.
0
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Adil, it seems you have a totally wrong impression what is involved in a name space extension. I can give you code and help to write and install the core of the extension. The rest is totally up to you.

What you need first is to write a shell folder interface. To do this create a new application (File|New|ActiveX|ActiveX Library). You will get a dpr file which looks like:

library Test;

uses
  ComServ,
  ShellFolder in 'ShellFolder.pas';

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.RES}

begin
end.

The Unit ShellFolder is of course not already there. You need to create that unit and add it to the project (File|New|ActiveX|COM object). The new COM object implements IShellFolder and IPersistFolder and is derived from TComObject. The result looks something like:

unit ShellFolder;

interface

uses
  Windows, ActiveX, Classes, ComObj, ShlObj;

type
  TShellFolder = class(TComObject, IShellFolder, IPersistFolder)
  protected
    // We do the following declaration to alias the Initialize function.
    // Initialize is also declared in TComObject and conflicts with the one from IPersistFolder
    function IPersistFolder.Initialize = IPersistFolder_Initialize;
  public
    // IPersist declarations
    function GetClassID(out classID: TCLSID): HResult; stdcall;

    // IPersistFolder declarations
    function IPersistFolder_Initialize(pidl: PItemIDList): HResult; stdcall;

    // IShellFolder declarations
    function ParseDisplayName(hwndOwner: HWND; pbcReserved: Pointer; lpszDisplayName: POLESTR; out pchEaten: ULONG;
             out ppidl: PItemIDList; var dwAttributes: ULONG): HResult; stdcall;
    function EnumObjects(hwndOwner: HWND; grfFlags: DWORD; out EnumIDList: IEnumIDList): HResult; stdcall;
    function BindToObject(pidl: PItemIDList; pbcReserved: Pointer; const riid: TIID; out ppvOut): HResult; stdcall;
    function BindToStorage(pidl: PItemIDList; pbcReserved: Pointer; const riid: TIID; out ppvObj): HResult; stdcall;
    function CompareIDs(lParam: LPARAM; pidl1, pidl2: PItemIDList): HResult; stdcall;
    function CreateViewObject(hwndOwner: HWND; const riid: TIID; out ppvOut): HResult; stdcall;
    function GetAttributesOf(cidl: UINT; var apidl: PItemIDList; var rgfInOut: UINT): HResult; stdcall;
    function GetUIObjectOf(hwndOwner: HWND; cidl: UINT; var apidl: PItemIDList; const riid: TIID; prgfInOut: Pointer;
             out ppvOut): HResult; stdcall;
    function GetDisplayNameOf(pidl: PItemIDList; uFlags: DWORD; var lpName: TStrRet): HResult; stdcall;
    function SetNameOf(hwndOwner: HWND; pidl: PItemIDList; lpszName: POLEStr; uFlags: DWORD; var ppidlOut: PItemIDList): HResult; stdcall;

    // ShellFolder declarations
    destructor Destroy; override;
  end;

const
  Class_ShellFolder: TGUID = '{449AB457-A7F8-11D3-8FC2-0080C894409B}';

implementation

uses ComServ;

{ TShellFolder }

function TShellFolder.BindToObject(pidl: PItemIDList;
  pbcReserved: Pointer; const riid: TIID; out ppvOut): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.BindToStorage(pidl: PItemIDList;
  pbcReserved: Pointer; const riid: TIID; out ppvObj): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.CompareIDs(lParam: LPARAM; pidl1,
  pidl2: PItemIDList): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.CreateViewObject(hwndOwner: HWND; const riid: TIID;
  out ppvOut): HResult;
begin
  Result := E_NOTIMPL;
end;

destructor TShellFolder.Destroy;
begin
  inherited;
end;

function TShellFolder.EnumObjects(hwndOwner: HWND; grfFlags: DWORD;
  out EnumIDList: IEnumIDList): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.GetAttributesOf(cidl: UINT; var apidl: PItemIDList;
  var rgfInOut: UINT): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.GetClassID(out classID: TCLSID): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.GetDisplayNameOf(pidl: PItemIDList; uFlags: DWORD;
  var lpName: TStrRet): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.GetUIObjectOf(hwndOwner: HWND; cidl: UINT;
  var apidl: PItemIDList; const riid: TIID; prgfInOut: Pointer;
  out ppvOut): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.IPersistFolder_Initialize(
  pidl: PItemIDList): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.ParseDisplayName(hwndOwner: HWND;
  pbcReserved: Pointer; lpszDisplayName: POLESTR; out pchEaten: ULONG;
  out ppidl: PItemIDList; var dwAttributes: ULONG): HResult;
begin
  Result := E_NOTIMPL;
end;

function TShellFolder.SetNameOf(hwndOwner: HWND; pidl: PItemIDList;
  lpszName: POLEStr; uFlags: DWORD; var ppidlOut: PItemIDList): HResult;
begin
  Result := E_NOTIMPL;
end;

initialization
  TComObjectFactory.Create(ComServer, TShellFolder, Class_ShellFolder,
    'ShellFolder', '', ciMultiInstance, tmApartment);
end.


Here I have already filled the class body with default results. This way you can compile it at least and see if it installs (Run|Register ActiveX server).

Ciao, Mike
0
 
LVL 4

Expert Comment

by:jeurk
Comment Utility
Snooping around...
0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
ps.
if you downloaded winshell3.zip you already have these files..
0
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Adil, Barry usually makes very good comments so I'd first download and see what's in winshell3 before we continue here...

Ciao, Mike
0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
mike ,
my advice,
download winshell example.
read tutorial etc to get understanding.
compile in d5 and get 1-2 errors ,come back and ask mike why the errors ;-)
i doubt i can fix these errors ,they dont look too bad but not stuff ive time to learn at moment ,but the example code may save you a lot of extra typing.

0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
sorry that should be to madil not mike (i think mike already understand this stuff :o)
0
 
LVL 4

Expert Comment

by:jeurk
Comment Utility
I tryed winshell.
It compiles and does install fine.
but when I browse in my windows explorer
to it, I get an Error:TShellFolderImpl.GetClassID
after clicking ok, I get an application
error:write where I cannot (I'm using NT)
And last explorer tells me they was an internal error and closes the window.
Even if I saw the contain of the two files
it tries to open...

I know, this is not my question ;)...
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 10

Expert Comment

by:Lischke
Comment Utility
I just tried it out myself and it works fine for me (D5, WinNT4, SP6). But I had to correct some errors in the sources which were made in pre D5 versions and have been corrected later. These errors, though, seem not to have serious impact on the way the extension works, because they dealt mainly with var parameters for a property sheet page or removed pointer paramter types.

So there must something other be wrong.

Ciao, Mike
0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
mike if you dont mind would you send me the "corrected for d5" code with a comment as to what was wrong, there will be some points waiting for you :o)
0
 
LVL 1

Author Comment

by:m_adil
Comment Utility
thanks for the code.
plz give me some time to check it out.

>>Adil, it seems you have a totally wrong impression what is involved in a name space extension.

Mike can u plz correct me if i'm wrong.
What I know about name space extension is that these are the folders displayed in the name space ext viewer (such as windows explorer) with the root folder starting from desktop. These name space ext are also visible in file open/save dislog boxes.
isn't it. plz correct me if i am wrong.
0
 
LVL 1

Expert Comment

by:xsoft
Comment Utility
I was playing around whith winshell too.
To update the code just look in the Delphi sourcode files or the helpfiles.
Will take 5 minutes to correct the parameters and get it compiled.
But to correctly implement all the interfaces you will have to read the MS-documentation on those interfaces which could take quite a while...
0
 
LVL 4

Expert Comment

by:jeurk
Comment Utility
In fact I have the same config then you Mike, but I compiled it with D3 because of the errors. Mays I get my hands on the D5 project too please ? Thank you.

And what about making it appear in open/save dialogs ? Is there a type we can give to our extension to make it appear ?

0
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Barry, xsoft is right, there are only very few changes to make. Just try to compile Winshell in D5 and it will show you the places where the declaration differs. Use then Ctrl+Left click on the particular interface to view the original declaration and change Winshell accordingly. No need to waste points for that, but thanks for your offer :-)

Adil,

you are right. Your description is roughly about what a name space extension is. But the actual implementation is much harder and actually one of the toughest areas in Windows programming I ever worked at.

Ciao, Mike
0
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Well, Barry, jeurk, mail me at public@lischke-online.de and I will send you the project.

Because also open and save dialogs are using the shell name space your own extension should appear there. But the must be of the correct type, I think. I have not yet tried it but I suppose the SFGAO_FILESYSTEM flag must be specified too for the extension to show up in those dialogs.

Ciao, Mike
0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
hehe cool i got it working at last ,for anyone interested  ,there only about 8 changes to make for d5 ,some in shellview.pas and shellfolder.pas ,you can find the proper declarations in ishellview declaration in shlobj.pas..

mike my ctrl-left click stopped working last week ,that was the biggest problem but something has now fixed it?strange stuff.
0
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Super Barry. Once you have got it working it is not half the stress to go further than before :-)

Ciao, Mike
0
 
LVL 1

Author Comment

by:m_adil
Comment Utility
I've gone through the code. Its almost the same as winshell3.zip. It is doing the basic functionality, but I want to do much more than this. for eg.

1. I want to use Explorers cut/copy/paste, change view buttons to work with my name-space

2. I want to add child items to my name-space icon on the left side TreeView.

How can I do this. Basically I need the basic features of the explorer to work with my name-space.
0
 
LVL 10

Accepted Solution

by:
Lischke earned 120 total points
Comment Utility
Mmh, all I can do now for you is to give you my registration procedure and a few hints. Name space extension are really hard stuff (Do you know what "really hard" means if "hard" is 200 points?).

To get your shell folder initially working you need to register it properly by creating your own COM factory. This is only to override the UpdateRegistry method, which should do similar things like this code:

type
  TIBFolderFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(DoRegister: Boolean); override;
  end;

//----------------------------------------------------------------------------------------------------------------------

procedure TIBFolderFactory.UpdateRegistry(DoRegister: Boolean);

// write all necessary registry keys to make our DLL available to the system if DoRegister is true
// else remove all created keys

var
  IBDatabaseName,
  ClassID,
  MenuID: String;
  Attributes: Cardinal;
  ModuleName: array[0..MAX_PATH] of Char;

begin
  with TRegistry.Create do
  try
    ClassID := GUIDToString(Class_IBFolder);
    MenuID := GUIDToString(Class_IBContextMenu);
    if DoRegister then
    begin
      inherited UpdateRegistry(DoRegister);

      // get this DLL's path and file name
      GetModuleFileName(HInstance, ModuleName, MAX_PATH);

      RootKey := HKEY_CLASSES_ROOT;

      // register default icon for the browser
      OpenKey('\CLSID\' + ClassID + '\DefaultIcon', True);
      WriteString('', ModuleName + ', 0');

      // register browsing attributes (HKEY_CLASSES_ROOT)
      OpenKey('\CLSID\' + ClassID + '\ShellFolder', True);
      Attributes := SFGAO_HASSUBFOLDER or SFGAO_FOLDER or SFGAO_NEWCONTENT or SFGAO_BROWSABLE;
      WriteBinaryData('Attributes', Attributes, Sizeof(Attributes));

      // context menu handler:
      // for gdb files
      OpenKey('\.gdb', True); // read the gdb file name to be used for registering the handler
      IBDatabaseName := ReadString('');
      // make sure we have a description
      if IBDataBaseName = '' then
      begin
        IBDatabaseName := 'InterbaseDatabase';
        WriteString('', IBDatabaseName);
      end;
      OpenKey('\' + IBDatabaseName + '\shellex\ContextMenuHandlers\IBExplorerMenu', True);
      WriteString('', MenuID);
      // our shell extension
      OpenKey('\CLSID\' + ClassID + '\shellex\ContextMenuHandlers\IBExplorerMenu', True);
      WriteString('', MenuID);

      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey('\Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace\' + ClassID, True);
      WriteString('', 'Database Explorer');
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      begin
        OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
        OpenKey('Approved', True);
        WriteString(ClassID, 'Digital Publishing IB Browser');
      end;
    end
    else
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      DeleteKey('\Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\NameSpace\' + ClassID);

      RootKey := HKEY_CLASSES_ROOT;
      DeleteKey('\CLSID\' + ClassID + '\DefaultIcon');
      DeleteKey('\CLSID\' + ClassID + '\ShellFolder');
      // unregister context menu for gdb files
      OpenKey('\.gdb', True); // read the gdb file name to be used for registering the handler
      IBDatabaseName := ReadString('');
      // do we have a description?
      if Length(IBDataBaseName) > 0 then DeleteKey('\' + IBDatabaseName + '\shellex');
      DeleteKey('\CLSID\' + ClassID + '\shellex');
      inherited UpdateRegistry(DoRegister);
    end;
  finally
    Free;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

In particular the browsing attributes are very important. Once set your shell folder's BindToObject will be called when the user selects/opens it. There you can create a new shell folder instance for your subitems. A typical BindToObject method looks like:

function TIBFolder.BindToObject(pidl: PItemIDList; pbcReserved: Pointer; const riid: TIID; out ppvOut): HResult; stdcall;

// create an item interface

var
  Factory: TComObjectFactory;
  AObject: TComObject;
  TempPIDL: PIBItem;

begin
  SetStatusText('');
  Result := E_NOINTERFACE;
  try
    // determine class factory for the required type
    if IsEqualGUID(riid, IShellFolder) then Factory := ComClassManager.GetFactoryFromClassID(Class_IBFolder)
                                       else Factory := nil;
    // Is there a factory for this kind of class?
    if assigned(Factory) then
    begin
      // yes, it is, so create a new instance of the class
      AObject := Factory.CreateComObject(nil);
      // successful?
      if assigned(AObject) then
      begin
        // set result and set reference count to 1
        Result := AObject.ObjQueryInterface(riid, ppvOut);
        TempPIDL := IDListManager.Concatenate(FLocation, Pointer(pidl));
        // initialize the object (this increments our reference counter again, but this increment is taken back
        // as soon as we out get of its scope (the end of this method))
        (AObject as IPersistFolder).Initialize(Pointer(TempPIDL));
        // our object has made a copy of the pidl, so free it now
        IDListManager.FreeItem(TempPIDL);
      end;
    end;
  except
    // catch all exceptions, nothing must disturb explorer's work or it'll crash
    on E: EOleSysError do Result := E.ErrorCode;
    else Result := E_UNEXPECTED;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

In order to allow Explorer to bind to a subitem it needs to know which are there. This information is retrieved by calling EnumObjects. You must return an IEnumIDList interface which will be used to build the subtree under the currently opening tree item. Here's the code to create the enumeration list and a viewer object:

function TIBFolder.CreateViewObject(hwndOwner: HWND; const riid: TIID; out ppvOut): HResult; stdcall;

// Create a new instance of the required view-object.

var
  Factory: TComObjectFactory;
  AObject: TComObject;

begin
  try
    Result := E_NOINTERFACE;
    // determine class factory for the required type
    if IsEqualGUID(riid, IShellView) then Factory := ComClassManager.GetFactoryFromClassID(Class_IBView)
                                    else Factory := nil;
    // Is there a factory for this kind of class?
    if assigned(Factory) then
    begin
      // yes, it is, so create a new instance of the class
      AObject := Factory.CreateComObject(nil);
      // successful?
      if assigned(AObject) then
      begin
        // set result and set reference count to 1
        Result := AObject.ObjQueryInterface(riid, ppvOut);
        (AObject as TIBView).CurrentFolder := Self;
      end;
    end;
  except
    // catch all exceptions, nothing must disturb explorer's work or it'll crash
    on E: EOleSysError do Result := E.ErrorCode;
    else Result := E_UNEXPECTED;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

function TIBFolder.EnumObjects(hwndOwner: HWND; grfFlags: DWORD; out EnumIDList: IEnumIDList): HResult; stdcall;

var
  Factory: TComObjectFactory;
  AObject: TComObject;

begin
  if hwndOwner <> 0 then
  begin
    // Undocumented feature to retrieve the currently active shell browser interface.
    // This is needed to access various properties of the explorer, even if no shell view has yet been created.
    // In CreateViewObject, though, this cheat is not needed, since each view object gets a valid shellbrowser
    // interface passed.
    if assigned(CurrentShellBrowser) then CurrentShellBrowser._Release;
    // this assignement doesn't actually increase the reference count of the interface, so we do it explicitely
    Pointer(CurrentShellBrowser) := Pointer(SendMessage(hwndOwner, WM_USER + 7, 0, 0));
    if assigned(CurrentShellBrowser) then CurrentShellBrowser._AddRef;
  end;

  try
    Result := E_NOINTERFACE;
    // determine class factory for the required type
    Factory := ComClassManager.GetFactoryFromClassID(Class_IBEnumList);
    // Is there a factory for this kind of class?
    if assigned(Factory) then
    begin
      // yes, it is, so create a new instance of the class
      AObject := Factory.CreateComObject(nil);
      // successful?
      if assigned(AObject) then
      begin
        // assign our object (this sets its reference count to 1)
        EnumIDList := AObject as IEnumIDList;
        // help the enumeration list to find the values to be enumerated
        (AObject as TIBEnumList).Anchor := IDListManager.Copy(FLocation);
        Result := S_OK;
      end;
    end;
  except
    // catch all exceptions, nothing must disturb explorer's work or it'll crash
    on E: EOleSysError do Result := E.ErrorCode;
    else Result := E_UNEXPECTED;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

The viewer object will be created when Explorer needs to display something in its right pane. This is typically the case after it has bound to a new object in the left pane.

Well, that's all I can do for you. I have by far not mentioned at least all core stuff, not to mention additional features like context menus and menu/toolbutton interaction with the Explorer. Be prepared for a real challenge!

Ciao, Mike
0
 
LVL 1

Author Comment

by:m_adil
Comment Utility
Thank u very much...
by the way are there any sites that can help name-space programming with Delphi.
0
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Well, I wasn't looking very hard for other informatin and the only address I have is http://members.tripod.com/~delphipower/shellext.htm, but unfortunately this site already disappeard. I strongly recommend that you do a search on www.deja.com.

Ciao, Mike
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
delphi exception 7 58
MVC and Angular 2 70
URL for downloading Google Chrome for Win XP 2 73
Delphi inherited method 6 35
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Styling your websites can become very complex. Here I'll show how SASS can help you better organize, maintain and reuse your CSS code.
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
The viewer will learn how to create and use a small PHP class to apply a watermark to an image. This video shows the viewer the setup for the PHP watermark as well as important coding language. Continue to Part 2 to learn the core code used in creat…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now