////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component crwdaq.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit provides wrapper classes to load and call DLL plugins.           //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20241102 - Creation, uses _crw_dcc32.pas                                   //
// 20241109 - Modified to use interfaces.                                     //
// 20260130 - PluginDllList                                                   //
////////////////////////////////////////////////////////////////////////////////

unit _crw_plugin_wrapper; // crwdaq plugin wrapper

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_fpu, _crw_ef, _crw_str, _crw_fio, _crw_fifo,
 _crw_proc, _crw_gloss, _crw_sect, _crw_task, _crw_utf8, _crw_dbglog,
 _crw_apputils, _crw_sesman, _crw_if_masters, _crw_crwapi;

 ///////////////////////////////////////////////////////////////////////////////
 // Базовый класс интерфейса, служащего для подключения динамических          //
 // расширений пакета CRWDAQ. Обратите внимание, PluginApi не использует      //
 // счетчик ссылок, т.к. наследуется от TNoRefCountMasterObject.              //
 ///////////////////////////////////////////////////////////////////////////////
type
 TPluginApi = class(TNoRefCountMasterObject)
 public
  //
  // 0    - Действия сервера перед вызовом плагина.
  //
  procedure ServerActionsBeforeExecution; virtual; abstract;
  //
  // 1    - Действия сервера после вызова плагина.
  //
  procedure ServerActionsAfterExecution;  virtual; abstract;
  //
  // 2    - CrwApi interface to execute.
  //
  function  CrwApi:ICrwApi;               virtual; abstract;
 protected
  function  RedirectStdInToFifo(var stdIn:Text; aFifo:TFifo):Boolean;
  function  RedirectStdOutToFifo(var stdOut:Text; aFifo:TFifo):Boolean;
 end;

 ///////////////////////////////////////////////////////////////////////////////
 // TPluginWrapper can help you to load plugin DLL and run plugin function,   //
 // which exported by this DLL. Plugin function have signature:               //
 //  function(Api:TPluginApi):Integer; AbiCall;                               //
 //    where AbiCall is StdCall for Windows or cdecl for Unix.                //
 //    Correct AbiCall contained in _crw_plugin_abicall.inc, so you can       //
 //    include {$I _crw_plugin_abicall.inc} and use definition:               //
 //  function(Api:TPluginApi):Integer; {$I _crw_plugin_abicall.inc};          //
 // Api class provides capabilities for main program <--> plugin interaction. //
 // Api class must be abstract virtual class, I mean, all members of this     //
 // class must be functions/procedures marked as "virtual; abstract;"         //
 // Main program create inherited Api class to overload abstract methods, but //
 // plugin knows only abstract Api. Plugin function executes in caller        //
 // context (address space, thread etc), but can use only methods provided by //
 // Api class.                                                                //
 // Publuc methods are:                                                       //
 //  DllInst    Return DLL instance <> 0, or 0 if DLL was not loaded          //
 //  DllPath    Return DLL file path                                          //
 //  PluginName Return plugin function name                                   //
 //  DllLoad    Load DLL, find plugin function address.                       //
 //             Return DLL instance <> 0 if Ok or 0 if any error.             //
 //  DllFree    Free DLL, if one was loaded.                                  //
 //  Execute    Load DLL, if need, and execute plugin function.               //
 //             Return Integer result of plugin function in lower 32 bits.    //
 //             Return Int64(-1) if any error.                                //
 // Example:                                                                  //
 //  Plugin DLL:                                                              //
 //   Library PluginLib;                                                      //
 //   uses _CrwApi;                                                           //
 //   function PluginExample(Api:TPluginApi):Integer; StdCall;                //
 //   begin                                                                   //
 //    with Api,SysApi do                                                     //
 //    if InitStdOut(Output) then begin                                       //
 //     writeln('Message from Plugin DLL!');                                  //
 //    end;                                                                   //
 //   end;                                                                    //
 //  Main program:                                                            //
 //   Api:=TCrwApiServer.Create;                                              //
 //   Plugin:=NewPluginWrapper('PluginLib.dll','PluginExample');              //
 //   Code:=Plugin.Execute(Api);                                              //
 //   if Code=-1 then writeln('Error') else writeln('Result=',Integer(Code)); //
 //   Kill(Plugin);                                                           //
 ///////////////////////////////////////////////////////////////////////////////
