ADD: Explorer preview plugin

plugins/wlx/preview/src/preview.lpi

@@ -0,0 +1,121 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="PreviewHandler"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="2">
+      <Item1 Name="Release" Default="True"/>
+      <Item2 Name="Debug">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="..\preview.wlx" ApplyConventions="False"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="..\..\..\..\sdk"/>
+            <UnitOutputDirectory Value="..\lib"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <IncludeAssertionCode Value="True"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <RelocatableUnit Value="True"/>
+            <Checks>
+              <IOChecks Value="True"/>
+              <RangeChecks Value="True"/>
+              <OverflowChecks Value="True"/>
+              <StackChecks Value="True"/>
+            </Checks>
+            <VerifyObjMethodCallValidity Value="True"/>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <DebugInfoType Value="dsDwarf2Set"/>
+              <UseHeaptrc Value="True"/>
+              <TrashVariables Value="True"/>
+              <UseExternalDbgSyms Value="True"/>
+            </Debugging>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+              <ExecutableType Value="Library"/>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item2>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="preview.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Preview"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="..\preview.wlx" ApplyConventions="False"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\..\..\..\sdk"/>
+      <UnitOutputDirectory Value="..\lib"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <SmartLinkUnit Value="True"/>
+      <RelocatableUnit Value="True"/>
+      <Optimizations>
+        <OptimizationLevel Value="3"/>
+      </Optimizations>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="False"/>
+      </Debugging>
+      <LinkSmart Value="True"/>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+        <ExecutableType Value="Library"/>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

plugins/wlx/preview/src/preview.lpr

