How-to-create-a-drop-handler-for-a-file-type


            Title: How to create a drop handler for a file type?
Question: I want to launch an action when I drop files on a file type associated to my appllication (just as WinZip does with zip archives)
Answer:
I'm sorry for my english ;-)
You know how WinZip behaves with zip files: it allows to add files to archive with a simple drag and drop operation on zip files. How they do this job? They did it through a shell extension. I won't explain here what a shell extension is, so let's say you already know its meaning; if you have just an idea only, you can open the folder \Demos\ActiveX\ShellExt of Delphi: there you will find a good example that shows how to associate a context menu to a file type (just as WinZip does), but what is if I need to transform a file into a "drop target"? A drop target can accept drag and drop operations and can fire an event when anything is dropped on it. Let's think to WinZip, again: if drag a file over a zip archive, WinZip adds it to the same archive that you choose as the drop target. This job also is done via a shell extension.
We can start opening the "ContMenu.dpr" project that you see in the ShellExt folder of Delphi, then we have to open the "contextm.pas" unit. We can turn a file type into a drop target with some modifications in this last unit.
Let's see the entire unit how it appears after I made the required changes (follow the comments in the unit).
(* ------------ BEGINNING OF CODE ------------- *)
unit ContextM;
interface
uses
 Windows, ActiveX, ComObj, ShlObj;
type
// We must add IUnknown, IPersitFile and IDropTarget, and we must remove IContextMenu interfaces
// We wanto to change TContextMenu into TDropHandler for convenience
 TDropHandler = class(TComObject, IShellExtInit, IUnknown, IPersistFile, IDropTarget)
	
 private
 FFileName: array[0..MAX_PATH] of Char;
 Nfiles: integer;
 FFiles: array[0..max_PATH] of PChar;
 dest: string;
 protected
// The {IContextMenu} section has been removed because we won't use that interface...
 { IShellExtInit }
 function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
 function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
 hKeyProgID: HKEY): HResult; stdcall;
// ... but we need to add the following two sections
 { IPersistFile }
 function IsDirty: HResult; stdcall;
 function Load(pszFileName: POleStr; dwMode: Longint): HResult; stdcall;
 function Save(pszFileName: POleStr; fRemember: BOOL): HResult; stdcall;
 function SaveCompleted(pszFileName: POleStr): HResult; stdcall;
 function GetCurFile(out pszFileName: POleStr): HResult; stdcall;
 function GetClassID(out classID: TCLSID): HResult; stdcall;
 { IDropTarget }
 function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
 function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
 function DragLeave: HResult; stdcall;
 function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
 end;
const
// Let's change Class_ContextMenu into Class_DropHandler for convenience:
 Class_DropHandler: TGUID = '{574AF620-AC3D-11D4-86B6-92AD195EF923}';
// You need to assign a different GUID for this handler, so you must click SHIFT+CTRL+G to obtain a new GUID to copy above.
implementation
uses ComServ, SysUtils, ShellApi, Registry;
function TDropHandler.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;
// Render the data referenced by the IDataObject pointer to an HGLOBAL
// storage medium in CF_HDROP format.
Result := lpdobj.GetData(FormatEtc, StgMedium);
if Failed(Result) then Exit;
Result := NOERROR;
ReleaseStgMedium(StgMedium);
end;
// Now we have to assign some job to the new functions that we must add because we
// declared them before in this same unit. You may think that having to leave
// some of these function only with a line of code is useless: well, you're wrong.
// Without these "silly" function the dll won't work
function TDropHandler.IsDirty: HResult; 
begin
 Result := E_NOTIMPL;
end;
function TDropHandler.Load(pszFileName: POleStr; dwMode: Integer): HResult;
begin
// Here we will retrieve the full path of the file on which other files are being dropped,
// so we will store it in the DestFile string;
 DestFile:=WideCharToString(pszFileName);
 Result := S_OK;
end;
function TDropHandler.Save(pszFileName: POleStr; fRemember: BOOL): HResult;
begin
 Result := E_NOTIMPL;
end;
function TDropHandler.SaveCompleted(pszFileName: POleStr): HResult;
begin
 Result := E_NOTIMPL;
end;
function TDropHandler.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
var
 StgMedium: TStgMedium;
 FormatEtc: TFormatEtc;
 hr: HRESULT;
begin
// Here starts the hard job
with FormatEtc do
 begin
 cfFormat := CF_HDROP;
 ptd := nil;
 dwAspect := DVASPECT_CONTENT;
 lindex := -1;
 tymed := TYMED_HGLOBAL;
 end;
