IPreviewHandler mit Delphi 7 anbinden!?

[Sushibb]

Hi @all,

ich habe versucht, in einem Tool das von Windows Vista, Office 2007 bzw Windows Search 4 bereitgestellte Interface für den PreviewHandler zu nutzen. Leider zeigt das Programm nichts an, obwohl ich als Rückgabewert keine Fehler erhalte. Kennt sich jemand damit aus?

Nachfolgend der Code. Es müsste nur ein neues Projekt und ein Button1 erstellt werden, dann sollte es schon laufen.

Bin für jeden Hinweis dankbar.

Achso, ich hab das Codebeispiel der MSDN in C# heruntergeladen und das funktioniert. Liegt also nicht an fehlenden Dateien oder OS-Unterstützung!

Code:

unit FMain;

{
[url]http://dedjo.blogspot.com/2008/04/using-vista-preview-handlers-in-wpf[/url]...
[url]http://blogs.claritycon.com/blogs/ryan_powers/archive/2007/07.aspx[/url]
[url]http://blogs.microsoft.co.il/blogs/eyal/archive/2007/07.aspx[/url]

}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
  Dialogs, StdCtrls, ExtCtrls, OleServer;

type
  TPreviewControl = class(TCustomControl)
  private
    FFileName: string;
    FLastError: string;
    procedure SetFileName(const Value: string);
    procedure PreviewFile;
  public
    property FileName: string read FFileName write SetFileName;
    property LastError: string read FLastError;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    FPreview: TPreviewControl;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Registry, ComObj, ActiveX, ShlObj;

type
  IPreviewHandler = interface(IUnknown)
    ['{8895b1c6-b41f-4c1c-a562-0d564250836f}']
    function DoPreview(): HRESULT; stdcall;
    function QueryFocus(phwnd: HWND): HRESULT; stdcall;
    function SetFocus(): HRESULT; stdcall;
    function SetRect(var RectangleRef: TRect): HRESULT;   stdcall;
    function SetWindow(hwnd: HWND; var RectangleRef: TRect): HRESULT;
stdcall;
    function TranslateAccelerator(PointerToWindowMessage: MSG):
HRESULT; stdcall;
    function Unload(): HRESULT; stdcall;
  end;

   IInitializeWithFile = interface(IUnknown)
     ['{b7d14566-0509-4cce-a71f-0a554233bd9b}']
     function Initialize(pszFilePath: LPWSTR; grfMode: DWORD):HRESULT;
stdcall;
   end;

  IInitializeWithStream = interface(IUnknown)
    ['{b824b49d-22ac-4161-ac8a-9916e8fa3f7f}']
    function Initialize(pstream: IStream; grfMode: DWORD): HRESULT;
stdcall;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  AFileName: string;
begin
  with TOpenDialog.Create(Self) do
  try
    if not Execute then
      Exit;
    AFileName := FileName;
  finally
    Free;
  end;

  FPreview.FileName := AFileName;
  Caption := FPreview.LastError;
end;

function GetCLSIDForFileName(AFileName: string): string;
var
  AREG: TRegistry;
  AFileExt, ARegistryPath: String;
  vNames: TStringList;
begin
  vNames := TStringList.Create();
  AREG := TRegistry.Create();
  try
    AREG.RootKey := HKEY_CLASSES_ROOT;
    AFileExt := ExtractFileExt(AFileName);
    ARegistryPath := AFileExt + '\shellex\{8895b1c6-b41f-4c1c-
a562-0d564250836f}';
    if AREG.KeyExists(ARegistryPath) then
    begin
      AREG.OpenKey(ARegistryPath, True);
      AREG.GetValueNames(vNames);
      Result := AREG.ReadString(vNames[0]);
      AREG.CloseKey;
    end
    else
      Result := '';
  finally
    FreeAndNil(vNames);
    FreeAndNil(AREG);
  end;
end;

{ TPreviewControl }

