Шаг 10.
Применение COM-объектов, входящих в Windows. Создание собственных окон просмотра данных в Windows Explorer (Проводнике)

    На этом шаге мы рассмотрим создание собственных окон просмотра данных в Windows.

Windows Explorer позволяет просматривать не только файловую систему, но и данные, которые не имеют непосредственного отношения к файловой системе. Хороший пример - стандартные приложения Microsoft: "Панель управления", "Корзина", "Сетевое окружение", "Принтеры". Доступ к этим приложениям осуществляется посредством выбора соответствующей пиктограммы в Windows Explorer, при этом в правой нижней части Windows Explorer показывается содержимое соответствующих хранилищ, которые никакого отношения к реальной файловой системе не имеют.

    Для создания подобного приложения необходимо реализовать интерфейс IShellFolder, который описывает пиктограмму в Windows Explorer и интерфейс IShellView, который создает окно для просмотра данных в правом нижнем углу Windows Explorer. Оба этих интерфейса следует помещать во внутренний сервер автоматизации.

    Реализация интерфейса IShellFolder приведена ниже: 

unit IShlFold;

interface

uses Windows,ActiveX,CommCtrl,ShellAPI,RegStr,Messages,ComObj,
     ComServ,ShlObj,Classes,IShlView,Dialogs;

const
     CLSID_CustomShellFolder:TGUID='{BF029401-68CC-11D2-9B02-0000E844A5C5}';

type
    TCustomShellFolder=class(TComObject,IShellFolder,IPersistFolder)
   protected
      function IPersistFolder.Initialize=PersistInitialize;
   public
      {IShellFolder}
      function ParseDisplayName(hwndOwner:HWND;pbcReserved:Pointer; 
           lpszDisplayName:POLESTR; out pchEaten:ULONG; out ppidl:PItemIDList;
           var dwAttributes:ULONG):HResult;stdcall;
      function EnumObjects(hwndOwner:HWND;grfFlags:DWORD;
           out EnumIDList:IEnumIDList):HResult;stdcall;
      function BindToObject(pidl:PItemIDList;
           pbcReserved:Pointer;const riid:TIID;out ppvOut):HResult;stdcall;
      function BindToStorage(pidl:PItemIDList;pbcReserved:Pointer;
          const riid:TIID;out ppvObj):HResult;stdcall;
      function CompareIDs(lParam:LPARAM;
          pidl1,pidl2:PItemIDList):HResult;stdcall;
      function CreateViewObject(hwndOwner:HWND;
          const riid:TIID;out ppvOut):HResult;stdcall;
      function GetAttributesOf(cidl:UINT;var apidl:PItemIDList;
          var rgfInOut:UINT):HResult;stdcall;
      function GetUIObjectOf(hwndOwner:HWND;cidl:UINT;var apidl:PItemIDList;
          const riid:TIID;prgfInOut:Pointer;out ppvOut):HResult;stdcall;
      function GetDisplayNameOf(pidl:PItemIDList;uFlags:DWORD;
          var lpName:TStrRet):HResult;stdcall;
      function SetNameOf(hwndOwner:HWND;pidl:PItemIDList;lpszName:POLEStr;
          uFlags:DWORD;var ppidlOut:PItemIDList):HResult;stdcall;
      {Persist}
      function GetClassID(out classID:TCLSID):HResult;stdcall;
      function PersistInitialize(pidl:PItemIDList):HResult;
         virtual;stdcall;
   end;

implementation
  uses Registry;

type
    TShellFolderObjectFactory=class(TComObjectFactory)
   public
      procedure UpdateRegistry(Register:Boolean);override;
   end;
function TCustomShellFolder.ParseDisplayName(hwndOwner:HWND;pbcReserved:Pointer;
   lpszDisplayName:POLESTR; out pchEaten:ULONG; out ppidl:PItemIDList; 
   var dwAttributes:ULONG):HResult;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellFolder.EnumObjects(hwndOwner:HWND;grfFlags:DWORD;
      out EnumIDList:IEnumIDList):HResult;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellFolder.BindToObject(pidl:PItemIDList;pbcReserved:Pointer;
      const riid:TIID;out ppvOut):HResult;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellFolder.BindToStorage(pidl:PItemIDList;
      pbcReserved:Pointer;const riid:TIID;out ppvObj):HResult;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellFolder.CompareIDs(lParam:LPARAM;
      pidl1,pidl2:PItemIDList):HResult;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellFolder.CreateViewObject(hwndOwner:HWND;
    const riid:TIID;out ppvOut):HResult;