@@ -0,0 +1,126 @@
+{
+   Double commander
+   -------------------------------------------------------------------------
+   Explorer preview plugin
+
+   Copyright (C) 2021 Alexander Koblov (alexx2000@mail.ru)
+
+   This library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   This library is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program. If not, see <http://www.gnu.org/licenses/>.
+}
+
+library Preview;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils,
+  Windows,
+  Messages,
+  WlxPlugin,
+  uPreviewHandler;
+
+type
+  TPreviewData = class
+    Handler: IPreviewHandler;
+  end;
+
+function WindowProc(hWnd: HWND; uiMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
+var
+  ARect: TRect;
+  AData: TPreviewData;
+  AHandle: THandle absolute AData;
+begin
+  if (uiMsg = WM_SETFOCUS) then
+  begin
+    AHandle:= GetWindowLongPtr(hWnd, GWLP_USERDATA);
+    if (AHandle <> 0) then AData.Handler.SetFocus();
+  end
+  else if (uiMsg = WM_SIZE) then
+  begin
+    AHandle:= GetWindowLongPtr(hWnd, GWLP_USERDATA);
+    if (AHandle <> 0) then
+    begin
+      ARect.Top:= 0;
+      ARect.Left:= 0;
+      ARect.Width:= LOWORD(lParam);
+      ARect.Height:= HIWORD(lParam);
+      AData.Handler.SetRect(@ARect);
+    end;
+  end;
+  Result := DefWindowProc(hWnd, uiMsg, wParam, lParam);
+end;
+
+function ListLoadW(ParentWin: HWND; FileToLoad: PWideChar; ShowFlags: Integer): HWND; stdcall;
+var
+  ARect: TRect;
+  AData: TPreviewData;
+  WindowClassW: TWndClassW;
+  AHandler: IPreviewHandler;
+  AHandle: THandle absolute AData;
+begin
+  AHandler:= GetPreviewHandler(FileToLoad);
+  if (AHandler = nil) then Exit(wlxInvalidHandle);
+
+  ZeroMemory(@WindowClassW, SizeOf(WndClassW));
+  with WindowClassW do
+  begin
+    Style := CS_DBLCLKS;
+    lpfnWndProc := @WindowProc;
+    cbWndExtra := SizeOf(Pointer);
+    hCursor := LoadCursor(0, IDC_ARROW);
+    lpszClassName := 'IPreviewHandler';
+    hInstance := GetModuleHandleW(nil);
+  end;
+  Windows.RegisterClassW(WindowClassW);
+
+  Result:= CreateWindowW('IPreviewHandler', 'PreviewHandler', WS_CHILD or WS_VISIBLE, 0, 0, 640,
+                         480, ParentWin, 0, WindowClassW.hInstance, nil);
+
+  if (Result <> wlxInvalidHandle) then
+  begin
+    AData:= TPreviewData.Create;
+    AData.Handler:= AHandler;
+    SetWindowLongPtr(Result, GWLP_USERDATA, AHandle);
+    ARect:= TRect.Create(0, 0, 640, 480);
+    AHandler.SetWindow(Result, ARect);
+    AData.Handler.DoPreview();
+  end;
+end;
+
+procedure ListCloseWindow(ListWin: HWND); stdcall;
+var
+  AData: TPreviewData;
+  AHandle: THandle absolute AData;
+begin
+  AHandle:= GetWindowLongPtr(ListWin, GWLP_USERDATA);
+  DestroyWindow(ListWin);
+  if Assigned(AData) then
+  begin
+    AData.Handler.Unload();
+    AData.Free;
+  end;
+end;
+
+procedure ListGetDetectString(DetectString: PAnsiChar; MaxLen: Integer); stdcall;
+begin
+  StrLCopy(DetectString, '(EXT="HTM")|(EXT="HTML")|(EXT="MHT")|(EXT="MHTML")', MaxLen);
+end;
+
+exports
+  ListLoadW,
+  ListCloseWindow,
+  ListGetDetectString;
+
+end.
+

plugins/wlx/preview/src/upreviewhandler.pas

@@ -0,0 +1,143 @@
+{
+   Double commander
+   -------------------------------------------------------------------------
+   Explorer preview handler
+
+   Copyright (C) 2021 Alexander Koblov (alexx2000@mail.ru)
+
+   Permission is hereby granted, free of charge, to any person obtaining
+   a copy of this software and associated documentation files (the
+   "Software"), to deal in the Software without restriction, including
+   without limitation the rights to use, copy, modify, merge, publish,
+   distribute, sublicense, and/or sell copies of the Software, and to
+   permit persons to whom the Software is furnished to do so, subject to
+   the following conditions:
+
+   The above copyright notice and this permission notice shall be included
+   in all copies or substantial portions of the Software.
+
+   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+   CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+   TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+   SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+}
+
+unit uPreviewHandler;
+
+{$mode delphi}
+
+interface
+
+uses
+  Classes, SysUtils, Windows, ShlObj, ActiveX;
+
+type
+  IPreviewHandler = interface(IUnknown)
+    ['{8895B1C6-B41F-4C1C-A562-0D564250836F}']
+    function SetWindow(hwnd: HWND; const prc: RECT): HRESULT; stdcall;
+    function SetRect(const prc: PRECT): HRESULT; stdcall;
+    function DoPreview(): HRESULT; stdcall;
+    function Unload(): HRESULT; stdcall;
+    function SetFocus(): HRESULT; stdcall;
+    function QueryFocus(out phwnd: HWND): HRESULT; stdcall;
+    function TranslateAccelerator(pmsg: PMSG): HRESULT; stdcall;
+  end;
+
+function GetPreviewHandler(const FileName: UnicodeString): IPreviewHandler;
+
+implementation
+
+uses
+  ComObj;
+
+type
+  IInitializeWithFile = interface(IUnknown)
+    ['{B7D14566-0509-4CCE-A71F-0A554233BD9B}']
+    function Initialize(pszFilePath: LPCWSTR; grfMode: DWORD): HRESULT; stdcall;
+  end;
+
+  IInitializeWithStream = interface(IUnknown)
+    ['{B824B49D-22AC-4161-AC8A-9916E8FA3F7F}']
+    function Initialize(const pstream: IStream; grfMode: DWORD): HRESULT; stdcall;
+  end;
+
+  IInitializeWithItem = interface(IUnknown)
+    ['{7F73BE3F-FB79-493C-A6C7-7EE14E245841}']
+    function Initialize(const psi: IShellItem; grfMode: DWORD): HRESULT; stdcall;
+  end;
+
+var
+  SHCreateItemFromParsingName: function(pszPath: LPCWSTR; const pbc: IBindCtx;
+                                        const riid: TIID; out ppv): HRESULT; stdcall;
+
+function AssocQueryStringW(flags: DWORD; str: DWORD; pszAssoc: LPCWSTR; pszExtra: LPCWSTR;
+                           pszOut: LPWSTR; pcchOut: PDWORD): HRESULT; stdcall; external 'shlwapi.dll';
+
+function GetShellClass(const FileExt: UnicodeString; interfaceID: TGUID): TGUID;
+const
+  ASSOCSTR_SHELLEXTENSION = 16;
+  ASSOCF_INIT_DEFAULTTOSTAR  = $00000004;
+var
+  Res: HRESULT;
+  cchOut: DWORD = MAX_PATH;
+  ABuffer: array[0..MAX_PATH] of WideChar;
+begin
+  Res := AssocQueryStringW(ASSOCF_INIT_DEFAULTTOSTAR, ASSOCSTR_SHELLEXTENSION, PWideChar(FileExt),
+                           PWideChar(UTF8Decode(GuidToString(interfaceID))), ABuffer, @cchOut);
+  if (Res <> S_OK) then Exit(Default(TGUID));
+  Res := CLSIDFromString(ABuffer, @Result);
+  if (Res <> NOERROR) then Exit(Default(TGUID));
+end;
+
+function GetPreviewHandler(const FileName: UnicodeString): IPreviewHandler;
+var
+  Res: HRESULT;
+  ClassID: TGUID;
+  AStream: IStream;
+  AFile: TFileStream;
+  AShellItem: IShellItem;
+  AInitializeWithFile: IInitializeWithFile;
+  AInitializeWithItem: IInitializeWithItem;
+  AInitializeWithStream: IInitializeWithStream;
+begin
+  ClassID:= GetShellClass(ExtractFileExt(FileName), IPreviewHandler);
+  if IsEqualGUID(ClassID, Default(TGUID)) then Exit(nil);
+  Result:= CreateComObject(ClassID) as IPreviewHandler;
+  if Assigned(Result) then
+  begin
+    if Supports(Result, IInitializeWithFile, AInitializeWithFile) then
+      Res:= AInitializeWithFile.Initialize(PWideChar(FileName), STGM_READ)
+    else if Supports(Result, IInitializeWithStream, AInitializeWithStream) then
+    try
+      AFile:= TFileStream.Create(UTF8Encode(FileName), fmOpenRead or fmShareDenyNone);
+      AStream:= TStreamAdapter.Create(AFile, soOwned) as IStream;
+      Res:= AInitializeWithStream.Initialize(AStream, STGM_READ);
+    except
+      Res:= E_FAIL;
+    end
+    else if (Win32MajorVersion > 5) and Supports(Result, IInitializeWithItem, AInitializeWithItem) then
+    begin
+      Res:= SHCreateItemFromParsingName(PWideChar(FileName), nil, IShellItem, AShellItem);
+      if Succeeded(Res) then Res:= AInitializeWithItem.Initialize(AShellItem, STGM_READ);
+    end
+    else begin
+      Res:= E_FAIL;
+    end;
+    if not Succeeded(Res) then
+    begin
+      Result:= nil;
+      AStream:= nil;
+    end;
+  end;
+end;
+
+initialization
+  if (Win32MajorVersion > 5) then
+    SHCreateItemFromParsingName:= GetProcAddress(GetModuleHandle('shell32.dll'),
+                                                 'SHCreateItemFromParsingName');
+
+end.
+