您现在的位置:首页 >> 硬件系统 >> 硬件系统 >> 内容

Delphi中用CopyHook实现文件夹防删除

时间:2011/9/3 15:19:22 点击:

  核心提示: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. 

作者:网络 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
  • 盒子文章(www.2ccc.com) © 2022 版权所有 All Rights Reserved.
  • 沪ICP备05001939号