Mega Code Archive
How to create a drop handler for a file type
<![CDATA[
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.
]]>