unit WlxPluginWrapper;

interface

uses
  Windows, Classes;

type
  TWlxPluginWrapper = class
  {$REGION ' Wlx (lister) plugin interface '}
  type
    TListDefaultParamStruct = record
      size,
      PluginInterfaceVersionLow,
      PluginInterfaceVersionHi: LongInt;
      DefaultIniName: array[0..MAX_PATH-1] of AnsiChar;
    end;
    PListDefaultParamStruct = ^TListDefaultParamStruct;
  type
    TListLoad = function(ParentWin: THandle; FileToLoad: PAnsiChar; ShowFlags: integer): THandle; stdcall;
    TListLoadW = function(ParentWin: THandle; FileToLoad: PWideChar; ShowFlags: integer): THandle; stdcall;
    TListLoadNext = function(ParentWin, PluginWin: THandle; FileToLoad: PAnsiChar; ShowFlags: integer): integer; stdcall;
    TListLoadNextW = function(ParentWin, PluginWin: THandle; FileToLoad: PWideChar; ShowFlags: integer): integer; stdcall;
    TListCloseWindow = procedure(ListWin: THandle); stdcall;
    TListGetDetectString = procedure(DetectString: PAnsiChar; MaxLen: integer); stdcall;
    TListSearchText = function(ListWin: THandle; SearchString: PAnsiChar;
                               SearchParameter: integer): integer; stdcall;
    TListSearchTextW = function(ListWin: THandle; SearchString: PWideChar;
                                SearchParameter: integer): integer; stdcall;
    TListSearchDialog = function(ListWin: THandle; FindNext: integer): integer; stdcall;
    TListSendCommand = function(ListWin: THandle; Command, Parameter: integer): integer; stdcall;
    TListPrint = function(ListWin: THandle; FileToPrint, DefPrinter: PAnsiChar;
                          PrintFlags: integer; Margins: PRect): integer; stdcall;
    TListPrintW = function(ListWin: THandle; FileToPrint, DefPrinter: PWideChar;
                           PrintFlags: integer; Margins: PRect): integer; stdcall;
    {$IFDEF WIN64}
    TListNotificationReceived = function(ListWin: THandle; Message: integer; wParam: WPARAM; lParam: LPARAM): integer; stdcall;
    {$ELSE}
    TListNotificationReceived = function(ListWin: THandle; Message: integer; wParam, lParam: integer): integer; stdcall;
    {$ENDIF}
    TListSetDefaultParams = procedure(dps: PListDefaultParamStruct); stdcall;
    TListGetPreviewBitmap = function(FileToLoad: PAnsiChar; Width, Height: integer;
        contentbuf: PAnsiChar; contentbuflen: integer): hBitmap; stdcall;
    TListGetPreviewBitmapW = function(FileToLoad: PWideChar; Width, Height: integer;
        contentbuf: PAnsiChar; contentbuflen: integer): hBitmap; stdcall;
  type
    TMethods = record
      ListLoad: TListLoad;
      ListLoadW: TListLoadW;
      ListLoadNext: TListLoadNext;
      ListLoadNextW: TListLoadNextW;
      ListCloseWindow: TListCloseWindow;
      ListGetDetectString: TListGetDetectString;
      ListSearchText: TListSearchText;
      ListSearchTextW: TListSearchTextW;
      ListSearchDialog: TListSearchDialog;
      ListSendCommand: TListSendCommand;
      ListPrint: TListPrint;
      ListPrintW: TListPrintW;
      ListNotificationReceived: TListNotificationReceived;
      ListSetDefaultParams: TListSetDefaultParams;
      ListGetPreviewBitmap: TListGetPreviewBitmap;
      ListGetPreviewBitmapW: TListGetPreviewBitmapW;
    end;
  {$ENDREGION}
  private
    FPluginFilename: string;
    FParentWin: HWND;
    FDefaultIniFile: string;
    FDLL: THandle;
    FMethods: TMethods;
    FPluginWin: HWND;

    FLoadedFile: string;
  public
    constructor Create(const ParentWin: HWND; const PluginFilename, DefaultIniFile: string);
    destructor  Destroy; override;

    // thin wrapper methods to make use of the plugin more transparent
    function Load(const FileToLoad: string; const ShowFlags: integer): HWND;
    function LoadNext(const FileToLoad: string; const ShowFlags: integer): boolean;
    procedure CloseWindow; // called in Destroy
    function GetDetectString: string;
    function SearchText(const SearchString: string; SearchParameter: integer): boolean;
    function SearchDialog(FindNext: boolean): boolean;
    function SendCommand(const Command, Parameter: integer): boolean;
    function Print(const DefPrinter: string = ''; const PrintFlags: integer = 0; const Margins: PRect = nil): boolean; overload;
    function Print(const DefPrinter: string; const PrintFlags: integer; const Margins: TRect): boolean; overload; inline;
    function NotificationReceived(const Message: integer; const wParam: WPARAM; const lParam: LPARAM): LRESULT;

    function GetPreviewBitmap(const FileToLoad: string; const Width, Height: integer; ContentBuffer: TStream = nil): hBitmap;

    // properties
    property PluginFilename: string read FPluginFilename;
    property ParentWindow: HWND     read FParentWin;
    property PluginWindow: HWND     read FPluginWin;
    property Methods: TMethods      read FMethods;
    property LoadedFilename: string read FLoadedFile;
  {$REGION ' Wlx plugin consts '}
  const
    LC_COPY = 1;
    LC_NEWPARAMS = 2;
    LC_SELECTALL = 3;
    LC_SETPERCENT = 4;
    LCP_WRAPTEXT = 1;
    LCP_FITTOWINDOW = 2;
    LCP_ANSI = 4;
    LCP_ASCII = 8;
    LCP_VARIABLE = 12;
    LCP_FORCESHOW = 16;
    LCP_FITLARGERONLY = 32;
    LCP_CENTER = 64;
    LCS_FINDFIRST = 1;
    LCS_MATCHCASE = 2;
    LCS_WHOLEWORDS = 4;
    LCS_BACKWARDS = 8;
    ITM_PERCENT = $FFFE;
    ITM_FONTSTYLE = $FFFD;
    ITM_WRAP = $FFFC;
    ITM_FIT = $FFFB;
    ITM_NEXT = $FFFA;
    ITM_CENTER = $FFF9;
    LISTPLUGIN_OK = 0;
    LISTPLUGIN_ERROR = 1;
  {$ENDREGION}
  end;

