Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 626
  • Last Modified:

Writing a shell extension

I thought about practicing my way into writing shell extensions, so I started by trying to make a custom icon extractor.
The idea was to make the .FOO type have a random icon.
For some reason or another, however, it doesn't seem to work. I'll post my code below, but I don't think that's where the problem lies.
Could anyone help me on this and tell me how I should have done it? (Starting with what projects/components I should create and how to enter the fields. For this thing I used File|New|ActiveX library and File|New|COM Object)

Here's my code. I have 4 different icons in the same DLL, and I want the .FOO files to get a random icon at run-time.


uses
  Windows, ActiveX, ComObj, ShlObj;

type
  TExtractor = class(TComObject, IExtractIcon)
  protected
    {Declare IExtractIcon methods here}
    function GetIconLocation(uFlags: UINT; szIconFile: PAnsiChar; cchMax: UINT;
      out piIndex: Integer; out pwFlags: UINT): HResult; stdcall;
    function Extract(pszFile: PAnsiChar; nIconIndex: UINT;
      out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult; stdcall;
  end;

const
  Class_Extractor: TGUID = '{9C13C622-1B8C-11D4-B2B4-008048E192B0}';

implementation

uses ComServ;

{ TExtractor }

function TExtractor.Extract(pszFile: PAnsiChar; nIconIndex: UINT;
  out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult;
begin
  Result:=S_FALSE;
end;

function TExtractor.GetIconLocation(uFlags: UINT; szIconFile: PAnsiChar;
  cchMax: UINT; out piIndex: Integer; out pwFlags: UINT): HResult;
Var
  ModuleName:Array[0..MAX_PATH] Of Char;
begin
  GetModuleFileName(HInstance, ModuleName, MAX_PATH);
  lstrcpy(szIconFile,ModuleName);
  piIndex:=Random(4);
  pwFlags:=GIL_DONTCACHE;
  Result:=S_OK;
end;
0
nrico
Asked:
nrico
  • 11
  • 10
  • 2
  • +1
1 Solution
 
bryan7Commented:
listenning
0
 
LischkeCommented:
I have so an idea but need to look up some code first (tomorrow). For now I'm just wondering how your shell extension should work when it isn't registered at all? Where is your COM factory?

Ciao, Mike
0
 
nricoAuthor Commented:
Isn't Delphi supposed to do that automatically?
I have done my special registry changes (the ShellEx entry under the foofile-type in HKEY_CLASSES_ROOT) manually.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LischkeCommented:
:-) Well, a little code is always needed and the registration is done in the COM factory. When you create your new COM object within the IDE (using the COM wizard from File|New) you get code very much like:

unit Unit1;

interface

uses
  Windows, ActiveX, Classes, ComObj;

type
  TTest = class(TComObject)
  protected
  end;

const
  Class_Test: TGUID = '{AC77742E-270C-11D4-9042-0080C894409B}';

implementation

uses ComServ;

initialization
  TComObjectFactory.Create(ComServer, TTest, Class_Test,
    'Test', '', ciMultiInstance, tmApartment);
end.

The factory registers itself with the COM Manager and is called when a DLL's DLLRegisterServer function is called. This is absolutely necessary to include important keys into the registry. The ShellEx entry is not enough! You need at least an entry which describes your interface (HKCR/CLSID).

About the idea I had. I though you must always implement the Extract method, but this seems only to be true when returning GIL_NOTFILENAME in GetIconLocation.

Here's the code of my own implementation. It will not be compilable on your machine but shows what I implemented (and this works):

unit IBExtractIcon;

interface

uses Windows, ActiveX, ComObj, ShlObj, PIDLManager;

type
  TIBExtractIcon = class(TComObject, IExtractIcon)
  private
    FPIDL: PIBItem;
  protected
    // IExtractIcon methods
    function GetIconLocation(uFlags: UINT; szIconFile: PAnsiChar; cchMax: UINT; out piIndex: Integer; out pwFlags: UINT): HResult; stdcall;
    function Extract(pszFile: PAnsiChar; nIconIndex: UINT; out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult; stdcall;
  public
    destructor Destroy; override;

    property PIDL: PIBItem read FPIDL write FPIDL;
  end;

const Class_IBExtractIcon: TGUID = '{170177EB-7E38-11D2-AA74-0080C845E84C}';

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

implementation

uses CommCtrl, ComServ, Graphics, Tools;

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

function TIBExtractIcon.GetIconLocation(uFlags: UINT; szIconFile: PAnsiChar; cchMax: UINT; out piIndex: Integer; out pwFlags: UINT): HResult; stdcall;

begin
  with IDListManager.GetLastItem(Pointer(FPIDL))^ do
  begin
    Result:=NOERROR;
    pwFlags:=GIL_NOTFILENAME;
    piIndex:=IconFromType[ItemType];
  end;
end;

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

function TIBExtractIcon.Extract(pszFile: PAnsiChar; nIconIndex: UINT; out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult; stdcall;

begin
  phIconLarge:=ImageList_GetIcon(LargeImages.Handle,nIconIndex,ILD_TRANSPARENT);
  phIconSmall:=ImageList_GetIcon(SmallImages.Handle,nIconIndex,ILD_TRANSPARENT);
  Result:=NOERROR;
end;

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

destructor TIBExtractIcon.Destroy;

begin
  IDListManager.FreeItem(FPIDL);
  inherited;
end;

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

initialization
  TComObjectFactory.Create(ComServer, TIBExtractIcon, Class_IBExtractIcon,'IBExtractIcon', '', ciMultiInstance, tmApartment);
end.

Ciao, Mike
0
 
nricoAuthor Commented:
Yes, I can understand your code. But can you point out where MY code is flawed, or can it be expected to work correctly?
If so, then the problem must indeed be with my registration.

The entries in the HKCR/CLSID are made by Delphi, right?
The only thing I've done is
 
  HKCR
    .foo = "foofile"
    (...)
    foofile = "FOO test file"
      (...)
      ShellEx
        IconHandler = "{9C13C622-1B8C-11D4-B2B4-008048E192B0}"

As far as I'm aware of, this should be the way to get it to work, yet still it doesn't, and I'm getting pretty desperate by now.
0
 
LischkeCommented:
The entry in HKCR/CLSID is only made when there is a COM object factory for this class! That's the problem I think.

Ciao, Mike
0
 
sistudio041900Commented:
I have done shellextension myself, just take the example demo code there is a full working a demo. It aint a problem. The problem I still have so far is writing custom property sheet handlers for my shell extensions.
0
 
nricoAuthor Commented:
Lischke --
  No, I have checked it, the entry is made.

Sistudio --
  There is? In the Demos directory?
0
 
sistudio041900Commented:
delphi5\demos\activex\shellext\
I would have been lost without that example, it does include all, but its a good starting point
0
 
LischkeCommented:
I have no clue why the entry is there but without COM factory no entry is made. I can tell you the line number of the base COM factory where the entry is made.

What about simply trying to create a COM factory and see whether it works then?

Ciao, Mike
0
 
nricoAuthor Commented:
Ummm... how do I create that COM factory?
0
 
LischkeCommented:
Copy this line to your unit initialization

initialization
  TComObjectFactory.Create(ComServer, TIBExtractIcon, Class_IBExtractIcon,'IBExtractIcon', '', ciMultiInstance, tmApartment);
end.

and change the GUID name, description and interface class to those you have. Should be done with a minute.

Ciao, Mike
0
 
nricoAuthor Commented:
Yeah, but that's something that Delphi has put there already. ???

P.S: I've copied the COM factory from the Delphi demos (changed the UpdateRegistry of course), and it still doesn't work!

If I put a MessageBox() call in my GetIconLocation I don't see the 'box, or isn't it supposed to show up?
0
 
LischkeCommented:
nrico, you  are right, this line should automatically be added when creating a new COM object. For the message box I recommend to use a Beep; instead and listen carefully :-). Could well be that it is problematic to use MessageBox. But somehow I have the feeling this will not change the result. There must be something wrong with the registration. Ok, let's make a check list:

1) you have an entry HKCR/.foo contain a description value like "foofile"

2) you have an enty HKCR/foofile

