wlxproc.pas

ATViewer is a component for Delphi/C++Builder, which allows to view files of various types. There is

{**************************************************}
{                                                  }
{  WLXProc - Total Commander Lister API Wrapper    }
{  Copyright (C) 2006-2008 Alexey Torgashin        }
{  http://atorg.net.ru                             }
{  [e-mail]                          }
{                                                  }
{**************************************************}

{$BOOLEVAL OFF} //Short boolean evaluation required.

{$I ATViewerOptions.inc} //ATViewer options.

unit WLXProc;

interface

uses
  Windows, Messages, SysUtils, Controls,
  {$ifdef WLX_FORM} Forms, {$endif}
  WLXPlugin;

const
  WlxPluginsMaxCount = 200;

type
  TListLoad = function(ParentWin: THandle; FileToLoad: PChar; ShowFlags: Integer): THandle; stdcall;
  TListLoadNext = function(ParentWin, PluginWin: THandle; FileToLoad: PChar;
                           ShowFlags: Integer): Integer; stdcall;
  TListCloseWindow = procedure(ListWin: THandle); stdcall;
  TListSetDefaultParams = procedure(dps: pListDefaultParamStruct); stdcall;
  TListGetDetectString = procedure(DetectString: PChar; maxlen: Integer); stdcall;
  TListSendCommand = function(ListWin: THandle; Command, Parameter: Integer): Integer; stdcall;
  TListPrint = function(ListWin: THandle; FileToPrint, DefPrinter: PChar;
                        PrintFlags: Integer; const {was var!} Margins: TRect): Integer; stdcall;
  TListSearchText = function(ListWin: THandle; SearchString: PChar;
                             SearchParameter: Integer): Integer; stdcall;
  TListSearchDialog = function(ListWin: THandle; FindNext: Integer): Integer; stdcall;


type
  TWlxFileName = AnsiString; //No support for Unicode plugins filenames currently

  TWlxNameEvent = procedure(const APluginName: string) of object;

  TWlxPluginRecord = record
    FileName: TWlxFileName;
    DetectStr: string;
    HLib: THandle;
    HWnd: THandle;
    ListLoad: TListLoad;
    ListLoadNext: TListLoadNext;
    ListCloseWindow: TListCloseWindow;
    ListSetDefaultParams: TListSetDefaultParams;
    ListSendCommand: TListSendCommand;
    ListPrint: TListPrint;
    ListSearchText: TListSearchText;
    ListSearchDialog: TListSearchDialog;
  end;

  TWlxPlugins = class
  private
    FPlugins: array[1..WlxPluginsMaxCount] of TWlxPluginRecord;
    FCount: Word;
    FActive: Word;
    FActiveFileName: AnsiString;
    FActivePosPercent: Word;
    FActiveForceMode: Boolean;
    FParent: TWinControl;
    FIniFileName: AnsiString;
    {$ifdef WLX_FORM}
    FTCWindow: TForm;
    {$endif}
    FFocused: Boolean;
    FBeforeLoading: TWlxNameEvent;
    FAfterLoading: TWlxNameEvent;
    function IsIndexValid(n: Word): Boolean;
    function Present(const AFileName: TWlxFileName): Boolean;
    function Load(n: Word): Boolean;
    procedure Unload(n: Word);
    function OpenWnd(n: Word; const AFileName: AnsiString; AFlags: Integer): Boolean;
    function ReopenWnd(const AFileName: AnsiString; AFlags: Integer): Boolean;
    procedure CloseWnd(n: Word);
    procedure ResizeWnd(n: Word; const ARect: TRect);
    procedure SendCommandWnd(n: Word; ACmd, AParam: Integer);
    procedure SetActivePosPercent(AValue: Word);
    function GetName(n: Word): string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure InitParams(AParent: TWinControl; const AIniFileName: AnsiString);
    function AddPlugin(const AFileName: TWlxFileName; const ADetect: string): Boolean;
    function GetPlugin(n: Word; var AFileName: TWlxFileName; var ADetect: string): Boolean;
    procedure ShowDebugInfo;
    function OpenMatched(const AFileName: WideString; AFit, AFitLargeOnly, ACenter, ATextWrap, AAnsiCP, ANewFile: Boolean): Boolean;
    procedure CloseActive;
    procedure ResizeActive(const ARect: TRect);
    procedure SendCommandToActive(ACmd, AParam: Integer);
    procedure SendParamsToActive(AFit, AFitLargeOnly, ACenter, ATextWrap, AAnsiCP: Boolean);
    function SendMessageToActive(const AMessage: TMessage): LRESULT;
    function PrintActive(const ARect: TRect): Boolean;
    function SearchActive(const AString: string; AFindFirst, AWholeWords, ACaseSens, ABackwards: Boolean): Boolean;
    function SearchDialogActive(AFindNext: Boolean): Boolean;
    function GetActiveName: string;
    procedure SetFocusToActive;
    property ActivePosPercent: Word read FActivePosPercent write SetActivePosPercent;
    function ActiveSupportsSearch: Boolean;
    function ActiveSupportsPrint: Boolean;
    function ActiveSupportsCommands: Boolean;
    function ActiveWindowHandle: THandle;
  published
    property IsFocused: Boolean read FFocused write FFocused;
    property OnBeforeLoading: TWlxNameEvent read FBeforeLoading write FBeforeLoading;
    property OnAfterLoading: TWlxNameEvent read FAfterLoading write FAfterLoading;
  end;

function WlxGetDetectString(const AFileName: TWlxFileName): string;


implementation

uses
  ATxSProc, ATxFProc, ATViewerMsg;

{ Not published Lister API constants }

const
  cWlxFindFirst = 0;
  cWlxFindNext = 1;


{ Helper fake TC window }

{$ifdef WLX_FORM}

{$R WLXProc_FormTC.dfm}

type
  TTOTAL_CMD = class(TForm)
  public
  end;

{$endif}


{ Helper functions }

// Currently we use simplified detect-string checking:
//
// 1) If string is empty (i.e. it doesn't contain 'EXT=' part), it's matched.
// 2) If it's not empty, it's matched when corresponding 'EXT=' part is present.
// 3) 'FORCE' special word is supported now. But it is expected only in its special
//    meaning, i.e. not as a part of file extension.
//
// To-do: add full parsing of detect-strings.
//

function WlxDetectMatch(const AFileName, ADetectStr: AnsiString; AForceMode: Boolean): Boolean;
var
  FN, Str, Ext: AnsiString;
  Empty, ExtMatch, ForceMatch: Boolean;
begin
  //Delete last slash from folder names:
  FN := AFileName;
  SDelLastSlash(FN);

  Str := UpperCase(ADetectStr);
  Ext := UpperCase(ExtractFileExt(FN));
  Delete(Ext, 1, 1);

  Empty := Pos('EXT=', Str) = 0;
  ExtMatch := Pos(Format('EXT="%s"', [Ext]), Str) > 0;
  ForceMatch := Pos('FORCE', Str) > 0;

  if AForceMode and ForceMatch then
    begin Result := True; Exit end;

  if Empty then 
    begin Result := True; Exit end;

  Result := ExtMatch;
end;


procedure MsgErrorWlx(const AFileName: TWlxFileName; const AFuncName: AnsiString);
begin
  MsgError(Format(MsgViewerWlxException, [ExtractFileName(AFileName), AFuncName]));
end;


function WlxGetDetectString(const AFileName: TWlxFileName): string;
const
  cBufSize = 4 * 1024; //4 Kb should be enough
var
  HLib: THandle;
  Buffer: array[0 .. cBufSize - 1] of Char;
  ListGetDetectString: TListGetDetectString;
begin
  Result := '';

  HLib := LoadLibrary(PChar(AFileName));
  if HLib <> 0 then
  begin
    ListGetDetectString := GetProcAddress(HLib, 'ListGetDetectString');

    if Assigned(ListGetDetectString) then
      try
        FillChar(Buffer, SizeOf(Buffer), 0);
        ListGetDetectString(Buffer, SizeOf(Buffer));
        Result := Buffer;
      except
        MsgErrorWlx(AFileName, 'ListGetDetectString');
      end;

    FreeLibrary(HLib);
  end;
end;

procedure InitPluginRecord(var Rec: TWlxPluginRecord);
begin
  with Rec do
  begin
    HLib := 0;
    HWnd := 0;
    ListLoad := nil;
    ListLoadNext := nil;
    ListCloseWindow := nil;
    ListSetDefaultParams := nil;
    ListSendCommand := nil;
    ListPrint := nil;
    ListSearchText := nil;
    ListSearchDialog := nil;
  end;
end;

function ParamsToFlags(AFit, AFitLargeOnly, ACenter, ATextWrap, AAnsiCP, AForceMode: Boolean): Integer;
begin
  Result := 0;

  if AFit then
    Inc(Result, lcp_fittowindow);

  if AFit and AFitLargeOnly then
    Inc(Result, lcp_fitlargeronly);

  if ACenter then
    Inc(Result, lcp_center);

  if ATextWrap then
    Inc(Result, lcp_wraptext);

  if AAnsiCP then
    Inc(Result, lcp_ansi)
  else
    Inc(Result, lcp_ascii);

  if AForceMode then
    Inc(Result, lcp_forceshow);
end;


{ Helper cracker class }

type
  TWinControlCracker = class(TWinControl);


{ TWlxPlugins }

constructor TWlxPlugins.Create;
begin
  inherited Create;

  FillChar(FPlugins, SizeOf(FPlugins), 0);
  FCount := 0;
  FActive := 0;
  FActiveFileName := '';
  FActivePosPercent := 0;
  FActiveForceMode := False;
  FParent := nil;
  FIniFileName := '';

  {$ifdef WLX_FORM}
  FTCWindow := nil;
  {$endif}

  FFocused := False;
  FBeforeLoading := nil;
  FAfterLoading := nil;
end;

destructor TWlxPlugins.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TWlxPlugins.Clear;
var
  i: Word;
begin
  CloseActive;

  for i := FCount downto 1 do
    with FPlugins[i] do
    begin
      FileName := '';
      DetectStr := '';
    end;

  FCount := 0;
  FActive := 0;
  FActiveFileName := '';
  FActivePosPercent := 0;
  FActiveForceMode := False;
end;

function TWlxPlugins.IsIndexValid(n: Word): Boolean;
begin
  Result := (n > 0) and (n <= FCount);
end;

function TWlxPlugins.Present(const AFileName: TWlxFileName): Boolean;
var
  i: Word;
begin
  Result := False;
  for i := 1 to FCount do
    if StrIComp(PChar(AFileName), PChar(FPlugins[i].FileName)) = 0 then
      begin Result := True; Break end;
end;

function TWlxPlugins.AddPlugin(const AFileName: TWlxFileName; const ADetect: string): Boolean;
begin
  Result := (FCount < WlxPluginsMaxCount) and (not Present(AFileName));
  if Result then
  begin
    Inc(FCount);
    with FPlugins[FCount] do
    begin
      FileName := AFileName;
      DetectStr := ADetect;
      SReplaceAll(DetectStr, ' = ', '='); //Some plugins give string with 'EXT = "extension"'
      InitPluginRecord(FPlugins[FCount]);
    end;
  end;
end;

function TWlxPlugins.GetPlugin(n: Word; var AFileName: TWlxFileName; var ADetect: string): Boolean;
begin
  Result := IsIndexValid(n);
  if Result then
  begin
    AFileName := FPlugins[n].FileName;
    ADetect := FPlugins[n].DetectStr;
  end
  else
  begin
    AFileName := '';
    ADetect := '';
  end;
end;

procedure TWlxPlugins.InitParams(AParent: TWinControl; const AIniFileName: AnsiString);
begin
  FParent := AParent;
  FIniFileName := AIniFileName;
end;

procedure TWlxPlugins.Unload(n: Word);
begin
  if not IsIndexValid(n) then Exit;

  with FPlugins[n] do
    if HLib <> 0 then
    begin
      CloseWnd(n);
      {$ifdef WLX_UNLOAD}
      FreeLibrary(HLib);
      InitPluginRecord(FPlugins[n]);
      {$endif}
    end;