Delphi write Shell Extension

Original link:

Create a housing extension (Shell Extension) program with delphi basic steps:

(1) Create an ActiveX Library project, named "CloudUpload"
(2) create a new automation objects (Automation Object). Named "TCloudUploadContext"

TCloudUploadContext i.e. class must implement two interfaces: the IShellExtInit and the IContextMenu ,
so you can integrate the context menu (Context Menu) in Windows Explorer.

The IShellExtInit Methods} {
{MENU context the Initialize The IF WAS A Selected} Files
function the IShellExtInit .Initialize = ShellExtInitialize ;
function ShellExtInitialize (pidlFolder: PItemIDList; lpdobj: the IDataObject;
hKeyProgID: HKEY): the HResult; _stdcall;

{ IContextMenu Methods }
{ Initializes the context menu and it decides which items appear in it,
based on the flags you pass }
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;

{The Execute The Command, Which Will BE The Upload to Amazon or Azure}
function InvokeCommand (var lpici: TCMInvokeCommandInfo): the HResult; _stdcall;
{the Set Help String ON The Explorer Status bar When The MENU Item IS Selected}
function GetCommandString (IdCmd: UINT_PTR ; uFlags: UINT; pwReserved: Puint;
pszName: LPSTR; cchMax: UINT): of the HResult; stdcall;

ShellExtInitialize defines whether to display a context menu (context menu) in Windows Explorer.
In this example, the context menu (Context Menu) only when a file is selected when it is displayed, or will not be displayed.
When a file is selected, Ffilename variable will receive the file name of the file.

function TCloudUploadContextMenu.ShellExtInitialize(pidlFolder: PItemIDList;
lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
DataFormat: TFormatEtc;
StrgMedium: TStgMedium;
Buffer: array [0 .. MAX_PATH] of Char;
Result := E_FAIL;

{ Check if an object was defined }
if lpdobj = nil then

{Prepare to get information about the object}
DataFormat.cfFormat: = CF_HDROP;
DataFormat.ptd: = nil;
DataFormat.dwAspect: = DVASPECT_CONTENT;
DataFormat.lindex: = -1;
DataFormat.tymed: = TYMED_HGLOBAL;

if lpdobj.GetData(DataFormat, StrgMedium) <> S_OK then

{ The implementation now support only one file }
if DragQueryFile(StrgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
SetLength(FFileName, MAX_PATH);
DragQueryFile(StrgMedium.hGlobal, 0, @Buffer, SizeOf(Buffer));
FFileName := Buffer;
Result := NOERROR;
// Don't show the Menu if more then one file was selected
FFileName := EmptyStr;
Result := E_FAIL;

{ }


After the handle up and down the File menu (context menu handler) is initialized in IShellExtInit interface,
Windows system using IContextMenu interfaces to call (call) other ways up and down the File menu in the handle.
In this case, it calls (Call) QueryContextMenu, GetCommandString and InvokeCommand .

Up and down the File menu options (including Amazon S3 and in the Microsoft Azure) through QueryContextMenu be created method.

function TCloudUploadContextMenu.QueryContextMenu(Menu: HMENU;
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
CloudMenuItem: TMenuItemInfo;
MenuCaption: String;
SubMenu: HMENU;
uId: UINT;
{ only adding one menu CloudMenuItem, so generate the result code accordingly }
Result := MakeResult(SEVERITY_SUCCESS, 0, 3);

{ store the menu CloudMenuItem index }
FMenuItemIndex := indexMenu;

{ specify what the menu says, depending on where it was spawned }
if (uFlags = CMF_NORMAL) then // from the desktop
MenuCaption := 'Send file from Desktop to the Cloud'
else if (uFlags and CMF_VERBSONLY) = CMF_VERBSONLY then // from a shortcut
MenuCaption := 'Send file from Shourtcut to the Cloud'
else if (uFlags and CMF_EXPLORE) = CMF_EXPLORE then // from explorer
MenuCaption := 'Send file from Explorer to the Cloud'
{ fail for any other value }
Result := E_FAIL;

if Result <> E_FAIL then

SubMenu := CreatePopupMenu;

uId := idCmdFirst;
InsertMenu(SubMenu, AmazonIndex, MF_BYPOSITION, uId, TClouds[AmazonIndex]);

InsertMenu(SubMenu, AzureIndex, MF_BYPOSITION, uId, TClouds[AzureIndex]);

FillChar(CloudMenuItem, SizeOf(TMenuItemInfo), #0);
CloudMenuItem.cbSize := SizeOf(TMenuItemInfo);
CloudMenuItem.fMask := MIIM_SUBMENU or MIIM_STRING or MIIM_ID;
CloudMenuItem.fType := MFT_STRING;
CloudMenuItem.wID := FMenuItemIndex;
CloudMenuItem.hSubMenu := SubMenu;
CloudMenuItem.dwTypeData := PWideChar(MenuCaption);
CloudMenuItem.cch := Length(MenuCaption);

InsertMenuItem(Menu, indexMenu, True, CloudMenuItem);

It will show instantaneous help (prompt) information in the status bar when you glide in Windows Explorer menu item in the cloud (Cloud menu items) with the mouse. This message is defined and GetCommandString realization method.

function TCloudUploadContextMenu.GetCommandString(idCmd: UINT_PTR; uFlags: UINT;

pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;

{ Set help string on the Explorer status bar when the menu item is selected }
if (idCmd in [AmazonIndex, AzureIndex]) and (uFlags = GCS_HELPTEXT) then
StrLCopy(PWideChar(pszName), PWideChar('Copy the selected file to ' +
TClouds[idCmd]), cchMax);
Result := NOERROR;


When the user clicks on a menu item cloud (Cloud menu items) in a particular time, InvokeCommand method will be called (call) and a start uploading selected files to the target process on the cloud (Cloud).
In this way, we already have the file name, lpici based on this parameter, we can tell which menu item the user clicked.

function TCloudUploadContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
Item: Word;
Result := E_FAIL;

if HiWord(Integer(lpici.lpVerb)) <> 0 then

{ if the index matches the index for the menu, show the cloud options }
Item := LoWord(Integer(lpici.lpVerb));

if Item in [AmazonIndex, AzureIndex] then
Upload(lpici.HWND, Item, FFileName);
on E: Exception do
MessageBox(lpici.hwnd, PWideChar(E.Message), 'Cloud Upload', MB_ICONERROR);

Result := NOERROR;


To ensure that when CloudUpload is loaded, the COM object (COM Object) is created, it is necessary to create an instance of a class factory, in particular, to create a an instance of the housing extension object (the shell extension object) of the plant instance It will be created in the initialization code.

TCloudUploadObjectFactory.Create(ComServer, TCloudUploadContextMenu, CLASS_CloudUploadContextMenu, ciMultiInstance, tmApartment);

Because of these factory will be responsible to register or unregister the DLL, when you use regsvr32.exe time, ApproveShellExtension and UpdateRegistry two methods will be called (invoked).

Sign CloudUpload shell extension application
to run as administrator cmd

Registration command:
regsvr32 <the PATH the WHERE IS LOCATED THE DLL> CloudUpload.dll

unregister command:
regsvr32 <the PATH the WHERE IS LOCATED THE DLL> CloudUpload.dll / U


Original Address:


Reproduced in: https: //

Guess you like