Solved

Shell Extension Menu - Controlling multiple menu items

Posted on 2008-10-24
9
801 Views
Last Modified: 2012-06-27
Alright, I decided to go with my first shell extension menu this time.

//When this is clicked, the program runs
          InsertMenu(PopupMenu,0,MF_STRING Or MF_BYPOSITION,idCmdFirst,PChar(Buffer));
//Nothing happens when this is clicked
          InsertMenu(PopupMenu,1,MF_STRING Or MF_BYPOSITION,idCmdFirst + 1,'Open WinCISO options. . .');

I guess my question is how do shell extension dll's go from GetCommandString to InvokeCommand? What is the proper way to handle multiple menu items?
unit CM;
 

interface
 

uses

  Windows, ActiveX, ComObj, ShlObj, Dialogs{, Graphics};
 

type

  TContextMenu = class(TComObject, IShellExtInit, IContextMenu)

  private

    fFileName : Array[0..MAX_PATH] Of Char;

    Output : String;

    function ExeFilePath(IsOptions: Bool = False): String;

  protected

    { IShellExtInit }

    function IShellExtInit.Initialize = SEIInitialize;

    function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HRESULT; stdcall;

    { IContextMenu }

    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;

  end;

  TDataType = (dtISO,dtCSO);
 

var

  DataType : TDataType;
 

const

  Class_ContextMenu : TGUID = '{F3026062-4D7E-4638-9A6B-382CCAC3FC0A}';
 

implementation
 

uses ComServ, SysUtils, ShellApi, Registry;

 

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HRESULT;

var

  StgMedium : TStgMedium;

  FormatEtc : TFormatEtc;

begin

  If (lpdobj = nil) Then

    begin

    Result := E_INVALIDARG;

    Exit;

  end;

  With FormatEtc Do

    begin

    cfFormat := CF_HDROP;

    ptd := nil;

    dwAspect := DVASPECT_CONTENT;

    lindex := -1;

    tymed := TYMED_HGLOBAL;

  end;

  Result := lpdobj.GetData(FormatEtc,StgMedium);

  If Failed(Result) Then Exit;

  If DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0) = 1 Then

    begin

    DragQueryFile(StgMedium.hGlobal,0,fFileName,SizeOf(fFileName));

    Result := NOERROR;

  end

  Else

    begin

    fFileName[0] := #0;

    Result := E_FAIL;

  end;

  ReleaseStgMedium(StgMedium);

  If Lowercase(ExtractFileExt(fFileName)) = '.iso' Then

    begin

    DataType := dtISO;

  end

  Else If Lowercase(ExtractFileExt(fFileName)) = '.cso' Then

    begin

    DataType := dtCSO;

  end

  Else

    begin

    fFileName[0] := #0;

    Result := E_FAIL;

  end;

end;
 

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HRESULT;

var

  Buffer : String;

  PopupMenu : HMenu;

begin

  Result := 0;

  Buffer := '%s ' + ExtractFileName(fFileName) + ' to %s. . .';

  Try

    Case DataType Of

      dtISO:

        begin

        Buffer := Format(Buffer,['Compress','cso']);

        If ((uFlags And $0000000F) = CMF_NORMAL) Or ((uFlags And CMF_EXPLORE) <> 0) Then

          begin

          PopupMenu := CreatePopupMenu;

          InsertMenu(Menu,indexMenu,MF_SEPARATOR Or MF_BYPOSITION,idCmdFirst,'');

          InsertMenu(Menu,indexMenu + 1,MF_STRING Or MF_BYPOSITION Or MF_POPUP,PopupMenu,'WinCISO Functions');

          InsertMenu(PopupMenu,0,MF_STRING Or MF_BYPOSITION,idCmdFirst,PChar(Buffer));

          InsertMenu(PopupMenu,1,MF_STRING Or MF_BYPOSITION,idCmdFirst + 1,'Open WinCISO options. . .');

          InsertMenu(Menu,indexMenu + 2,MF_SEPARATOR Or MF_BYPOSITION,idCmdFirst,'');

          Result := 3;

        end;

      end;

      dtCSO:

        begin

        Buffer := Format(Buffer,['Decompress','iso']);

        If ((uFlags And $0000000F) = CMF_NORMAL) Or ((uFlags And CMF_EXPLORE) <> 0) Then

          begin

          PopupMenu := CreatePopupMenu;

          InsertMenu(Menu,indexMenu,MF_SEPARATOR Or MF_BYPOSITION,idCmdFirst,'');

          InsertMenu(Menu,indexMenu + 1,MF_STRING Or MF_BYPOSITION Or MF_POPUP,PopupMenu,'WinCISO Functions');

          InsertMenu(PopupMenu,0,MF_STRING Or MF_BYPOSITION,idCmdFirst,PChar(Buffer));

          InsertMenu(PopupMenu,1,MF_STRING Or MF_BYPOSITION,idCmdFirst + 1,'Open WinCISO options. . .');

          InsertMenu(Menu,indexMenu + 2,MF_SEPARATOR Or MF_BYPOSITION,idCmdFirst,'');

          Result := 3;

        end

      end;

    end;

  Finally

  end;

end;
 

function TContextMenu.ExeFilePath(IsOptions: Bool = False): String;

var

  Reg : TRegistry;

begin

  Reg := TRegistry.Create;

  Try

    With Reg Do

      begin

      RootKey := HKEY_LOCAL_MACHINE;

      OpenKey('\SOFTWARE\WinCISO', False);

      Result := ReadString('FileName');

    end;

    If Not(IsOptions) Then

      begin

      Case DataType Of

        dtISO: Result := Result + ' c ' + fFileName;

        dtCSO: Result := Result + ' d ' + fFileName;

      end;

    end

    Else

      begin

      Result := Result + ' o';

    end;

  Finally

    Reg.Free;

  end;

