library CopyHook;
uses
ComServ,
CopyMain in ‘CopyMain.pas‘;
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$$$$R *.TLB}
{$$$$R *.RES}
begin
end.
CopyMain.pas
unit CopyMain;
interface
uses Windows, ComObj, ShlObj;
type
TCopyHook = class(TComObject,
ICopyHook)
protected
function CopyCallback(Wnd:
HWND; wFunc, wFlags: UINT;
pszSrcFile: PAnsiChar;
dwSrcAttribs: DWORD;
pszDestFile: PAnsiChar;
dwDestAttribs: DWORD): UINT;
stdcall;
end;
TCopyHookFactory = class
(TComObjectFactory)
protected
function GetProgID: string;
override;
procedure
ApproveShellExtension(Register:
Boolean; const ClsID: string);
virtual;
public
procedure *Registry(Register:
Boolean); override;
end;
implementation
uses ComServ, SysUtils, Registry;
{ TCopyHook }
//file://当Windows外壳程序执行文
件夹或者打印机端口操作时，
CopyCallBack
//file://方法就会被调用。
function
TCopyHook.CopyCallback(Wnd:
HWND; wFunc, wFlags: UINT;
pszSrcFile: PAnsiChar;
dwSrcAttribs: DWORD;
pszDestFile: PAnsiChar;
dwDestAttribs: DWORD): UINT;
const
FO_COPY = 2;
FO_* = 3;
FO_MOVE = 1;
FO_RENAME = 4;
var
sOp:string;
begin
Case wFunc of
FO_COPY: sOp:=format(‘你确定要
将 %s 拷贝到 %s 吗？‘,
[pszSrcFile,pszDestFile]);
FO_*: sOp:=format(‘你确定要将
%s 删除吗？‘,);
FO_MOVE: sOp:=format(‘你确定
要将 %s 转移到 %s 吗？‘,
[pszSrcFile,pszDestFile]);
FO_RENAME: sOp:=format(‘你确
定要将 %s 重命名为 %s 吗？‘,
[pszSrcFile,pszDestFile]);
else
sOp:=format(‘无法识别的操作代码
%d‘,);
end;
// 提示，让用户决定是否执行操作
Result := MessageBox(Wnd,
PChar(sOp),
‘文件挂钩演示‘,
MB_YESNOCANCEL);
end;
{ TCopyHookFactory }
function
TCopyHookFactory.GetProgID:
string;
begin
Result := ‘‘;
end;
procedure
TCopyHookFactory.*Registry
(Register: Boolean);
var
ClsID: string;
begin
ClsID := GUIDToString(ClassID);
inherited *Registry(Register);
ApproveShellExtension(Register,
ClsID);
if Register then
// file://将clsid 加入到注册表的
CopyHookHandlers中
*RegKey(‘directory\shellex
\CopyHookHandlers\‘ +
ClassName, ‘‘,
ClsID)
else
*RegKey(‘directory\shellex
\CopyHookHandlers\‘ +
ClassName);
end;
procedure TCopyHookFactory.
ApproveShellExtension(Register:
Boolean;
const ClsID: string);
const
SApproveKey = ‘SOFTWARE
\Microsoft\Windows
\CurrentVersion\Shell Extensions
\Approved‘;
begin
with TRegistry.* do
try
RootKey :=
HKEY_LOCAL_MACHINE;
if not OpenKey(SApproveKey,
True) then Exit;
if Register then WriteString
(ClsID, Description)
else *Value(ClsID);
finally
Free;
end;
end;
const
CLSID_CopyHook: TGUID =
‘{66CD5F60-A044-11D0-
A9BF-00A024E3867F}‘;
LIBID_CopyHook: TGUID =
‘{D2F531A0-0861-11D2-
AE5C-74640BC10000}‘;
initialization
TCopyHookFactory.*
(ComServer, TCopyHook,
CLSID_CopyHook,
‘CR_CopyHook‘, ‘文件操作挂钩演
示‘,ciMultiInstance,
tmApartment);end.