3) the foofile entry contains an entry DefaultIcon with value %1

4) the foofile entry contains a shellex entry with an IconHandler sub entry

5) the IconHandler contains in its default entry a class id

6) there is an entry in HKCR/CLSID/class id (probably with an default entry containing a description)

7) the CLSID entry contains a subentry InProcServer32 with the default entry containing the image path (your DLL name+path) and an entry ThreadingModel containing "Apartment"

It *should* work when all these points are ok. Btw: Point 6 and 7 are made by the COM factory, while the others must be done by your code (e.g. creating an own COM factory and overriding the UpdateRegistry method). It was my fault that I have not told you that before because I assumed the icon handler would work with the code I already posted here. But my own icon handler is called from an IShellFolder implementation I wrote, sorry.

Ciao, Mike
0
 
nricoAuthor Commented:
By my knowledge this all doesn't happen, but with the samples from Borland, I've just made a few extensions myself, and those seem to work correctly.

Maybe it's better if I start over again and pay a little more attention. :-)
0
 
LischkeCommented:
nrico, don't rely on the demos and that they work (more or less). Make all the entries manually as a test (there are other very similar entries in the registry to compare with) and see if your icon handler works then.

Ciao, Mike
0
 
nricoAuthor Commented:
Yeah, but I tested the demos (they work) and I made a variation on each demo myself, and they work, too.

