{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: All Projects | } { | | } { | Description: Universal Plugin Manager. | } { | | } { | | } { | Copyright (C) - 2002 - Gerrit Moeller. | } { | | } { | Source code distributed under MIT license. | } { | | } { | See: https://www.gm-software.de | } { | | } { +-------------------------------------------------------------+ } {$INCLUDE GMCompilerSettings.inc} unit GMPluginMgr; interface uses GMStrDef, GMIntf, GMCollections, GMCommon; type TPLuginCreateObjFunc = function (const ClassID, IID: TGuid; out Intf): HResult; stdcall; IGMPluginModule = interface(IGMGetHandle) ['{A851DFDB-A97B-42ef-9F0E-A9F3E7F9DCDF}'] function IsValidPlugin: Boolean; stdcall; function PluginCreateObject(const ClassID, IID: TGuid; out Intf): HResult; stdcall; end; TGMPluginModule = class(TGMDLLHandleObj, IGMGetFileName, IGMPluginModule) protected FModuleFileName: TGMString; FPluginCreateObjectFunc: TPLuginCreateObjFunc; public constructor Create(const AModuleFileName, ACreateObjFuncName: AnsiString; const ARefLifeTime: Boolean = True); reintroduce; overload; function IsValidPlugin: Boolean; stdcall; function PluginCreateObject(const ClassID, IID: TGuid; out Intf): HResult; stdcall; function GetFileName: TGMString; stdcall; end; TGMFillPathListProc = procedure (const PPathList: PGMStringArray); function GMPluginModuleList: IGMIntfArrayCollection; procedure GMDfltFillPluginSearchPathList(const PPathList: PGMStringArray); procedure GMLoadPlugins(const ASearchMask, ACreateObjFuncName: TGMString); var GMFillPluginSearchPathList: TGMFillPathListProc = GMDfltFillPluginSearchPathList; implementation uses {$IFDEF JEDIAPI}jwaWinType, jwaWinBase, jwaWinError{$ELSE}Windows{$ENDIF}; var gPluginModuleList: IGMIntfArrayCollection = nil; { ------------------------- } { ---- Global Routines ---- } { ------------------------- } function GMPluginModuleList: IGMIntfArrayCollection; begin if gPluginModuleList = nil then gPluginModuleList := TGMIntfArrayCollection.Create(False, False, GMCompareByFileName); Result := gPluginModuleList; end; procedure GMDfltFillPluginSearchPathList(const PPathList: PGMStringArray); begin if PPathList = nil then Exit; SetLength(PPathList^, Length(PPathList^)+1); PPathList^[High(PPathList^)] := GMExtractPath(GMApplicationExeName); end; procedure GMLoadPlugins(const ASearchMask, ACreateObjFuncName: TGMString); var pathList: TGMStringArray; i, chPos: PtrInt; mask: TGMString; procedure FindPluginModules(const APath, AMask: TGMString); var findData: TWin32FindData; hSearch: THandle; newModule: IGMPluginModule; begin hSearch := FindFirstFile(PGMChar(GMAppendPath(APath, AMask)), findData); if hSearch <> INVALID_HANDLE_VALUE then try repeat newModule := TGMPluginModule.Create(GMAppendPath(APath, findData.cFileName), ACreateObjFuncName); if newModule.IsValidPlugin then GMPluginModuleList.Add(newModule); until not FindNextFile(hSearch, findData); finally FindClose(hSearch); end; end; begin if (Length(ASearchMask) <= 0) or (Length(ACreateObjFuncName) <= 0) then Exit; SetLength(pathList, 0); GMFillPluginSearchPathList(@pathList); //GMPluginModuleList.Clear; // <- don't clear for i:=Low(pathList) to High(pathList) do if GMFolderExists(pathList[i]) then begin chPos:=1; repeat mask := GMStrip(GMNextWord(chPos, ASearchMask, ';'), cWhiteSpace); if Length(mask) > 0 then FindPluginModules(pathList[i], mask); until Length(mask) = 0; end; end; { ------------------------- } { ---- TGMPluginModule ---- } { ------------------------- } constructor TGMPluginModule.Create(const AModuleFileName, ACreateObjFuncName: AnsiString; const ARefLifeTime: Boolean); begin FModuleFileName := AModuleFileName; inherited Create(AModuleFileName, False, ARefLifeTime); if Handle = 0 then Exit; //FModuleFileName := GMModuleFileName(Handle); FPluginCreateObjectFunc := GetProcAddress(Handle, PAnsiChar(ACreateObjFuncName)); end; function TGMPluginModule.GetFileName: TGMString; begin Result := FModuleFileName; //if Handle = 0 then Result := '' else Result := GMModuleFileName(Handle); end; function TGMPluginModule.IsValidPlugin: Boolean; begin Result := (Handle <> 0) and Assigned(FPluginCreateObjectFunc); end; function TGMPluginModule.PluginCreateObject(const ClassID, IID: TGuid; out Intf): HResult; begin if Assigned(FPluginCreateObjectFunc) then Result := FPluginCreateObjectFunc(ClassID, IID, Intf) else Result := E_NOTIMPL; end; end.