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;
var
DataFormat: TFormatEtc;
StrgMedium: TStgMedium;
Buffer: array [0 .. MAX_PATH] of Char;
begin
Result := E_FAIL;
{ Check if an object was defined }
if lpdobj = nil then
Exit;
{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
Exit;
{ The implementation now support only one file }
if DragQueryFile(StrgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
begin
SetLength(FFileName, MAX_PATH);
DragQueryFile(StrgMedium.hGlobal, 0, @Buffer, SizeOf(Buffer));
FFileName := Buffer;
Result := NOERROR;
end
else
begin
// Don't show the Menu if more then one file was selected
FFileName := EmptyStr;
Result := E_FAIL;
end;
{ http://msdn.microsoft.com/en-us/library/ms693491(v=vs.85).aspx }
ReleaseStgMedium(StrgMedium);
end;
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;
var
CloudMenuItem: TMenuItemInfo;
MenuCaption: String;
SubMenu: HMENU;
uId: UINT;
begin
{ 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'
else
{ fail for any other value }
Result := E_FAIL;
if Result <> E_FAIL then
begin
SubMenu := CreatePopupMenu;
uId := idCmdFirst;
InsertMenu(SubMenu, AmazonIndex, MF_BYPOSITION, uId, TClouds[AmazonIndex]);
Inc(uId);
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);
end;
end;
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;
begin
Result := E_INVALIDARG;
{ Set help string on the Explorer status bar when the menu item is selected }
if (idCmd in [AmazonIndex, AzureIndex]) and (uFlags = GCS_HELPTEXT) then
begin
StrLCopy(PWideChar(pszName), PWideChar('Copy the selected file to ' +
TClouds[idCmd]), cchMax);
Result := NOERROR;
end;
end;
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;
var
Item: Word;
begin
Result := E_FAIL;
if HiWord(Integer(lpici.lpVerb)) <> 0 then
Exit;
{ if the index matches the index for the menu, show the cloud options }
Item := LoWord(Integer(lpici.lpVerb));
if Item in [AmazonIndex, AzureIndex] then
begin
try
Upload(lpici.HWND, Item, FFileName);
except
on E: Exception do
MessageBox(lpici.hwnd, PWideChar(E.Message), 'Cloud Upload', MB_ICONERROR);
end;
Result := NOERROR;
end;
end;
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.
initialization
TCloudUploadObjectFactory.Create(ComServer, TCloudUploadContextMenu, CLASS_CloudUploadContextMenu, ciMultiInstance, tmApartment);
end.
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: http://www.andreanolanusse.com/en/shell-extension-for-windows-32-bit-and-64-bit-with-delphi-xe2/
Reproduced in: https: //www.cnblogs.com/yzryc/p/6408998.html