var SV:IShellView;
begin
     try
        Pointer(ppvOut):=nil;
        if IsEqualGUID(riid,IShellView) then 
        begin
          try
            SV:=CreateComObject(CLSID_CustomShellView) as IShellView;
          except
           CoInitialize(nil);
           SV:=CreateComObject(CLSID_CustomShellView) as IShellView;
         end;
        if Assigned(SV) then 
        begin
            SV._AddRef;
            Pointer(ppvOut):=Pointer(SV);
        end;
        Result:=S_OK;
      end
      else Result:=E_NOINTERFACE;
      except
           on E:EOleSysError do Result:=E.ErrorCode;
           else Result:=E_UNEXPECTED;
     end;
end;

function TCustomShellFolder.GetAttributesOf(cidl:UINT;
   var apidl:PItemIDList;var rgfInOut:UINT):HResult;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellFolder.GetUIObjectOf(hwndOwner:HWND;cidl:UINT;
   var apidl:PItemIDList;const riid:TIID;prgfInOut:Pointer;out ppvOut):HResult;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellFolder.GetDisplayNameOf(pidl:PItemIDList;uFlags:DWORD;
   var lpName:TStrRet):HResult;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellFolder.SetNameOf(hwndOwner:HWND;pidl:PItemIDList;
   lpszName:POLEStr;uFlags:DWORD;var ppidlOut:PItemIDList):HResult;
begin
     Result:=E_NOTIMPL;
end;

{IPersistFolder}

function TCustomShellFolder.GetClassID(out classID:TCLSID):HResult;
begin
     classID:=CLSID_CustomShellFolder;
     Result:=NOERROR;
end;

function TCustomShellFolder.PersistInitialize(pidl:PItemIDList):HResult;
begin
     Result:=NOERROR;
end;
{---------------------------------------------}
procedure TShellFolderObjectFactory.UpdateRegistry(Register:boolean);
var Reg:TRegistry;
    B:array[0..3] of byte;
