怎么样具体实现添加属性页

Question

怎么利用Property sheet handlers实现添加自定义的属性页
常规下.exe的文件会有"常规,兼容性,安全,摘要"等信息,比如我想在上面添加一个自己的属性页:文件名.
请问怎么样实现,最好给出代码,谢谢

Answer 1

shell 扩展详情

Answer 2

unit  unit  Unit1;
  
  interface
  
  uses
      Windows,  Sysutils,  Messages,  Registry,  Shellapi,  ActiveX,  Classes,  ComObj,  Shlobj,  ComServ,  MMSystem，Dialogs,  Commctrl;
  
  type
      TPropSheetExt  =  class(TComObject,  IShellExtInit,  IShellPropSheetExt)
      private
          TempFile:string;//定义一个文件名传递变量。
      protected
          {Declare  IShellExtInit  methods  here}
          function  IShellExtInit.Initialize=MyInitialize;
        //进行初始化代码的转移，使系统执行初始化操作时调用自己的代码//
          function  MyInitialize(pidlFolder:  PItemIDList;  lpdobj:  IDataObject;
                    hKeyProgID:  HKEY):  HResult;  stdcall;
        //Initialize的方法定义在shlobj.pas文件中//
          {Declare  IShellPropSheetExt  methods  here}
          function  AddPages(lpfnAddPage:  TFNAddPropSheetPage;  lParam:  LPARAM):  HResult;  stdcall;
          function  ReplacePage(uPageID:  UINT;  lpfnReplaceWith:  TFNAddPropSheetPage;
              lParam:  LPARAM):  HResult;  stdcall;
          //IShellPropSheetExt的方法定义在shlobj.pas文件中//
      end;
  type//每一个COM对象必须有一个类工厂，用于在服务器端实现COM对象//
        TPropSheetExtFactory=class(TComObjectFactory)
        public
              procedure  UpdateRegistry(Register:  Boolean);  override;
        end;
  const
      Class_PropSheetExt:  TGUID  =  '{2356E2F2-419F-11D4-9376-5254AB159E5E}';
    //GUID值系统唯一产生// 
