From e270d3193a2a5b958e6416ce340246e790f7bd86 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 27 Oct 2007 09:10:29 +0000 Subject: Finished pluginloader, plugininterface Some fixes and error management (needs improvement) in Core and Service/Hook classes. "Clean Plugin Unloading on Error" finished Some debuging messages on startup. to Fix this remove old Plugins from Pluginfolder git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@535 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UCore.pas | 36 +- Game/Code/Classes/UCoreModule.pas | 13 +- Game/Code/Classes/UHooks.pas | 117 +++-- Game/Code/Classes/UModules.pas | 9 +- Game/Code/Classes/UPluginInterface.pas | 48 +- Game/Code/Classes/UServices.pas | 14 +- Game/Code/Classes/uPluginLoader.pas | 786 +++++++++++++++++++++++++++++++++ 7 files changed, 947 insertions(+), 76 deletions(-) (limited to 'Game') diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index de44fb3b..a8a29aeb 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -38,6 +38,7 @@ type sRetranslate: THandle; sReloadTextures: THandle; sGetModuleInfo: THandle; + sGetApplicationHandle: THandle; Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; @@ -86,6 +87,9 @@ type //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown Procedure Run; + //Method for other Classes to get Pointer to a specific Module + Function GetModulebyName(const Name: String): PCoreModule; + //-------------- // Hook and Service Procs: //-------------- @@ -95,6 +99,7 @@ type Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook Function GetModuleInfo(wParam, lParam: DWord): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam + Function GetApplicationHandle(wParam, lParam: DWord): integer; //Returns Application Handle end; var @@ -354,6 +359,10 @@ begin sRetranslate := Services.AddService('Core/Retranslate', nil, Self.Retranslate); sReloadTextures := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures); sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo); + sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle); + + //A little Test + Hooks.AddSubscriber('Core/NewError', HookTest); end; //------------- @@ -374,6 +383,21 @@ begin // to-do : write TService-/HookManager.Free and call it here end; +//------------- +//Method for other Classes to get Pointer to a specific Module +//------------- +Function TCore.GetModulebyName(const Name: String): PCoreModule; +var I: Integer; +begin + Result := nil; + For I := 0 to high(Modules) do + If (Modules[I].Info.Name = Name) then + begin + Result := @Modules[I].Module; + Break; + end; +end; + //------------- // Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) //------------- @@ -405,11 +429,11 @@ end; //------------- Function TCore.ReportError(wParam, lParam: DWord): integer; begin - Hooks.CallEventChain(hError, wParam, lParam); - //Update LastErrorReporter and LastErrorString LastErrorReporter := String(PChar(Ptr(lParam))); LastErrorString := String(PChar(Ptr(wParam))); + + Hooks.CallEventChain(hError, wParam, lParam); end; //------------- @@ -460,4 +484,12 @@ begin end; end; +//------------- +// Returns Application Handle +//------------- +Function TCore.GetApplicationHandle(wParam, lParam: DWord): integer; +begin + Result := hInstance; +end; + end. \ No newline at end of file diff --git a/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas index 6fca5d37..e5a874f0 100644 --- a/Game/Code/Classes/UCoreModule.pas +++ b/Game/Code/Classes/UCoreModule.pas @@ -13,10 +13,13 @@ uses UPluginDefs; {$ENDIF} type + PCoreModule = ^TCoreModule; TCoreModule = class public + Constructor Create; virtual; + //Function that gives some Infos about the Module to the Core - Procedure Info(const pInfo: PModuleInfo); + Procedure Info(const pInfo: PModuleInfo); virtual; //Is Called on Loading. //In this Method only Events and Services should be created @@ -47,6 +50,14 @@ type implementation +//------------- +// Just the Constructor +//------------- +Constructor TCoreModule.Create; +begin + //Dummy maaaan ;) +end; + //------------- // Function that gives some Infos about the Module to the Core //------------- diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas index c73ccbbb..c3684ed1 100644 --- a/Game/Code/Classes/UHooks.pas +++ b/Game/Code/Classes/UHooks.pas @@ -6,7 +6,7 @@ unit UHooks; Saves all hookable events and their subscribers *********************} interface -uses uPluginDefs, SysUtils, WINDOWS; +uses uPluginDefs, SysUtils; {$IFDEF FPC} {$MODE Delphi} @@ -21,6 +21,8 @@ type Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook) Next: PSubscriberInfo; //Pointer to next Item in HookChain + Owner: Integer; //For Error Handling and Plugin Unloading. + //Here is s/t tricky //To avoid writing of Wrapping Functions to Hook an Event with a Class //We save a Normal Proc or a Method of a Class @@ -39,6 +41,8 @@ type private Events: array of TEventInfo; SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items) + + Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); public constructor Create(const SpacetoAllocate: Word); @@ -50,15 +54,17 @@ type Function CallEventChain (const hEvent: THandle; const wParam, lParam: LongWord): Integer; Function EventExists (const EventName: PChar): Integer; + + Procedure DelbyOwner(const Owner: Integer); end; function HookTest(wParam, lParam: DWord): integer; stdcall; -function HookTest2(wParam, lParam: DWord): integer; stdcall; var HookManager: THookManager; implementation +uses UCore; //------------ // Create - Creates Class and Set Standard Values @@ -192,6 +198,9 @@ begin //Fill it with Data Cur.Next := nil; + //Add Owner + Cur.Owner := Core.CurExecuted; + If (@Proc = nil) then begin //Use the ProcofClass Method Cur.isClass := True; @@ -228,12 +237,37 @@ begin Events[EventIndex].LastSubscriber := Cur; {$IFDEF DEBUG} - WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''); + WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner)); {$ENDIF} end; end; end; +//------------ +// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. +//------------ +Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); +begin + //Delete from Chain + If (Last <> nil) then + begin + Last.Next := Cur.Next; + end + else //Was first Popup + begin + Events[EventIndex].FirstSubscriber := Cur.Next; + end; + + //Was this Last subscription ? + If (Cur = Events[EventIndex].LastSubscriber) then + begin //Change Last Subscriber + Events[EventIndex].LastSubscriber := Last; + end; + + //Free Space: + FreeMem(Cur, SizeOf(TSubscriberInfo)); +end; + //------------ // DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure //------------ @@ -259,24 +293,7 @@ begin begin If (Cur.Self = hSubscriber) then begin //Found Subscription we searched for - //Delete from Chain - If (Last <> nil) then - begin - Last.Next := Cur.Next; - end - else //Was first Popup - begin - Events[EventIndex].FirstSubscriber := Cur.Next; - end; - - //Was this Last subscription ? - If (Cur = Events[EventIndex].LastSubscriber) then - begin //Change Last Subscriber - Events[EventIndex].LastSubscriber := Last; - end; - - //Free Space: - FreeMem(Cur, SizeOf(TSubscriberInfo)); + FreeSubscriber(EventIndex, Last, Cur); {$IFDEF DEBUG} WriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); @@ -303,18 +320,24 @@ Function THookManager.CallEventChain (const hEvent: THandle; const wParam, lPara var EventIndex: Cardinal; Cur: PSubscriberInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute begin Result := -1; EventIndex := hEvent - 1; If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then begin //Existing Event + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + //Start calling the Chain !!!11 Cur := Events[EventIndex].FirstSubscriber; Result := 0; //Call Hooks until the Chain is at the End or breaked While ((Cur <> nil) AND (Result = 0)) do begin + //Set CurExecuted + Core.CurExecuted := Cur.Owner; if (Cur.isClass) then Result := Cur.ProcOfClass(wParam, lParam) else @@ -322,6 +345,9 @@ begin Cur := Cur.Next; end; + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; end; {$IFDEF DEBUG} @@ -354,22 +380,49 @@ begin end; end; - -function HookTest(wParam, lParam: DWord): integer; stdcall; -var Test: String[60]; -var T2: String; +//------------ +// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) +//------------ +Procedure THookManager.DelbyOwner(const Owner: Integer); +var + I: Integer; + Cur, Last: PSubscriberInfo; begin - Messagebox(0, 'Test', 'test', MB_ICONWARNING or MB_OK); - - Result := 0; //Don't break the chain + //Search for Owner in all Hooks Chains + For I := 0 to High(Events) do + begin + If (Events[I].Name[1] <> chr(0)) then + begin + + Last := nil; + Cur := Events[I].FirstSubscriber; + //Went Through Chain + While (Cur <> nil) do + begin + If (Cur.Owner = Owner) then + begin //Found Subscription by Owner -> Delete + FreeSubscriber(I, Last, Cur); + If (Last <> nil) then + Cur := Last.Next + else + Cur := Events[I].FirstSubscriber; + end + Else + begin + //Next Item: + Last := Cur; + Cur := Cur.Next; + end; + end; + end; + end; end; -function HookTest2(wParam, lParam: DWord): integer; stdcall; -begin - //Showmessage(String(PCHAR(Ptr(lParam))); - Messagebox(0, Ptr(lParam), 'test', MB_ICONWARNING or MB_OK); +function HookTest(wParam, lParam: DWord): integer; stdcall; +begin Result := 0; //Don't break the chain + Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Ptr(lParam))) + ': ' + String(PChar(Ptr(wParam)))))); end; end. diff --git a/Game/Code/Classes/UModules.pas b/Game/Code/Classes/UModules.pas index e8e759ff..c126e9ee 100644 --- a/Game/Code/Classes/UModules.pas +++ b/Game/Code/Classes/UModules.pas @@ -8,11 +8,14 @@ interface *********************} uses - UCoreModule; + UCoreModule, + uPluginLoader; const - CORE_MODULES_TO_LOAD: Array[0..0] of cCoreModule = ( - TCoreModule //Remove this later, just a dummy + CORE_MODULES_TO_LOAD: Array[0..2] of cCoreModule = ( + TPluginLoader, //First because it has to look if there are Module replacements (Feature o/t Future) + TCoreModule, //Remove this later, just a dummy + TtehPlugins //Represents the Plugins. Last because they may use CoreModules Services etc. ); implementation diff --git a/Game/Code/Classes/UPluginInterface.pas b/Game/Code/Classes/UPluginInterface.pas index 6d17d51d..a9cc7e46 100644 --- a/Game/Code/Classes/UPluginInterface.pas +++ b/Game/Code/Classes/UPluginInterface.pas @@ -8,11 +8,6 @@ unit uPluginInterface; interface uses uPluginDefs; -//--------------- -// Procedure that Sets the PluginInterface Record -//--------------- - Procedure Init_PluginInterface; - //--------------- // Methods for Plugin //--------------- @@ -59,29 +54,8 @@ uses uPluginDefs; otherwise 0} Function ServiceExists (ServiceName: PChar): Integer; stdcall; -var - PluginInterface: TUS_PluginInterface; - implementation - -//--------------- -// Procedure that Sets the PluginInterface Record -//--------------- -Procedure Init_PluginInterface; -begin - PluginInterface.CreateHookableEvent := CreateHookableEvent; - PluginInterface.DestroyHookableEvent := DestroyHookableEvent; - PluginInterface.NotivyEventHooks := NotivyEventHooks; - PluginInterface.HookEvent := HookEvent; - PluginInterface.UnHookEvent := UnHookEvent; - PluginInterface.EventExists := EventExists; - - PluginInterface.CreateService := CreateService; - PluginInterface.DestroyService := DestroyService; - PluginInterface.CallService := CallService; - PluginInterface.ServiceExists := ServiceExists; -end; - +uses UCore; {******** Hook specific Methods ********} //--------------- @@ -90,7 +64,7 @@ end; //--------------- Function CreateHookableEvent (EventName: PChar): THandle; stdcall; begin - + Result := Core.Hooks.AddEvent(EventName); end; //--------------- @@ -99,7 +73,7 @@ end; //--------------- Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; begin - + Result := Core.Hooks.DelEvent(hEvent); end; //--------------- @@ -109,7 +83,7 @@ end; //--------------- Function NotivyEventHooks (hEvent: THandle; wParam, lParam: dWord): integer; stdcall; begin - + Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam); end; //--------------- @@ -118,7 +92,7 @@ end; //--------------- Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; begin - + Result := Core.Hooks.AddSubscriber(EventName, HookProc); end; //--------------- @@ -127,7 +101,7 @@ end; //--------------- Function UnHookEvent (hHook: THandle): Integer; stdcall; begin - + Result := Core.Hooks.DelSubscriber(hHook); end; //--------------- @@ -136,7 +110,7 @@ end; //--------------- Function EventExists (EventName: PChar): Integer; stdcall; begin - + Result := Core.Hooks.EventExists(EventName); end; {******** Service specific Methods ********} @@ -146,7 +120,7 @@ end; //--------------- Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; begin - + Result := Core.Services.AddService(ServiceName, ServiceProc); end; //--------------- @@ -155,7 +129,7 @@ end; //--------------- Function DestroyService (hService: THandle): integer; stdcall; begin - + Result := Core.Services.DelService(hService); end; //--------------- @@ -164,7 +138,7 @@ end; //--------------- Function CallService (ServiceName: PChar; wParam, lParam: dWord): integer; stdcall; begin - + Result := Core.Services.CallService(ServiceName, wParam, lParam); end; //--------------- @@ -173,7 +147,7 @@ end; //--------------- Function ServiceExists (ServiceName: PChar): Integer; stdcall; begin - + Result := Core.Services.ServiceExists(ServiceName); end; end. diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas index fce81bd8..0028576b 100644 --- a/Game/Code/Classes/UServices.pas +++ b/Game/Code/Classes/UServices.pas @@ -22,7 +22,7 @@ type Hash: Integer; //4 Bit Hash of the Services Name Name: TServiceName; //Name of this Service - Owner: Integer; //If > 0 [DLLMan Pluginindex + 1]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] + Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] Next: PServiceInfo; //Pointer to the Next Service in teh list @@ -63,6 +63,7 @@ var ServiceManager: TServiceManager; implementation +uses UCore; //------------ // Create - Creates Class and Set Standard Values @@ -125,6 +126,9 @@ begin Cur.Name := String(ServiceName); Cur.Hash := NametoHash(Cur.Name); + //Add Owner to Service + Cur.Owner := Core.CurExecuted; + //Add Service to the List If (FirstService = nil) then FirstService := Cur; @@ -208,18 +212,26 @@ Function TServiceManager.CallService(const ServiceName: PChar; const wParam, lPa var SExists: Integer; Service: PServiceInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute begin Result := SERVICE_NOT_FOUND; SExists := ServiceExists(ServiceName); If (SExists <> 0) then begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + Service := ptr(SExists); + If (Service.isClass) then //Use Proc of Class Result := Service.ProcOfClass(wParam, lParam) Else //Use normal Proc Result := Service.Proc(wParam, lParam); + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; end; {$IFDEF DEBUG} diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas index 929fd84e..fadea0c6 100644 --- a/Game/Code/Classes/uPluginLoader.pas +++ b/Game/Code/Classes/uPluginLoader.pas @@ -1,7 +1,793 @@ unit uPluginLoader; +{********************* + uPluginLoader + Unit contains to Classes + TPluginLoader: Class Searching for and Loading the Plugins + TtehPlugins: Class that represents the Plugins in Modules chain +*********************} interface +uses UPluginDefs, UCoreModule; +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +type + TPluginListItem = record + Info: TUS_PluginInfo; + State: Byte; //State of this Plugin: 0 - undefined; 1 - Loaded; 2 - Inited / Running; 4 - Unloaded; 254 - Loading aborted by Plugin; 255 - Unloaded because of Error + Path: String; //Path to this Plugin + NeedsDeInit: Boolean; //If this is Inited correctly this should be true + hLib: THandle; //Handle of Loaded Libary + Procs: record //Procs offered by Plugin. Don't call this directly use wrappers of TPluginLoader + Load: Func_Load; + Init: Func_Init; + DeInit: Proc_DeInit; + end; + end; + {********************* + TPluginLoader + Class Searches for Plugins and Manages loading and unloading + *********************} + PPluginLoader = ^TPluginLoader; + TPluginLoader = class (TCoreModule) + private + LoadingProcessFinished: Boolean; + sUnloadPlugin: THandle; + sLoadPlugin: THandle; + sGetPluginInfo: THandle; + sGetPluginState: THandle; + + Procedure FreePlugin(Index: Cardinal); + public + PluginInterface: TUS_PluginInterface; + Plugins: Array of TPluginListItem; + + //TCoreModule methods to inherit + Constructor Create; override; + Procedure Info(const pInfo: PModuleInfo); override; + Function Load: Boolean; override; + Function Init: Boolean; override; + Procedure DeInit; override; + Procedure Free; override; + + //New Methods + Procedure BrowseDir(Path: String); //Browses the Path at _Path_ for Plugins + Function PluginExists(Name: String): Integer; //If Plugin Exists: Index of Plugin, else -1 + Procedure AddPlugin(Filename: String);//Adds Plugin to the Array + + Function CallLoad(Index: Cardinal): Integer; + Function CallInit(Index: Cardinal): Integer; + Procedure CallDeInit(Index: Cardinal); + + //Services offered + Function LoadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + Function UnloadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + Function GetPluginInfo(wParam, lParam: DWord): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) Else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) + Function GetPluginState(wParam, lParam: DWord): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) Else (Return PluginInfo of Plugin with Index(wParam)) + + end; + + {********************* + TtehPlugins + Class Represents the Plugins in Module Chain. + It Calls the Plugins Procs and Funcs + *********************} + TtehPlugins = class (TCoreModule) + private + PluginLoader: PPluginLoader; + public + //TCoreModule methods to inherit + Constructor Create; override; + + Procedure Info(const pInfo: PModuleInfo); override; + Function Load: Boolean; override; + Function Init: Boolean; override; + Procedure DeInit; override; + end; + +const + {$IFDEF win32} + PluginFileExtension = '.dll'; + {$ELSE} + PluginFileExtension = '.so'; + {$ENDIF} implementation +uses UCore, UPluginInterface, +{$IFDEF win32} + windows, +{$ELSE} + dynlibs, +{$ENDIF} +UMain, SysUtils; + +{********************* + TPluginLoader + Implentation +*********************} + +//------------- +// Function that gives some Infos about the Module to the Core +//------------- +Procedure TPluginLoader.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TPluginLoader'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Searches for Plugins, loads and unloads them'; +end; + +//------------- +// Just the Constructor +//------------- +Constructor TPluginLoader.Create; +begin + //Init PluginInterface + //Using Methods from UPluginInterface + PluginInterface.CreateHookableEvent := CreateHookableEvent; + PluginInterface.DestroyHookableEvent := DestroyHookableEvent; + PluginInterface.NotivyEventHooks := NotivyEventHooks; + PluginInterface.HookEvent := HookEvent; + PluginInterface.UnHookEvent := UnHookEvent; + PluginInterface.EventExists := EventExists; + + PluginInterface.CreateService := CreateService; + PluginInterface.DestroyService := DestroyService; + PluginInterface.CallService := CallService; + PluginInterface.ServiceExists := ServiceExists; + + //UnSet Private Var + LoadingProcessFinished := False; +end; + +//------------- +//Is Called on Loading. +//In this Method only Events and Services should be created +//to offer them to other Modules or Plugins during the Init process +//If False is Returned this will cause a Forced Exit +//------------- +Function TPluginLoader.Load: Boolean; +begin + Result := True; + + Try + //Start Searching for Plugins + BrowseDir(PluginPath); + Except + Result := False; + Core.ReportError(Integer(PChar('Error Browsing and Loading.')), Integer(PChar('TPluginLoader'))); + end; +end; + +//------------- +//Is Called on Init Process +//In this Method you can Hook some Events and Create + Init +//your Classes, Variables etc. +//If False is Returned this will cause a Forced Exit +//------------- +Function TPluginLoader.Init: Boolean; +begin + //Just set Prvate Var to true. + LoadingProcessFinished := True; + Result := True; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +Procedure TPluginLoader.DeInit; +var + I: Integer; +begin + //Force DeInit + //If some Plugins aren't DeInited for some Reason o0 + For I := 0 to High(Plugins) do + begin + If (Plugins[I].State < 4) then + FreePlugin(I); + end; + + //Nothing to do here. Core will remove the Hooks +end; + +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Procedure TPluginLoader.Free; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Plugins, 0); +end; + +//-------------- +// Browses the Path at _Path_ for Plugins +//-------------- +Procedure TPluginLoader.BrowseDir(Path: String); +var + SR: TSearchRec; +begin + //Search for other Dirs to Browse + if FindFirst(Path + '*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + BrowseDir(Path + Sr.Name + PathDelim); + until FindNext(SR) <> 0; + end; + FindClose(SR); + + //Search for Plugins at Path + if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then + begin + repeat + AddPlugin(Path + SR.Name); + until FindNext(SR) <> 0; + end; + FindClose(SR); +end; + +//-------------- +// If Plugin Exists: Index of Plugin, else -1 +//-------------- +Function TPluginLoader.PluginExists(Name: String): Integer; +var + I: Integer; +begin + Result := -1; + + If (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then + begin + For I := 0 to High(Plugins) do + if (Plugins[I].Info.Name = Name) then + begin //Found the Plugin + Result := I; + Break; + end; + end; +end; + +//-------------- +// Adds Plugin to the Array +//-------------- +Procedure TPluginLoader.AddPlugin(Filename: String); +var + hLib: THandle; + PInfo: Proc_PluginInfo; + Info: TUS_PluginInfo; + PluginID: Integer; +begin + If (FileExists(Filename)) then + begin //Load Libary + hLib := LoadLibrary(PChar(Filename)); + If (hLib <> 0) then + begin //Try to get Address of the Info Proc + PInfo := GetProcAddress (hLib, PChar('USPlugin_Info')); + If (@PInfo <> nil) then + begin + Info.cbSize := SizeOf(TUS_PluginInfo); + + Try //Call Info Proc + PInfo(@Info); + Except + Info.Name := ''; + Core.ReportError(Integer(PChar('Error getting Plugin Info: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + + //Is Name set ? + If (Trim(Info.Name) <> '') then + begin + PluginID := PluginExists(Info.Name); + + If (PluginID > 0) AND (Plugins[PluginID].State >=4) then + PluginID := -1; + + If (PluginID = -1) then + begin + //Add new item to array + PluginID := Length(Plugins); + SetLength(Plugins, PluginID + 1); + + //Fill with Info: + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].hLib := hLib; + + //Try to get Procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + If (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + begin + Plugins[PluginID].State := 255; + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + + //Emulate loading process if this Plugin is loaded to late + If (LoadingProcessFinished) then + begin + CallLoad(PluginID); + CallInit(PluginID); + end; + end + Else If (LoadingProcessFinished = False) then + begin + If (Plugins[PluginID].Info.Version < Info.Version) then + begin //Found newer Version of this Plugin + Core.ReportDebug(Integer(PChar('Found a newer Version of Plugin: ' + Info.Name)), Integer(PChar('TPluginLoader'))); + + //Unload Old Plugin + UnloadPlugin(Integer(nil), PluginID); + + //Fill with new Info + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].hLib := hLib; + + //Try to get Procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + If (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + begin + FreeLibrary(hLib); + Plugins[PluginID].State := 255; + Core.ReportError(Integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + end + else + begin //Newer Version already loaded + FreeLibrary(hLib); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('Plugin with this Name already exists: ' + Info.Name)), Integer(PChar('TPluginLoader'))); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('No name reported: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(Integer(PChar('Can''t find Info Procedure: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; + end + else + Core.ReportError(Integer(PChar('Can''t load Plugin Libary: ' + Filename)), Integer(PChar('TPluginLoader'))); + end; +end; + +//-------------- +// Calls Load Func of Plugin with the given Index +//-------------- +Function TPluginLoader.CallLoad(Index: Cardinal): Integer; +begin + Result := -2; + If(Index < Length(Plugins)) then + begin + If (@Plugins[Index].Procs.Load <> nil) AND (Plugins[Index].State = 0) then + begin + Try + Result := Plugins[Index].Procs.Load(@PluginInterface); + Except + Result := -3; + End; + + If (Result = 0) then + Plugins[Index].State := 1 + Else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(Integer(PChar('Error calling Load Function from Plugin: ' + Plugins[Index].Info.Name)), Integer(PChar('TPluginLoader'))); + end; + end; + end; +end; + +//-------------- +// Calls Init Func of Plugin with the given Index +//-------------- +Function TPluginLoader.CallInit(Index: Cardinal): Integer; +begin + Result := -2; + If(Index < Length(Plugins)) then + begin + If (@Plugins[Index].Procs.Init <> nil) AND (Plugins[Index].State = 1) then + begin + Try + Result := Plugins[Index].Procs.Init(@PluginInterface); + Except + Result := -3; + End; + + If (Result = 0) then + begin + Plugins[Index].State := 2; + Plugins[Index].NeedsDeInit := True; + end + Else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(Integer(PChar('Error calling Init Function from Plugin: ' + Plugins[Index].Info.Name)), Integer(PChar('TPluginLoader'))); + end; + end; + end; +end; + +//-------------- +// Calls DeInit Proc of Plugin with the given Index +//-------------- +Procedure TPluginLoader.CallDeInit(Index: Cardinal); +begin + If(Index < Length(Plugins)) then + begin + If (Plugins[Index].State < 4) then + begin + If (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then + Try + Plugins[Index].Procs.DeInit(@PluginInterface); + Except + + End; + + //Don't forget to remove Services and Subscriptions by this Plugin + Core.Hooks.DelbyOwner(-1 - Index); + + FreePlugin(Index); + end; + end; +end; + +//-------------- +// Frees all Plugin Sources (Procs and Handles) - Helper for Deiniting Functions +//-------------- +Procedure TPluginLoader.FreePlugin(Index: Cardinal); +begin + Plugins[Index].State := 4; + Plugins[Index].Procs.Load := nil; + Plugins[Index].Procs.Init := nil; + Plugins[Index].Procs.DeInit := nil; + + If (Plugins[Index].hLib <> 0) then + FreeLibrary(Plugins[Index].hLib); +end; + + + +//-------------- +// wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin +//-------------- +Function TPluginLoader.LoadPlugin(wParam, lParam: DWord): integer; +var + Index: Integer; + sFile: String; +begin + Result := -1; + sFile := ''; + //lParam is ID + If (Ptr(wParam) = nil) then + begin + Index := lParam; + end + else + begin //wParam is PChar + try + sFile := String(PChar(Ptr(wParam))); + Index := PluginExists(sFile); + If (Index < 0) And FileExists(sFile) then + begin //Is Filename + AddPlugin(sFile); + Result := Plugins[High(Plugins)].State; + end; + except + Index := -2; + end; + end; + + + If (Index >= 0) and (Index < Length(Plugins)) then + begin + AddPlugin(Plugins[Index].Path); + Result := Plugins[Index].State; + end; +end; + +//-------------- +// wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin +//-------------- +Function TPluginLoader.UnloadPlugin(wParam, lParam: DWord): integer; +var + Index: Integer; + sName: String; +begin + Result := -1; + //lParam is ID + If (Ptr(wParam) = nil) then + begin + Index := lParam; + end + else + begin //wParam is PChar + try + sName := String(PChar(Ptr(wParam))); + Index := PluginExists(sName); + except + Index := -2; + end; + end; + + + If (Index >= 0) and (Index < Length(Plugins)) then + CallDeInit(Index) +end; + +//-------------- +// If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) Else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) +//-------------- +Function TPluginLoader.GetPluginInfo(wParam, lParam: DWord): integer; +var I: Integer; +begin + Result := 0; + If (wParam < 0) then + begin //Get Info of 1 Plugin + If (Ptr(lParam) <> nil) AND (wParam < Length(Plugins)) then + begin + Try + Result := 1; + PUS_PluginInfo(Ptr(lParam))^ := Plugins[wParam].Info; + Except + + End; + end; + end + Else If (Ptr(lParam) = nil) then + begin //Get Length of Plugin (Info) Array + Result := Length(Plugins); + end + Else //Write PluginInfo Array to Address in lParam + begin + Try + For I := 0 to high(Plugins) do + PAUS_PluginInfo(Ptr(lParam))^[I] := Plugins[I].Info; + Result := Length(Plugins); + Except + Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), Integer(PChar('TPluginLoader'))); + End; + end; + +end; + +//-------------- +// If wParam = -1 then (If lParam = nil then get length of Plugin State Array. If lparam <> nil then write array of Byte to address at lparam) Else (Return State of Plugin with Index(wParam)) +//-------------- +Function TPluginLoader.GetPluginState(wParam, lParam: DWord): integer; +var I: Integer; +begin + Result := -1; + If (wParam < 0) then + begin //Get State of 1 Plugin + If (wParam < Length(Plugins)) then + begin + Result := Plugins[wParam].State; + end; + end + Else If (Ptr(lParam) = nil) then + begin //Get Length of Plugin (Info) Array + Result := Length(Plugins); + end + Else //Write PluginInfo Array to Address in lParam + begin + Try + For I := 0 to high(Plugins) do + Byte(Ptr(lParam + I)^) := Plugins[I].State; + Result := Length(Plugins); + Except + Core.ReportError(Integer(PChar('Could not write PluginState Array')), Integer(PChar('TPluginLoader'))); + End; + end; +end; + + + + + +{********************* + TtehPlugins + Implentation +*********************} + +//------------- +// Function that gives some Infos about the Module to the Core +//------------- +Procedure TtehPlugins.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TtehPlugins'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Module executing the Plugins!'; +end; + +//------------- +// Just the Constructor +//------------- +Constructor TtehPlugins.Create; +begin + PluginLoader := nil; +end; + +//------------- +//Is Called on Loading. +//In this Method only Events and Services should be created +//to offer them to other Modules or Plugins during the Init process +//If False is Returned this will cause a Forced Exit +//------------- +Function TtehPlugins.Load: Boolean; +var + I: Integer; //Counter + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +label Continue; +begin + //Get Pointer to PluginLoader + PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader')); + If (PluginLoader = nil) then + begin + Result := False; + Core.ReportError(Integer(PChar('Could not get Pointer to PluginLoader')), Integer(PChar('TtehPlugins'))); + end + else + begin + Result := True; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + I := 0; + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + Core.CurExecuted := -1 - I; + + //Unload Plugin if not correctly Executed + If (PluginLoader.CallLoad(I) <> 0) then + begin + PluginLoader.CallDeInit(I); + PluginLoader.Plugins[I].State := 254; //Plugin asks for unload + Core.ReportDebug(Integer(PChar('Plugin Selfabort during loading process: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + end + else + Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + + Inc(I); + end; + Except + //Plugin could not be loaded. + // => Show Error Message, then ShutDown Plugin + on E: Exception do + begin + PluginLoader.CallDeInit(I); + PluginLoader.Plugins[I].State := 255; //Plugin causes Error + Core.ReportError(Integer(PChar('Plugin causes Error during loading process: ' + PluginLoader.Plugins[I].Info.Name + ', ErrorMsg: "' + E.Message + '"')), Integer(PChar('TtehPlugins'))); + + + //don't forget to increase I + Inc(I); + end; + End; + + If (I <= High(PluginLoader.Plugins)) then + Goto Continue; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; +end; + +//------------- +//Is Called on Init Process +//In this Method you can Hook some Events and Create + Init +//your Classes, Variables etc. +//If False is Returned this will cause a Forced Exit +//------------- +Function TtehPlugins.Init: Boolean; +var + I: Integer; //Counter + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +label Continue; +begin + Result := True; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + I := 0; + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + Core.CurExecuted := -1 - I; + + //Unload Plugin if not correctly Executed + If (PluginLoader.CallInit(I) <> 0) then + begin + PluginLoader.CallDeInit(I); + PluginLoader.Plugins[I].State := 254; //Plugin asks for unload + Core.ReportDebug(Integer(PChar('Plugin Selfabort during init process: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + end + else + Core.ReportDebug(Integer(PChar('Plugin inited succesful: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + + //don't forget to increase I + Inc(I); + end; + Except + //Plugin could not be loaded. + // => Show Error Message, then ShutDown Plugin + PluginLoader.CallDeInit(I); + PluginLoader.Plugins[I].State := 255; //Plugin causes Error + Core.ReportError(Integer(PChar('Plugin causes Error during init process: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins'))); + + //don't forget to increase I + Inc(I); + End; + + If (I <= High(PluginLoader.Plugins)) then + GoTo Continue; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +Procedure TtehPlugins.DeInit; +var + I: Integer; //Counter + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +label Continue; +begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loop + I := 0; + + Continue: + Try + While (I <= High(PluginLoader.Plugins)) do + begin + //DeInit Plugin + PluginLoader.CallDeInit(I); + + Inc(I); + end; + Except + Inc(I); + End; + + If I <= High(PluginLoader.Plugins) then + Goto Continue; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; end. -- cgit v1.2.3