{"id":702,"date":"2012-11-14T15:37:55","date_gmt":"2012-11-14T23:37:55","guid":{"rendered":"http:\/\/www.andreanolanusse.com\/en\/?p=702"},"modified":"2012-12-28T00:34:23","modified_gmt":"2012-12-28T08:34:23","slug":"shell-extension-for-windows-32-bit-and-64-bit-with-delphi-xe2","status":"publish","type":"post","link":"http:\/\/www.andreanolanusse.com\/en\/shell-extension-for-windows-32-bit-and-64-bit-with-delphi-xe2\/","title":{"rendered":"Shell Extension for Windows 32-bit and 64-bit with Delphi XE2 or XE3"},"content":{"rendered":"

Compile Delphi code for 64-bit platform is possible now with Delphi XE2 and XE3<\/a>, developers can go beyond Windows 32-bit and start creating Windows Shell Extension for Windows 64-bit. Shell Extensions are in-process COM objects which extends the abilities of Windows OS. In this post I’m going to add two new context menu items in Windows Explorer. The menus will allow users to\u00a0upload files to Microsoft Azure and Amazon S3. This post will go through how to create the extension, register and compile for 32-bit and 64-bit. I’m preparing another post, in which I will explain how to upload files to Amazon S3 and Microsoft Azure.<\/p>\n

Creating the CloudUpload Shell Extension<\/h3>\n

In order to start creating a Shell Extension in Delphi, you first need to create an ActiveX Library project and after that create a new Automation Object. In the example I use for this post, the project name is CloudUpload and the Automation Object is called\u00a0TCloudUploadContext. The TCloudUploadContext class must implement the interfaces IShellExtInit and IContextMenu in order to integrate the Context Menu in Windows Explorer.<\/p>\n

    { IShellExtInit Methods }\r\n    { Initialize the context menu if a files was selected}\r\n    function IShellExtInit.Initialize = ShellExtInitialize;\r\n    function ShellExtInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;\r\n      hKeyProgID: HKEY): HResult; stdcall;\r\n\r\n    { IContextMenu Methods }\r\n    { Initializes the context menu and it decides which items appear in it,\r\n      based on the flags you pass }\r\n    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,\r\n      uFlags: UINT): HResult; stdcall;\r\n\r\n    { Execute the command, which will be the upload to Amazon or Azure}\r\n    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;\r\n    { Set help string on the Explorer status bar when the menu item is selected }\r\n    function GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT;\r\n      pszName: LPSTR; cchMax: UINT): HResult; stdcall;<\/pre>\n
