lazarus-ccr/wst/trunk/library_imp_utils.pas

unit library_imp_utils;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils; 

type

  IwstModule = interface
    ['{A62A9A71-727E-47AD-9B84-0F7CA0AE51D5}']
    function GetFileName():string;
    function GetProc(const AProcName : string):Pointer;
  end;
  
  IwstModuleManager = interface
    ['{0A49D315-FF3E-40CD-BCA0-F958BCD5C57F}']
    function Get(const AFileName : string):IwstModule;
    procedure Clear();
  end;

var
  LibraryManager : IwstModuleManager = nil;

implementation
uses DynLibs;


type

  { TwstModule }

  TwstModule = class(TInterfacedObject,IwstModule)
  private
    FFileName : string;
    FHandle : TLibHandle;
  private
    procedure Load(const ADoLoad : Boolean);
  protected
    function GetFileName():string;
    function GetProc(const AProcName : string):Pointer;
  public
    constructor Create(const AFileName : string);
    destructor Destroy();override;
  end;

  { TwstModuleManager }

  TwstModuleManager = class(TInterfacedObject,IwstModuleManager)
  private
    FList : IInterfaceList;
  private
    function Load(const AFileName : string):IwstModule;
    function GetItem(const AIndex : Integer):IwstModule;
    function IndexOf(const AFileName : string):Integer;
  protected
    function Get(const AFileName : string):IwstModule;
    procedure Clear();
  public
    constructor Create();
    destructor Destroy();override;
  end;

procedure TwstModule.Load(const ADoLoad : Boolean);
begin
  if ADoLoad then begin
    if ( FHandle = NilHandle ) then begin
      FHandle := LoadLibrary(FFileName);
      if ( FHandle = NilHandle ) then
        raise Exception.CreateFmt('Error while loading : "%s".',[FFileName]);
    end;
  end else begin
    if ( FHandle <> NilHandle ) then begin
      FreeLibrary(FHandle);
      FHandle := NilHandle;
    end;
  end;
end;

function TwstModule.GetFileName(): string;
begin
  Result := FFileName;
end;

function TwstModule.GetProc(const AProcName: string): Pointer;
begin
  Result := GetProcAddress(FHandle,AProcName);
  if not Assigned(Result) then
    raise Exception.CreateFmt('Procedure "%s" not found in this module( "%s" ).',[AProcName,FFileName]);
end;

constructor TwstModule.Create(const AFileName: string);
begin
  if not FileExists(AFileName) then
    raise Exception.CreateFmt('File not found : "%s".',[AFileName]);
  FHandle := NilHandle;
  FFileName := AFileName;
  Load(True);
end;

destructor TwstModule.Destroy();
begin
  Load(False);
  inherited Destroy();
end;

{ TwstModuleManager }

function TwstModuleManager.Get(const AFileName: string): IwstModule;
var
  i : Integer;
begin
  i := IndexOf(AFileName);
  if ( i < 0 ) then
    Result := Load(AFileName)
  else
    Result := GetItem(i);
end;

procedure TwstModuleManager.Clear();
begin
  FList.Clear();
end;

function TwstModuleManager.Load(const AFileName: string): IwstModule;
begin
  Result := TwstModule.Create(AFileName);
end;

function TwstModuleManager.GetItem(const AIndex: Integer): IwstModule;
begin
  Result := FList[AIndex] as IwstModule;
end;

function TwstModuleManager.IndexOf(const AFileName: string): Integer;
begin
  for Result := 0 to Pred(FList.Count) do begin
    if AnsiSameStr(AFileName,(FList[Result] as IwstModule).GetFileName()) then
      Exit;
  end;
  Result := -1;
end;

constructor TwstModuleManager.Create();
begin
  inherited;
  FList := TInterfaceList.Create();
end;

destructor TwstModuleManager.Destroy();
begin
  FList := nil;
  inherited Destroy();
end;

procedure InitLibraryManager();
begin
  LibraryManager := TwstModuleManager.Create();
end;

initialization
  InitLibraryManager();
  
finalization
  LibraryManager := nil;
  
end.