var
    Error,  dwFlags:  Longint;
      DeviceID  :  Word;
  
  implementation
  //---------------------------------------------------------------------------------//
  function  PropCallback(hWndDlg:  HWnd;  Msg:  Integer;
        var  PPSP:  TPropSheetPage):  Integer;  stdcall;
  begin
        case  Msg  of
              PSPCB_RELEASE:  if  ppsp.lparam<>  0  then    TPropSheetExt(ppsp.lparam)._release;
        end;//使用完接口后通过调用_release来减少对接口的引用。//
      result:=1;
  end;
  //-------------------------------------------------------------------------------//
  function  DialogProc(hwndDlg:  HWnd;  Msg:  UINT;  wParam:  wParam;
        lParam:  LPARAM):  Bool;  stdcall;//该回调函数用于处理属性页的消息//
  var
        MyPropsheetExt:  TPropSheetExt;
        filename:  string;
      //  displayName  :  string;
      //  buffer:  array[0..255]of  char;
        //SheetHWnd:  HWnd;
  begin
        result:=false;
        try
              if  Msg=WM_INITDIALOG  then//该消息用于初始化页面显示信息// 
                                            begin
                  MyPropSheetExt:=TPropSheetExt(PPropSheetPage(lParam)^.lParam);
                  SetWindowLong(hwndDlg,  DWL_USER,  integer(MyPropSheetExt));
                    SetDlgItemText(hwndDlg,  100,  PChar(ExtractFileName(MyPropSheetExt.TempFile)));
                    SetWindowLong(hwndDlg,  DWL_MSGRESULT,  0);
                    Result:=TRUE;
                                                  end;
                if(Msg=WM_COMMAND)then//该消息用于响应用户在属性页上的按扭事件// 
                            begin
                  if  Lo(wParam)=101  then//101为资源文件上IDC_PUSHBUTTON1的标示符// 
                      showmessage('谢谢你使用');
                            end  ;
        except//在处理属性页面失效时显示出错信息//
              on  e:  exception  do
                begin
                    e.message:='PropExtDlgProc  '+e.message;
                    messagebox(0,  pchar(e.message),  'error',  mb_ok);
              end;
        end;
  end;
  //------------------------------------------------------------------------------------//
  
  
  procedure  TPropSheetExtFactory.UpdateRegistry(Register:  Boolean);
  var//注册属性页以便同指定的文件关联//
      MyClassID:  string;
  begin
        inherited  UpdateRegistry(Register);
        if  Register  then
        begin
            MyClassID:=GUIDToString(Class_PropSheetExt);
            with  TRegistry.Create  do
            try
                RootKey:=HKEY_CLASSES_ROOT;
                createregkey('.bbs','','sunhangdong');
                createregkey('sunhangdong\shellex\PropertySheetHandlers\'+classname,'',MyClassID);
            finally
              Free;
            end;
        end
        else
        begin
        deleteregkey('sunhangdong\shellex\PropertySheetHandlers\'+classname);
        end;
  end;
  
  //----------------------------------------------------------------------------------------//
  {  TPropSheetExt  }
  
  function  TPropSheetExt.AddPages(lpfnAddPage:  TFNADDPROPSHEETPAGE;
      lParam:  LPARAM):  HResult;
  var//初始化快捷菜单//
        TProp:  TPropSheetPage;
        HProP:  HPropSheetPage;
  begin
        result:=E_FAIL;
        try
              TProp.dwSize:=SizeOf(TProp);
              TProp.dwFlags:=PSP_USEREFPARENT  or  PSP_USETITLE  or  PSP_USECALLBACK;
              TProp.hInstance:=hInstance;
              TProp.pszTemplate:=MakeIntResource(1);//属性页的标示符//
              TProp.pszTitle:='特别消息';//属性页标题
              Tprop.pfnDlgProc:=@DialogProc;
              TProp.pfnCallBack:=@PropCallback;
            //设立回调函数//
              TProp.pcRefParent:[email protected];
  //把扩展对象引用计数赋予pcRefParent对象，以防止属性页在显示时就被删除//
              TProp.lParam:=integer(self);//传递对象指针//
              HProP:=CreatePropertySheetPage(TProp);
              if  HPSP<>nil  then  begin
                    if  not  lpfnAddPage(HProP,  lParam)then  begin
                          DestroyPropertySheetPage(HProP);
                    end  else  begin
                          _addref;//增加引用计数，以防止方法不在作用范围时，被系统释放//
                          result:=S_OK;
                    end
              end
        except
              on  e:  exception  do  begin
                    e.message:='AddPages  '+e.message;
                    messagebox(0,  pchar(e.message),  'error',  mb_ok);
              end;
        end;
  end;
  //------------------------------------------------------------------------------------------//
  function  TPropSheetExt.ReplacePage(uPageID:  UINT;
      lpfnReplaceWith:  TFNADDPROPSHEETPAGE;  lParam:  LPARAM):  HResult;
  begin//当属性页和控制面版相关时，系统会调用该方法来替换属性页，在本程序中无用，但必须定义//
      Result:=E_NOTIMPL;
  end;
  //-----------------------------------------------------------------------------------------//
  function  TPropSheetExt.MyInitialize(pidlFolder:  PItemIDList;
      lpdobj:  IDataObject;  hKeyProgID:  HKEY):  HResult;
  var//实现初始化快捷菜单处理器//
        MyStgMedium:  TStgMedium;
        MyFormatEtc:  TFormatEtc;
        Filelength:  array[0..MAX_PATH+1]of  Char;
        count:  integer;
  begin
        Result:=E_FAIL;
        if(lpdobj=nil)then  begin
              Result:=E_INVALIDARG;//如果COM服务器没有对象提供//
              messagebox(0,  '1',  'error',  mb_ok);
              Exit;
        end;
  
        with  MyFormatEtc  do  begin//在用户进行数据接口的呈现时必须用此接口//
              cfFormat:=CF_HDROP;
              ptd:=nil;
              dwAspect:=DVASPECT_CONTENT;
              lindex:=-1;
              tymed:=TYMED_HGLOBAL;
        end;
        Result:=lpdobj.GetData(MyFormatEtc,  MyStgMedium);
        if  Failed(Result)then
              Exit;//如果从数据接口无法得到数据//
        count:=DragQueryFile(Mystgmedium.hGlobal,  $FFFFFFFF,  nil,  0);//count返回的是用户选择的文件数//
        if  count=1  then//用于确保用户只选择了一个文件// 
            begin
            Result:=NOERROR;
            DragQueryFile(Mystgmedium.hGlobal,  0,  FileLength,  MAX_PATH);
              TempFile:=strpas(FileLength);
              end;
        ReleaseStgMedium(MyStgMedium);
  end;
  //--------------------------------------------------------------------------------------------//
  initialization
      TPropSheetExtFactory.Create(ComServer,  TPropSheetExt,  Class_PropSheetExt,
          'PropSheetExt',  '',  ciMultiInstance,  tmApartment);
  end. 
参自:http://www.it222.cn/softedu/g/10546.html

Answer 3

2楼提供的代码对检索资源得到的信息是固定的,我如何动态取得比如:文件名等信息呢?
ra.rc代码如下 #define  DIALOG_1  1        //资源文件标示符
  #define  IDC_PUSHBUTTON1  101    //按扭标示符
  
  DIALOG_1  DIALOG  6,  15,  161,  127
  STYLE  WS_POPUP  |  WS_VISIBLE  |  WS_CAPTION  |  WS_SYSMENU  |  WS_THICKFRAME  |  WS_MINIMIZEBOX  |  WS_MAXIMIZEBOX
  CAPTION  "DIALOG_1"
  FONT  8,  "MS  Sans  Serif"
  {
    LTEXT  "作者",  -1,  9,  15,  47,  18   //比如我这要换成文件名.........
    LTEXT  "时间",  -1,  8,  38,  44,  17
    LTEXT  "孙航东",  -1,  79,  17,  64,  20
    LTEXT  "2002.04.26",  -1,  80,  41,  60,  18
    PUSHBUTTON  "Button",  IDC_PUSHBUTTON1,  79,  88,  53,  17
  }