The ShellExtInitialize defines if the Context Menu will appear or not in Windows Explorer. In this sample the context menu only shows up if one file has been selected, otherwise no Context Menu. In case only one file was selected the FFileName variable will receive the name of the file.<\/p>\n
function TCloudUploadContextMenu.ShellExtInitialize(pidlFolder: PItemIDList;\r\n  lpdobj: IDataObject; hKeyProgID: HKEY): HResult;\r\nvar\r\n  DataFormat: TFormatEtc;\r\n  StrgMedium: TStgMedium;\r\n  Buffer: array [0 .. MAX_PATH] of Char;\r\nbegin\r\n  Result := E_FAIL;\r\n\r\n  { Check if an object was defined }\r\n  if lpdobj = nil then\r\n    Exit;\r\n\r\n  { Prepare to get information about the object }\r\n  DataFormat.cfFormat := CF_HDROP;\r\n  DataFormat.ptd := nil;\r\n  DataFormat.dwAspect := DVASPECT_CONTENT;\r\n  DataFormat.lindex := -1;\r\n  DataFormat.tymed := TYMED_HGLOBAL;\r\n\r\n  if lpdobj.GetData(DataFormat, StrgMedium) <> S_OK then\r\n    Exit;\r\n\r\n  { The implementation now support only one file }\r\n  if DragQueryFile(StrgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1 then\r\n  begin\r\n    SetLength(FFileName, MAX_PATH);\r\n    DragQueryFile(StrgMedium.hGlobal, 0, @Buffer, SizeOf(Buffer));\r\n    FFileName := Buffer;\r\n    Result := NOERROR;\r\n  end\r\n  else\r\n  begin\r\n    \/\/ Don't show the Menu if more then one file was selected\r\n    FFileName := EmptyStr;\r\n    Result := E_FAIL;\r\n  end;\r\n\r\n  { http:\/\/msdn.microsoft.com\/en-us\/library\/ms693491(v=vs.85).aspx }\r\n  ReleaseStgMedium(StrgMedium);\r\n\r\nend;<\/pre>\n
After the context menu handler is initialized via the IShellExtInit interface, Windows uses the IContextMenu interface to call the other methods of our context menu handler. In this case it will call QueryContextMenu, GetCommandString and InvokeCommand.<\/p>\n
The Context Menu options (Amazon S3<\/a>, Microsoft Azure<\/a>) will be created through the QueryContextMenu method.<\/p>\n
function TCloudUploadContextMenu.QueryContextMenu(Menu: HMENU;\r\n  indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;\r\nvar\r\n  CloudMenuItem: TMenuItemInfo;\r\n  MenuCaption: String;\r\n  SubMenu: HMENU;\r\n  uId: UINT;\r\nbegin\r\n  { only adding one menu CloudMenuItem, so generate the result code accordingly }\r\n  Result := MakeResult(SEVERITY_SUCCESS, 0, 3);\r\n\r\n  { store the menu CloudMenuItem index }\r\n  FMenuItemIndex := indexMenu;\r\n\r\n  { specify what the menu says, depending on where it was spawned }\r\n  if (uFlags = CMF_NORMAL) then \/\/ from the desktop\r\n    MenuCaption := 'Send file from Desktop to the Cloud'\r\n  else if (uFlags and CMF_VERBSONLY) = CMF_VERBSONLY then \/\/ from a shortcut\r\n    MenuCaption := 'Send file from Shourtcut to the Cloud'\r\n  else if (uFlags and CMF_EXPLORE) = CMF_EXPLORE then \/\/ from explorer\r\n    MenuCaption := 'Send file from Explorer to the Cloud'\r\n  else\r\n    { fail for any other value }\r\n    Result := E_FAIL;\r\n\r\n  if Result <> E_FAIL then\r\n  begin\r\n\r\n    SubMenu := CreatePopupMenu;\r\n\r\n    uId := idCmdFirst;\r\n    InsertMenu(SubMenu, AmazonIndex, MF_BYPOSITION, uId, TClouds[AmazonIndex]);\r\n\r\n    Inc(uId);\r\n    InsertMenu(SubMenu, AzureIndex, MF_BYPOSITION, uId, TClouds[AzureIndex]);\r\n\r\n    FillChar(CloudMenuItem, SizeOf(TMenuItemInfo), #0);\r\n    CloudMenuItem.cbSize := SizeOf(TMenuItemInfo);\r\n    CloudMenuItem.fMask := MIIM_SUBMENU or MIIM_STRING or MIIM_ID;\r\n    CloudMenuItem.fType := MFT_STRING;\r\n    CloudMenuItem.wID := FMenuItemIndex;\r\n    CloudMenuItem.hSubMenu := SubMenu;\r\n    CloudMenuItem.dwTypeData := PWideChar(MenuCaption);\r\n    CloudMenuItem.cch := Length(MenuCaption);\r\n\r\n    InsertMenuItem(Menu, indexMenu, True, CloudMenuItem);\r\n  end;\r\nend;<\/pre>\n
When you are in the Windows Explorer and you pass the mouse over one of the Cloud menu items a short help message is displayed in the Windows Explorer status bar, it is defined on the implementation of the method GetCommandString, which returns a string to the Windows Explorer to display.<\/p>\n
function TCloudUploadContextMenu.GetCommandString(idCmd: UINT_PTR; uFlags: UINT;<\/p>\n
  pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;\r\nbegin\r\n  Result := E_INVALIDARG;\r\n\r\n  { Set help string on the Explorer status bar when the menu item is selected }\r\n  if (idCmd in [AmazonIndex, AzureIndex]) and (uFlags = GCS_HELPTEXT) then\r\n  begin\r\n    StrLCopy(PWideChar(pszName), PWideChar('Copy the selected file to ' +\r\n      TClouds[idCmd]), cchMax);\r\n    Result := NOERROR;\r\n  end;\r\n\r\nend;<\/pre>\n
As the user clicks in one of the Cloud menu items, the method InvokeCommand will be called and start the process to upload the selected file to the Cloud selected. At this point we already have the file name and based on the lpici parameters we can identify what menu item the user clicked.<\/p>\n
function TCloudUploadContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;\r\nvar\r\n  Item: Word;\r\nbegin\r\n  Result := E_FAIL;\r\n\r\n  if HiWord(Integer(lpici.lpVerb)) <> 0 then\r\n    Exit;\r\n\r\n  { if the index matches the index for the menu, show the cloud options }\r\n  Item := LoWord(Integer(lpici.lpVerb));\r\n\r\n  if Item in [AmazonIndex, AzureIndex] then\r\n  begin\r\n    try\r\n      Upload(lpici.HWND, Item, FFileName);\r\n    except\r\n      on E: Exception do\r\n        MessageBox(lpici.hwnd, PWideChar(E.Message), 'Cloud Upload', MB_ICONERROR);\r\n\r\n    end;\r\n    Result := NOERROR;\r\n  end;\r\n\r\nend;<\/pre>\n
In order for the COM object to be created whenever the CloudUpload is loaded, it’s necessary to create an instance of a class factory that specifically creates an instance of the shell extension object, the factory instance will be created on the initialization section, based on the following code, which is a replacement for the default code created by Delphi.<\/p>\n
initialization\r\n  TCloudUploadObjectFactory.Create(ComServer, TCloudUploadContextMenu, CLASS_CloudUploadContextMenu, ciMultiInstance, tmApartment);\r\nend.<\/pre>\n
Since the class factory will be responsible to register\/unregister the DLL, the methods ApproveShellExtension and UpdateRegistry will be invoked, it will happen when you use the regsvr32.exe.<\/p>\n
  { the new class factory }\r\n  TCloudUploadObjectFactory = class(TAutoObjectFactory)\r\n  protected\r\n    procedure ApproveShellExtension(&Register: Boolean; const ClsID: string);\r\n    function GetProgID: string; override;\r\n  public\r\n    procedure UpdateRegistry(Register: Boolean); override;\r\n  end;\r\n\r\n{ TCloudUploadObjectFactory }\r\n\r\n{ Required to registration for Windows NT\/2000 }\r\nprocedure TCloudUploadObjectFactory.ApproveShellExtension(&Register: Boolean;\r\n  const ClsID: string);\r\nConst\r\n  WinNTRegKey =\r\n    'SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Shell Extensions\\Approved';\r\nvar\r\n  Reg: TRegistry;\r\nbegin\r\n  Reg := TRegistry.Create;\r\n\r\n  try\r\n    Reg.RootKey := HKEY_LOCAL_MACHINE;\r\n\r\n    if not Reg.OpenKey(WinNTRegKey, True) then\r\n      Exit;\r\n\r\n    { register the extension appropriately }\r\n    if &Register then\r\n      Reg.WriteString(ClsID, Description)\r\n    else\r\n      Reg.DeleteValue(ClsID);\r\n  finally\r\n    Reg.Free;\r\n  end;\r\n\r\nend;\r\n\r\nfunction TCloudUploadObjectFactory.GetProgID: string;\r\nbegin\r\n  { ProgID not required for shell extensions }\r\n  Result := '';\r\nend;\r\n\r\nprocedure TCloudUploadObjectFactory.UpdateRegistry(Register: Boolean);\r\nConst\r\n  ContextKey = '*\\shellex\\ContextMenuHandlers\\%s';\r\nbegin\r\n  { perform normal registration }\r\n  inherited UpdateRegistry(Register);\r\n\r\n  { Registration required for Windows NT\/2000 }\r\n  ApproveShellExtension(Register, GUIDToString(ClassID));\r\n\r\n  { if this server is being registered, register the required key\/values\r\n    to expose it to Explorer }\r\n  if Register then\r\n    CreateRegKey(Format(ContextKey, [ClassName]), '', GUIDToString(ClassID),\r\n      HKEY_CLASSES_ROOT)\r\n  else\r\n    DeleteRegKey(Format(ContextKey, [ClassName]));\r\n\r\nend;<\/pre>\n
Compile for 32-bit or 64-bit platform<\/h3>\n
At this point we just need to compile the extension, for this sample the Win APIs and RTL methods are the same for both platforms, we don’t need any specific code. You can define the target platform through the Project Manager, by default your project target 32-bit Windows, right click on Target Platforms to add 64-bit Windows.<\/p>\n
\"Delphi<\/a><\/p>\n
You can’t register 32-bit dll in 64-bit operation system, and you can not register 64-bit dll in 32-bit operation system. If you are using your develop machine to test, compile for the platform compatible with your OS.<\/p>\n
 <\/p>\n
Registering the CloudUpload Shell Extension<\/h3>\n
First, you must Run as Administrator the application you are going to use to register the shell extensions even if you are the Administrator user.<\/p>\n
32-bit shell extensions can be registered through the IDE, and command line (cmd) can be used to register 32-bit and 64-bit.<\/p>\n
Here the cmd line to register and unregister:<\/p>\n
– Run as Administrator the cmd;<\/p>\n
– Register the extension using the following command line: regsvr32 <PATH WHERE IS LOCATED THE DLL>CloudUpload.dll<\/p>\n
– To unregister the extension using the following command line: regsvr32 <PATH WHERE IS LOCATED THE DLL>CloudUpload.dll \/u<\/p>\n
After register the DLL you can\u00a0open the Windows Explorer, select one file and right click, you will see the new menu “Send file from Explorer to the Cloud”. The following screenshot show the shell extension on my Windows 7 64-bit.<\/p>\n
\"Shell<\/a><\/p>\n
You can download he source code in 2 different ways:<\/p>\n