Solved

InProcServer(IContextMenu)

Posted on 2000-03-01
8
505 Views
Last Modified: 2012-05-05
I want to know how Winzip works :

When user selects several files in explorer shell ,
then right click mouse button,
An Item-'Add to Zip' can be added ,
This menuitem can include an icon .

I want to know :
1. How to add an menuitem with an icon .
2. How to add an menuitem when several files are selected .(I have run the demo-ConMenu.dpr with delphi, but the menuitem can be added only when one .dpr file was selected --not several but one!)
3. How to get filenames user selected.

Give A demo for me is best.
Thank you very much !
 
0
Comment
Question by:flyindance
  • 5
  • 3
8 Comments
 
LVL 10

Accepted Solution

by:
Lischke earned 100 total points
ID: 2572095
Hi flyer,

three questions for 100 points... Here's code directly from one of my projects:

unit IBContextMenu;

interface

{$R-}

uses Windows, ActiveX, Classes, ComObj, ShlObj, PIDLManager;

type TMenuType = (mtAlias, mtExtension, mtFile);

     TIBContextMenu = class(TComObject, IContextMenu, IContextMenu2, IShellExtInit)
     private
       FMenuType  : TMenuType;
       FFileList  : TStringList;
       FPIDLList  : PIBItemArray;
       FPIDLListSize,
       FIDOffset  : Cardinal;
       // IContextMenu methods
       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 HandleMenuMsg(uMsg: UINT; WParam, LParam: Integer): HResult; stdcall;

       // IShellExtInit methods
       function IShellExtInit.Initialize = IShellExtInit_Initialize;
       function IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
     public
       destructor Destroy; override;

       procedure Initialize; override;

       property PIDLList: PIBItemArray read FPIDLList write FPIDLList;
       property PIDLListSize: Cardinal read FPIDLListSize write FPIDLListSize;
     end;

const Class_IBContextMenu: TGUID = '{5A5D3B5F-7ECA-11D2-AA75-0080C845E84C}';

//--------------------------------------------------------------------------------

implementation

uses ComServ, ShellAPI, SysUtils, Graphics, WideStrings, DBStuff,
     Tools, IBFolder, Preferences, Dialogs, Controls, Messages, CommCtrl;

const // menu IDs
      IDM_FIRST    = 2;

      IDM_RENAME   = 2;
      IDM_CONNECT  = 3;
      IDM_ADDNEW   = 4;
      IDM_ADDDB    = 5;
      IDM_DELETE   = 6;
      IDM_EXPLORE  = 7;
      IDM_CLOSE    = 8;

      IDM_LAST     = 8;

//----------------- TIBContextMenu -----------------------------------------------

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

const HelpText : array[IDM_FIRST..IDM_LAST] of String =
        ({HELP_RENAME}   'Rename the selected connection',
         {HELP_CONNECT}  'Establish a database connection',
         {HELP_ADDNEW}   'Create a new connection',
         {HELP_ADDDB}    'Add the selected Interbase files to the connection list',
         {HELP_DELETE}   'Remove the selected connection from the list',
         {HELP_EXPLORE}  'Explore all registered connections',
         {HELP_CLOSE}    'Close the selected connection');

begin
  Result:=E_INVALIDARG;

  case uType of
    GCS_HELPTEXTA : begin
                      StrPLCopy(pszName,HelpText[idCmd],cchMax);
                      Result:=NOERROR;
                    end;
    GCS_HELPTEXTW : begin
                     StrPLCopyW(PWideChar(pszName),HelpText[idCmd],cchMax);
                     Result:=NOERROR;
                   end;
    GCS_VERBA : case idCmd of
                  IDM_RENAME : begin
                                 StrLCopy(pszName,'rename',cchMax);
                                 Result:=NOERROR;
                               end;
                  IDM_EXPLORE : begin
                                  StrLCopy(pszName,'explore',cchMax);
                                  Result:=NOERROR;
                                end;
                end;
    GCS_VERBW : case idCmd of
                  IDM_RENAME : begin
                                 StrPLCopyW(PWideChar(pszName),'rename',cchMax);
                                 Result:=NOERROR;
                               end;
                  IDM_EXPLORE : begin
                                  StrPLCopyW(PWideChar(pszName),'explore',cchMax);
                                  Result:=NOERROR;
                                end;
                end;
    GCS_VALIDATEA,
    GCS_VALIDATEW : Result:=NOERROR;
  end;
