{ Summary: Loadable module system ## $Id: modules.pas,v 1.5 2004/04/10 22:24:03 druid Exp $ } unit modules; interface uses {$IFDEF WIN32} Windows, {$ENDIF} {$IFDEF LINUX} Libc, {$ENDIF} SysUtils, dtypes; type IModuleInterface = interface ['{8DF7865B-69A9-4AA8-A415-E82553597B1C}'] procedure registerModule(); procedure unregisterModule(); end; GReturnModuleInterfaceFunction = function() : IModuleInterface; GModuleInfo = class private _handle : HMODULE; _filename : string; _description : string; _intf : IModuleInterface; published constructor Create(handle_ : HMODULE; const filename_, description_ : string; intf_ : IModuleInterface); procedure clearInterface(); property handle : HMODULE read _handle; property filename : string read _filename; property description : string read _description; property intf : IModuleInterface read _intf; end; procedure loadModules(); procedure unloadModules(); procedure addModule(const name : string); procedure removeModule(const name : string); var module_list : GHashTable; implementation uses constants, chars, debug, util, commands, console; constructor GModuleInfo.Create(handle_ : HMODULE; const filename_, description_ : string; intf_ : IModuleInterface); begin inherited Create(); _handle := handle_; _filename := filename_; _description := description_; _intf := intf_; end; procedure GModuleInfo.clearInterface(); begin _intf := nil; end; procedure do_modules(ch : GCharacter; param : string); var iterator : GIterator; module : GModuleInfo; arg : string; begin if (length(param) = 0) then begin iterator := module_list.iterator(); ch.sendBuffer('Usage: MODULES <load|unload> <modules_name>'#13#10#13#10); ch.sendBuffer('Registered modules:'#13#10#13#10); while (iterator.hasNext()) do begin module := GModuleInfo(iterator.next()); ch.sendBuffer(module.filename + ' (' + module.description + ')'#13#10); end; iterator.Free(); end else begin param := one_argument(param, arg); if (arg = 'load') then try addModule(param); ch.sendBuffer('Module ' + param + ' was loaded.'#13#10); except on E : Exception do ch.sendBuffer('Could not load module ' + param + ': ' + E.Message + #13#10); end else if (arg = 'unload') then try removeModule(param); ch.sendBuffer('Module ' + param + ' was unloaded.'#13#10); except on E : Exception do ch.sendBuffer('Could not load module ' + param + ': ' + E.Message + #13#10); end; end; end; procedure loadModules(); var t : TSearchRec; begin module_list := GHashTable.Create(128); registerCommand('do_modules', do_modules); {$IFDEF LINUX} if (FindFirst('modules' + PathDelimiter + 'bpl*.so', faAnyFile, t) = 0) then {$ELSE} if (FindFirst('modules' + PathDelimiter + '*.bpl', faAnyFile, t) = 0) then {$ENDIF} repeat try addModule(t.name); except on E : Exception do writeConsole('Unable to load module ' + t.name + ': ' + E.Message); end; until (FindNext(t) <> 0); FindClose(t); end; procedure unloadModules(); var iterator : GIterator; module : GModuleInfo; begin iterator := module_list.iterator(); while (iterator.hasNext()) do begin module := GModuleInfo(iterator.next()); writeConsole('Unloading module ' + module.filename); // possibly dangerous terrain try module.intf.unregisterModule(); module.clearInterface(); UnloadPackage(module.handle); except on E : Exception do reportException(E); end; writeConsole('Unloaded module ' + module.filename); end; module_list.clear(); module_list.Free(); iterator.Free(); end; procedure addModule(const name : string); var hndl : HMODULE; module : GModuleInfo; returnModuleInterface : GReturnModuleInterfaceFunction; begin if (module_list.get(name) <> nil) then raise Exception.Create('Module already loaded'); hndl := LoadPackage('modules' + PathDelimiter + name); @returnModuleInterface := GetProcAddress(hndl, 'returnModuleInterface'); if (@returnModuleInterface = nil) then begin writeConsole('Could not find interface function in ' + name); UnloadPackage(hndl); end else begin try module := GModuleInfo.Create(hndl, name, GetPackageDescription(PChar('modules' + PathDelimiter + name)), returnModuleInterface()); module.intf.registerModule(); module_list.put(name, module); writeConsole('Loaded module ' + name + ' (' + module.description + ')'); except on E : Exception do reportException(E); end; end; end; procedure removeModule(const name : string); var module : GModuleInfo; begin module := GModuleInfo(module_list.get(name)); if (module = nil) then raise Exception.Create('Module not loaded'); try module.intf.unregisterModule(); module.clearInterface(); UnloadPackage(module.handle); except on E : Exception do reportException(E); end; writeConsole('Unloaded module ' + module.filename, 1); module_list.remove(name); module.Free; end; end.