Solved

Shell Extension Menu - Controlling multiple menu items

Posted on 2008-10-24
9
808 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
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 13

Author Comment

by:ThievingSix
ID: 22804145
I actually don't know why I missed it. I will obey and respond. xD
0
 
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

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
HTML text in the body of an email (delphi code) 12 173
Working with hours 3 65
Delphi: Connect to running MS Outlook 4 125
Twebbrowser in Fire monkey android scrolling to bottom 1 45
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

820 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