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.