copyhookimpl.pas

详细讲述如何用delphi进行com编程

unit CopyHookImpl;

interface

uses
  Windows, ComObj, ShlObj, ShellApi;

type
  TCopyHook = class(TComObject, ICopyHook)
  protected
    {Declare ICopyHook methods here}
    function CopyCallback(Wnd: HWND; wFunc, wFlags: UINT;
      pszSrcFile: PAnsiChar; dwSrcAttribs: DWORD;
      pszDestFile: PAnsiChar; dwDestAttribs: DWORD): UINT; stdcall;
  end;

  TCHClassFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

const
  Class_CopyHook: TGUID = '{9090D650-0ACE-11D3-B3DF-0040F67455FE}';

implementation

uses ComServ;

{ TCopyHook }

function TCopyHook.CopyCallback(Wnd: HWND; wFunc, wFlags: UINT;
  pszSrcFile: PAnsiChar; dwSrcAttribs: DWORD; pszDestFile: PAnsiChar;
  dwDestAttribs: DWORD): UINT;
var
  OpString: string;
begin
  case wFunc of
    FO_MOVE: OpString := ' move ';
    FO_COPY: OpString := ' copy ';
    FO_DELETE: OpString := ' delete ';
    FO_RENAME: OpString := ' rename ';
  end;

  Result := MessageBox(Wnd, PChar('Are you sure you want to ' + OpString +
    pszSrcFile + '?'), 'CopyHookDemo', MB_YESNOCANCEL);
end;

{ TCHClassFactory }

procedure TCHClassFactory.UpdateRegistry(Register: Boolean);
begin
  inherited UpdateRegistry(Register);

  if Register then begin
    CreateRegKey('directory\shellex\CopyHookHandlers\' + ClassName,
      '', GUIDToString(ClassID));
  end else begin
    DeleteRegKey('directory\shellex\CopyHookHandlers\' + ClassName);
  end;
end;

initialization
{$IFDEF VER100}
  TCHClassFactory.Create(ComServer, TCopyHook, Class_CopyHook,
    'CopyHook', '', ciMultiInstance);
{$ELSE}
  TCHClassFactory.Create(ComServer, TCopyHook, Class_CopyHook,
    'CopyHook', '', ciMultiInstance, tmApartment);
{$ENDIF}
end.