registering a dll on Vista/W7

I have a DLL that I am trying to register as a shell extension and it works perfectly on Windows2k and WindowsXP but fails without an error on Vista and Windows7.

Included is the code for the shell extension dll.  My question is, has WindowsVista/7 changed something?  What do I need to do to get the extension working?

I am using Delphi 2009.  I ran the installer as admin and registered the server manually as admin.

library tcshellex;
 
uses
  madExcept,
  madLinkDisAsm,
  madListHardware,
  madListProcesses,
  madListModules,
  Windows,
  ShlObj,
  ComObj,
  ComServ,
  ActiveX,
  ShellApi,
  SysUtils,
  Registry,
  madkernel;
 
{$R *.RES}
 
const
 IID_IMalloc: TGUID = '{2DE506B9-4320-11d3-8E42-002035221EDA}';
 
type
    TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
    private
      szFile: array[0..MAX_PATH] of Char;
    public
      function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
        uFlags: UINT): HResult; stdcall;
      function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
      function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
        pszName: LPSTR; cchMax: UINT): HResult; stdcall;
      function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
        hKeyProgID: HKEY): HResult; stdcall;
    end;
 
function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
begin
  // Add one menu item to context menu
  InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
    'Scan with The App');
  // Return number of menu items added
  Result := 1;
end;
 
function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
  H: THandle;
  R: tregistry;
  t: string;
begin
  // Make sure we are not being called by an application
  if HiWord(Integer(lpici.lpVerb)) <> 0 then
  begin
    Result := E_FAIL;
    Exit;
  end;
  // Make sure we aren't being passed an invalid argument number
  if LoWord(lpici.lpVerb) > 0 then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;
  // Execute the command specified by lpici.lpVerb.
  if LoWord(lpici.lpVerb) = 0 then
  begin
    R:=tregistry.create;
    R.rootkey:=HKEY_CURRENT_USER;
    r.openkey('\Software\Company\TheApp\', false);
    t:=r.readstring('tcshellex');
    r.closekey;
    r.Free;
    NewProcess(t,szfile);
  end;
  Result := NOERROR;
end;
 
function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HRESULT;
begin
  if (idCmd = 0) then begin
    if (uType = GCS_HELPTEXT) then
      // return help string for menu item
      strlCopy(pszName, 'Scan with The App',cchmax-1);
    Result := NOERROR;
  end
  else
    Result := E_INVALIDARG;
end;
 
function TContextMenu.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  medium: TStgMedium;
  fe: TFormatEtc;
  i,c,size: integer;
  temp: string;
begin
  with fe do
  begin
    cfFormat := CF_HDROP;
    ptd := Nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  // Fail the call if lpdobj is Nil.
  if lpdobj = Nil then
  begin
    Result := E_FAIL;
    Exit;
  end;
  // Render the data referenced by the IDataObject pointer to an HGLOBAL
  // storage medium in CF_HDROP format.
  Result := lpdobj.GetData(fe, medium);
  if Failed(Result) then Exit;
  // If only one file is selected, retrieve the file name and store it in
  // szFile. Otherwise fail the call.
//  if DragQueryFile(medium.hGlobal, $FFFFFFFF, Nil, 0) = 1 then
  begin
    try
      temp:='';
      c:=DragQueryFile(medium.hGlobal, $FFFFFFFF, Nil, 0);
      for i:=0 to c-1 do
        begin
          size:=DragQueryFile(medium.hGlobal, i, nil, 0)+2;
          DragQueryFile(medium.hGlobal, i, szFile, size);
          temp:=temp+'"'+szfile+'"'+#32;
        end;
      if (length(temp) > MAX_PATH) then
        Result := E_FAIL
         else
        begin
          strcopy(szfile, pchar(temp));
          Result := NOERROR;
        end;
    except
      Result := E_FAIL;
    end;
  end;
  ReleaseStgMedium(medium);
end;
 
exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;
 
begin
    TComObjectFactory.Create(ComServer, TContextMenu, IID_IMalloc,
         'The.App', 'TheApp', ciMultiInstance);
end.

Select allOpen in new window