unit F_PE_PreviewHandlers;

interface

uses
  System.SysUtils, System.Variants, System.Classes, System.Generics.Collections,
  Winapi.Windows, Winapi.Messages,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  U_PreviewEngine, uHostPreview;

type
  TfrmPEPreviewHandlers = class(TCustomPreviewEngineForm)
  private
    { Private declarations }
    FRenderersByExtension: TDictionary<string,TDynRendererArray>;
    FPreviewHost: THostPreviewHandler;

    procedure DoHostPreview(const FileName: string; const Renderer: TRenderer);
  protected
    function GetRenderers: TRendererList; override;
  public
    destructor Destroy; override;

    function  CouldShowFile(const FileName: string): TDynRendererArray; override;

    { Public declarations }
    procedure Clear; override;
  end;

var
  frmPEPreviewHandlers: TfrmPEPreviewHandlers;

implementation

uses
  System.Win.Registry;

{$R *.dfm}

type
  { ------------------------------------------------------------------------------------------------ }
  TPreviewRenderer = class(TRenderer)
  public
    constructor Create(const Parent: TCustomPreviewEngineForm; const GUID: string);
    function  CouldShowFile(const FileName: string): boolean; override;
    function  TryShowFile(const FileName: string): boolean; override;
    procedure PopulateInfo(const Lines: IInfoLineDisplayer); override;
  end {TRichTextRenderer};


{ ================================================================================================ }
{ TfrmPEPreviewHandlers }

{ ------------------------------------------------------------------------------------------------ }
destructor TfrmPEPreviewHandlers.Destroy;
begin
  try
    FRenderersByExtension.Free;
  finally
    inherited;
  end;
end {TfrmPEPreviewHandlers.Destroy};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmPEPreviewHandlers.Clear;
begin
  inherited;
  FreeAndNil(FPreviewHost);
end {TfrmPEPreviewHandlers.Clear};

{ ------------------------------------------------------------------------------------------------ }
function IndexOfRendererName(const Renderers: TRendererList; const Name: string): integer;
var
  i: Integer;
begin
  for i := 0 to Renderers.Count - 1 do begin
    if SameText(Name, Renderers[i].Name) then begin
      Result := i;
      Exit;
    end;
  end;
  Result := -1;
end {IndexOfRendererName};

{ ------------------------------------------------------------------------------------------------ }
function TfrmPEPreviewHandlers.CouldShowFile(const FileName: string): TDynRendererArray;
var
  Reg: TRegistry;
  Ext, Key: String;
  Found: Boolean;
  ProgId: string;
  CLSIDs, ProgIds: TStringList;
  i: Integer;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  procedure AddCLSID(const CLSID: string; const Primary: boolean);
  var
    Index: Integer;
    Name: string;
    Renderer: TRenderer;
  begin
    Index := CLSIDs.IndexOfName(CLSID);
    if Index > -1 then
      Exit;

    Index := IndexOfRendererName(FRenderers, CLSID);
    if Index > -1 then begin
      Renderer := FRenderers[Index];
    end else begin
      Renderer := TPreviewRenderer.Create(Self, CLSID);
      Reg.RootKey := HKEY_CLASSES_ROOT;
      Key := 'CLSID\' + CLSID;
      Found := Reg.KeyExists(Key);
      {$IFDEF WIN64}
      if not Found then begin
        Key := 'Wow6432Node\' + Key;
        Found := Reg.KeyExists(Key);
      end;
      {$ENDIF}
      if Found then begin
        Reg.OpenKeyReadOnly(Key);
        try
          if Reg.ValueExists('DisplayName') then
            Name := Reg.ReadString('DisplayName')
          else
            Name := Reg.ReadString('');
        finally
          Reg.CloseKey;
        end;
        // TODO: if Name starts with '@', try to load the name from the specified resource?
        Renderer.DisplayName := Name;
      end;
      FRenderers.Add(Renderer);
    end;
    if Primary then begin
      for Index := 0 to CLSIDs.Count - 1 do begin
        if CLSIDs.ValueFromIndex[Index] = BoolToStr(False) then begin
          CLSIDs.InsertObject(Index, CLSID + CLSIDs.NameValueSeparator + BoolToStr(Primary), Renderer);
          Exit;
        end;
      end;
    end;
    CLSIDs.AddObject(CLSID + CLSIDs.NameValueSeparator + BoolToStr(Primary), Renderer);
  end {AddCLSID};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  procedure FindClassHandler(const BaseKey: string; const Primary: boolean);
  var
    Key: string;
    CLSID: string;
  begin
    Key := BaseKey + '\ShellEx\{8895b1c6-b41f-4c1c-a562-0d564250836f}';
    if Reg.KeyExists(Key) then begin
      Reg.OpenKeyReadOnly(Key);
      try
        CLSID := Reg.ReadString('').ToLowerInvariant;
      finally
        Reg.CloseKey;
      end;
      AddCLSID(CLSID.ToLowerInvariant, Primary);
    end;
  end {FindClassHandler};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