So now (today) I'm gonna try the icon handler again.

Question: Does the threading model matter much? If so, then that was probably the problem.
0
 
LischkeCommented:
Mmh, I think the threading model does not matter, but I'm not 100% sure about it. This model describes how many client threads may access an instance of your COM object simultanously.

For your icon handler: Today is a good day to ....... get a COM object working ;-)

Ciao, Mike
0
 
nricoAuthor Commented:
It appears my day was not so well... ;-)

It !#@$^#@#$ing still doesn't work!!

Right now, I'm getting the all-too familiar "ARGH!" feeling, so now I'm posting my complete code, and I sure hope you can find out what's wrong with it.

unit ico_main;

interface

uses
  Windows, ActiveX, ComObj, ShlObj;

type
  TRandomExtractor = class(TComObject, IExtractIcon)
  protected
    function GetIconLocation(uFlags: UINT; szIconFile: PAnsiChar; cchMax: UINT;
      out piIndex: Integer; out pwFlags: UINT): HResult; stdcall;
    function Extract(pszFile: PAnsiChar; nIconIndex: UINT;
      out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult; stdcall;
  end;

const
  Class_RandomExtractor: TGUID = '{F8F0EF60-300B-11D4-B2B4-008048E192B0}';

implementation

uses ComServ, ShellAPI, SysUtils, Registry;

{ TRandomExtractor }

function TRandomExtractor.Extract(pszFile: PAnsiChar; nIconIndex: UINT;
  out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult;
begin
  Result:=E_NOTIMPL;
end;

function TRandomExtractor.GetIconLocation(uFlags: UINT;
  szIconFile: PAnsiChar; cchMax: UINT; out piIndex: Integer;
  out pwFlags: UINT): HResult;
Var
  SelfName:Array[0..MAX_PATH] Of Char;
begin
  MessageBox(0,'[-----]','DEBUG',0);
  GetModuleFileName(HInstance,SelfName,cchMax);
  lstrcpy(szIconFile,SelfName);
  piIndex:=0;
  pwFlags:=GIL_DONTCACHE;
  Result:=NOERROR;
end;

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

Type
  TIconHandlerFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(DoRegister: Boolean); override;
  end;

{ TIconHandlerFactory }

procedure TIconHandlerFactory.UpdateRegistry(DoRegister: Boolean);
Var
  ClassID:String;
begin
  If DoRegister Then
  Begin // Register
    Inherited UpdateRegistry(DoRegister);
    ClassID:=GUIDToString(Class_RandomExtractor);

    CreateRegKey('.foo','','foofile');
    CreateRegKey('foofile','','FOO test file');
    CreateRegKey('foofile\DefaultIcon','','%1');
    CreateRegKey('foofile\Shell\open\command','','c:\delphi\crap\unreal.exe "%1"');
    CreateRegKey('foofile\shellex\IconHandler','',ClassID);

    If Win32Platform=VER_PLATFORM_WIN32_NT Then
    With TRegistry.Create Do
    Try
      RootKey:=HKEY_LOCAL_MACHINE;
      OpenKey('Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',True);
      WriteString(ClassID,'Delphi 4 Random Icon Extractor Shell Extension');
    Finally
      Free;
    End;

  End Else
  Begin // Unregister

    DeleteRegKey('.foo');
    DeleteRegKey('foofile');

    Inherited UpdateRegistry(DoRegister);
  End;
end;

initialization
  TIconHandlerFactory.Create(ComServer, TRandomExtractor, Class_RandomExtractor,
    'RandomExtractor', 'Delphi 4 Random Icon Extractor Shell Extension', ciMultiInstance, tmApartment);
end.
0
 
nricoAuthor Commented:
P.S: The DEBUG MessageBox doesn't show up!!
0
 
LischkeCommented:
I found it! It's actually that you need to implement IPersistFile too. This interface is first called (in particular its Load method) before the icon handler is activated. Here is the code. Just copy it into your existing unit and compile (and smile :-)).

unit ico_main;

interface

uses
  Windows, ActiveX, ComObj, ShlObj;

type
  TRandomExtractor = class(TComObject, IPersistFile, IExtractIcon)
  protected
    // IPersist
    function GetClassID(out classID: TCLSID): HResult; stdcall;

    // IPersistFile
    function IsDirty: HResult; stdcall;
    function Load(pszFileName: POleStr; dwMode: Longint): HResult; stdcall;
    function Save(pszFileName: POleStr; fRemember: BOOL): HResult; stdcall;
    function SaveCompleted(pszFileName: POleStr): HResult; stdcall;
    function GetCurFile(out pszFileName: POleStr): HResult; stdcall;

    // IExtractIcon
    function GetIconLocation(uFlags: UINT; szIconFile: PAnsiChar; cchMax: UINT;
      out piIndex: Integer; out pwFlags: UINT): HResult; stdcall;
    function Extract(pszFile: PAnsiChar; nIconIndex: UINT;
      out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult; stdcall;
  end;

const
  Class_RandomExtractor: TGUID = '{F8F0EF60-300B-11D4-B2B4-008048E192B0}';

implementation

uses ComServ, ShellAPI, SysUtils, Registry;

{ TRandomExtractor }

function TRandomExtractor.Extract(pszFile: PAnsiChar; nIconIndex: UINT;
  out phiconLarge, phiconSmall: HICON; nIconSize: UINT): HResult;
begin
  MessageBox(0, 'Extract', 'Debug', 0);
  Result:=E_NOTIMPL;
end;

function TRandomExtractor.GetClassID(out classID: TCLSID): HResult;
begin
  MessageBox(0, 'GetClassID', 'Debug', 0);
  classID := Class_RandomExtractor;
  Result := S_OK;
end;

function TRandomExtractor.GetCurFile(out pszFileName: POleStr): HResult;
begin
  MessageBox(0, 'GetCurFile', 'Debug', 0);
  Result:=E_NOTIMPL;
end;

function TRandomExtractor.GetIconLocation(uFlags: UINT;
  szIconFile: PAnsiChar; cchMax: UINT; out piIndex: Integer;
  out pwFlags: UINT): HResult;
Var
  SelfName:Array[0..MAX_PATH] Of Char;
begin
  MessageBox(0, 'GetIconLocation', 'Debug', 0);
  GetModuleFileName(HInstance,SelfName,cchMax);
  lstrcpy(szIconFile,SelfName);
  piIndex:=0;
  pwFlags:=GIL_DONTCACHE;
  Result:=NOERROR;
end;

function TRandomExtractor.IsDirty: HResult;
begin
  MessageBox(0, 'IsDIrty', 'Debug', 0);
  Result := S_FALSE;
end;

function TRandomExtractor.Load(pszFileName: POleStr;
  dwMode: Integer): HResult;
begin
  Result := S_OK;
end;

function TRandomExtractor.Save(pszFileName: POleStr;
  fRemember: BOOL): HResult;
begin
  MessageBox(0, 'Save', 'Debug', 0);
  Result:=E_NOTIMPL;
end;

function TRandomExtractor.SaveCompleted(pszFileName: POleStr): HResult;
begin
  MessageBox(0, 'SaveCompleted', 'Debug', 0);
  Result:=E_NOTIMPL;
end;

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

Type
  TIconHandlerFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(DoRegister: Boolean); override;
  end;

{ TIconHandlerFactory }

procedure TIconHandlerFactory.UpdateRegistry(DoRegister: Boolean);
Var
  ClassID:String;
begin
  If DoRegister Then
  Begin // Register
    Inherited UpdateRegistry(DoRegister);
    ClassID:=GUIDToString(Class_RandomExtractor);

    CreateRegKey('.foo','','foofile');
    CreateRegKey('foofile','','FOO test file');
    CreateRegKey('foofile\DefaultIcon','','%1');
    CreateRegKey('foofile\Shell\open\command','','c:\delphi\crap\unreal.exe "%1"');
    CreateRegKey('foofile\shellex\IconHandler','',ClassID);

    If Win32Platform=VER_PLATFORM_WIN32_NT Then
    With TRegistry.Create Do
    Try
      RootKey:=HKEY_LOCAL_MACHINE;
      OpenKey('Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',True);
      WriteString(ClassID,'Delphi 4 Random Icon Extractor Shell Extension');
    Finally
      Free;
    End;

  End Else
  Begin // Unregister

    DeleteRegKey('.foo');
    DeleteRegKey('foofile');

    Inherited UpdateRegistry(DoRegister);
  End;
end;

initialization
  TIconHandlerFactory.Create(ComServer, TRandomExtractor, Class_RandomExtractor,
    'RandomExtractor', 'Delphi 4 Random Icon Extractor Shell Extension', ciMultiInstance, tmApartment);
end.


Ciao, Mike
0
 
nricoAuthor Commented:
!! Yeah, I found it this morning too !!

I must have looked over the line in the Win32 Programmer's Reference that told me so the first few times.
It works now -- yeehaw!

And it appears GetClassID() and the IPersistFile members other than Load() never get called.
It had to be so, of course, because IPersistFile::Load() is the only way for Windows to tell you what file you need to perform the icon extraction on.

Because you got the right answer, I will give you the points, but because I found it myself before you did, I'm only giving you a B ;-).
0
 
LischkeCommented:
Mmh, I don't want complain since it's quite a lot of points, but actually you found the solution too because I gave you some important information (e.g. without the COM factory you would never have come so far).

Anyway, I'm waiting for your next COM question (hopefully also highly endowed :-))

Ciao, Mike
0
 
nricoAuthor Commented:
That's not entirely true. A standard COM factory is put there by Delphi; I just hadn't posted that part of the code since I thought it wasn't necessary.

And the custom COM factory with the registry updates was mostly copied from the Borland examples.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 11
  • 10
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now