Programowanie w języku Delphi » FAQ

Jak wstawić własne dymki podpowiedzi dla plików w powłoce windows (IQueryInfo)

  • 2008-03-16 12:31
  • 4 komentarze
  • 763 odsłony
  • Oceń ten tekst jako pierwszy
Nie mogłem sobie tego odpuścić bo jestem maniakiem powłoki windowsowej

Zatem do rzeczy :

Chcemy aby po najechaniu kursorem (zaznaczeniu) na plik w windowsowym explore'rze
pojawiał się dymek z naszym opisem pliku (lub pojawiał się opis w pasku statusu).

Do tego celu najbardziej odpowiednim narzędziem w windows jest interfejs IQueryInfo,
wyglądający tak:

type
  IQueryInfo = interface(IUnknown)
    [SID_IQueryInfo]
    function GetInfoTip(dwFlags: DWORD; var ppwszTip: PWideChar): HResult; stdcall;
    function GetInfoFlags(out pdwFlags: DWORD): HResult; stdcall;
  end;


Do jego działania (MSDN) potrzebny jest również interfejs  IPersistFile
razem cały interfejs w delphi będzie wyglądał tak:

TTxtTipView = class(TComObject,IQueryInfo, IPersistFile)
  private
    FFile:string;
  protected
    //IPersistFile
    function IsDirty: HResult; stdcall;
    function Load(pszFileName: POleStr; dwMode: Longint): HResult; stdcall;
    function Save(pszFileName: POleStr; fRemember: BOOL): HResult; stdcall;
    function SaveCompleted(pszFileName: POleStr): HResult; stdcall;
    function GetCurFile(out pszFileName: POleStr): HResult; stdcall;
    function GetClassID(out classID: TCLSID): HResult; stdcall;
    //IQueryInfo
    function GetInfoTip(dwFlags: DWORD; var ppwszTip: PWideChar): HResult; stdcall;
    function GetInfoFlags(out pdwFlags: DWORD): HResult; stdcall;
 public
end;


Na pierwszy rzut oka wygląda to strasznie (ale tak jest z interfejsami nie należy się zrażać!)
nam jednak będzie potrzebna tylko funkcja GetInfoTip oraz Load,
pozostałe otrzymają status niezaimplementowanych co po delphi'emu i OLE będzie oznaczało, że muszą
zwrócić one E_NOTIMPL (w przeciwieństwie do zaimplementowanych,
 które zwracają S_OK gdy OK a w w razie niepowodzenia E_FAIL).
 
UWAGA: To nie oznacza, że pozostałe funkcje są nie potrzebne!
Tylko w tym przypadku chcemy uruchomić interfejs z jak najprostszymi możliwościami !  
 
Obsługa Load należy do bardzo prostych, wygląda ona tak:

function TTxtTipView.Load(pszFileName: POleStr; dwMode: Integer): HResult;
begin
//pobieramy nazwe pliku - aby mozna bylo ja widziec globalnie
  FFile  := pszFileName;
// i zwracamy OK (standardowe komunikaty dla OLE)
  Result := S_OK;
end;


GetInfoTip już jest nieco bardziej złożona

function TTxtTipView.GetInfoTip(dwFlags: DWORD; var ppwszTip: PWideChar): HResult;
var
 pMalloc:IMalloc;
 F:TextFile;
 ToolTipS,FLine:string;
begin
 
    {$I-}
    AssignFile(F,FFile);
    FileMode := 0;
    Reset(F);
    {$I+}
//Sprawdz czy da sie otworzyc plik, jesli nie to sie wycofaj
    if IOResult <> 0 then
    begin
      result := E_FAIL;
      exit;
    end;
 
//Pobirze interfejs IMalloc z powloki
    if (  SHGetMalloc ( pMalloc ) = E_FAIL ) then
    begin
//... a jak sie nie uda to zamknij plik i powiadom o bledzie
       CloseFile(F);
       result := E_FAIL;
       exit;
    end;
 
 
 
//czytamy pierwsza linie z pliku ....
    ReadLn(F,FLine);
//oraz jego wielkosc ...
    ToolTipS := Format ('Wielkość pliku : %d',[SizeFile(FFile)]);
//zamykamy plik bo nie bedzie juz potrzebny
    CloseFile(F);
 
//i jesli linia nie jest pusta to dodajemy ja do naszego "tipa"
    if  Length(FLine) > 0 then
        ToolTipS := ToolTipS+ #10#13 + FLine;
 
//alokacja pamieci dla powloki systemu tu powinno sie stosowac interfejs
// IMalloc do zarzadzania pamiecia
    ppwszTip := pMalloc.Alloc ( Length(ToolTipS)*SizeOf(WideChar) + 1);
 
//interfejs juz nam nie bedzie potrzebny mozemy go zwolnic (w poprzednich wersjach delphi .Realease
// - powoduje zmniejszenie licznikow interfejsow w systemie)
    pMalloc._Release();
 
