The idea behind this scene is to hook the interface method by it's index. It's likelly if you have a table of procedures in a memory area. This is how the interface is exposed in memory. All we do is to patch this table, using madCodeHook's function hookCode(). It will place a JUMP inside the place where the entries of this table points to.
These are the methods of IFileOperation:
/* IUnknown methods */
STDMETHOD( QueryInterface )( THIS_ REFIID, void ** ) PURE;
STDMETHOD_( ULONG, AddRef )( THIS ) PURE;
STDMETHOD_( ULONG, Release )( THIS ) PURE;
/* IFileOperation methods */
STDMETHOD( Advise )( THIS_ IFileOperationProgressSink *, DWORD * ) PURE;
STDMETHOD( Unadvise )( THIS_ DWORD ) PURE;
STDMETHOD( SetOperationFlags )( THIS_ DWORD ) PURE;
STDMETHOD( SetProgressMessage )( THIS_ LPCWSTR ) PURE;
STDMETHOD( SetProgressDialog )( THIS_ IOperationsProgressDialog * ) PURE;
STDMETHOD( SetProperties )( THIS_ IPropertyChangeArray * ) PURE;
STDMETHOD( SetOwnerWindow )( THIS_ HWND ) PURE;
STDMETHOD( ApplyPropertiesToItem )( THIS_ IShellItem * ) PURE;
STDMETHOD( ApplyPropertiesToItems )( THIS_ IUnknown * ) PURE;
STDMETHOD( RenameItem )( THIS_ IShellItem *, LPCWSTR, IFileOperationProgressSink * ) PURE;
STDMETHOD( RenameItems )( THIS_ IUnknown *, LPCWSTR ) PURE;
STDMETHOD( MoveItem )( THIS_ IShellItem *, IShellItem *, LPCWSTR, IFileOperationProgressSink * ) PURE;
STDMETHOD( MoveItems )( THIS_ IUnknown *, IShellItem * ) PURE;
STDMETHOD( CopyItem )( THIS_ IShellItem *, IShellItem *, LPCWSTR, IFileOperationProgressSink * ) PURE;
STDMETHOD( CopyItems )( THIS_ IUnknown *, IShellItem * ) PURE;
STDMETHOD( DeleteItem )( THIS_ IShellItem *, IFileOperationProgressSink * ) PURE;
STDMETHOD( DeleteItems )( THIS_ IUnknown * ) PURE;
STDMETHOD( NewItem )( THIS_ IShellItem *, DWORD, LPCWSTR, LPCWSTR, IFileOperationProgressSink * ) PURE;
STDMETHOD( PerformOperations )( THIS ) PURE;
STDMETHOD( GetAnyOperationsAborted )( THIS_ BOOL * ) PURE;
Given this, all we need to do is to count how many methods we have till we find the one we want. In case we want this ones: RenameItem, RenameItems, MoveItem, MoveItems, CopyItem, CopyItems, DeleteItem and DeleteItems. As Gabriel Lopes, a friend, said on his tests, DeleteItem will aways call the base kernel32 API called DeleteFileA/W. But we are still hooking inside the interface to keep it standardized. Theier indexes are 12, 13, 14, 15, 16, 17 and 19. The interface GUID we need to look for before hooking is {3AD05575-8857-4850-9277-11B85BDB8E09}. Interface hooking is accomplished by hooking the API CoCreateInstance and comparing the GUID with that one.
All functions wich manages with more then one item, according to MSDN will receive something called PunkItems instead of only one ShellItem. This PunkItem can be a ShellItemArray or a DataObject. Those ShellItems have this method called GetDisplayName(), which will tell us the full path of the item being copied, moved or deleted. The ShellItemArray is an interfaced object with the key methods getCount() and getItemAt() that able us to walk trough the ShellItems. The DataObject itself was the one which gave me more work, basically, there is this API from shell32.dll called SHCreateShellItemArrayFromDataObject. Obvious unh? But I would never guess by my self the existence of this API. Anyway, it works and can convert the DataObject passed to DeleteItems, MoveItems and CopyItems to a ShellItem.
Another detail before we go into the code. Note that on the hooked methods there's a first param of type POINTER, which there's is not on the MSDN definitions. That's given because all method inside an interface must have somewhere in the function the "self" pointer.
Here's the code. Maybe you want to copy it to notepad or any editor for a better viewing. Ah, of course, you need to inject it in order to get other processes monitoring.
library ifo;
// Coded by Bruno Martins Stuani
// brunildo@gmail.com
// ---------------------
// You are free to use this code on any situation.
uses
SysUtils,
Classes,
Windows,
madCodeHook,
ActiveX;
{$R *.res}
type
_tagpropertykey = packed record
fmtid: TGUID;
pid: DWORD;
end;
PROPERTYKEY = _tagpropertykey;
//----------------------------------------------
// IShellItem interface declaration
//----------------------------------------------
IShellItem = interface(IUnknown)
['{43826d1e-e718-42ee-bc55-a1e261c37bfe}']
function BindToHandler(const pbc: IBindCtx; const bhid: TGUID;
const riid: TIID; out ppv): HResult; stdcall;
function GetParent(var ppsi: IShellItem): HResult; stdcall;
function GetDisplayName(sigdnName: DWORD; var ppszName: LPWSTR): HResult; stdcall;
function GetAttributes(sfgaoMask: DWORD; var psfgaoAttribs: DWORD): HResult; stdcall;
function Compare(const psi: IShellItem; hint: DWORD;
var piOrder: Integer): HResult; stdcall;
end;
//----------------------------------------------
// ISHellEnumItems interface declaration
//----------------------------------------------
IEnumShellItems = interface(IUnknown)
['{70629033-e363-4a28-a567-0db78006e6d7}']
function Next(celt: ULONG; out rgelt; pceltFetched: PLongint): HResult; stdcall;
function Skip(celt: ULONG): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out ppenum: IEnumShellItems): HResult; stdcall;
end;
//----------------------------------------------
// IShellItemArray interface declaration
//----------------------------------------------
IShellItemArray = interface(IUnknown)
['{b63ea76d-1f85-456f-a19c-48159efa858b}']
function BindToHandler(const pbc: IBindCtx; const rbhid: TGUID;
const riid: TIID; out ppvOut): HResult; stdcall;
function GetPropertyStore(flags: DWORD; const riid: TIID; out ppv): HResult; stdcall;
function GetPropertyDescriptionList(const keyType: PropertyKey;
const riid: TIID; out ppv): HResult; stdcall;
function GetAttributes(dwAttribFlags: DWORD; sfgaoMask: DWORD;
var psfgaoAttribs: DWORD): HResult; stdcall;
function GetCount(var pdwNumItems: DWORD): HResult; stdcall;
function GetItemAt(dwIndex: DWORD; var ppsi: IShellItem): HResult; stdcall;
function EnumItems(var ppenumShellItems: IEnumShellItems): HResult; stdcall;
end;
//----------------------------------------------
// SHCreateShellItemArrayFromDataObject declaration
//----------------------------------------------
TSHCreateShellItemArrayFromDataObject = function(pdo: IDataObject;
const riid: TGUID; ppv: Pointer): HRESULT; StdCall;
//----------------------------------------------
// Operations done by IFileOperation
//----------------------------------------------
TFileOperation = (opCopy, opMove, opDelete, opRename);
var
//---------------------------------------------------------------------------
// Hook's nextProcs
//---------------------------------------------------------------------------
CoCreateInstance_np: function(const clsid: TCLSID; unkOuter: Pointer;
dwClsContext: Longint; const iid: TIID; pv: Pointer): HResult; stdcall;
CopyItems_np: function( p: POinter; punkItems: IUnknown;
psiDestinationFolder: IShellItem ): HRESULT; stdcall;
CopyItem_np: function( p: POinter; psiitem: IShellItem;
psiDestinationFolder: IShellItem; pszCopyName: LPCWSTR;
pfopsItem: Pointer ): HRESULT; stdcall;
DeleteItem_np: function( p: POinter; psiItem: IShellItem; pfopsItem:
Pointer ): HRESULT; stdcall;
DeleteItems_np: function( p: POinter; punkItems: IUnknown ): HRESULT; stdcall;
MoveItems_np: function( p: POinter; punkItems: IUnknown;
psiDestinationFolder: IShellItem ): HRESULT; stdcall;
MoveItem_np: function( p: POinter; psiitem: IShellItem;
psiDestinationFolder: IShellItem; pszCopyName: LPCWSTR;
pfopsItem: Pointer ): HRESULT; stdcall;
RenameItem_np: function( p: Pointer; psiItem: IShellItem; pszNewName:
LPCWSTR; pfopsItem: Pointer ): HRESULT; stdcall;
RenameItems_np: function( p: Pointer; punkItems: IUnknown; pszNewName:
LPCWSTR ): HRESULT; stdcall;
const
IID_ShellItemArray : TGUID = '{b63ea76d-1f85-456f-a19c-48159efa858b}';
IID_DataObject: TGUID = '{0000010E-0000-0000-C000-000000000046}';
SIGDN_FILESYSPATH = $80058000;
SIGDN_NORMALDISPLAY = $00000000;
//----------------------------------------------
// Little function for string to PWideChar convertion
//----------------------------------------------
function PWideToString( wide: PWideChar ): string;
var
pAtual: Pointer;
begin
pAtual := wide;
Result := '';
// A PWideChar ends when a #0#0 is found. 2 bytes, then we can
// typecast for a Word comparasion
while PWord( pAtual )^ <> 0 do
begin
// We use only the first byte. Jump 2.
Result := Result + Chr( PByte( pAtual )^ );
pAtual := Pointer( Integer( pAtual ) + 2 );
end;
end;
//----------------------------------------------
// Convert and returns as true, to be used on one line IF
//----------------------------------------------
function ConvertWtoS( wide: PWideChar; var output: string ): Boolean;
begin
Result := True;
output := PWideToString( wide );
end;
//----------------------------------------------
// All one item operation will step here.
//----------------------------------------------
function canPerform_ShellItem( item, dest: IShellItem; secParam: LPCWSTR;
op: TFileOperation ): Boolean;
var
itemPath, destPath: PWideChar;
sItemPath, sDestPath: string;
begin
Result := True;
if Item.GetDisplayName( SIGDN_FILESYSPATH, itemPath ) = S_OK then
begin
// Extract the origin file path
sItemPath := PWideToString( itemPath );
// For deletion, there's no need for destiny
if op <> opDelete then
begin
// There's destiny
if ( dest <> nil ) and (dest.GetDisplayName(
SIGDN_FILESYSPATH, destPath ) = S_OK) then
// Transforms the string including a path delimiter
sDestPath := IncludeTrailingPathDelimiter( PWideToString( destPath ) )
else sDestPath := IncludeTrailingPathDelimiter( ExtractFilePath( sItemPath ) );
// If there's no destiny, we'll use the origin
if secParam = nil then
sDestPath := sDestPath + ExtractFileName( sItemPath )
else sDestPath := sDestPath + PWideToString( secParam );
end;
case op of
opCopy:
// Shows a messageBox
Result := MessageBoxA( 0, PChar( 'Copying from: ' + sItemPath + #13#10 + 'to: ' + sDestPath ),'Allow?', MB_YESNO ) = ID_YES;
opMove :
// Shows a messageBox
Result := MessageBoxA( 0, PChar( 'Moving from: ' + sItemPath + #13#10 + 'to: ' + sDestPath ),'Allow?', MB_YESNO ) = ID_YES;
opDelete:
// Shows a messageBox
Result := MessageBoxA( 0, PChar( 'Deleteing file: ' + sItemPath ),'Allow?', MB_YESNO ) = ID_YES;
opRename:
// Shows a messageBox
Result := MessageBoxA( 0, PChar( 'Renaming from: ' + sItemPath + #13#10 + 'to: ' + sDestPath ),'Allow?', MB_YESNO ) = ID_YES;
end;
end;
end;
//-------------------------------------
// Many items performing method
//-------------------------------------
function canPerform_ShellItemArray( itemArr: IShellItemArray; dest: IShellItem;
op: TFileOperation ): Boolean;
var
nTotal: Cardinal;
nAux: Integer;
shellItem: IShellItem;
begin
Result := True;
// Is a valid array?
if itemArr.GetCount( nTotal ) = S_OK then
begin
for nAux := 0 to nTotal -1 do
begin
// Extract the current item
if itemArr.GetItemAt( nAux, shellItem ) = S_OK then
begin
// check if the operation can be performed
Result := Result and canPerform_ShellItem( shellItem, dest, nil, op );
// In abortion case, break
if not Result then
Break;
end;
end;
end;
end;
//-------------------------------------
// Many items performing method, trough IDataObject
//-------------------------------------
function canPerform_DataObject( dataObject: IDataObject; dest: IShellItem;
op: TFileOperation ): Boolean;
var
SHConverteFromData: TSHCreateShellItemArrayFromDataObject;
shellItemArr: IShellItemArray;
begin
Result := True;
// Windows Vista has implemented a function to convert an
// IDataObject to ISHellItemArray. We'll use it.
@SHConverteFromData := GetProcAddress( GetModuleHandle('shell32.dll'),
'SHCreateShellItemArrayFromDataObject' );
// Functoun found, use it.
if (@SHConverteFromData <> nil) and ( SHConverteFromData(
dataObject, IID_ShellItemArray, @shellItemArr ) = S_OK ) then
begin
// Perform the item now.
Result := canPerform_ShellItemArray( shellItemArr, dest, op );
end;
end;
//------------------------------------
// Many items performing method, trough punkData
//------------------------------------
function canPerform_PunkItem( punkItems: IUnknown; dest: IShellItem;
op: TFileOperation ): Boolean;
var
shellItemArr: IShellItemArray;
dataObject: IDataObject;
begin
Result := True;
if punkItems.QueryInterface( IID_ShellItemArray, shellItemArr ) = S_OK then
// If we have a ShellItemArr, check directly
result := canPerform_ShellItemArray( shellItemArr, dest, op )
// In case of IDataObject, convert to IShellItemArray
else if punkItems.QueryInterface( IID_DataObject, dataObject ) = S_OK then
result := canPerform_DataObject( dataObject, dest, op );
end;
//------------------------------------------
// Given an interface pointer, find out the position by it's index
//------------------------------------------
function GetInterfaceMethod(const intf; methodIndex: dword) : pointer;
begin
result := pointer(pointer(dword(pointer(intf)^) + methodIndex * sizeOf(cardinal))^);
end;
//-----------------------------
// DeleteItems callBack
//-----------------------------
function DeleteItems_cb( p: POinter; punkItems: IUnknown ): HRESULT; stdcall;
begin
if canPerform_PunkItem( punkItems, nil, opDelete ) then
Result := deleteItems_np( p, punkItems )
else Result := E_ABORT;
end;
function DeleteItem_cb( p: POinter; psiItem: IShellItem;
pfopsItem: Pointer ): HRESULT; stdcall;
begin
if canPerform_ShellItem( psiItem, nil, nil, opDelete ) then
Result := deleteItem_np( p, psiItem, pfopsItem )
else Result := E_ABORT;
end;
function CopyItem_cb( p: POinter; psiItem: IShellItem; psiDestinationFolder:
IShellItem; pszCopyName: LPCWSTR; pfopsItem: Pointer ): HRESULT; stdcall;
begin
if canPerform_ShellItem( psiItem, psiDestinationFolder, pszCopyName, opCopy ) then
Result := CopyItem_np( p, psiItem, psiDestinationFolder, pszCopyName,
pfopsItem )
else Result := E_ABORT;
end;
function CopyItems_cb( p: POinter; punkItems: IUnknown; psiDestinationFolder:
IShellItem ): HRESULT; stdcall;
begin
if canPerform_PunkItem( punkItems, psiDestinationFolder, opCopy ) then
Result := CopyItems_np( p, punkItems, psiDestinationFolder )
else Result := E_ABORT;
end;
function MoveItem_cb( p: POinter; psiItem: IShellItem; psiDestinationFolder:
IShellItem; pszCopyName: LPCWSTR; pfopsItem: Pointer ): HRESULT; stdcall;
begin
if canPerform_ShellItem( psiItem, psiDestinationFolder, pszCopyName, opMove ) then
Result := MoveItem_np( p, psiItem, psiDestinationFolder, pszCopyName,
pfopsItem )
else Result := E_ABORT;
end;
function MoveItems_cb( p: POinter; punkItems: IUnknown; psiDestinationFolder:
IShellItem ): HRESULT; stdcall;
begin
if canPerform_PunkItem( punkItems, psiDestinationFolder, opMove ) then
Result := MoveItems_np( p, punkItems, psiDestinationFolder )
else Result := E_ABORT;
end;
function RenameItem_cb( p: Pointer; psiItem: IShellItem; pszNewName:
LPCWSTR; pfopsItem: Pointer ): HRESULT; stdcall;
begin
if canPerform_ShellItem( psiItem, nil, pszNewName, opRename ) then
Result := RenameItem_np( p, psiItem, pszNewName, pfopsItem )
else Result := E_ABORT;
end;
function RenameItems_cb( p: Pointer; punkItems: IUnknown; pszNewName:
LPCWSTR ): HRESULT; stdcall;
begin
if canPerform_PunkItem( punkItems, nil, opRename ) then
Result := RenameItems_np( p, punkItems, pszNewName )
else Result := E_ABORT;
end;
function CoCreateInstance_cb(const clsid: TCLSID; unkOuter: Pointer;
dwClsContext: Longint; const iid: TIID; pv: Pointer): HResult; stdcall;
const
IFileOperation_GUID = '3AD05575-8857-4850-9277-11B85BDB8E09';
procedure HookFunctionIndex( index: Integer; CallBack: Pointer; var NextProc: Pointer );
begin
// Hook if it is not yet hooked
if NextProc = nil then
HookCode( GetInterfaceMethod( pv^, index ), CallBack, NextProc );
end;
begin
// Call the original API to get it's instance pointer
Result := CoCreateInstance_np( clsid, unkOuter, dwClsContext, iid, pv );
// Check IFileOperation GUID
if pos( IFIleOperation_GUID, GUIDToString(clsid) ) <> 0 then
begin
//------------------------------------
// Hook each function of our interface
//------------------------------------
HookFunctionIndex( 12, @RenameItem_Cb , @RenameItem_np );
HookFunctionIndex( 13, @RenameItems_Cb, @RenameItems_np );
HookFunctionIndex( 14, @MoveItem_Cb , @MoveItem_np );
HookFunctionIndex( 15, @MoveItems_cb , @MoveItems_np );
HookFunctionIndex( 16, @CopyItem_cb , @CopyItem_np );
HookFunctionIndex( 17, @CopyItems_cb , @CopyItems_np );
HookFunctionIndex( 18, @DeleteItem_cb , @DeleteItem_np );
HookFunctionIndex( 19, @DeleteItems_cb, @DeleteItems_np );
end;
end;
begin
// coCreateInstance hook
HookAPI( 'ole32.dll', 'CoCreateInstance', @CoCreateInstance_cb, @CoCreateInstance_np );
end.
// Coded by Bruno Martins Stuani
// brunildo@gmail.com
// ---------------------
// You are free to use this code on any situation.
uses
SysUtils,
Classes,
Windows,
madCodeHook,
ActiveX;
{$R *.res}
type
_tagpropertykey = packed record
fmtid: TGUID;
pid: DWORD;
end;
PROPERTYKEY = _tagpropertykey;
//----------------------------------------------
// IShellItem interface declaration
//----------------------------------------------
IShellItem = interface(IUnknown)
['{43826d1e-e718-42ee-bc55-a1e261c37bfe}']
function BindToHandler(const pbc: IBindCtx; const bhid: TGUID;
const riid: TIID; out ppv): HResult; stdcall;
function GetParent(var ppsi: IShellItem): HResult; stdcall;
function GetDisplayName(sigdnName: DWORD; var ppszName: LPWSTR): HResult; stdcall;
function GetAttributes(sfgaoMask: DWORD; var psfgaoAttribs: DWORD): HResult; stdcall;
function Compare(const psi: IShellItem; hint: DWORD;
var piOrder: Integer): HResult; stdcall;
end;
//----------------------------------------------
// ISHellEnumItems interface declaration
//----------------------------------------------
IEnumShellItems = interface(IUnknown)
['{70629033-e363-4a28-a567-0db78006e6d7}']
function Next(celt: ULONG; out rgelt; pceltFetched: PLongint): HResult; stdcall;
function Skip(celt: ULONG): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out ppenum: IEnumShellItems): HResult; stdcall;
end;
//----------------------------------------------
// IShellItemArray interface declaration
//----------------------------------------------
IShellItemArray = interface(IUnknown)
['{b63ea76d-1f85-456f-a19c-48159efa858b}']
function BindToHandler(const pbc: IBindCtx; const rbhid: TGUID;
const riid: TIID; out ppvOut): HResult; stdcall;
function GetPropertyStore(flags: DWORD; const riid: TIID; out ppv): HResult; stdcall;
function GetPropertyDescriptionList(const keyType: PropertyKey;
const riid: TIID; out ppv): HResult; stdcall;
function GetAttributes(dwAttribFlags: DWORD; sfgaoMask: DWORD;
var psfgaoAttribs: DWORD): HResult; stdcall;
function GetCount(var pdwNumItems: DWORD): HResult; stdcall;
function GetItemAt(dwIndex: DWORD; var ppsi: IShellItem): HResult; stdcall;
function EnumItems(var ppenumShellItems: IEnumShellItems): HResult; stdcall;
end;
//----------------------------------------------
// SHCreateShellItemArrayFromDataObject declaration
//----------------------------------------------
TSHCreateShellItemArrayFromDataObject = function(pdo: IDataObject;
const riid: TGUID; ppv: Pointer): HRESULT; StdCall;
//----------------------------------------------
// Operations done by IFileOperation
//----------------------------------------------
TFileOperation = (opCopy, opMove, opDelete, opRename);
var
//---------------------------------------------------------------------------
// Hook's nextProcs
//---------------------------------------------------------------------------
CoCreateInstance_np: function(const clsid: TCLSID; unkOuter: Pointer;
dwClsContext: Longint; const iid: TIID; pv: Pointer): HResult; stdcall;
CopyItems_np: function( p: POinter; punkItems: IUnknown;
psiDestinationFolder: IShellItem ): HRESULT; stdcall;
CopyItem_np: function( p: POinter; psiitem: IShellItem;
psiDestinationFolder: IShellItem; pszCopyName: LPCWSTR;
pfopsItem: Pointer ): HRESULT; stdcall;
DeleteItem_np: function( p: POinter; psiItem: IShellItem; pfopsItem:
Pointer ): HRESULT; stdcall;
DeleteItems_np: function( p: POinter; punkItems: IUnknown ): HRESULT; stdcall;
MoveItems_np: function( p: POinter; punkItems: IUnknown;
psiDestinationFolder: IShellItem ): HRESULT; stdcall;
MoveItem_np: function( p: POinter; psiitem: IShellItem;
psiDestinationFolder: IShellItem; pszCopyName: LPCWSTR;
pfopsItem: Pointer ): HRESULT; stdcall;
RenameItem_np: function( p: Pointer; psiItem: IShellItem; pszNewName:
LPCWSTR; pfopsItem: Pointer ): HRESULT; stdcall;
RenameItems_np: function( p: Pointer; punkItems: IUnknown; pszNewName:
LPCWSTR ): HRESULT; stdcall;
const
IID_ShellItemArray : TGUID = '{b63ea76d-1f85-456f-a19c-48159efa858b}';
IID_DataObject: TGUID = '{0000010E-0000-0000-C000-000000000046}';
SIGDN_FILESYSPATH = $80058000;
SIGDN_NORMALDISPLAY = $00000000;
//----------------------------------------------
// Little function for string to PWideChar convertion
//----------------------------------------------
function PWideToString( wide: PWideChar ): string;
var
pAtual: Pointer;
begin
pAtual := wide;
Result := '';
// A PWideChar ends when a #0#0 is found. 2 bytes, then we can
// typecast for a Word comparasion
while PWord( pAtual )^ <> 0 do
begin
// We use only the first byte. Jump 2.
Result := Result + Chr( PByte( pAtual )^ );
pAtual := Pointer( Integer( pAtual ) + 2 );
end;
end;
//----------------------------------------------
// Convert and returns as true, to be used on one line IF
//----------------------------------------------
function ConvertWtoS( wide: PWideChar; var output: string ): Boolean;
begin
Result := True;
output := PWideToString( wide );
end;
//----------------------------------------------
// All one item operation will step here.
//----------------------------------------------
function canPerform_ShellItem( item, dest: IShellItem; secParam: LPCWSTR;
op: TFileOperation ): Boolean;
var
itemPath, destPath: PWideChar;
sItemPath, sDestPath: string;
begin
Result := True;
if Item.GetDisplayName( SIGDN_FILESYSPATH, itemPath ) = S_OK then
begin
// Extract the origin file path
sItemPath := PWideToString( itemPath );
// For deletion, there's no need for destiny
if op <> opDelete then
begin
// There's destiny
if ( dest <> nil ) and (dest.GetDisplayName(
SIGDN_FILESYSPATH, destPath ) = S_OK) then
// Transforms the string including a path delimiter
sDestPath := IncludeTrailingPathDelimiter( PWideToString( destPath ) )
else sDestPath := IncludeTrailingPathDelimiter( ExtractFilePath( sItemPath ) );
// If there's no destiny, we'll use the origin
if secParam = nil then
sDestPath := sDestPath + ExtractFileName( sItemPath )
else sDestPath := sDestPath + PWideToString( secParam );
end;
case op of
opCopy:
// Shows a messageBox
Result := MessageBoxA( 0, PChar( 'Copying from: ' + sItemPath + #13#10 + 'to: ' + sDestPath ),'Allow?', MB_YESNO ) = ID_YES;
opMove :
// Shows a messageBox
Result := MessageBoxA( 0, PChar( 'Moving from: ' + sItemPath + #13#10 + 'to: ' + sDestPath ),'Allow?', MB_YESNO ) = ID_YES;
opDelete:
// Shows a messageBox
Result := MessageBoxA( 0, PChar( 'Deleteing file: ' + sItemPath ),'Allow?', MB_YESNO ) = ID_YES;
opRename:
// Shows a messageBox
Result := MessageBoxA( 0, PChar( 'Renaming from: ' + sItemPath + #13#10 + 'to: ' + sDestPath ),'Allow?', MB_YESNO ) = ID_YES;
end;
end;
end;
//-------------------------------------
// Many items performing method
//-------------------------------------
function canPerform_ShellItemArray( itemArr: IShellItemArray; dest: IShellItem;
op: TFileOperation ): Boolean;
var
nTotal: Cardinal;
nAux: Integer;
shellItem: IShellItem;
begin
Result := True;
// Is a valid array?
if itemArr.GetCount( nTotal ) = S_OK then
begin
for nAux := 0 to nTotal -1 do
begin
// Extract the current item
if itemArr.GetItemAt( nAux, shellItem ) = S_OK then
begin
// check if the operation can be performed
Result := Result and canPerform_ShellItem( shellItem, dest, nil, op );
// In abortion case, break
if not Result then
Break;
end;
end;
end;
end;
//-------------------------------------
// Many items performing method, trough IDataObject
//-------------------------------------
function canPerform_DataObject( dataObject: IDataObject; dest: IShellItem;
op: TFileOperation ): Boolean;
var
SHConverteFromData: TSHCreateShellItemArrayFromDataObject;
shellItemArr: IShellItemArray;
begin
Result := True;
// Windows Vista has implemented a function to convert an
// IDataObject to ISHellItemArray. We'll use it.
@SHConverteFromData := GetProcAddress( GetModuleHandle('shell32.dll'),
'SHCreateShellItemArrayFromDataObject' );
// Functoun found, use it.
if (@SHConverteFromData <> nil) and ( SHConverteFromData(
dataObject, IID_ShellItemArray, @shellItemArr ) = S_OK ) then
begin
// Perform the item now.
Result := canPerform_ShellItemArray( shellItemArr, dest, op );
end;
end;
//------------------------------------
// Many items performing method, trough punkData
//------------------------------------
function canPerform_PunkItem( punkItems: IUnknown; dest: IShellItem;
op: TFileOperation ): Boolean;
var
shellItemArr: IShellItemArray;
dataObject: IDataObject;
begin
Result := True;
if punkItems.QueryInterface( IID_ShellItemArray, shellItemArr ) = S_OK then
// If we have a ShellItemArr, check directly
result := canPerform_ShellItemArray( shellItemArr, dest, op )
// In case of IDataObject, convert to IShellItemArray
else if punkItems.QueryInterface( IID_DataObject, dataObject ) = S_OK then
result := canPerform_DataObject( dataObject, dest, op );
end;
//------------------------------------------
// Given an interface pointer, find out the position by it's index
//------------------------------------------
function GetInterfaceMethod(const intf; methodIndex: dword) : pointer;
begin
result := pointer(pointer(dword(pointer(intf)^) + methodIndex * sizeOf(cardinal))^);
end;
//-----------------------------
// DeleteItems callBack
//-----------------------------
function DeleteItems_cb( p: POinter; punkItems: IUnknown ): HRESULT; stdcall;
begin
if canPerform_PunkItem( punkItems, nil, opDelete ) then
Result := deleteItems_np( p, punkItems )
else Result := E_ABORT;
end;
//-----------------------------
// DeleteItem callBack
//-----------------------------
function DeleteItem_cb( p: POinter; psiItem: IShellItem;
pfopsItem: Pointer ): HRESULT; stdcall;
begin
if canPerform_ShellItem( psiItem, nil, nil, opDelete ) then
Result := deleteItem_np( p, psiItem, pfopsItem )
else Result := E_ABORT;
end;
//-----------------------------
// CopyItem callBack
//-----------------------------
function CopyItem_cb( p: POinter; psiItem: IShellItem; psiDestinationFolder:
IShellItem; pszCopyName: LPCWSTR; pfopsItem: Pointer ): HRESULT; stdcall;
begin
if canPerform_ShellItem( psiItem, psiDestinationFolder, pszCopyName, opCopy ) then
Result := CopyItem_np( p, psiItem, psiDestinationFolder, pszCopyName,
pfopsItem )
else Result := E_ABORT;
end;
//-----------------------------
// CopyItems callBack
//-----------------------------
function CopyItems_cb( p: POinter; punkItems: IUnknown; psiDestinationFolder:
IShellItem ): HRESULT; stdcall;
begin
if canPerform_PunkItem( punkItems, psiDestinationFolder, opCopy ) then
Result := CopyItems_np( p, punkItems, psiDestinationFolder )
else Result := E_ABORT;
end;
//-----------------------------
// MoveItem callBack
//-----------------------------
function MoveItem_cb( p: POinter; psiItem: IShellItem; psiDestinationFolder:
IShellItem; pszCopyName: LPCWSTR; pfopsItem: Pointer ): HRESULT; stdcall;
begin
if canPerform_ShellItem( psiItem, psiDestinationFolder, pszCopyName, opMove ) then
Result := MoveItem_np( p, psiItem, psiDestinationFolder, pszCopyName,
pfopsItem )
else Result := E_ABORT;
end;
//-----------------------------
// MoveItems callBack
//-----------------------------
function MoveItems_cb( p: POinter; punkItems: IUnknown; psiDestinationFolder:
IShellItem ): HRESULT; stdcall;
begin
if canPerform_PunkItem( punkItems, psiDestinationFolder, opMove ) then
Result := MoveItems_np( p, punkItems, psiDestinationFolder )
else Result := E_ABORT;
end;
//-----------------------------
// RenameItem callBack
//-----------------------------
function RenameItem_cb( p: Pointer; psiItem: IShellItem; pszNewName:
LPCWSTR; pfopsItem: Pointer ): HRESULT; stdcall;
begin
if canPerform_ShellItem( psiItem, nil, pszNewName, opRename ) then
Result := RenameItem_np( p, psiItem, pszNewName, pfopsItem )
else Result := E_ABORT;
end;
//-----------------------------
// RenameItems callBack
//-----------------------------
function RenameItems_cb( p: Pointer; punkItems: IUnknown; pszNewName:
LPCWSTR ): HRESULT; stdcall;
begin
if canPerform_PunkItem( punkItems, nil, opRename ) then
Result := RenameItems_np( p, punkItems, pszNewName )
else Result := E_ABORT;
end;
//-----------------------------
// coCreateInstance callBack
//-----------------------------
function CoCreateInstance_cb(const clsid: TCLSID; unkOuter: Pointer;
dwClsContext: Longint; const iid: TIID; pv: Pointer): HResult; stdcall;
const
IFileOperation_GUID = '3AD05575-8857-4850-9277-11B85BDB8E09';
procedure HookFunctionIndex( index: Integer; CallBack: Pointer; var NextProc: Pointer );
begin
// Hook if it is not yet hooked
if NextProc = nil then
HookCode( GetInterfaceMethod( pv^, index ), CallBack, NextProc );
end;
begin
// Call the original API to get it's instance pointer
Result := CoCreateInstance_np( clsid, unkOuter, dwClsContext, iid, pv );
// Check IFileOperation GUID
if pos( IFIleOperation_GUID, GUIDToString(clsid) ) <> 0 then
begin
//------------------------------------
// Hook each function of our interface
//------------------------------------
HookFunctionIndex( 12, @RenameItem_Cb , @RenameItem_np );
HookFunctionIndex( 13, @RenameItems_Cb, @RenameItems_np );
HookFunctionIndex( 14, @MoveItem_Cb , @MoveItem_np );
HookFunctionIndex( 15, @MoveItems_cb , @MoveItems_np );
HookFunctionIndex( 16, @CopyItem_cb , @CopyItem_np );
HookFunctionIndex( 17, @CopyItems_cb , @CopyItems_np );
HookFunctionIndex( 18, @DeleteItem_cb , @DeleteItem_np );
HookFunctionIndex( 19, @DeleteItems_cb, @DeleteItems_np );
end;
end;
begin
// coCreateInstance hook
HookAPI( 'ole32.dll', 'CoCreateInstance', @CoCreateInstance_cb, @CoCreateInstance_np );
end.