Solved

registering a dll on Vista/W7

Posted on 2009-03-29
8
783 Views
Last Modified: 2012-05-06
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.

Open in new window

0
Comment
Question by:DSOM
  • 4
  • 4
8 Comments
 
LVL 18

Expert Comment

by:Johnjces
ID: 24021144
A couple of thoughts come to mind...

1). Did you try registering the dll in an administrator command prompt, runas cmd.exe?

2). Does your dll have a Vista manifest resource compiled with it?  

John
0
 

Author Comment

by:DSOM
ID: 24021613
I registered it as admin in a cmd prompt.  It doesn't have a manifest with it, I'll try that!
0
 

Author Comment

by:DSOM
ID: 24022240
Well that didn't work.  I put in a messagebox and it shows that it is calling the proper file.  So the registration works, but it fails to launch the process.
0
 
LVL 18

Expert Comment

by:Johnjces
ID: 24022323
One last thought, then I am out of ideas, turn all of Vista's UAC stuff off temporarily. If it still does not register, it is not a UAC or permissions issue. At least you will know for certain that it does not pertain to UAC stuff.

Is all the MAD classes Vista updated/aware?

Sorry I couldn't help you more.

John
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 

Author Comment

by:DSOM
ID: 24023194
I ditched the NewProcess function for createprocess and now I get "The requested operation requires elevation."  How do you run a process that needs elevation with createprocess?
0
 
LVL 18

Accepted Solution

by:
Johnjces earned 500 total points
ID: 24023437
Delphi.about.com had some articles on doing dlls as com processes as I recall that do not require the user to elevate a process. I think it was about.delphi.com anyway.

I do helper applications that when called and with an asAdminitrator Vista manifest, (which asks the user for administrator credentials), runs and does whatever as an admin.

You might also try my function below which I just cut and pasted so you'll have to clean it up a bit for your use but it does not use creatprocess. Check for Vista/W7 before running this chunk of code or it will ask XP users for elevated privledges too.

The example shows starting up a service with command line arguments.

Maybe this will help you.

John


function VistaExecElevated(FileName, CLParams, Dir : String; var ExitCode: DWORD; const Wait: DWORD = 0): LongWord;

var

 shExecInfo : TShellExecuteInfo;

 iWaitRes: DWORD;

begin

 Result := 0;

 if FileName <> '' then

  begin

   FillChar(shExecInfo, SizeOf(shExecInfo), 0);

   shExecInfo.cbSize := SizeOf(shExecInfo);

   {if hHandle <> null then

    shExecInfo.WND := Hhandle;}

   shExecInfo.fMask  := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;

   //shExecInfo.hInstApp := NULL;

   shExecInfo.lpVerb := PChar('runas');

   shExecInfo.lpFile := PChar(FileName);

   if CLParams <> '' then

    shExecInfo.lpParameters := PChar(CLParams);

   if Dir <> '' then

    shExecInfo.lpDirectory := pchar(Dir);

   shExecInfo.nShow := SW_HIDE;   {SW_SHOW}

   ShellExecuteEx(@shExecInfo);

   Result := shExecInfo.hInstApp;

   if Result > 32 then

    begin

     // wait on process ?

     if (Wait > 0) then

      begin

       iWaitRes := WaitForSingleObject(shExecInfo.hProcess, Wait);

       // timeout reached ?

       if (iWaitRes = WAIT_TIMEOUT) then

        begin

          //Result := 0;

          TerminateProcess(shExecInfo.hProcess, 0);

        end;

       // get the exitcode

       GetExitCodeProcess(shExecInfo.hProcess, ExitCode);

      end;

     // close handle, because SEE_MASK_NOCLOSEPROCESS was set

     CloseHandle(shExecInfo.hProcess);

    end;

 end;

end;
 
 

if VistaExecElevated('CDLibServerSvc.exe', '/install /silent', ExtractFilePath(application.ExeName), ExitCode) < 32 then

    begin

     Memo1.Lines.Add('Unable to find the service executable to remove!');

     exit;

    end;

Open in new window

0
 

Author Closing Comment

by:DSOM
ID: 31564207
I boiled that down to:

ShellExecute(0, 'open', pchar(t), szfile, nil, SW_SHOWNORMAL);

It works!  Thank you for leading me in the right direction!
0
 
LVL 18

Expert Comment

by:Johnjces
ID: 24023645
Glad I could help! That was a lot of distilling! I was thinking a bit more complex in what you were needing.

John
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
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…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

706 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

19 Experts available now in Live!

Get 1:1 Help Now