end;

 

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HRESULT;

resourcestring

  sPathError = 'Error setting current directory';

var

  H : THandle;

  PrevDir : String;

begin

  Result := E_FAIL;

  If HiWord(Integer(lpici.lpVerb)) <> 0 Then Exit;

  If LoWord(lpici.lpVerb) <> 0 Then

    begin

    Result := E_INVALIDARG;

    Exit;

  end;

  PrevDir := GetCurrentDir;

  Try

    If Not(SetCurrentDir(ExtractFilePath(fFileName))) Then

      begin

      Raise Exception.CreateRes(@sPathError);

    end;

    MessageBox(0,PChar(Output),'',0);

    H := WinExec(PChar(Output),lpici.nShow);

    If H < 32 Then

      begin

      MessageBox(lpici.hWnd,'Could not execute WinCISO correctly!','Error',MB_ICONERROR Or MB_OK);

      Result := NOERROR;

    end;

  Finally

    SetCurrentDir(PrevDir);

  end;

end;

 

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HRESULT;

begin

  Result := E_INVALIDARG;

  If idCmd = 0 Then

    begin

    If uType = GCS_HELPTEXT Then

      begin

      StrCopy(pszName,'Compresses or decompresses PSP files');

      Result := NOERROR;

    end

    Else If uType = GCS_VERB Then

      begin

      Output := ExeFilePath;

      Result := NOERROR;

    end;

  end

  Else

    begin

    If uType = GCS_HELPTEXT Then

      begin

      StrCopy(pszName,'Open the options menu for WinCISO');

      Result := NOERROR;

    end

    Else If uType = GCS_VERB Then

      begin

      Output := ExeFilePath(False);

      Result := NOERROR;

    end;

  end;

end;

 

type

  TContextMenuFactory = class(TComObjectFactory)

  public

    procedure UpdateRegistry(Register: Boolean); override;

  end;

 

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);

var

  ClassID : String;

begin

  If Register Then

    begin

    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(Class_ContextMenu);

    CreateRegKey('*\shellex','','');

    CreateRegKey('*\shellex\ContextMenuHandlers','','');

    CreateRegKey('*\shellex\ContextMenuHandlers\WinCISO','',ClassID);

    If Win32Platform = VER_PLATFORM_WIN32_NT Then

      begin

      With TRegistry.Create Do

        begin

        Try

          RootKey := HKEY_LOCAL_MACHINE;

          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions',True);

          OpenKey('Approved',True);

          WriteString(ClassID,'WinCISO Context Menu Shell Extension');

        Finally

          Free;

        end;

      end;

    end;

  end

  Else

    begin

    DeleteRegKey('*\shellex\ContextMenuHandlers\WinCISO');

    inherited UpdateRegistry(Register);

  end;

end;

 

initialization

  TContextMenuFactory.Create(ComServer,TContextMenu,Class_ContextMenu,'','WinCISO Context Menu Shell Extension',ciMultiInstance,tmApartment);

end.

Open in new window

0
Comment
Question by:ThievingSix
  • 5
  • 4
9 Comments
 
LVL 28

Accepted Solution

by:
2266180 earned 500 total points
ID: 22803814
because of you I have an open question: http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_23751370.html

:P

regarding your problem. why do you do:
  If LoWord(lpici.lpVerb) <> 0 Then
    begin
    Result := E_INVALIDARG;
    Exit;
  end;

?
isn't the command in the LoWord(lpici.lpVerb)  ? so first menu is 0, second one is 1, and so on. it's been a while so I might be wrong; but I did a small google and found http://www.delphi3000.com/articles/article_2926.asp?SK= which supports my memory.

log that value to file and see if I am right or not :)
0
 
LVL 13

Author Comment

by:ThievingSix
ID: 22803987
*Fails to see how that question is my fault, but accepts the fact that it is my fault as cuily is always right*

And that pertains to this question as well. It seems the example I was looking at for this was made to accommodate only one menu item. Even so, I over looked it in win32.hlp =P
0
 
LVL 28

Expert Comment

by:2266180
ID: 22804007
>> *Fails to see how that question is my fault, but accepts the fact that it is my fault as cuily is always right*

well (FYI), usually this is how it works: somebody congrats an expert and gives a 20 point (minimum) on the question. that expert will say something liek "gee, thanks guys" and after a while, that somebody will close the question by accepting the experts answer ;) since you did not say anything in that question, I'm kind of forced to either wait for you or delete it -_-
0
 
LVL 13

Author Comment

by:ThievingSix
ID: 22804145
I actually don't know why I missed it. I will obey and respond. xD
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 28

Expert Comment

by:2266180
ID: 22804151
lol :)

thanks :P
0
 
LVL 28

Expert Comment

by:2266180
ID: 22804159
oh my god. my deepest and sincerest apologies. I really don't know what's wrong with me. for some reason I was seeing TheRealLoki when I was looking at your username :| I am completely lost at how my eyes (or brain) could fail me like this.
I'll go shoot myself now -_-
0
 
LVL 13

Author Comment

by:ThievingSix
ID: 22804174
I was sure confused myself. But please, you answer 90% of my questions. Shooting yourself will not be favorable for me =P
0
 
LVL 28

Expert Comment

by:2266180
ID: 22804205
0
 
LVL 13

Author Comment

by:ThievingSix
ID: 22804289
That's hilarious:

"The compiler won't let you shoot yourself in the foot."
"The bullet travels to your foot instantly, but it took you three weeks to load the round and aim the gun."
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

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…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
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…

948 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

18 Experts available now in Live!

Get 1:1 Help Now