type
 EPluginFailure = class(EEchoException);
 TPluginWrapper = class(TMasterObject)
 private
  myDllInst     : HMODULE;
  myDllPath     : LongString;
  myPluginFunc  : TPluginFun;
  myPluginName  : LongString;
  myDllInstPath : LongString;
  function    GetDllInst:HMODULE;
  function    GetDllPath:LongString;
  function    GetDllInstPath:LongString;
  function    GetPluginName:LongString;
 protected
  procedure   ErrorFound(E:Exception; const Note:LongString=''); override;
 public
  constructor Create(const aDllPath,aPluginName:LongString);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property    DllInst     : HMODULE     read GetDllInst;     // DLL Handle
  property    DllPath     : LongString  read GetDllPath;     // Original DLL
  property    DllInstPath : LongString  read GetDllInstPath; // Instance DLL
  property    PluginName  : LongString  read GetPluginName;
  function    DllLoad     : HMODULE;
  procedure   DllFree;
  function    Execute(Api:TPluginApi):Int64;
 end;

function  NewPluginWrapper(const aDllPath,aPluginName:LongString):TPluginWrapper;
procedure Kill(var TheObject:TPluginWrapper); overload;

 ///////////////////////////////////////////////////////////////////////////////
 // TPluginDllList - list of loaded plugin's DLL instance files.              //
 // To avoid plugin instances conflict, make a copy of DLL for each plugin    //
 // instance. First instance running with original DLL, others make a copy    //
 // of DLL file in $CRW_DAQ_SYS_VAR_TMP_DIR/plugins directory.                //
 ///////////////////////////////////////////////////////////////////////////////
type
 TPluginDllList = class(TLatch)
 private
  myFileNames:TStringList;
 public
  constructor Create;
  destructor  Destroy; override;
 public
  function FileNames:LongString;
  function HasFile(aFileName:LongString):Boolean;
  function AddFile(aFileName:LongString):Boolean;
  function Delete(aFileName:LongString):Boolean;
  function PrepareInst(const aFileName:LongString; Mode:Integer):LongString;
 public
  class var MaxInstNumber:Integer;
  class function ValidateDllPath(const aFileName:LongString):LongString;
 end;

function PluginDllList:TPluginDllList;

function dlc_PluginBug:Integer;
function dlc_PluginLog:Integer;

implementation

uses LazUtf8;

/////////////////
// Debug routines
/////////////////

function dlc_PluginBug:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_PluginBug');
 Result:=dlc;
end;

function dlc_PluginLog:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_PluginLog');
 Result:=dlc;
end;

 ////////////////////////////
 // TPluginApi implementation
 ////////////////////////////
function TPluginApi.RedirectStdInToFifo(var stdIn:Text; aFifo:TFifo):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if Assigned(aFifo) then begin
  SmartFileClose(stdIn);
  AssignFifo(stdIn,aFifo);
  SetInOutRes(0);
  Reset(stdIn);
  Result:=(IOResult=0);
 end;
end;

function TPluginApi.RedirectStdOutToFifo(var stdOut:Text; aFifo:TFifo):Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 if Assigned(aFifo) then begin
  if not IsFileClosed(stdOut) then Flush(stdOut);
  SmartFileClose(stdOut);
  AssignFifo(stdOut,aFifo);
  SetInOutRes(0);
  Append(stdOut);
  Result:=(IOResult=0);
 end;
end;

 ////////////////////////////////
 // TPluginWrapper implementation
 ////////////////////////////////
constructor TPluginWrapper.Create(const aDllPath,aPluginName:LongString);
begin
 inherited Create;
 myDllInst:=0;
 myDllPath:=PluginDllList.ValidateDllPath(aDllPath);
 myDllInstPath:=PluginDllList.PrepareInst(myDllPath,1);
 myPluginFunc:=nil;
 myPluginName:=Trim(aPluginName);
 Exceptions:=false;
 ErrorReportProc:=DefaultObjectErrorReportProc;
end;

destructor TPluginWrapper.Destroy;
begin
 DllFree;
 myDllPath:='';
 myPluginName:='';
 myDllInstPath:='';
 inherited Destroy;
end;

procedure TPluginWrapper.AfterConstruction;
begin
 inherited AfterConstruction;
 PluginDllList.AddFile(DllInstPath);
end;

procedure TPluginWrapper.BeforeDestruction;
begin
 PluginDllList.Delete(DllInstPath);
 inherited BeforeDestruction;
end;

function TPluginWrapper.GetDllInst:HMODULE;
begin
 if Assigned(Self) then Result:=myDllInst else Result:=0;
end;

function TPluginWrapper.GetDllPath:LongString;
begin
 if Assigned(Self) then Result:=myDllPath else Result:='';