//zamieniamy ....
    StringToWideChar(ToolTipS,ppwszTip,Length(ToolTipS)*SizeOf(WideChar) + 1);
 
    result := S_OK;
end;


Tu szczególną uwagę należy zwrócić na  interfejs IMalloc, służ on do zarządzania pamięcią
w implementacjach interfejsów powłoki i jest zalecany przez MS do tego.

Może to ograniczać troche korzystanie z innych obiektów delphi, które rezerwują pamięć w "tradycyjny" sposób, jednak
z własnych doświadczeń stosowania innych obiektów,
 nie zauważyłem jakiś problemów (wieszanie systemu, trudności z odrejestrowaniem biblioteki etc.).
 
 ostatnia część w plikuTxtTipViewU.pas służy do rejestracji biblioteki w powłoce (np za pomocą popularnego regsvr32)
 z tego na co warto zwrócić uwagę to to, że nazwa klucza zawiera w sobie numer CLSID ( 'txtfile\shellex\'+SID_IQueryInfo) interfejsu IQueryInfo
 (nie tego który my generujemy wciskajac Ctrl+Shift+G !!).
 
 
 
//*************************************************************
//Czesc programu zwiazana z rejestracja/od_rejestracja naszej
// obslugi interfejsu
 
type
  TTxtTipViewFactory = class(TComObjectFactory)
  public
    procedure UpdateRegistry(register: Boolean); override;
  end;
 
procedure TTxtTipViewFactory.UpdateRegistry(register: Boolean);
var
  ClassID: string;
  Buf:array[0..MAX_PATH] of Char;
begin
  if register then begin
    inherited UpdateRegistry(register);
 
     ClassID := GUIDToString(Class_TxtTipView);
      with TRegistry.Create do
        try
          RootKey := HKEY_CLASSES_ROOT;
          OpenKey('txtfile\shellex\'+SID_IQueryInfo,True);
          WriteString('',ClassID);
          CloseKey;
 
          OpenKey('CLSID\'+ClassID+'\InprocServer32',True);
          GetModuleFileName(Hinstance,buf,sizeof(buf));
          WriteString('',Buf);
          WriteString('ThreadingModel','Apartment');
          CloseKey;
        finally
          Free;
        end;
//w przypadku gdy mamy doczynienia z systemami NT (teraz juz to prawie standard)        
    if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      with TRegistry.Create do
        try
          RootKey := HKEY_LOCAL_MACHINE;
          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
          OpenKey('Approved', True);
          WriteString(ClassID, szDescr);
        finally
          Free;
        end;
  end
  else begin
    with TRegistry.Create do
    try
      RootKey := HKEY_CLASSES_ROOT;
      DeleteKey('CLSID\'+ClassID+'\InprocServer32');
      DeleteKey('txtfile\shellex\'+SID_IQueryInfo);
    finally
          Free;
    end;
    inherited UpdateRegistry(register);
  end;
end;
 
initialization
  TTxtTipViewFactory.Create(ComServer, TTxtTipView, Class_TxtTipView, '', szDescr, ciMultiInstance, tmApartment);
end.

 
Na koniec jeszcze warto wspomnieć, że w pliku projektu powinniśmy udostępnić (wyeksportować) funkcje
za pomocą których powłoka windows mogła by się dostać do naszej implementacji interfejsu.
a zatem projekt powinien wyglądać:

library TxtTipView;
 
uses
  ComServ,
  TxtTipViewU in 'TxtTipViewU.pas';
 
exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;
 
begin
end.


Kończąc przedstawiam rezultat (przed i po rejestracji biblioteki)

Przed rejestracją

<image>http://4programmers.net/bin/przed.png</image>

Po rejestracji  ( z konsoli należy wydać polecenie regsvr32 TxtTipViewU.dll)


<image>http://4programmers.net/bin/po.png</image>

oraz źrodła (link)
http://4programmers.net/bin/dobry_src.rar

4 komentarze

reichel 2008-03-16 22:51

dzieki, troche trudno jest sie polapac jak teraz powinno sie dodawac elementy (niby jest tekst, ale za dlugi za malo encyklopedyczny). A swoja drogo po prostu zrobilem jak 3 lata temu (bo orginalnie to tekst z 2005 :) )
http://rudy.mif.pg.gda.pl/~reichel/unknown/IQueryInfo.htm

Coldpeer 2008-03-16 21:27

reichel: obrazki możesz wstawiać poprzez {{Image:nazwa}} ;)

reichel 2008-03-16 10:53

No  bo  to  sie  kompiluje  do  DLL.  I  ta  trzeba  zarejestrowac  w  systemie  (np  regsvr32).
Doczytaj troche na czym polegaja "Windows Shell extension"

bordeux 2008-03-16 09:20

hehhe :D Prosto z forum reichel :p

Cannot debug project unless a host application is defined. Use the Run|Parameters... dialog box

Ymm wiecie o co chodzi z tym komunikatem??