Plugins en Delphi

[elcolo83]

Hola a todos.... bueno, luego de andar por unos foros, leer un poco sobre el tema y finalmente sentarme a programar algo se me ocurrio hacer una Unit para administrar los plugins (archivos BPL) que una aplicacion pueda usar. Con esta unit podran usar facilmente los archivos bpl utilizados en este caso como plugins.
Aca va un poco de mi trabajo:

Código Delphi [-]
unit Plugins_Master_;

interface

uses
  Windows, SysUtils, Classes, Forms, Dialogs, Messages;
/////////////////////////////////////////////////////////////////////////////////////////////
///  Otras Unidades:
///  Messages, Variants, Graphics, Controls,  ComCtrls, StdCtrls, ShellApi
/////////////////////////////////////////////////////////////////////////////////////////////

type
  TExecuteRoutine = procedure(sender:TObject) of Object;

  TPluginsList = Record
    Activo: Boolean;
    NombreCorto, Plugin, PFORM, Command: string;
    AForm: TForm;
    hndl: HModule;
  End;

var
  inicio: boolean;
  Apl: TApplication;
  self_: TObject;
  PluginsList: array of TPlugInsList;


function SpStr(str: string): string;

Procedure Iniciar_PlugIn_Master(_Apl: TApplication; _self_: TObject);
function AddPlugin(Plugin, PFORM, Command, NombreCorto: string): boolean;
function ExecutePlugin(Plugin: string; p: integer): integer;
function Plugin_OFF(NombreCorto: string): boolean;
function Plugin_OFF_ALL: boolean;
function Plugin_ON(NombreCorto: string): boolean;
function Plugin_STATE(NombreCorto: string): boolean;
function Plugin_Name_Exist(NombreCorto: string): integer;
function Plugin_Exist(Plugin: string): integer;


implementation

function SpStr(str: string): string;
begin
  str:= lowercase(trim(str));
  if Str[1] in ['a'..'z'] then
    Str[1]:=  chr(ord(Str[1])-32);
  Result:= Str;
end;


Procedure Iniciar_PlugIn_Master(_Apl: TApplication; _self_: TObject);
begin
 Apl:= _Apl;
 Self_:= _self_;
 Inicio:= True;
end;

function AddPlugin(Plugin, PFORM, Command, NombreCorto: string): boolean;
////////////////////////////////////////////////////////////////////////////////////////
/// Agrega un Plug-In a la lista. Luego quedara disponible para su ejecución.
////////////////////////////////////////////////////////////////////////////////////////
var i: integer;
    esta: Boolean;
begin
if not inicio then
    begin
      Result:= false;
      exit;
    end;

esta:= False;
if (Plugin_Exist(Plugin)>-1)or(Plugin_Name_Exist(NombreCorto)>-1) then
    begin
      result:= false;
      exit;
    end;

SetLength(PluginsList, Length(PluginsList)+1); //agrego un lugar mas en el arreglo
PluginsList[Length(PluginsList)-1].Activo:= False;
PluginsList[Length(PluginsList)-1].Plugin:= LowerCase(Plugin);
PluginsList[Length(PluginsList)-1].PFORM:= PForm;
PluginsList[Length(PluginsList)-1].Command:= Command;
PluginsList[Length(PluginsList)-1].NombreCorto:= spStr(NombreCorto);
result:= true;
end;


function ExecutePlugin(Plugin: string; P: integer): integer;
////////////////////////////////////////////////////////////////////////////////////////
///  ExecutePluin se encarga de cargar el plug-in, ejecutarlo y agregarlo a la lista de
///  Plug-ins activos para darlos de baja cuendo ya no se utilice.
///  Result:
///     0: No hay Error;
///     1: No se econtro el procedimiento (command) buscado.
////////////////////////////////////////////////////////////////////////////////////////
var
  hndl: HModule;
  AClass: TPersistentClass;
  AForm: TForm;
  Routine: TMethod;
begin
if not inicio then
    begin
      Result:= -1;
      exit;
    end;

if FileExists(Plugin) then
  begin
    hndl:= LoadPackage(PluginsList[p].Plugin);
    AClass:= GetClass(PluginsList[p].PFORM);
    try
        if (AClass <> nil) then
          begin
            AForm:= TComponentClass(AClass).Create(Apl) as TForm;
            try
              Routine.Data:= Pointer(AForm);
              Routine.Code:= (AForm).MethodAddress(PluginsList[p].Command);

              if (Routine.Code = Nil) then
                begin
                  MessageDlg('Error al cargar el Plug-in', mterror, [mbOk], 0);
                  MessageDlg('Error, no se ha encontrado el procedimiento (Execute) para el correcto funcionamieno del Plug-in.', mtError, [mbOK], 0);
                  Result:= 1;
                  Exit;
                end;
              TExecuteRoutine(Routine)(self_);
              result:= 0;
            finally
              //AForm.Free;
            end;
            PluginsList[p].Activo:= True;
            PluginsList[p].hndl:= hndl;
            PluginsList[p].AForm:= AForm;//.Handle;
          end
        else
          MessageDlg('La clase para acceder al plug-in parece que no está correctamente registrada.', mtError, [mbOK], 0);
    except
      on E:Exception do
         MessageDlg('Error al cargar el plug-in.', mtError, [mbOK], 0);
    end;
  end;
end;



function Plugin_OFF(NombreCorto: string): boolean;
var i, j: integer;
    H: HWND;
    M: TMemoryBasicInformation;
begin
  Result:= True;
  if not inicio then
    begin
      Result:= false;
      exit;
    end;
