I am writting a shell extension handler to overlay shell icon like
TortoiseCVS does.

After fighting for a long night, I got some code which I will add below.
After testing again and again, it can make system default overlay icon for
link to disappear.  However, it doesn't show the overlay icon which I want
to overlay.

So I post the source code here, maybe anyone would like/be interested to
help me to find where I am wrong.
(Hope it is not too long for you)

--------------------------------------------------------
unit Unit1;

interface

uses
  ComObj, ActiveX, Types, Windows, Classes;

const
{$EXTERNALSYM SID_IShellIconOverlayIdentifier}
  SID_IShellIconOverlayIdentifier =
'{0C6C4200-C589-11D0-999A-00C04FD655E1}';
{$EXTERNALSYM ISIOI_ICONFILE}
  ISIOI_ICONFILE = $00000001; // path is returned through pwszIconFile
{$EXTERNALSYM ISIOI_ICONINDEX}
  ISIOI_ICONINDEX = $00000002; // icon index in pwszIconFile is returned
through pIndex
{$EXTERNALSYM ISIOI_SYSIMAGELISTINDEX}
  ISIOI_SYSIMAGELISTINDEX = $00000004; // system imagelist icon index is
returned through pIndex

type
{$EXTERNALSYM IShellIconOverlayIdentifier}
  IShellIconOverlayIdentifier = interface(IUnknown)
    [SID_IShellIconOverlayIdentifier]
    function IsMemberOf(pwszPath: PWideChar; dwAttrib: DWORD): HResult;
stdcall;
    function GetOverlayInfo(out pwszIconFile: PWideChar; cchMax: Integer;
var pIndex: Integer; var pdwFlags: DWORD): HResult; stdcall;
    function GetPriority(out pIPriority: Integer): HResult; stdcall;
  end;

  TOverlayIcon = class(TComObject, IShellIconOverlayIdentifier)
  private
    FFileName: string;
  protected
    { IShellIconOverlayIdentifier }
    function IsMemberOf(pwszPath: PWideChar; dwAttrib: DWORD): HResult;
stdcall;
    function GetOverlayInfo(out pwszIconFile: PWideChar; cchMax: Integer;
var pIndex: Integer; var pdwFlags: DWORD): HResult; stdcall;
    function GetPriority(out pIPriority: Integer): HResult; stdcall;
  end;

  TOverlayIconFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

const
  Class_OverlayIcon: TGUID = '{65961FC9-6C38-4043-A632-92ACD0A217EA}';

implementation

uses
  SysUtils, Registry, ComServ;

{ TOverlayIcon }

function TOverlayIcon.GetOverlayInfo(out pwszIconFile: PWideChar; cchMax:
Integer; var pIndex: Integer; var pdwFlags: DWORD): HResult;
begin
  pwszIconFile := StringToOleStr('c:\a.ico');
  pdwFlags := ISIOI_ICONFILE;
  Result := S_OK;
end;

function TOverlayIcon.GetPriority(out pIPriority: Integer): HResult;
begin
  pIPriority := 0;
  Result := S_OK;
end;

function TOverlayIcon.IsMemberOf(pwszPath: PWideChar; dwAttrib: DWORD):
HResult;
begin
  WideCharToStrVar(pwszPath, FFileName);
  Result := S_OK;
end;

{ TOverlayIconFactory }

procedure TOverlayIconFactory.UpdateRegistry(Register: Boolean);
const
  KeyName =
'SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifi
ers\DMS';
var
  ClassID: string;
begin
  if Register then
  begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(Class_OverlayIcon);
    with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey(KeyName, True);
      WriteString('', ClassID);
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      begin
        RootKey := HKEY_LOCAL_MACHINE;
        OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell
Extensions', True);
        OpenKey('Approved', True);
        WriteString(ClassID, 'Delphi OverlayIcon Shell Extension Example');
      end;
    finally
      Free;
    end;
  end
  else
  begin
    with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      DeleteKey(KeyName);
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      begin
        RootKey := HKEY_LOCAL_MACHINE;
        OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell
Extensions', True);
        OpenKey('Approved', True);
        DeleteValue(ClassID);
      end;
    finally
      Free;
    end;
    inherited UpdateRegistry(Register);
  end;
end;

initialization
  TOverlayIconFactory.Create(ComServer, TOverlayIcon, Class_OverlayIcon, '',
'DMS OverlayIcon', ciMultiInstance, tmApartment);

end.
-------------------------------------------------------

Something I need to write here.  As you saw, I put some declaration of
IShellIconOverlayIdentifier in my code.  The reason is I think there is a
bug for IShellIconOverlayIdentifier  in ShlObj.pas.
I am not sure, but I think the param pwszIconFile of method GetOverlayInfo
need a out/var reserved word.  So I add it.  Am I right?

Search web for a night, including borland news search, I don't find any
example for IShellIconOverlayIdentifier with Delphi.
Although I do find some example in C++, I cannot read it.

Hope anyone can give me some hint to help me, thank.

By the way, the overlay icon file 'c:\A.ico' mentioned in source is copied
from TortoiseCVS's icon file, just renamed.

---Pascal, using D7 ent

Hi,

> Thank you, I got answer from your code.

