Solved

registering a dll on Vista/W7

Posted on 2009-03-29
8
795 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
Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

 
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
 

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

Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
This tutorial gives a high-level tour of the interface of Marketo (a marketing automation tool to help businesses track and engage prospective customers and drive them to purchase). You will see the main areas including Marketing Activities, Design …
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

777 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