begin
     if Register then 
     begin
       inherited UpdateRegistry(Register);
       Reg:=nil;
       try
         Reg:=TRegistry.Create;
         Reg.RootKey:=HKEY_CLASSES_ROOT;
         Reg.OpenKey('CLSID\'+GUIDToString(CLSID_CustomShellFolder)+
             '\InprocServer32',True);
         Reg.WriteString('ThreadingModel','Apartment');
         Reg.CloseKey;
         Reg.OpenKey('CLSID\'+GUIDToString(CLSID_CustomShellFolder)+
             '\ShellFolder',True);
         Reg.WriteString('','');
         B[0]:=$40;
         B[1]:=$01;
         B[2]:=$00;
         B[3]:=$20;
         Reg.WriteBinaryData('Attributes',B,sizeof(B));
         Reg.CloseKey;
         Reg.RootKey:=HKEY_LOCAL_MACHINE;
         Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\
            Desktop\Namespace\'+GUIDToString(CLSID_CustomShellFolder),True);
         Reg.WriteString('','Shell Test view object');
         Reg.CloseKey;
       finally
         Reg.Free;
       end;
    end
    else 
    begin
      Reg:=nil;
      try
       Reg:=TRegistry.Create;
       Reg.Rootkey:=HKEY_LOCAL_MACHINE;
       Reg.DeleteKey('Software\Microsoft\Windows\CurrentVersion\Explorer\
          Desktop\Namespace\'+GUIDToString(CLSID_CustomShellFolder));
       Reg.CloseKey;
     finally
       if Assigned(Reg) then Reg.Free;
  end;
  inherited UpdateRegistry(Register);
 end;
end;

initialization
  TShellFolderObjectFactory.Create(ComServer,TCustomShellFolder,
    CLSID_CustomShellFolder,'','Inprise fish viewer',ciSingleInstance);

end.

    IShellFolder содержит реализацию одного метода - CreateView. Этот метод будет вызываться всякий раз, когда в Windows Explorer (Проводнике) будет выбрана пиктограмма, которая описывается в IShellFolder. Имя этой пиктограммы будет соответствовать текстовому описанию фабрики класса TShellObjectFactory - в данном случае 'Inprise fish viewer'. В этом методе необходимо создать интерфейс IShellView и передать указатель на него.

    Следует обратить внимание на защищенный блок try-except-end. Если при создании экземпляра интерфейса возникает исключение, это значит, что запрос к интерфейсу IShellView был выполнен не из главного потока Windows Explorer (Проводник, как известно, работает в многопоточном режиме). Соответственно в нем не был произведен вызов метода CoInitialize, поэтому СОМ-объект не может быть создан. В этом случае необходимо вызвать метод CoInitialize перед созданием СОМ-объекта.

    Регистрация фабрики класса IShellFolder в системном реестре существенно отличается от регистрации стандартной фабрики класса сервера автоматизации. Прежде всего она должна поддерживать модель Apartment при работе в многопоточном режиме. Начиная с Delphi 4 это достигается добавлением еще одного параметра в конструктор фабрики класса, а в Delphi 3 надо было отдельно описать этот параметр под именем ThreadingModel в секции CLSID\<IID>\InprocServer32 (где <IID> - идентификатор созданного здесь интерфейса IShellFolder - BF029401-68CC-11D2-9B02-0000E844A5C5). Кроме того, необходимо создать подсекцию с именем ShellFolder в секции CLSID\<IID> и поместить туда двоичные данные $40 $01 $00 $20 с именем Attributes. Без установки этого значения пиктограмма не будет показываться в Windows Explorer. Помимо этого, в разделе HKEY_LOCAL_MACHINE системного реестра в секции Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\Namespace\ необходимо создать подсекцию <IID> - в данном случае BF029401-68CC-11D2-9B02-0000E844A5C5. В эту секцию поместить краткое текстовое описание просматриваемых данных.

    Все необходимые записи в системный реестр (и их удаление) выполняет, переписанный в данном примере метод UpdateRegistry фабрики класса TComObjectFactory.

    Реализация интерфейса IShellView приведена ниже: 

unit IShlView;

interface

uses Windows,ActiveX,ShellAPI,ComObj,ComServ,ShlObj,CommCtrl,UTestF;

const
     CLSID_CustomShellView:TGUID='{BF029403-68CC-11D2-9B02-0000E844A5C5}';

type
    TCustomShellView=class(TComObject,IShellView)
   private
      FFolderSettings:TFolderSettings;
      FShellBrowser:IShellBrowser;
      FHWndParent:HWND;
      FForm:TForm1;
   public
      {IOleWindow Methods}
      function GetWindow(out wnd:HWnd):HResult;stdcall;
      function ContextSensitiveHelp(fEnterMode:BOOL):HResult;stdcall;
      {IShellView Methods}
      function TranslateAccelerator(var Msg:TMsg):HResult;stdcall;
      function EnableModeless(Enable:Boolean):HResult;stdcall;
      function UIActivate(State:UINT):HResult;stdcall;
      function Refresh:HResult;stdcall;
      function CreateViewWindow(PrevView:IShellView;
         var FolderSettings:TFolderSettings;ShellBrowser:IShellBrowser;
         var Rect:TRect;out Wnd:HWND):HResult;stdcall;
      function DestroyViewWindow:HResult;stdcall;
      function GetCurrentInfo(out FolderSettings:TFolderSettings):HResult;stdcall;
      function AddPropertySheetPages(Reseved:DWORD;
         var lpfnAddPage:TFNAddPropSheetPage;lParam:LPARAM):HResult;stdcall;
      function SaveViewState:HResult;stdcall;
      function SelectItem(pidl:PItemIDList;flags:UINT):HResult;stdcall;
      function GetItemObject(Item:UINT;const iid:TIID;
         var IPtr:Pointer):HResult;stdcall;
   end;

implementation
  Uses Dialogs,SysUtils,Forms;

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

function TCustomShellView.GetWindow(out wnd:HWND):HResult;stdcall;
begin
     if Assigned(FForm) then Wnd:=FForm.Handle
        else Wnd:=0;
     Result:=NOERROR;
end;

function TCustomShellView.ContextSensitiveHelp(fEnterMode:BOOL):HResult;stdcall;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellView.TranslateAccelerator(var Msg:TMsg):HResult;stdcall;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellView.EnableModeless(Enable:Boolean):HResult;stdcall;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellView.UIActivate(State:UINT):HResult;stdcall;
var S:string;
begin
     case TSVUIAEnums(State) of
          SVUIA_DEACTIVATE:S:='Deactivate view';
          SVUIA_ACTIVATE_NOFOCUS:S:='Activate view without focus';
          SVUIA_ACTIVATE_FOCUS:S:='Activate view with focus';
          SVUIA_INPLACEACTIVATE:S:='Activate view for 
                inplace-activation within ActiveX control';
     end;
     FShellBrowser.SetStatusTextSB(StringToOleStr('IShellView.UIActivate:'+S));
     Result:=NOERROR;
end;

function TCustomShellView.Refresh:HResult;stdcall;
begin
     FShellBrowser.SetStatusTextSB(StringToOleStr('IShellView.Refresh'));
     Result:=E_NOTIMPL;
end;

function TCustomShellView.CreateViewWindow(PrevView:IShellView;
    var FolderSettings:TFolderSettings;ShellBrowser:IShellBrowser;
    var Rect:TRect;out Wnd:HWND):HResult;stdcall;
begin
     FFolderSettings:=FolderSettings;
     FShellBrowser:=ShellBrowser;
     if Assigned(FShellBrowser) then 
            FShellBrowser.GetWindow(FHWndParent)
     else FHWndParent:=0;
     if not Assigned(FForm) then FForm:=TForm1.Create(nil);
     Wnd:=FForm.Handle;
     if FHWndParent<>0 then 
     begin
         SetParent(Wnd,FHWndParent);
         with FForm do
         begin
           SetWindowPos(Handle,HWND_TOP,Rect.Left,Rect.Top,Rect.Right-Rect.Left,
               Rect.Bottom-Rect.Top,SWP_SHOWWINDOW);
           Show;
         end;
     end
     else begin
            FForm.BorderStyle:=bsDialog;
            FForm.ShowModal;
          end;
     if Wnd<>0 then Result:=NOERROR
     else Result:=E_UNEXPECTED;
end;

function TCustomShellView.DestroyViewWindow:HResult;stdcall;
begin
     if Assigned(FForm) then FForm.Free;
     FForm:=nil;
     Result:=NOERROR;
end;

function TCustomShellView.GetCurrentInfo
   (out FolderSettings:TFolderSettings):HResult;stdcall;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellView.AddPropertySheetPages(Reseved:DWORD;
   var lpfnAddPage:TFNAddPropSheetPage;lParam:LPARAM):HResult;stdcall;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellView.SaveViewState:HResult;stdcall;
begin
     Result:=E_NOTIMPL;
end;

function TCustomShellView.SelectItem(pidl:PItemIDList;flags:UINT):HResult;stdcall;
begin
     Result:=NOERROR;
end;

function TCustomShellView.GetItemObject(Item:UINT;
   const iid:TIID;
   var IPtr:Pointer):HResult;stdcall;
begin
     Result:=E_NOTIMPL;
end;

{----------------------------------------}
procedure TShellViewFactory.UpdateRegistry(Register:Boolean);
begin
     if Register then 
     begin
       CreateRegKey('CLSID\'+GUIDToString(CLSID_CustomShellView)+
           '\InprocServer32','ThreadingModel','Apartment');
       inherited UpdateRegistry(Register);
     end
     else begin
            inherited UpdateRegistry(Register);
          end;
end;

initialization

   TShellViewFactory.Create(ComServer,TCustomShellView,CLSID_CustomShellView,'',
        'View fish',ciMultiInstance);

end.

    Главный метод, который необходимо описать в этом интерфейсе, - создание окна для просмотра данных. В частности, этим окном может быть любая форма со значением свойства BorderStyle, равным bsNone. На этой форме могут размещаться любые элементы управления (кроме ActiveX). Подобная форма, показывающая содержимое таблицы BIOLIFE демонстрационной базы DBDEMOS, реализована в модуле UTestF, текст которого приведен ниже: 

unit UTestF;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ShellCtrls, Grids, DBGrids, ExtCtrls,
  DBCtrls, Buttons, Menus, DB, DBTables;

type
  TForm1 = class(TForm)
    DBNavigator1: TDBNavigator;
    DBGrid1: TDBGrid;
    Table1: TTable;
    DataSource1: TDataSource;
    DBImage1: TDBImage;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   if Table1.Active=False Then Table1.Active:=True
   else Table1.Active:=False;
end;

end.
Текст этого приложения можно взять здесь (17,7 Кб).

    Окно для просмотра данных реализуется при вызове метода CreateViewWindow. При этом передается ссылка на рабочую копию Windows Explorer в интерфейсе IShellBrowser. Создаваемая форма становится дочерним окном Windows Explorer и помещается в область, указанную в переменной Rect. Соответственно метод DestroyViewWindow должен разрушить созданную форму. И наконец, метод UIActivate просто показывает тип активации окна просмотра на панели состояния Windows Explorer.

    Дополнительные данные, которые должны быть занесены в реестр, описывают тип работы интерфейса в многопоточном режиме. Они выполняются в переписанном методе UpdateRegistry фабрики класса TComObjectFactory.

    Данная пара модулей (вместе с модулем реализации формы) должна быть реализована в библиотеке ActiveX. После вызова команды регистрации элемента управления ActiveX в системном реестре и перезагрузки компьютера на рабочем столе Windows появляется папка Inprise Fish Viewer. Она же появится и в Windows Explorer. При попытке открытия этой папки появляется содержимое формы, определенной в модуле UTestF (рис. 1).


Рис.1. Окно просмотра нефайловых данных в Windows Explorer (Проводнике)

    На следующем шаге мы рассмотрим OLE-реализацию метода drag-and-drop (реализацию контейнера).




Предыдущий шаг Содержание Следующий шаг