unit uPlugins;

interface

uses Windows, SysUtils;

type
  TStringArray = array of string;
  TCallState = (onGetProcsList, onInit, onDeInit, onProgress);
  TLibrary = record
    Lib: Cardinal;
    MainProc: function (State: TCallState): TStringArray; stdcall;
    Name: string;
  end;
  TFunction = record
    Func: function(Params: array of variant): variant; stdcall;
    Name: String;
    Lib: integer;
  end;

var
  Libs: array of TLibrary;
  Funcs: array of TFunction;
  LastError: string;

  OnError: procedure(Msg: string);
  function PluginLoad(FileName: string): boolean; stdcall;
  function PluginLoaded(FileName: string): boolean; stdcall;
  function Call(Func: string; Params: array of variant): variant; stdcall;

  procedure AddFunction(Name: string; Func: pointer);

implementation

function PluginLoaded(FileName: string): boolean;
var
  x: integer;
begin
  Result:=true;
  for x := 0 to length(Libs) - 1 do
    if lowercase(Libs[x].Name)=lowercase(ExtractFileName(FileName)) then exit;
  Result:=false;
end;

function Call(Func: string; Params: array of variant): variant;
var
  x: integer;
  Msg: string;
begin
  for x := 0 to length(Funcs) - 1 do
  if lowercase(Func)=Funcs[x].Name then
  begin
    try
      Result:=Funcs[x].Func(Params);
    except
      on E: Exception do
      begin
        Msg:='Error in library "'+Libs[Funcs[x].Lib].Name+'" in function "'+Funcs[x].Name+'": '+E.Message;
        LastError:=Msg;
        if @OnError=nil then raise Exception.Create(Msg) else OnError(Msg);        
      end;
    end;
    exit;
  end;
  Msg:='Function "'+Func+'" not found!';
  LastError:=Msg;
  if @OnError=nil then raise Exception.Create(Msg) else OnError(Msg);
end;

function PluginLoad(FileName: string): boolean;
var
  x: integer;
  SA: TStringArray;
  SendHandles: procedure(Procs: array of pointer); stdcall;
begin
  SetLength(Libs, length(Libs)+1);
  Libs[length(Libs)-1].Lib:=LoadLibrary(PChar(FileName));
  if Libs[length(Libs)-1].Lib=0 then                               //Lib loaded?
  begin
    SetLength(Libs, length(Libs)-1);
    Result:=false;
  end else
  begin
    Libs[length(Libs)-1].MainProc:=GetProcAddress(Libs[length(Libs)-1].Lib, 'MainProc');
    if @Libs[length(Libs)-1].MainProc=nil then                     //MainProc detected?
    begin
      SetLength(Libs, length(Libs)-1);
      Result:=false;
    end else
    begin
      Libs[length(Libs)-1].Name:=ExtractFileName(FileName);
      //Libs[length(Libs)-1].MainProc:=GetProcAddress(Libs[length(Libs)-1].Lib, 'MainProc');

      SendHandles:=GetProcAddress(Libs[length(Libs)-1].Lib, 'SendHandles');
      if @SendHandles<>nil then SendHandles([@Call, @PluginLoad, @PluginLoaded]);

      SA:=Libs[length(Libs)-1].MainProc(onGetProcsList);           //Loading procedures
      for x := 0 to length(SA) - 1 do
      begin
        SetLength(Funcs, length(Funcs)+1);
        Funcs[length(Funcs)-1].Func:=GetProcAddress(Libs[length(Libs)-1].Lib, PChar(SA[x]));
        if @Funcs[length(Funcs)-1].Func=nil then SetLength(Funcs, length(Funcs)-1) else
        begin
          Funcs[length(Funcs)-1].Name:=lowercase(SA[x]);
          Funcs[length(Funcs)-1].Lib:=length(Libs)-1;
        end;
      end;
      Result:=true;
    end;
  end;
end;

procedure AddFunction(Name: string; Func: pointer);
begin
  SetLength(Funcs, length(Funcs)+1);
  Funcs[length(Funcs)-1].Func:=Func;
  Funcs[length(Funcs)-1].Name:=lowercase(Name);
  Funcs[length(Funcs)-1].Lib:=0;
end;

initialization
  SetLength(Libs,1);
  Libs[0].Lib:=0;
  Libs[0].Name:='Core';
end.