implementation
uses
  SysUtils, RTTI, AnsiStrings;

{ ================================================================================================ }
{ TWlxPluginWrapper }

{ ------------------------------------------------------------------------------------------------ }
constructor TWlxPluginWrapper.Create(const ParentWin: HWND; const PluginFilename, DefaultIniFile: string);
var
  DPS: TListDefaultParamStruct;
begin
  FParentWin := ParentWin;
  FPluginFilename := PluginFilename;
  FDefaultIniFile := DefaultIniFile;

  FDLL := LoadLibrary(PChar(PluginFilename));
  if FDLL = 0 then
    RaiseLastOSError;
  try
    FMethods.ListLoad := GetProcAddress(FDLL, 'ListLoad');
    FMethods.ListLoadW := GetProcAddress(FDLL, 'ListLoadW');
    FMethods.ListLoadNext := GetProcAddress(FDLL, 'ListLoadNext');
    FMethods.ListLoadNextW := GetProcAddress(FDLL, 'ListLoadNextW');
    FMethods.ListCloseWindow := GetProcAddress(FDLL, 'ListCloseWindow');
    FMethods.ListGetDetectString := GetProcAddress(FDLL, 'ListGetDetectString');
    FMethods.ListSearchText := GetProcAddress(FDLL, 'ListSearchText');
    FMethods.ListSearchTextW := GetProcAddress(FDLL, 'ListSearchTextW');
    FMethods.ListSearchDialog := GetProcAddress(FDLL, 'ListSearchDialog');
    FMethods.ListSendCommand := GetProcAddress(FDLL, 'ListSendCommand');
    FMethods.ListPrint := GetProcAddress(FDLL, 'ListPrint');
    FMethods.ListPrintW := GetProcAddress(FDLL, 'ListPrintW');
    FMethods.ListNotificationReceived := GetProcAddress(FDLL, 'ListNotificationReceived');
    FMethods.ListSetDefaultParams := GetProcAddress(FDLL, 'ListSetDefaultParams');
    FMethods.ListGetPreviewBitmap := GetProcAddress(FDLL, 'ListGetPreviewBitmap');
    FMethods.ListGetPreviewBitmapW := GetProcAddress(FDLL, 'ListGetPreviewBitmapW');

    if Assigned(FMethods.ListSetDefaultParams) then begin
      DPS.size := SizeOf(DPS);
      {$MESSAGE WARN 'TODO: Use the correct plugin version!'}
      DPS.PluginInterfaceVersionHi := 1;
      DPS.PluginInterfaceVersionLow := 0;
      AnsiStrings.StrCopy(@DPS.DefaultIniName[0], PAnsiChar(AnsiString(DefaultIniFile)));
      FMethods.ListSetDefaultParams(@DPS);
    end;
  except
    FreeLibrary(FDLL);
    raise;
  end;