Great.  Please also read about the bug in the Delphi and CBuilder RTL
that has existed since at least D4 and likely D2.  It will eventually
crash Explorer if you don't do it.   Also note that with my package you
can create a column handler DLL that is less than 200k.  Lastly I say
that the implementation of the COM Server in the VCL does not follow
the rules of COM.  If this will cause strange hidden problems in
Explorer I don't know.  Hence the existence of EasyNSE.  It fixes the
RTL bug, creates most extensions without sucking Forms and about 250k
of bloat into the DLL, and creates COM objects in a way that is 100%
compliant with COM rules.

Jim
-- 
www.mustangpeak.net

Jim,

Thank you, I got answer from your code.

---Pascal

I put my working source here to help others....

----------------------------------------------------------------------------
------------------------

unit Unit1;

interface

uses
  ComObj, ActiveX, Types, Windows, Classes, ShlObj;

type
  TOverlayIcon = class(TComObject, IShellIconOverlayIdentifier)
  private
    FFileName: string;
  protected
    { IShellIconOverlayIdentifier }
    function IsMemberOf(pwszPath: PWideChar; dwAttrib: DWORD): HResult;
stdcall;
    function GetOverlayInfo(pwszIconFile: PWideChar; cchMax: Integer; var
pIndex: Integer; var pdwFlags: DWORD): HResult; stdcall;
    function GetPriority(out pIPriority: Integer): HResult; stdcall;
  end;

  TOverlayIconFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

const
  Class_OverlayIcon: TGUID = '{65961FC9-6C38-4043-A632-92ACD0A217EA}';

implementation

uses
  SysUtils, Registry, ComServ;

{ TOverlayIcon }

function TOverlayIcon.GetOverlayInfo(pwszIconFile: PWideChar; cchMax:
Integer; var pIndex: Integer; var pdwFlags: DWORD): HResult;
var
  FileName: Widestring;
  Ext: Widestring;
begin
  Result := S_OK;
  try
    ZeroMemory(pwszIconFile, cchMax * 2);
    Filename:='C:\a.ico';
    Ext := LowerCase(ExtractFileExt(FileName));
    if (Ext = '.exe') or (Ext = '.dll') or (Ext = '.ico') or (Ext = '') then
    begin
      if Length(FileName) < cchMax then
      begin
        CopyMemory(pwszIconFile, PWideChar(FileName), Length(FileName) * 2);
        if Filename <> '' then
          pdwFlags := pdwFlags or ISIOI_ICONFILE;
        if (pIndex > -1) and (LowerCase(ExtractFileExt(FileName)) <> '.ico')
then
          pdwFlags := pdwFlags or ISIOI_ICONINDEX;
      end
      else
        Result := S_FALSE
    end
    else
      Result := S_FALSE;
  except
    Result := S_FALSE;
  end
end;

function TOverlayIcon.GetPriority(out pIPriority: Integer): HResult;
begin
  pIPriority := 0;
  Result := S_OK;
end;

function TOverlayIcon.IsMemberOf(pwszPath: PWideChar; dwAttrib: DWORD):
HResult;
begin
  WideCharToStrVar(pwszPath, FFileName);
  Result := S_OK;
end;

{ TOverlayIconFactory }

procedure TOverlayIconFactory.UpdateRegistry(Register: Boolean);
const
  KeyName =
'SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellIconOverlayIdentifi
ers\DMS';
var
  ClassID: string;
begin
  if Register then
  begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(Class_OverlayIcon);
    with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey(KeyName, True);
      WriteString('', ClassID);
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      begin
        RootKey := HKEY_LOCAL_MACHINE;
        OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell
Extensions', True);
        OpenKey('Approved', True);
        WriteString(ClassID, 'Delphi OverlayIcon Shell Extension Example');
      end;
    finally
      Free;
    end;
  end
  else
  begin
    with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      DeleteKey(KeyName);
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      begin
        RootKey := HKEY_LOCAL_MACHINE;
        OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell
Extensions', True);
        OpenKey('Approved', True);
        DeleteValue(ClassID);
      end;
    finally
      Free;
    end;
    inherited UpdateRegistry(Register);
  end;
end;

initialization
  TOverlayIconFactory.Create(ComServer, TOverlayIcon, Class_OverlayIcon, '',
'DMS OverlayIcon', ciMultiInstance, tmApartment);

end.

Hi,

> After fighting for a long night, I got some code which I will add
> below.  After testing again and again, it can make system default
> overlay icon for link to disappear.  However, it doesn't show the
> overlay icon which I want to overlay.

Stop fighting and download EasyNSE from my website....

Jim
-- 
www.mustangpeak.net

"Jim"  ¼¶¼g©ó¶l¥ó·s»D
:41c261d9@newsgroups.borland.com...
>
>
> Great.  Please also read about the bug in the Delphi and CBuilder RTL
> that has existed since at least D4 and likely D2.  It will eventually
> crash Explorer if you don't do it.   Also note that with my package you
> can create a column handler DLL that is less than 200k.  Lastly I say
> that the implementation of the COM Server in the VCL does not follow
> the rules of COM.  If this will cause strange hidden problems in
> Explorer I don't know.  Hence the existence of EasyNSE.  It fixes the
> RTL bug, creates most extensions without sucking Forms and about 250k
> of bloat into the DLL, and creates COM objects in a way that is 100%
> compliant with COM rules.
>
> Jim

Oh?  Thanks for your warning.
And thanks for your struggle and open.
You are the man.

---Pascal