aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Game/Code/Classes/UCore.pas36
-rw-r--r--Game/Code/Classes/UCoreModule.pas13
-rw-r--r--Game/Code/Classes/UHooks.pas117
-rw-r--r--Game/Code/Classes/UModules.pas9
-rw-r--r--Game/Code/Classes/UPluginInterface.pas48
-rw-r--r--Game/Code/Classes/UServices.pas14
-rw-r--r--Game/Code/Classes/uPluginLoader.pas786
7 files changed, 947 insertions, 76 deletions
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;
//-------------
@@ -375,6 +384,21 @@ begin
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)
//-------------
Function TCore.ShowMessage(wParam, lParam: DWord): integer;
@@ -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
@@ -48,6 +51,14 @@ type
implementation
//-------------
+// Just the Constructor
+//-------------
+Constructor TCoreModule.Create;
+begin
+ //Dummy maaaan ;)
+end;
+
+//-------------
// Function that gives some Infos about the Module to the Core
//-------------
Procedure TCoreModule.Info(const pInfo: PModuleInfo);
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,13 +237,38 @@ 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
//------------
Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer;
@@ -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
@@ -9,11 +9,6 @@ interface
uses uPluginDefs;
//---------------
-// Procedure that Sets the PluginInterface Record
-//---------------
- Procedure Init_PluginInterface;
-
-//---------------
// Methods for Plugin
//---------------
{******** Hook specific Methods ********}
@@ -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.
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-31 22:18:49 +0000