unit uHostManager;

interface

uses
  Windows, Classes, Forms, Menus, Contnrs,
  uInterfaces, uModuleController;

type
  { TModuleInfo }
  TModuleInfo = class(TObject)
  private
    FPackageHandle: HModule;
    FFileName : String;
    FName: string;
    FVersion : string;
    FModule: TModuleController;
    FModuleClass: TModuleControllerClass;
  public
    constructor Create(AModuleClass: TModuleControllerClass;
      const FileName : String);
    destructor Destroy; override;
    property Module: TModuleController read FModule;
    property Name: string read FName;
    property FileName : string read FFileName;
    property PackageHandle: HModule read FPackageHandle;
    property Version: String read FVersion;
  end;

  { Events }
  TBeforeLoadEvent = procedure(Sender: TObject; FileName: string; var Allow: Boolean) of object;
  TAfterLoadEvent = procedure(Sender: TObject; AModuleInfo : TModuleInfo) of object;
  TBeforeUnloadEvent = procedure(Sender: TObject; AModuleInfo : TModuleInfo) of object;
  TAfterUnloadEvent = procedure(Sender: TObject; FileName: string) of object;

  { THostManager }
  THostManager = class(TComponent)
  private
    FMainForm : TForm;
    FMainMenu : TMainMenu;
    FBPLPath : String;
    FInstancesList : TList;
    FModules : TObjectList;
    FOnBeforeLoad : TBeforeLoadEvent;
    FOnAfterLoad : TAfterLoadEvent;
    FOnBeforeUnload : TBeforeUnloadEvent;
    FOnAfterUnload : TAfterUnloadEvent;
  protected
    function GetInstanceCount: integer;
    function GetInstances(Index: integer): TModuleController;
    function GetModules(Index: Integer): TModuleInfo;
    function GetModulesCount: Integer;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Instances[Index : integer] : TModuleController read GetInstances;
    property InstanceCount : integer read GetInstanceCount;
    procedure LoadModules;
    function LoadModule(const AFileName : String) : Boolean;
    procedure UnloadModules;
    function UnloadModule(const AIndex : Integer): Boolean; 
    property ModulesCount: Integer read GetModulesCount;
    property Modules[Index: Integer]: TModuleInfo read GetModules;
  published
    property BPLPath: string read FBPLPath write FBPLPath;
    property MainMenu: TMainMenu read FMainMenu write FMainMenu;
    property MainForm: TForm read FMainForm write FMainForm;
    property OnBeforeLoad: TBeforeLoadEvent read FOnBeforeLoad write FOnBeforeLoad;
    property OnAfterLoad: TAfterLoadEvent read FOnAfterLoad write FOnAfterLoad;
    property OnBeforeUnload : TBeforeUnloadEvent read FOnBeforeUnload write FOnBeforeUnload;
    property OnAfterUnload: TAfterUnloadEvent read FOnAfterUnload write FOnAfterUnload;
  end;

procedure RegisterModuleClass(AModuleClass : TModuleControllerClass);
procedure UnRegisterModuleClass(AModuleClass : TModuleControllerClass);
function GetModuleClass(AHandle: HMODULE): TModuleControllerClass;

implementation

uses
  SysUtils, Dialogs;

const
  MODULES_FILES = '*.bpl';
  DEFAULT_DIR = 'Modules';

var
  FModuleClassList: TClassList;
  FModuleHandleList: TStringList;


{ TModuleInfo }
constructor TModuleInfo.Create(AModuleClass: TModuleControllerClass;
  const FileName : String);
var
  GetModulefunc : TGetModuleFunc;
begin
  FName := AModuleClass.ClassName;
  FPackageHandle := HMODULE(FindClassHInstance(AModuleClass));
  FModuleClass := TModuleControllerClass(FindClass(FName));
  FFileName := FileName;

  @GetModulefunc := GetProcAddress(FPackageHandle, PChar(GET_MODULE_FUNC));
  if (@GetModulefunc = NIL) then
    raise Exception.Create('No se ha podido registrar el módulo')
  else begin
    FModule := GetModulefunc;
  end;
end;

destructor TModuleInfo.Destroy;
begin
  FreeAndNIL(FModule);
  inherited;
end;

{ THostManager }
constructor THostManager.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FMainForm := nil;
  FMainMenu := nil;
  FBPLPath := '';

  FInstancesList := TList.Create;
  FModules := TObjectList.Create;
end;

destructor THostManager.Destroy;
begin
  UnloadModules;
  FreeAndNil(FInstancesList);
  FreeAndNil(FModules);
  inherited;
