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;
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;
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); 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;
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
end;
PluginsList[p].Activo:= True;
PluginsList[p].hndl:= hndl;
PluginsList[p].AForm:= AForm; 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].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].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',
'Execute', ExtractFileName(ListaArchPlugins.FileName))) 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...