end;

//--------------------------------------------------------------------------------

function TIBContextMenu.HandleMenuMsg(uMsg: UINT; WParam, LParam: Integer): HResult; stdcall;

// handle messages related to our context menu, sent by the owner window of the menu (the explorer)

var MIS    : PMeasureItemStruct;
    DIS    : PDrawItemStruct;
    S,
    Name   : String;
    Color  : Cardinal;
    DC     : HDC;
    Size   : TSize;
    Index  : Integer;

begin
  Result:=1;
  Name:='';
  for Index:=0 to FPIDLListSize-1 do
  begin
    if Length(Name) > 0 then Name:=Name+', ';
    Name:=Name+IDListManager.GetLastItem(Pointer(FPIDLList[Index])).Name;
  end;
  if Length(Name) > 50 then
  begin
    SetLength(Name,50);
    Name:=Name+'...';
  end;
  case uMsg of
    WM_MEASUREITEM : begin
                       MIS:=Pointer(LParam);
                       DC:=GetDC(0);
                       SelectObject(DC,GetStockObject(DEFAULT_GUI_FONT));
                       case MIS.itemID-FIDOffset of
                         IDM_CONNECT : S:=StrOpenConnection+' '''+Name+'''';
                         IDM_ADDNEW  : S:=StrAddNewConnection+' '''+Name+'''';
                         IDM_DELETE  : S:=StrDeleteConnection+' '''+Name+'''';
                         IDM_CLOSE   : S:=StrCloseConnection+' '''+Name+'''';
                         IDM_RENAME  : S:=StrRenameConnection+' '''+Name+'''';
                       else
                         S:='???';
                       end;
                       GetTextExtentPoint32(DC,PChar(S),Length(S),Size);
                       MIS.itemWidth:=Size.cx;
                       MIS.itemHeight:=20;
                       ReleaseDC(0,DC);
                     end;
    WM_DRAWITEM : begin
                    DIS:=Pointer(LParam);
                    SelectObject(DIS.hDC,GetStockObject(DEFAULT_GUI_FONT));
                    case DIS.itemID-FIDOffset of
                      IDM_CONNECT : begin
                                      S:=StrOpenConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitConnect];
                                    end;
                      IDM_ADDNEW  : begin
                                      S:=StrAddNewConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitAddNew];
                                    end;
                      IDM_DELETE  : begin
                                      S:=StrDeleteConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitDelete];
                                    end;
                      IDM_CLOSE   : begin
                                      S:=StrCloseConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitClose];
                                    end;
                      IDM_RENAME  : begin
                                      S:=StrRenameConnection+' '''+Name+'''';
                                      Index:=MenuIconFromType[mitRename];
                                    end;
                    else
                      S:='???';
                      Index:=-1;
                    end;
                    if (DIS.itemState and ODS_SELECTED) <> 0 then Color:=COLOR_BTNSHADOW
                                                             else Color:=COLOR_BTNFACE;
                    FillRect(DIS.hDC,DIS.rcItem,Color+1);
                    DrawIconEx(DIS.hDC,2,DIS.rcItem.Top+2,ImageList_GetIcon(MenuImages.Handle,Index,ILD_NORMAL),16,16,0,0,DI_NORMAL);
                    Inc(DIS.rcItem.Left,20);
                    SetBkMode(DIS.hDC,TRANSPARENT);
                    SetTextColor(DIS.hDC,ColorTORGB(clGrayText));
                    if (DIS.itemState and ODS_DISABLED) <> 0 then ;
                    DrawText(DIS.hDC,PChar(S),Length(S),DIS.rcItem,DT_LEFT or DT_SINGLELINE or DT_VCENTER);
                  end;
  end;
end;

//--------------------------------------------------------------------------------

procedure TIBContextMenu.Initialize;

// this gets called before IShellExtInit.Initialize

begin
  FFileList:=TStringList.Create;
  FMenuType:=mtAlias;
end;

//--------------------------------------------------------------------------------

function TIBContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;

var Counter : Cardinal;
    Name    : String;
    Server  : String;
    Item    : PIBItem;

begin
  with lpici do
  begin
    // is the command being sent via a verb ?
    if HiWord(Cardinal(lpVerb)) <> 0 then Result:=NOERROR
                                     else
      if LoWord(Cardinal(lpVerb)) > IDM_LAST then Result:=E_INVALIDARG
                                             else
      begin
        case LoWord(Cardinal(lpVerb)) of
          IDM_ADDNEW : begin
                         UsePreferences('IBExplorer');
                         Counter:=ReadPreferenceFor('Counter',0) mod 1000;
                         Connections.NewConnection('New Connection '+IntToStr(Counter),'server name','database path');
                         Inc(Counter);
                         UsePreferences('IBExplorer');
                         WritePreferenceFor('Counter', Integer(Counter));
                         if assigned(RootFolder) then SHChangeNotify(SHCNE_UPDATEDIR,SHCNF_IDLIST or SHCNF_FLUSH,RootFolder.AbsoluteLocation,nil);
                         SetStatusTextW('new connection added.');
                       end;
          IDM_DELETE : begin
                         MessageBeep(MB_ICONQUESTION);
                         if MessageDlg(StrDelConQuestion,mtConfirmation,[mbOK,mbCancel],0) = mrOK then
                         begin
                           for Counter:=0 to FPIDLListSize-1 do
                           begin
                             Item:=IDListManager.GetLastItem(FPIDLList[Counter]);
                             ReleaseConnectionSet(Pointer(Item));
                             Connections.DeleteConnection(Item.Name);
                           end;
                           SHChangeNotify(SHCNE_UPDATEDIR,SHCNF_IDLIST or SHCNF_FLUSH,RootFolder.AbsoluteLocation,nil);
                           SetStatusTextW('connection(s) removed.');
                         end;
                       end;
          IDM_CONNECT : begin
                          for Counter:=0 to FPIDLListSize-1 do
                            CurrentShellBrowser.BrowseObject(Pointer(IDListManager.GetLastItem(FPIDLList[Counter])),
                                                             SBSP_DEFBROWSER or SBSP_DEFMODE or SBSP_ABSOLUTE);
                        end;
          IDM_CLOSE : begin
                        for Counter:=0 to FPIDLListSize-1 do
                        begin
                          Item:=IDListManager.GetLastItem(FPIDLList[Counter]);
                          ReleaseConnectionSet(Pointer(Item));
                        end;
                        CurrentShellBrowser.BrowseObject(Pointer(RootFolder.AbsoluteLocation),SBSP_DEFBROWSER or SBSP_DEFMODE or SBSP_ABSOLUTE);
                        SHChangeNotify(SHCNE_SERVERDISCONNECT,SHCNF_IDLIST or SHCNF_FLUSH,FPIDLList[0],nil);
                      end;
          IDM_ADDDB : begin
                        // Aufruf kam von einem oder mehreren gdb Files, also alle hinzuf|gen,
                        // die Dateiliste wurde schon beim Aufruf zusammengesammelt
                        for Counter:=0 to FFileList.Count-1 do
                        begin
                          SetStatusTextW(Format('adding connection ''%s''...',[FFileList[Counter]]));
                          Name:=ExtractFileName(FFileList[Counter]);
                          Delete(Name,Pos('.',Name),4);
                          Server:=ExpandUNCFileName(FFileList[Counter]);
                          if Pos('\\',Server) = 1 then
                          begin
                            Delete(Server,1,2);
                            Server:=Copy(Server,1,Pos('\',Server)-1);
                          end
                          else Server:='';
                          Connections.NewConnection(Name,Server,FFileList[Counter]);
                        end;
                        SetStatusTextW('finished adding connection(s).');
                        if assigned(RootFolder) then SHChangeNotify(SHCNE_UPDATEDIR,SHCNF_IDLIST or SHCNF_FLUSH,RootFolder.AbsoluteLocation,nil);
                      end;
        end;
        Result:=NOERROR;
      end;
  end;
end;

//--------------------------------------------------------------------------------

function TIBContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;

var MII    : TMenuItemInfo;
    S      : String;
    LastID : UINT;
    Item   : PIBItem;

begin
  Result:=MakeResult(SEVERITY_SUCCESS,0,0);

  FillChar(MII,SizeOf(MII),0);
  MII.cbSize:=sizeof(MII);

  LastID:=0;
  Item:=IDListManager.GetLastItem(FPIDLList[0]);
  FIDOffset:=idCmdFirst;
  if (CMF_DEFAULTONLY and uFlags) = 0 then
  begin
    case FMenuType of
      mtFile: begin
                MII.fMask:=MIIM_ID or MIIM_TYPE or MIIM_STATE;
                MII.wID:=idCmdFirst+IDM_ADDDB;
                if LastID < IDM_ADDDB then LastID:=IDM_ADDDB;
                MII.fType:=MFT_STRING;
                if FFileList.Count > 1 then S:='&Add databases to connection list'
                                       else S:='&Add database to connection list';
                MII.dwTypeData:=PChar(S);
                MII.fState:=MFS_ENABLED or MFS_DEFAULT;
                InsertMenuItem(Menu,indexMenu,True,MII);
                Inc(indexMenu);

                MII.fMask:=MIIM_ID or MIIM_TYPE;
                MII.wID:=0;
                MII.fType:=MFT_SEPARATOR;
                InsertMenuItem(Menu,indexMenu,True,MII);
                Inc(indexMenu);
              end;
      mtExtension: begin
                     MII.fMask:=MIIM_ID or MIIM_TYPE or MIIM_STATE;
                     MII.wID:=idCmdFirst+IDM_ADDNEW;
                     if LastID < IDM_ADDNEW then LastID:=IDM_ADDNEW;
                     MII.fType:=MFT_STRING;
                     MII.dwTypeData:=PChar(StrAddNewConnection);
                     MII.fState:=MFS_ENABLED or MFS_DEFAULT;
                     InsertMenuItem(Menu,indexMenu,True,MII);
                     Inc(indexMenu);

                     MII.fMask:=MIIM_ID or MIIM_TYPE;
                     MII.wID:=0;
                     MII.fType:=MFT_SEPARATOR;
                     InsertMenuItem(Menu,indexMenu,True,MII);
                     Inc(indexMenu);
                   end;
      mtAlias: begin
                 MII.fMask:=MIIM_ID or MIIM_TYPE or MIIM_STATE;
                 MII.wID:=idCmdFirst+IDM_CONNECT;
                 if LastID < IDM_CONNECT then LastID:=IDM_CONNECT;
                 MII.fType:=MFT_OWNERDRAW;
                 if ConnectionExists(Pointer(Item)) then MII.fState:=MFS_DISABLED
                                                    else MII.fState:=MFS_ENABLED  or MFS_DEFAULT;
                 InsertMenuItem(Menu,indexMenu,True,MII);
                 Inc(indexMenu);

                 MII.wID:=idCmdFirst+IDM_CLOSE;
                 if LastID < IDM_CLOSE then LastID:=IDM_CLOSE;
                 MII.fType:=MFT_OWNERDRAW;
                 if ConnectionExists(Pointer(Item)) then MII.fState:=MFS_ENABLED  or MFS_DEFAULT
                                                    else MII.fState:=MFS_DISABLED;
                 InsertMenuItem(Menu,indexMenu,True,MII);
                 Inc(indexMenu);

                 MII.wID:=idCmdFirst+IDM_DELETE;
                 if LastID < IDM_DELETE then LastID:=IDM_DELETE;
                 MII.fType:=MFT_OWNERDRAW;
                 MII.fState:=MFS_ENABLED;
                 InsertMenuItem(Menu,indexMenu,True,MII);
                 Inc(indexMenu);

                 if (uFlags and CMF_CANRENAME) <> 0 then
                 begin
                   MII.fMask:=MIIM_ID or MIIM_TYPE;
                   MII.wID:=0;
                   MII.fType:=MFT_SEPARATOR;
                   InsertMenuItem(Menu,indexMenu,True,MII);
                   Inc(indexMenu);

                   MII.fMask:=MIIM_ID or MIIM_TYPE or MIIM_STATE;
                   MII.wID:=idCmdFirst+IDM_RENAME;
                   if LastID < IDM_RENAME then LastID:=IDM_RENAME;
                   MII.fType:=MFT_OWNERDRAW;
                   MII.fState:=MFS_ENABLED;
                   InsertMenuItem(Menu,indexMenu,True,MII);
                   Inc(indexMenu);
                 end;
               end;
    end;
    if indexMenu > 0 then Result:=MakeResult(SEVERITY_SUCCESS,0,LastID+1)
                     else Result:=MakeResult(SEVERITY_SUCCESS,0,0);
  end;
end;

//--------------------------------------------------------------------------------

function TIBContextMenu.IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;

// gets only called when the context menu is used for file objects or the IBBrowser extension itself

var StgMedium   : TStgMedium;
    FormatEtc   : TFormatEtc;
    FileCount   : Integer;
    I           : Integer;
    Buffer      : array[0..MAX_PATH] of Char;

begin
  // fail the call if lpdobj is nil
  if lpdobj = nil then
  begin
    Result:=E_INVALIDARG;
    Exit;
  end;

  // try to read file objects
  with FormatEtc do
  begin
    cfFormat:=CF_HDROP;
    ptd     :=nil;
    dwAspect:=DVASPECT_CONTENT;
    lindex  :=-1;
    tymed   :=TYMED_HGLOBAL;
  end;

  // Render the data referenced by the IDataObject pointer to an HGLOBAL
  // storage medium in CF_HDROP format.
  Result:=lpdobj.GetData(FormatEtc,StgMedium);
  // got we called on file objects?
  if not Failed(Result) then
  begin
    FMenuType:=mtFile;
    // peel out Interbase database files potentially to be added to our alias list
    FileCount:=DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);
    for I:=0 to FileCount-1 do
    begin
      DragQueryFile(StgMedium.hGlobal,I,Buffer,MAX_PATH);
      if CompareText(ExtractFileExt(Buffer),'.gdb') = 0 then FFileList.Add(Buffer);
    end;
    Result:=NOERROR;
    ReleaseStgMedium(StgMedium);
  end
  else
  begin
    // reading file objects failed, so we got called by a click on the extension
    FMenuType:=mtExtension;
    Result:=NOERROR;
  end;
end;

//--------------------------------------------------------------------------------

destructor TIBContextMenu.Destroy;

begin
  IDListManager.FreeItemList(FPIDLList,FPIDLListSize);
  FFileList.Free;
  inherited;
end;

//--------------------------------------------------------------------------------

initialization
  TComObjectFactory.Create(ComServer, TIBContextMenu, Class_IBContextMenu, 'IBContextMenu', '', ciMultiInstance, tmApartment);
end.


Ciao, Mike
0
 

Author Comment

by:flyindance
ID: 2575947
Hi , Thanks .
But What is 'PIDLManager'?(Uses ..)
0
 

Author Comment

by:flyindance
ID: 2575955
Can you give me a demo can be run and
tested?
I will give you my last 100 points.
Many thanks!
0
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 

Author Comment

by:flyindance
ID: 2575995
Waiting....
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2576113
Unfortunately, this stuff is quite complex. I recommend that you copy out those parts from my code which you need, say into the context menu demo comming with Delphi.

The code is by no means intended to be runnable by you (there is quite a lot missing, like my PIDL manager class which handles allocation, deallocation, concatenation etc. of pidls). It is the idea that counts. Shell extensions are much too complex to give complete examples. You should have a fair amount of programming experience and if you have this then the code I gave you should answer many of your questions (if this is enough to answer this question here at E-E is a different thing and a decision you have to make yourself).

Ciao, Mike
0
 

Author Comment

by:flyindance
ID: 2576150
Many Thanks...
I will try it ...

0
 
LVL 10

Expert Comment

by:Lischke
ID: 2576175
Thank you for the A grading. Although I cannot give you a complete sample I still can lend a hand on specific details. So just ask if you need some additional information...

Ciao, Mike
0
 

Author Comment

by:flyindance
ID: 2576219
Please look for the new 'Question'
that name is:
'Mr.Mike Lischke'

:-)

Please answer it .
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say 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
add combobox item based on numbers 9 154
Send message from delphi to whatsapp, is it possible? 3 1,672
find a node in VST 2 73
Twebbrowser add css to the header 3 28
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…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

860 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