关于外壳扩展,文件夹防删除

Question

http://www.51one.net/study/Delphi/39389.html以上页面中的代码经实测，无任何效果．测试环境 DELPHI 5.0  Windows XP SP2.谁有可以工作的代码? 帮助解决问题另赠100分．

Answer 1

代码如下///////////// CopyHook.dprlibrary CopyHook;uses
  ComServ,
  CopyMain in 'CopyMain.pas';exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;{$R *.TLB}{$R *.RES}begin
end.
//////////// CopyMain.pasunit CopyMain;interfaceuses 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;implementationuses 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.

Answer 2

經過測試,我這裡完全可以!!!!編譯環境: Windows XP Sp2, Borland Delphi 2006
測試環境: Windows XP Sp2,P4 3G CPU, 1G Mem

Answer 3

楼上兄弟，注册该dll后, 删除或改名文件夹时，有提示吗

Answer 4

请问一下强哥，你的完整的代码是写在什么地方的？
这些代码都是写在一个application中的吗？还是dll中？是一个普通的dll吗？
我完全看不懂你的代码的每部分都写在什么文件中，请指教一下。

Answer 5

就两个文件．一个 .dpr,一个 .pas. 编译生成 dll可是我注册主该dll后，没发现有任何作用.

Answer 6

是不是昨天沒注冊成功?呵呵?注冊 DLL 成功的結果就是, del 一個文件夾,先是系統確認對話框,然後是自己的 HOOK 的確認對話框,很正常.

Answer 7

这个方法防止文件被删除是没作用的
CMD下用命令就能跳过Shell的监控

Answer 8

我想问一下，怎么利用shell监视进程的运行，就是说有进程运行的时候我能够得到运行的进程名？不知道用shell可不可以实现。。

Answer 9

经过测试发现，注册DLL后，有时并不能立即生效。注销再登录就生效了，当然重启也会生效。