核心提示：libraryCopyHook; uses ComServ, CopyMainin’CopyMain.pas’; exports DllGetClassObject, DllCanUnloadNow,...
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 UpdateRegistry(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_DELETE = 3;
FO_MOVE = 1;
FO_RENAME = 4;
var
sOp:string;
begin
Case wFunc of
FO_COPY: sOp:=format(’你确定要将 %s 拷贝到 %s 吗？’,[pszSrcFile,pszDestFile]);
FO_DELETE: sOp:=format(’你确定要将 %s 删除吗？’,[pszSrcFile]);
FO_MOVE: sOp:=format(’你确定要将 %s 转移到 %s 吗？’,[pszSrcFile,pszDestFile]);
FO_RENAME: sOp:=format(’你确定要将 %s 重命名为 %s 吗？’,[pszSrcFile,pszDestFile]);
else
sOp:=format(’无法识别的操作代码 %d’,[wFlags]);
end;
// 提示，让用户决定是否执行操作
Result := MessageBox(Wnd, PChar(sOp),
’文件挂钩演示’, MB_YESNOCANCEL);
end;
{ TCopyHookFactory }
function TCopyHookFactory.GetProgID: string;
begin
Result := ’’;
end;
procedure TCopyHookFactory.UpdateRegistry(Register: Boolean);
var
ClsID: string;
begin
ClsID := GUIDToString(ClassID);
inherited UpdateRegistry(Register);
ApproveShellExtension(Register, ClsID);
if Register then
// file://将clsid 加入到注册表的CopyHookHandlers中
CreateRegKey(’directory\shellex\CopyHookHandlers\’ + ClassName, ’’,
ClsID)
else
DeleteRegKey(’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.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if not OpenKey(SApproveKey, True) then Exit;
if Register then WriteString(ClsID, Description)
else DeleteValue(ClsID);
finally
Free;
end;
end;
const
CLSID_CopyHook: TGUID = ’{66CD5F60-A044-11D0-A9BF-00A024E3867F}’;
LIBID_CopyHook: TGUID = ’{D2F531A0-0861-11D2-AE5C-74640BC10000}’;
initialization
TCopyHookFactory.Create(ComServer, TCopyHook, CLSID_CopyHook,
’CR_CopyHook’, ’文件操作挂钩演示’,ciMultiInstance, tmApartment);
end.