end;

function TPluginWrapper.GetDllInstPath:LongString;
begin
 if Assigned(Self) then Result:=myDllInstPath else Result:='';
end;

function TPluginWrapper.GetPluginName:LongString;
begin
 if Assigned(Self) then Result:=myPluginName else Result:='';
end;

procedure TPluginWrapper.ErrorFound(E:Exception; const Note:LongString);
begin
 if Exceptions then begin
  if (E is Exception)
  then RAISE EPluginFailure.Create(E.Message)
  else RAISE EPluginFailure.Create(Note);
 end else ErrorReport(E,Note);
end;

function TPluginWrapper.DllLoad:HMODULE;
begin
 Result:=0;
 if Assigned(Self) then
 try
  myPluginFunc:=nil;
  if (DllInst=0) then begin
   if FileExists(DllInstPath)
   then myDllInst:=SafeLoadLibrary(DllInstPath)
   else RAISE EPluginFailure.Create(Format('File "%s" not found.',[DllInstPath]));
  end;
  if (DllInst=0)
  then RAISE EPluginFailure.Create(Format('Error SafeLoadLibrary("%s"): "%s".',
                                     [DllInstPath,SysErrorMessage(GetLastOsError)]));
  myPluginFunc:=TPluginFun(System.GetProcAddress(DllInst,PluginName));
  if Assigned(myPluginFunc)
  then Result:=DllInst
  else RAISE EPluginFailure.Create(Format('Function "%s" not found  in "%s".',
                                     [PluginName,DllInstPath]));
 except
  on E:Exception do begin
   DllFree;
   ErrorFound(E,'DllLoad');
  end;
 end;
end;

procedure TPluginWrapper.DllFree;
begin
 if Assigned(Self) then
 try
  try
   if (DllInst<>0) then
   if not FreeLibrary(DllInst)
   then RAISE EPluginFailure.Create(Format('Error FreeLibrary("%s"): "%s".',
                                    [DllInstPath,SysErrorMessage(GetLastOsError)]));
  finally
   myPluginFunc:=nil;
   myDllInst:=0;
  end;
 except
  on E:Exception do ErrorFound(E,'DllFree');
 end;
end;

function TPluginWrapper.Execute(Api:TPluginApi):Int64;
begin
 Result:=-1;
 if Assigned(Api) then
 if Assigned(Self) then
 try
  try
   if not Assigned(myPluginFunc) then DllLoad;
   if Assigned(myPluginFunc) then begin
    Api.ServerActionsBeforeExecution;
    try
     if not Assigned(Api.CrwApi)
     then raise ECrwApi.Create('CrwApi is not assigned.');
     Result:=myPluginFunc(Api.CrwApi);
    finally
     Api.ServerActionsAfterExecution;
    end;
   end;
  finally
   FpuSetCurrentModes(FpuDefaultModes);
   // FpuSetExceptions(false);
   FpuClearExceptions;
  end;
 except
  on E:Exception do ErrorFound(E,'Execute');
 end;
end;

function NewPluginWrapper(const aDllPath,aPluginName:LongString):TPluginWrapper;
begin
 Result:=nil;
 try
  Result:=TPluginWrapper.Create(aDllPath,aPluginName);
 except
  on E:Exception do BugReport(E,nil,'NewPluginWrapper');
 end;
end;

procedure Kill(var TheObject:TPluginWrapper); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

////////////////////////////////
// TPluginDllList implementation
////////////////////////////////

constructor TPluginDllList.Create;
begin
 inherited Create;
 myFileNames:=TStringList.Create;
 myFileNames.Duplicates:=dupIgnore;
 myFileNames.UseLocale:=False;
 myFileNames.Sorted:=True;
end;

destructor TPluginDllList.Destroy;
begin
 try
  Lock;
  Kill(myFileNames);
 finally
  UnLock;
 end;
 inherited Destroy;
end;

function TPluginDllList.FileNames:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  try
   Lock;
   Result:=myFileNames.Text;
  finally
   UnLock;
  end;
 except
  on E:Exception do BugReport(E,Self,'FileNames');
 end;
end;

function TPluginDllList.HasFile(aFileName:LongString):Boolean;
begin
 Result:=False;
 if Assigned(Self) then
 if IsNonEmptyStr(aFileName) then
 try
  aFileName:=ValidateDllPath(aFileName);
  try
   Lock;
   Result:=(myFileNames.IndexOf(aFileName)>=0);
  finally
   UnLock;
  end;
 except
  on E:Exception do BugReport(E,Self,'HasFile');
 end;