end;

function THostManager.GetInstanceCount: integer;
begin
  Result := FInstancesList.Count;
end;

function THostManager.GetInstances(Index: integer): TModuleController;
begin
  Result := TModuleController(FInstancesList.Items[Index]);
end;

function THostManager.GetModules(Index: Integer): TModuleInfo;
begin
  Result := TModuleInfo(FModules[Index]);
end;

function THostManager.GetModulesCount: Integer;
begin
  Result := 0;
  if Assigned(FModules) then
    Result := FModules.Count;
end;

function THostManager.LoadModule(const AFileName: String): Boolean;
var
  AHandle : HMODULE;
  AModuleClass : TModuleControllerClass;
  AModuleInfo: TModuleInfo;
  CanContinue : Boolean;
  AFile : String;
begin
  Result := False;
  CanContinue := True;
  AFile := ExtractFileName(AFileName);
  if Assigned(FOnBeforeLoad) then
    FOnBeforeLoad(Self, AFile, CanContinue);

  if CanContinue then
  begin
    AHandle := LoadPackage(AFileName);
    AModuleClass := GetModuleClass(AHandle);
    if Assigned(AModuleClass) then
    begin
      AModuleInfo := TModuleInfo.Create(AModuleClass, AFile);
      FModules.Add(AModuleInfo);
      if Assigned(FOnAfterLoad) then
        FOnAfterLoad(Self, AModuleInfo);
    end;
    Result := True;
  end;
end;

procedure THostManager.LoadModules;
var
  SRec : TSearchRec;
  AFileName : String;
begin
  if FBPLPath = '' then
    FBPLPath := ExtractFilePath(Application.ExeName) +
      PathDelim + DEFAULT_DIR + PathDelim;

  if Copy(FBPLPath, Length(FBPLPath), 1) <> PathDelim then
    FBPLPath := FBPLPath + PathDelim;

  if FindFirst(FBPLPath + MODULES_FILES, faAnyFile, SRec) = 0 then
  begin
    repeat
      AFileName := FBPLPath + SRec.Name;
      LoadModule(AFileName);
    until FindNext(SRec) <> 0;
  end;
end;

procedure THostManager.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  case Operation of
    opRemove:
      begin
        if (FMainMenu <> nil) and (AComponent is TMainMenu) and
          (AComponent = FMainMenu) then
          FMainMenu := NIL;

        if (FMainForm <> nil) and (AComponent is TForm)
          and (FMainForm = AComponent)then
          FMainForm := NIL;
      end;
  end;
end;

function THostManager.UnloadModule(const AIndex: Integer): Boolean;
var
  AFileName : String;
  AHandle : HModule;
begin
  if Assigned(FOnBeforeUnload) then
    FOnBeforeUnload(Self, Modules[AIndex]);

  AFileName := Modules[AIndex].FileName;
  AHandle := Modules[AIndex].PackageHandle;
  FModules.Delete(AIndex);
  UnloadPackage(AHandle);

  if Assigned(FOnAfterUnload) then
    FOnAfterUnload(Self, AFileName);
  Result := True;
end;

procedure THostManager.UnloadModules;
var
  i : integer;
begin
  for i := (FModules.Count - 1) downto 0 do
    UnloadModule(i);
end;

procedure RegisterModuleClass(AModuleClass : TModuleControllerClass);
var
  x : Integer;
begin
  x := FModuleClassList.IndexOf(AModuleClass);
  if x < 0 then
  begin
    Classes.RegisterClass(AModuleClass);
    FModuleClassList.Add(AModuleClass);
    FModuleHandleList.Add(IntToStr(HMODULE(FindClassHInstance(AModuleClass))));
  end;
end;

procedure UnRegisterModuleClass(AModuleClass : TModuleControllerClass);
var
  x : Integer;
begin
  x := FModuleClassList.IndexOf(AModuleClass);
  if x >= 0 then
  begin
    FModuleClassList.Delete(x);
    FModuleHandleList.Delete(x);
    Classes.UnRegisterClass(AModuleClass);
  end;
end;

function GetModuleClass(AHandle: HMODULE): TModuleControllerClass;
var
  x : Integer;
begin
  Result := Nil;

  x := FModuleHandleList.IndexOf(IntToStr(AHandle));
  if x <> -1 then
     Result := TModuleControllerClass(FModuleClassList.Items[x]);
end;


initialization
  FModuleClassList := TClassList.Create;
  FModuleHandleList := TStringList.Create;

finalization
  FreeAndNIL(FModuleClassList);
  FreeAndNIL(FModuleHandleList);
end.