try
  NombreCorto:= spStr(NombreCorto);
  for i := 0 to Length(PluginsList) - 1 do
      if (PluginsList[i].NombreCorto = NombreCorto)and(PluginsList[i].Activo) then
        begin
          try
            PluginsList[i].Activo:= False;
            //H:= PluginsList[i].HForm;
            //if h <> 0 then PostMessage(h, WM_DESTROY, 0, 0);
            h:= PluginsList[i].hndl;

            for j := Application.ComponentCount - 1 downto 0 do
              begin
                VirtualQuery(
                GetClass(Application.Components[j].ClassName),
                        M, SizeOf(M));
                if (h = 0) or
                  (HMODULE(M.AllocationBase) = h) then
                      Application.Components[j].Free;
              end;
            UnRegisterModuleClasses(h);
            UnLoadPackage(h);

            Result:= True;
          except
            Result:= False;
          end;
          break;
        end;
finally

end;
end;


function Plugin_OFF_ALL: boolean;
var i, j: integer;
    h: HWND;
    M: TMemoryBasicInformation;
begin
try
  Result:= True;
  if not inicio then
    begin
      Result:= false;
      exit;
    end;
  for i := 0 to Length(PluginsList) - 1 do
      if PluginsList[i].Activo then
        begin
          try
            PluginsList[i].Activo:= False;
            //H:= PluginsList[i].HForm;
            //if h <> 0 then PostMessage(h, WM_DESTROY, 0, 0);
            h:= PluginsList[i].hndl;

            for j := Application.ComponentCount - 1 downto 0 do
              begin
                VirtualQuery(
                GetClass(Application.Components[j].ClassName),
                        M, SizeOf(M));
                if (h = 0) or
                  (HMODULE(M.AllocationBase) = h) then
                      Application.Components[j].Free;
              end;
            UnRegisterModuleClasses(h);
            UnLoadPackage(h);

            Result:= True;
          except
            Result:= False;
            Break;
          end;
        end;
finally

end;
end;



function Plugin_ON(NombreCorto: string): boolean;
var i: integer;
begin
  if not inicio then 
    begin
      Result:= false;
      exit;
    end;

  NombreCorto:= spStr(NombreCorto);
  Result:= False;
  for i := 0 to Length(PluginsList) - 1 do
      if PluginsList[i].NombreCorto = NombreCorto then
        begin
          ExecutePlugin(PluginsList[i].Plugin, i);  
          Result:= true;    
          break;
        end;   
end;


function Plugin_STATE(NombreCorto: string): boolean;
var i: integer;
begin
  if not inicio then 
    begin
      Result:= false;
      exit;
    end;

  NombreCorto:= spStr(NombreCorto);
  for i := 0 to Length(PluginsList) - 1 do
      if PluginsList[i].NombreCorto = NombreCorto then
        begin          
          Result:= PluginsList[i].Activo;    
          break;
        end; 
end;


function Plugin_Name_Exist(NombreCorto: string): Integer;
var i: integer;
begin
  if not inicio then 
    begin
      Result:= -1;
      exit;
    end;
    
  NombreCorto:= spStr(NombreCorto);
  result:= -1;
  for i := 0 to Length(PluginsList) - 1 do
      if PluginsList[i].NombreCorto = NombreCorto then
        begin          
          Result:= i;    
          break;
        end;
end;


function Plugin_Exist(Plugin: string): Integer;
var i: integer;
begin 
  if not inicio then 
    begin
      Result:= -1;
      exit;
    end;
  Plugin:= LowerCase(Plugin);
  result:= -1;
  for i := 0 to Length(PluginsList) - 1 do
      if PluginsList[i].Plugin = Plugin then
        begin          
          Result:= i;    
          break;
        end;
end;


initialization
  Inicio:= False;  

end.

Como usarla:
1) Para iniciar poner en el evento OnCreate de la aplicacion

Código Delphi [-]
Iniciar_PlugIn_Master(Application, sender);

2) Para usarla, una forma sencilla es cargar en un TCheckListBox los plugins (archivos bpl) de una carpeta X y en el evento onClickCheck del componente poner lo siguiente:

Código Delphi [-]
procedure TPrincipal.ListaPluginsClickCheck(Sender: TObject);
var i:integer;
    ListaP: TStringList;
begin
try
ListaArchPlugins.ItemIndex:= ListaPlugins.ItemIndex;
if ListaPlugins.Checked[ListaPlugins.ItemIndex] then
  begin
    if plugin_exist(ListaArchPlugins.FileName)<0 then
      if not (AddPlugin(ListaArchPlugins.FileName, 'TOtroPlugin'{Clase registrada del Plugin},
          'Execute'{nombre de la funcion a ejecutar del plugin}, ExtractFileName(ListaArchPlugins.FileName)){la ruta completa del archivo}) then
        showmessage('No se pudo Agregar el Plug-In');
    if not Plugin_ON(ExtractFileName(ListaArchPlugins.FileName)) then
      showmessage('No se pudo ejecutar el Plug-In');
  end
else Plugin_OFF(ExtractFileName(ListaArchPlugins.FileName));

ListaP:= TStringList.Create;
for i := 0 to ListaPlugins.Count - 1 do
    if ListaPlugins.Checked[i] then
         ListaP.Add(Cifrar(ListaPlugins.Items[i], gg+gs));
ListaP.SaveToFile(CarpetaDatos+'Extras.phcea');
ListaP.Free;
finally

end;
end;

La ruta completa del archivo en mi caso lo saco de un TFileListBox.


Si a alguno le interesa pongo un modelo de plugin para que vean el ejemplo...

No cuesta nada compartir lo que uno hace... Espero que sea de utilidad...