hr := dataobj.QueryGetData(formatetc);
if Failed(hr) then
 begin
 // If anything is gone bad, then we won't see any drag'n'drop	
 dwEffect:=DROPEFFECT_NONE;
 Result := E_FAIL;
 Exit;
 end
 else
 begin
 // Everything is OK: we need only a drag and drop "COPY" action
 dwEffect:=DROPEFFECT_COPY;
 Result := NOERROR;
 end;
end;
function TDropHandler.DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
begin
dwEffect:=DROPEFFECT_COPY;
Result := S_OK;
end;
function TDropHandler.DragLeave: HResult; stdcall;
begin
 Result := S_OK;
end;
function TDropHandler.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
var
 StgMedium: TStgMedium;
 FormatEtc: TFormatEtc;
 hr: HRESULT;
 F: TextFile;	
begin
// This is the most important part of the unit. Files are dropped on th drop target,
// so our DLL we will do something. In this example we will write a text file
// that contains all the filenames of the dropped files.
if (dataobj = 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;
// Render the data referenced by the IDataObject pointer to an HGLOBAL
// storage medium in CF_HDROP format.
hr := dataobj.GetData(FormatEtc, StgMedium);
if Failed(hr) then Exit;
// Writes a list of dragged files: this list could be read by our app.
NFiles:=DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0); // How many file were dropped?
AssignFile(F,'C:\Windows\Desktop\DroppedFiles.txt');
Rewrite(f);
for i:=0 to nfiles-1 do
 begin
 // We are reading the list of files being dropped...
 DragQueryFile(StgMedium.hGlobal, i, FFileName , SizeOf(FFilename));
 writeln(F, FFilename);
 // If we dropped a folder we will obtain the following:
 if GetFileAttributes(FFilename)=faDirectory then writeln (f,'Folder - '+ffilename);
 end;
// Let's write on which file we dropped the other files...
writeln(f,'Drop Target - '+DestFile);
// We're finished!
CloseFile(f);
Result := NOERROR;
ReleaseStgMedium(StgMedium);
end;
function TDropHandler.GetClassID(out classID: TCLSID): HResult;
begin
 Result := E_NOTIMPL;
end;
function TDropHandler.GetCurFile(out pszFileName: POleStr): HResult;
begin
 Result := E_NOTIMPL;
end;
type
// Let's modify TContextMenuFactory into TDropHandlerFactory for convenience
 TDropHandlerFactory = class(TComObjectFactory)
 public
 procedure UpdateRegistry(Register: Boolean); override;
 end;
procedure TDropHandlerFactory.UpdateRegistry(Register: Boolean);
var
 ClassID: string;
begin
// To make this drop handler working, we must register it in the Registry.
// This code is already in the originale COntextM.pas, but we still need some changes.
 if Register then begin
 inherited UpdateRegistry(Register);
 ClassID := GUIDToString(Class_DropHandler);
// We want to transform .DPR files into drop target... 
 CreateRegKey('DelphiProject\shellex', '', '');
// ... but we must change "CreateRegKey('DelphiProject\shellex\ContextMenuHandlers', '', '');" into the following:
 CreateRegKey('DelphiProject\shellex\DropHandler', '', ClassID);
// "CreateRegKey('DelphiProject\shellex\ContextMenuHandlers\ContMenu', '', ClassID);" has been deleted
 if (Win32Platform = VER_PLATFORM_WIN32_NT) then
 with TRegistry.Create do
 try
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
 OpenKey('Approved', True);
 WriteString(ClassID, 'Delphi 4.0 Drop Handler Shell Extension Example');
 finally
 Free;
 end;
 end
 else begin
// Also, we must delete "DeleteRegKey('DelphiProject\shellex\ContextMenuHandlers\ContMenu');" 
/ and change " DeleteRegKey('DelphiProject\shellex\ContextMenuHandlers');" into the following:
 DeleteRegKey('DelphiPorject\shellex\DropHandler');
 DeleteRegKey('DelphiProject\shellex');
 inherited UpdateRegistry(Register);
 end;
end;
initialization
 TDropHandlerFactory.Create(ComServer, TDropHandler, Class_DropHandler,
 '', 'Delphi 4.0 Drop Handler Shell Extension Example', ciMultiInstance,
 tmApartment);
end.
(* ------------ END OF CODE ------------- *)
Save the unit and compile the DLL, then register it using the command line:
regsvr32 c:\windows\desktop\contmenu.dll (if you placed the dll on the desktop)
Finally, test the DLL: open a folder that contains Delphi Projects (.DPR files) and drop other files on them. The result is in a new text file on the desktop.
Files Delphi