begin
  // Note: GetRenderers also creates FRenderersByExtension
  GetRenderers;

  Ext := ExtractFileExt(FileName).ToLower;
  if FRenderersByExtension.ContainsKey(Ext) then begin
    Result := FRenderersByExtension.Items[Ext];
    Exit;
  end;

  CLSIDs := TStringList.Create;
  try
    Reg := TRegistry.Create(KEY_READ);
    try
      Reg.RootKey := HKEY_CLASSES_ROOT;

      // {.ext}\ShellEx\{88951...}
      // {.ext}\'' => class
      // {.ext}\OpenWithProgIds
      //   (class => {class}\ShellEx\{88951...})

      ProgIds := TStringList.Create;
      try
        Key := Ext;
        if Reg.KeyExists(Key) then begin
          Reg.OpenKeyReadOnly(Key);
          try
            ProgId := Reg.ReadString('');

            if Reg.KeyExists('OpenWithProgIds') then begin
              Reg.OpenKeyReadOnly('OpenWithProgIds');
              Reg.GetValueNames(ProgIds);
            end;

            if ProgId <> '' then begin
              i := ProgIds.IndexOf(ProgId);
              if i > -1 then
                ProgIds.Delete(i);
              ProgIds.InsertObject(0, ProgId, TObject(True));
            end;
          finally
            Reg.CloseKey;
          end;

          FindClassHandler(Key, True); // {.ext}\ShellEx\{88951...}
        end;
        FindClassHandler('SystemFileAssociations\' + Key, True); // SystemFileAssociations\{.ext}\ShellEx\{88951...}

        for i := 0 to ProgIds.Count - 1 do begin
          FindClassHandler(ProgIds[i], Boolean(ProgIds.Objects[i]));
        end;
      finally
        ProgIds.Free;
      end;
    finally
      Reg.Free;
    end;

    SetLength(Result, CLSIDs.Count);
    for i := 0 to CLSIDs.Count - 1 do begin
      Result[i] := CLSIDs.Objects[i] as TRenderer;
    end;
    FRenderersByExtension.Add(Ext, Result);
  finally
    CLSIDs.Free;
  end;
end {TfrmPEPreviewHandlers.CouldShowFile};

{ ------------------------------------------------------------------------------------------------ }
function TfrmPEPreviewHandlers.GetRenderers: TRendererList;
var
  Reg: TRegistry;
  i: Integer;
  PreviewHandlers: TStringList;
  CLSID: string;
  Renderer: TPreviewRenderer;
begin
  Result := inherited;
  if Result.Count = 0 then begin
    FRenderersByExtension := TDictionary<string,TDynRendererArray>.Create;
    Reg := TRegistry.Create(KEY_READ);
    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\PreviewHandlers');
      PreviewHandlers := TStringList.Create;
      try
        Reg.GetValueNames(PreviewHandlers);
        Result.Capacity := PreviewHandlers.Count;
        for i := 0 to PreviewHandlers.Count - 1 do begin
          CLSID := PreviewHandlers[i].ToLowerInvariant;
          Renderer := TPreviewRenderer.Create(Self, CLSID);
          Renderer.DisplayName := Reg.ReadString(CLSID);
          Result.Add(Renderer);
        end;
      finally
        PreviewHandlers.Free;
      end;
    finally
      Reg.Free;
    end;
  end;
end {TfrmPEPreviewHandlers.GetRenderers};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmPEPreviewHandlers.DoHostPreview(const FileName: string; const Renderer: TRenderer);
begin
  if Assigned(FPreviewHost) then begin
    if SameFileName(FileName, FPreviewHost.FileName) and SameStr(FPreviewHost.PreviewGUIDStr, Renderer.Name) then
      Exit
    else
      FreeAndNil(FPreviewHost);
  end;

  FPreviewHost := THostPreviewHandler.Create(Self);
//  FPreviewHost.Top := 0;
//  FPreviewHost.Left := 0;
//  FPreviewHost.Width := ClientWidth;
//  FPreviewHost.Height := ClientHeight;
  FPreviewHost.Parent := Self;
  FPreviewHost.Align  := alClient;
  FPreviewHost.PreviewGUIDStr := Renderer.Name;
  FPreviewHost.FileName := FileName;
  FPreviewHost.Invalidate;
end {TfrmPEPreviewHandlers.RenderPreview};


{ ================================================================================================ }
{ TPreviewRenderer }

{ ------------------------------------------------------------------------------------------------ }
constructor TPreviewRenderer.Create(const Parent: TCustomPreviewEngineForm; const GUID: string);
begin
  inherited Create(Parent, GUID);
  {$MESSAGE HINT 'TODO: read display name from registry?'}
end {TPreviewRenderer.Create};

{ ------------------------------------------------------------------------------------------------ }
function TPreviewRenderer.CouldShowFile(const FileName: string): boolean;
var
  Renderer: TRenderer;
begin
  for Renderer in TfrmPEPreviewHandlers(Form).CouldShowFile(FileName) do begin
    if Renderer = Self then
      Exit(True);
  end;
  Result := False;
end {TPreviewRenderer.CouldShowFile};

{ ------------------------------------------------------------------------------------------------ }
function TPreviewRenderer.TryShowFile(const FileName: string): boolean;
begin
  Result := FileExists(FileName);
  if Result then
    TfrmPEPreviewHandlers(Form).DoHostPreview(FileName, Self);
end {TPreviewRenderer.TryShowFile};

{ ------------------------------------------------------------------------------------------------ }
procedure TPreviewRenderer.PopulateInfo(const Lines: IInfoLineDisplayer);
begin
  inherited;
  Lines.Add('Windows Preview Handler', 'GUID', '', Self.Name);
end {TPreviewRenderer.PopulateInfo};





////////////////////////////////////////////////////////////////////////////////////////////////////
initialization
  TCustomPreviewEngineForm.RegisterForm(TfrmPEPreviewHandlers);

end.
