copyhook_unit.pas

在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码

unit CopyHook_Unit;

interface

uses Windows, ComObj, ShlObj, StdVcl;

type
  TCopyMain = 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;

function TCopyMain.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;

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
    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, TCopyMain, CLSID_CopyHook,
    'CR_CopyHook', '文件操作挂钩演示',ciMultiInstance, tmApartment);
end.