procedure TPreviewControl.PreviewFile;
var
  ACLSID: string;
  AGUID: TGUID;
  AMyPreviewHandler: IPreviewHandler;
  ARect: TRect;
  AInit: IInitializeWithFile;
  AResult: HRESULT;
  AFile: PWideChar;
begin
  FLastError := '';
  ACLSID := GetCLSIDForFileName(FFileName);
  if ACLSID = '' then
  begin
    FLastError := 'No CLSID';
    Exit;
  end;

  AGUID := StringToGUID(ACLSID);
  ARect := Rect(0, 0, Width, Height);
  AMyPreviewHandler := CreateComObject(AGUID) as IPreviewHandler;
  if (AMyPreviewHandler = nil) then
  begin
    FLastError := 'No Handler';
    Exit;
  end;

  AGUID := StringToGUID('{b7d14566-0509-4cce-a71f-0a554233bd9b}');
  if not Supports(AMyPreviewHandler, AGUID, AInit) then
  begin
    FLastError := 'Support';
    Exit;
  end;

  GetMem(AFile, 1024);
  AFile := StringToWideChar(FFileName, AFile, 1024);
  AResult := AInit.Initialize(AFile, STGM_READ);
  if AResult <> 0 then
  begin
    FLastError := 'Initialize';
    Exit;
  end;

  AResult := AMyPreviewHandler.SetWindow(Self.Handle, ARect);
  if AResult <> 0 then
  begin
    FLastError := 'SetWindow';
    Exit;
  end;

  AResult := AMyPreviewHandler.SetRect(ARect);
  if AResult <> 0 then
  begin
    FLastError := 'SetRect';
    Exit;
  end;

  AResult := AMyPreviewHandler.DoPreview;
  if AResult <> 0 then
  begin
    FLastError := 'DoPreview';
    Exit;
  end;
end;

procedure TPreviewControl.SetFileName(const Value: string);
begin
  FFileName := Value;
  PreviewFile;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FPreview := TPreviewControl.Create(Self);
  FPreview.ParentColor := False;
  FPreview.ParentBackground := False;
  FPreview.Top := 10;
  FPreview.Left := 10;
  FPreview.Width := 200;
  FPreview.Height := 200;
  FPreview.Parent := Self;
end;

end.

[omata]

Was schreibt er denn in deine Form-Caption?

Bei mir springt er gleich hier raus...

Delphi-Quellcode:

procedure TPreviewControl.PreviewFile;
:
begin
:
  ACLSID := GetCLSIDForFileName(FFileName);
  if ACLSID = '' then
  begin
    FLastError := 'No CLSID';
    Exit;
  end;

Weil bei mir der folgende Schlüssel nicht existiert...

Delphi-Quellcode:

    ARegistryPath := AFileExt + '\shellex\{8895b1c6-b41f-4c1c-a562-0d564250836f}';

Also steht bei mir: No CLSID

[Sushibb]

Bei mir bleib die Form-Caption leer. Der Schlüssel ist da, wie gesagt mit C#-Beispiel läufts auch. Hast du Vista? XP + Windows Search 4? Office 2007?

[omata]

Ich habe XP und keine dieser neuen Funktionen. Ich habe einfach mal einen Breakpoint gesetzt und mir angesehen, was da so passiert. Wenn ich eine Datei auswähle, wird das PreviewFile-Event ausgelöst und in der Routine habe ich dann das beschriebene und nicht wirklich unerwartete Verhalten.
Keine Ahnung warum sich bei dir nicht mal die Form-Caption ändert. Was passiert den bei dir? Setze doch einfach mal einen Breakpoint und schau nach...

[Sushibb]

AResult ist immer 0, was so schlecht erstmal nicht klingt, da dies ein 'OK' sein sollte. Auf der Form ändert sich nichts. Die Caption bleibt leer, weil FLastError nur gesetzt wird, wenn AResult != 0 ist.

[Sushibb]

Hat keiner eine Idee? Funktionierts bei euch denn?