end {TWlxPluginWrapper.Create};
{ ------------------------------------------------------------------------------------------------ }
destructor TWlxPluginWrapper.Destroy;
begin
  try
    CloseWindow;
    if FDLL <> 0 then
      FreeLibrary(FDLL);
  except
    inherited;
    raise;
  end;
end {TWlxPluginWrapper.Destroy};

{ ------------------------------------------------------------------------------------------------ }
procedure TWlxPluginWrapper.CloseWindow;
begin
  if FPluginWin = 0 then
    Exit;
  try
    if Assigned(FMethods.ListCloseWindow) then
      FMethods.ListCloseWindow(FPluginWin)
    else
      DestroyWindow(FPluginWin);
  finally
    FPluginWin := 0;
  end;
end {TWlxPluginWrapper.CloseWindow};

{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.GetDetectString: string;
var
  Buffer: AnsiString;
begin
  if not Assigned(FMethods.ListGetDetectString) then
    Exit;
  Buffer := StringOfChar(AnsiChar(#0), 2048);
  FMethods.ListGetDetectString(PAnsiChar(Buffer), Length(Buffer));
  Result := string(PAnsiChar(Buffer));
end {TWlxPluginWrapper.GetDetectString};

{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.GetPreviewBitmap(const FileToLoad: string;
                                            const Width, Height: integer;
                                            ContentBuffer: TStream): hBitmap;
const
  cMaxBufferSize = 8192;
var
  OwnBuffer: Boolean;
  Buffer: RawByteString;
  BufferSize: integer;
begin
  Result := 0;
  if not (Assigned(FMethods.ListGetPreviewBitmapW) or Assigned(FMethods.ListGetPreviewBitmap)) then
    Exit;

  OwnBuffer := not Assigned(ContentBuffer);
  if OwnBuffer then
    ContentBuffer := TFileStream.Create(FileToLoad, fmOpenRead or fmShareDenyNone);
  try
    if ContentBuffer.Size >= cMaxBufferSize then
      BufferSize := cMaxBufferSize
    else
      BufferSize := ContentBuffer.Size;
    SetLength(Buffer, BufferSize);
    if Assigned(FMethods.ListGetPreviewBitmapW) then begin
      Result := FMethods.ListGetPreviewBitmapW(PWideChar(FileToLoad), Width, Height, PAnsiChar(Buffer), BufferSize);
    end else if Assigned(FMethods.ListGetPreviewBitmap) then begin
      Result := FMethods.ListGetPreviewBitmap(PAnsiChar(AnsiString(FileToLoad)), Width, Height, PAnsiChar(Buffer), BufferSize);
    end;
  finally
    if OwnBuffer then
      ContentBuffer.Free;
  end;
end {TWlxPluginWrapper.GetPreviewBitmap};

{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.Load(const FileToLoad: string; const ShowFlags: integer): HWND;
begin
  Result := 0;
  if Assigned(FMethods.ListLoadW) or Assigned(FMethods.ListLoad) then begin
    if Assigned(FMethods.ListLoadW) then begin
      Result := FMethods.ListLoadW(FParentWin, PChar(FileToLoad), ShowFlags);
    end else if Assigned(FMethods.ListLoad) then begin
      Result := FMethods.ListLoad(FParentWin, PAnsiChar(AnsiString(FileToLoad)), ShowFlags);
    end;
    if IsWindow(Result) then begin
      FLoadedFile := FileToLoad;
      SetParent(Result, FParentWin);
    end;
  end;
  FPluginWin := Result;
end {TWlxPluginWrapper.Load};

{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.LoadNext(const FileToLoad: string; const ShowFlags: integer): boolean;
begin
  Result := False;
  if not (Assigned(FMethods.ListLoadNextW) or Assigned(FMethods.ListLoadNext)) then
    Exit;
  if Assigned(FMethods.ListLoadNextW) then begin
    Result := FMethods.ListLoadNextW(FParentWin, FPluginWin, PChar(FileToLoad), ShowFlags) = LISTPLUGIN_OK;
  end else if Assigned(FMethods.ListLoadNext) then begin
    Result := FMethods.ListLoadNext(FParentWin, FPluginWin, PAnsiChar(AnsiString(FileToLoad)), ShowFlags) = LISTPLUGIN_OK;
  end;
  if Result then
    FLoadedFile := FileToLoad;
end {TWlxPluginWrapper.LoadNext};

{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.NotificationReceived(const Message: integer;
  const wParam: WPARAM; const lParam: LPARAM): LRESULT;
begin
  Result := 0;
  if not Assigned(FMethods.ListNotificationReceived) then
    Exit;
  Result := FMethods.ListNotificationReceived(FPluginWin, Message, wParam, lParam);
end {TWlxPluginWrapper.NotificationReceived};

{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.Print(const DefPrinter: string; const PrintFlags: integer;
                                  const Margins: PRect): boolean;
begin
  Result := False;
  if not (Assigned(FMethods.ListPrintW) or Assigned(FMethods.ListPrint)) then
    Exit;
  if Assigned(FMethods.ListPrintW) then begin
    Result := FMethods.ListPrintW(FPluginWin,
                                  PChar(FLoadedFile),
                                  PChar(DefPrinter),
                                  PrintFlags,
                                  Margins) = LISTPLUGIN_OK;
  end else if Assigned(FMethods.ListPrint) then begin
    Result := FMethods.ListPrint(FPluginWin,
                                  PAnsiChar(AnsiString(FLoadedFile)),
                                  PAnsiChar(AnsiString(DefPrinter)),
                                  PrintFlags,
                                  Margins) = LISTPLUGIN_OK;
  end;
end {TWlxPluginWrapper.Print};
{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.Print(const DefPrinter: string; const PrintFlags: integer;
                                  const Margins: TRect): boolean;
begin
  Result := Print(DefPrinter, PrintFlags, @Margins);
end {TWlxPluginWrapper.Print};

{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.SearchDialog(FindNext: boolean): boolean;
begin
  if Assigned(FMethods.ListSearchDialog) then
    Result := FMethods.ListSearchDialog(FPluginWin, Ord(FindNext)) = LISTPLUGIN_OK
  else
    Result := False;
end {TWlxPluginWrapper.SearchDialog};

{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.SearchText(const SearchString: string; SearchParameter: integer): boolean;
begin
  if Assigned(FMethods.ListSearchTextW) then
    Result := FMethods.ListSearchTextW(FPluginWin, PChar(SearchString), SearchParameter) = LISTPLUGIN_OK
  else if Assigned(FMethods.ListSearchText) then
    Result := FMethods.ListSearchText(FPluginWin, PAnsiChar(AnsiString(SearchString)), SearchParameter) = LISTPLUGIN_OK
  else
    Result := False;
end {TWlxPluginWrapper.SearchText};

{ ------------------------------------------------------------------------------------------------ }
function TWlxPluginWrapper.SendCommand(const Command, Parameter: integer): boolean;
begin
  if Assigned(FMethods.ListSendCommand) then
    Result := FMethods.ListSendCommand(FPluginWin, Command, Parameter) = LISTPLUGIN_OK
  else
    Result := False;
end {TWlxPluginWrapper.SendCommand};

end.
