elcolo83
04-01-2008, 13:34:48
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:
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
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:
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...
Aca va un poco de mi trabajo:
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
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:
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...