end;

function TPluginDllList.AddFile(aFileName:LongString):Boolean;
begin
 Result:=False;
 if Assigned(Self) then
 if IsNonEmptyStr(aFileName) then
 try
  aFileName:=ValidateDllPath(aFileName);
  try
   Lock;
   Result:=(myFileNames.Add(aFileName)>=0);
   if Result
   then DebugLog(dlc_PluginLog,'Init: '+aFileName)
   else DebugLog(dlc_PluginBug,'Fail: '+aFileName);
  finally
   UnLock;
  end;
 except
  on E:Exception do BugReport(E,Self,'AddFile');
 end;
end;

function TPluginDllList.Delete(aFileName:LongString):Boolean;
var i:Integer;
begin
 Result:=False;
 if Assigned(Self) then
 if IsNonEmptyStr(aFileName) then
 try
  aFileName:=ValidateDllPath(aFileName);
  try
   Lock;
   i:=myFileNames.IndexOf(aFileName);
   if (i>=0) then myFileNames.Delete(i);
   if (i>=0) then DebugLog(dlc_PluginLog,'Done: '+aFileName);
   Result:=True;
  finally
   UnLock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Delete');
 end;
end;

function TPluginDllList.PrepareInst(const aFileName:LongString; Mode:Integer):LongString;
var Src,Dir,Base,Ext,FName,cmd,ans:LongString; i:Integer;
begin
 Result:='';
 if Assigned(Self) then
 if IsNonEmptyStr(aFileName) then
 try
  Src:=ValidateDllPath(aFileName);
  Dir:=''; Base:=''; Ext:=''; FName:='';
  if not FileExists(Src) then Exit(Src);
  if not HasFile(Src) then Exit(Src);
  Dir:=AddPathDelim(SessionManager.VarTmpDir)+'plugins';
  Base:=ExtractBaseName(Src); Ext:=ExtractFileExt(Src);
  if not DirExists(Dir) then MkDir(Dir);
  if DirExists(Dir) then
  try
   Lock;
   for i:=1 to MaxInstNumber do begin
    FName:=AddPathDelim(Dir)+Format('%s_%d',[Base,i])+Ext;
    if HasFile(FName) then FName:='' else Break;
   end;
   if (FName<>'') then begin
    if HasFlags(Mode,1) then begin
     if FileCopy(Src,FName) then begin
      DebugLog(dlc_PluginLog,'Copy: '+FName);
      if not FileIsReadable(FName) or not FileIsExecutable(FName) then
      if IsUnix and FileIsReadable(Src) and FileIsExecutable(Src) then begin
       cmd:='chmod -c ugo+rx '+QArg(FName); ans:='';
       if RunCommandInDir(Dir,cmd,ans) then begin
        DebugLog(dlc_PluginLog,'Exec: '+cmd+EOL+ans);
       end else begin
        DebugLog(dlc_PluginBug,'Exec: '+cmd+EOL+ans);
       end;
      end;
     end else begin
      DebugLog(dlc_PluginBug,'Fail: '+FName);
     end;
    end;
    DebugLog(dlc_PluginLog,'Inst: '+FName);
    Result:=FName;
    Exit;
   end;
   Result:=Src;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'PrepareInst');
 end;
end;

class function TPluginDllList.ValidateDllPath(const aFileName:LongString):LongString;
var FName:LongString;
begin
 Result:='';
 if IsNonEmptyStr(aFileName) then begin
  FName:=DefaultExtension(Trim(aFileName),'.dll');
  FName:=UnifyFileAlias(AdaptDllFileName(FName),ua_FileLow);
  Result:=FName;
 end;
end;

///////////////////////////////
// PluginDllList implementation
///////////////////////////////

const
 ThePluginDllList:TPluginDllList=nil;

function PluginDllList:TPluginDllList;
begin
 if not Assigned(ThePluginDllList) then begin
  ThePluginDllList:=TPluginDllList.Create;
  ThePluginDllList.Master:=@ThePluginDllList;
 end;
 Result:=ThePluginDllList;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_plugin_wrapper;
begin
 dlc_PluginLog;
 dlc_PluginBug;
 PluginDllList.Ok;
 PluginDllList.MaxInstNumber:=32;
end;

procedure Free_crw_plugin_wrapper;
begin
 Kill(TObject(ThePluginDllList));
end;

initialization

 Init_crw_plugin_wrapper;

finalization

 Free_crw_plugin_wrapper;

end.

//////////////
// END OF FILE
//////////////

