Solved

Writing a shell extension

Posted on 2000-05-09
24
580 Views
Last Modified: 2010-04-04
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
Comment
Question by:nrico
  • 11
  • 10
  • 2
  • +1
24 Comments
 
LVL 3

Expert Comment

by:bryan7
ID: 2794426
listenning
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2794688
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
 
LVL 1

Author Comment

by:nrico
ID: 2799338
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
 
LVL 10

Expert Comment

by:Lischke
ID: 2799389
:-) 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
 
LVL 1

Author Comment

by:nrico
ID: 2799447
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
 
LVL 10

Expert Comment

by:Lischke
ID: 2799472
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
 
LVL 1

Expert Comment

by:sistudio041900
ID: 2808679
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
 
LVL 1

Author Comment

by:nrico
ID: 2816599
Lischke --
  No, I have checked it, the entry is made.

Sistudio --
  There is? In the Demos directory?
0
 
LVL 1

Expert Comment

by:sistudio041900
ID: 2817189
delphi5\demos\activex\shellext\
I would have been lost without that example, it does include all, but its a good starting point
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2817230
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
 
LVL 1

Author Comment

by:nrico
ID: 2820575
Ummm... how do I create that COM factory?
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2820746
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
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 1

Author Comment

by:nrico
ID: 2823450
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
 
LVL 10

Expert Comment

by:Lischke
ID: 2824719
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
 
LVL 1

Author Comment

by:nrico
ID: 2830181
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
 
LVL 10

Expert Comment

by:Lischke
ID: 2830447
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
 
LVL 1

Author Comment

by:nrico
ID: 2832666
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
 
LVL 10

Expert Comment

by:Lischke
ID: 2832714
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
 
LVL 1

Author Comment

by:nrico
ID: 2834912
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
 
LVL 1

Author Comment

by:nrico
ID: 2834917
P.S: The DEBUG MessageBox doesn't show up!!
0
 
LVL 10

Accepted Solution

by:
Lischke earned 250 total points
ID: 2836486
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
 
LVL 1

Author Comment

by:nrico
ID: 2836537
!! 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
 
LVL 10

Expert Comment

by:Lischke
ID: 2836568
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
 
LVL 1

Author Comment

by:nrico
ID: 2836591
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

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

747 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

9 Experts available now in Live!

Get 1:1 Help Now