A while ago I blogged about Safe event hooking for Delphi IDE plugins. I have used this method in GExperts as well as my Delphi IDE Explorer and it worked fine for both plugins.
Today I looked at the code again and didn’t like it very much. Yes, it works fine and there aren’t any apparent bugs, but it blatantly violates the DRY (don’t repeat yourself) principle. Back, when I wrote it, my goal was to get something working fast so I could use it for my main goal: Make GExperts and the IDE explorer coexist peacefully within the same Delphi instance, even though they both hook Screen.OnFormChange and Screen.OnControlChange. Today, my goal changed. It’s now: Improve the code.
So, what’s the problem?
First, there must be a Hook-class for each event type. There isn’t much that can be done about this since the method signature of each event is different and we don’t want to resort to assembly language. Also, we can’t use generics because I want the code to work with ancient Delphi versions back to Delphi 6 that just didn’t have generics. So, unfortunately I can’t think of any way to improve on that.
Secondly, there are the simple Hook function and the rather complex Unhook procedure. These are also duplicated, not only for each event type but also for each actual event we want to hook. That’s a really bad code smell. What can be be done to improve on that? First I thought I could just abstract from the actual event by passing a pointer to the memory that stores the event. Unfortunately this doesn’t work because an event might have setter and getter methods. So, what about passing procedure pointers for getting and setting that event? Yes, that would work but it would also be so 1980ies an C-ish. Improve on that, pass an object with getter and setter methods? Yes, but I don’t want to create such an object and free it later. Use an extended record? Not available before Delphi 2006. Use an interface? Too much boiler plate code to be worth it. Then it struck me: Why not use class methods? So the first idea was a class like this:
type
TScreenOnFormChangeAccess = class
public
class function GetEvent: TMethod;
class procedure SetEvent(_Value: TMethod);
end;
// [...]
class function TScreenOnFormChangeAccess.GetEvent: TMethod;
begin
Result := TMethod(Screen.OnFormChange);
end;
class procedure TScreenOnFormChangeAccess.SetEvent(_Value: TMethod);
begin
Screen.OnFormChange := TNotifyEvent(_Value);
end;
I could pass this class to the Hook/Unhook functions to abstract the code for getting/setting the event from the actual program logic.
Great! Got rid of one copy of the Hook/Unhook code: Un-/HookScreenOnFormChange and Un-/HookScreenOnControlChange became simple functions that called a Un-/HookNotifyEvent function, passing it appropriate classes. And since everything was class methods, no class instance had to be created.
function HookScreenActiveFormChange(_HookEvent: TNotifyEvent): TNotifyEventHook; begin Result := HookNotifyEvent(TScreenOnFormChangeAccess, TMethod(_HookEvent)); end; procedure UnhookScreenActiveFormChange(_Hook: TNotifyEventHook); begin UnhookNotifyEvent(TScreenOnFormChangeAccess, _Hook); end;
Once I had figured out this solution, there was another thought: Since I already have a class, why not make Hook/Unhook also methods of this class and make Get/SetEvent virtual class methods that are called by Hook/Unhook? At first, I was not sure whether Delphi 6 already had virtual class methods, but it turned out, it had. So, we get to a more object oriented implementation:
First, there is a pure abstract ancestor class TSecureEventHook:
type
///<summary>
/// This class provides the abstract declarations of two class methods:
/// GetEvent returns the original event handler, typecasted to TMethod
/// SetEvent sets the replacement event handler, typecated from TMethod
/// Both methods must be overriden to access an actual event. </summary>
TSecureEventHook = class
protected
class function GetEvent: TMethod; virtual; abstract;
class procedure SetEvent(_Value: TMethod); virtual; abstract;
end;
All it does, is declaring two virtual abstract class methods GetEvent and SetEvent. Since these events are treated as TMethod (that is: A record with a Data and a Code pointer which is what an event pointer really is.) this can be agnostic of the actual event type.
Now, for each event type, we need a specialized class, e.g. for a TNotifyEvent:
type
///<summary>
/// Provides the Methods Install and Remove to hook/unhook an event of type TNotifyEvent
/// It uses the inherited virtual methods GetEvent and SetEvent to access the actual
/// event. Since GetEvent/SetEvent are still abstract, a descendant is required
/// that implements them. </summary>
TSecureNotifyEventHook = class(TSecureEventHook)
public
class function Install(_HookEvent: TNotifyEvent): TNotifyEventHook;
class procedure Remove(_Hook: TNotifyEventHook);
end;
This class introduces two class methods: Install and Remove. They have the same signature as the old HookScreenActiveControlChange function and UnhookScreenActiveControlChange procedure. But since they call the inherited GetEvent/SetEvent methods, they don’t need to know which event they are hooking. I’ll come back to the implementation later.
The last building block is a class that actually implements GetEvent/SetEvent for a particular event, let’s say Screen.OnActiveFormChange. We already had that above, but this time we must derive from TSecureNotifyEventHook and override the methods inherited from TSecureEventHook:
type
///<summary>
/// Implements the GetEvent/SetEvent methods to access Screen.ActiveFormChange </summary>
TScreenActiveFormChangeHook = class(TSecureNotifyEventHook)
protected
class function GetEvent: TMethod; override;
class procedure SetEvent(_Value: TMethod); override;
end;
So, in order to hook / unhook the Screen.OnActiveFormChange event, we call:
FHook := TScreenActiveFormChangeHook.Install(MyHookMethod); // [...] TScreenActiveFormChangeHook.Remove(FHook);
The neat part is, that since we now have an object oriented implementation, adding support to hook another TNotifyEvent simply requires adding another descendant from TSecureNotifyEventHook, e.g. for Screen.OnActiveControlChange:
type
///<summary>
/// Implements the GetEvent/SetEvent methods to access Screen.ActiveControlChange </summary>
TScreenActiveControlChangeHook = class(TSecureNotifyEventHook)
protected
class function GetEvent: TMethod; override;
class procedure SetEvent(_Value: TMethod); override;
end;
// [...]
class function TScreenActiveControlChangeHook.GetEvent: TMethod;
begin
Result := TMethod(Screen.OnActiveControlChange);
end;
class procedure TScreenActiveControlChangeHook.SetEvent(_Value: TMethod);
begin
Screen.OnActiveControlChange := TNotifyEvent(_Value);
end;
What’s missing? The actual Hook/Unhook code, now in the Install/Remove class methods:
{ TSecureNotifyEventHook }
class function TSecureNotifyEventHook.Install(_HookEvent: TNotifyEvent): TNotifyEventHook;
var
evt: TNotifyEvent;
begin
// Here we use the inherited virtual GetEvent method which
// will be overridden by descendants to access an actual event.
Result := TNotifyEventHook.Create(GetEvent, TMethod(_HookEvent));
evt := Result.HandleEvent;
// Here we use the inherited virtual SetEvent method which
// will be overridden by descendants to access an actual event.
SetEvent(TMethod(evt));
end;
class procedure TSecureNotifyEventHook.Remove(_Hook: TNotifyEventHook);
var
Ptr: TMethod;
begin
if not Assigned(_Hook) then begin
// Just in case somebody did not check whether HookScreenActiveFormChange actually returned
// a valid object or simply didn't call it.
Exit;
end;
// Here we use the inherited virtual GetEvent method which
// will be overridden by descendants to access an actual event.
Ptr := GetEvent;
if not Assigned(Ptr.Data) and not Assigned(Ptr.Code) then begin
// Somebody has assigned NIL to the event.
// It's probably safe to assume that there will be no reference to our hook left, so we just
// free the object and be done.
_Hook.Free;
Exit;
end;
while TObject(Ptr.Data).ClassNameIs('TNotifyEventHook') do begin
// Somebody who knows about this standard has hooked the event.
// (Remember: Do not change the class name or the class structure. Otherwise this
// check will fail!)
// Let's check whether we can find our own hook in the chain.
if Ptr.Data = _Hook then begin
// We are lucky, nobody has tampered with the event, we can just assign the original event,
// free the hook object and be done with it.
// Here we use the inherited virtual SetEvent method which
// will be overridden by descendants to access an actual event.
SetEvent(_Hook.OrigEvent);
_Hook.Free;
Exit;
end;
// check the next event in the chain
Ptr := TMethod(TNotifyEventHook(Ptr.Data).OrigEvent);
end;
// If we get here, somebody who does not adhere to this standard has changed the event.
// The best thing we can do, is Assign NIL to the HookEvent so it no longer gets called.
// We cannot free the hook because somebody might still have reference
// to _Hook.HandleEvent.
_Hook.HookEvent.Code := nil;
_Hook.HookEvent.Data := nil;
end;
Note that the code to actually get and set the event has been abstracted to call the virtual GetEvent/SetEvent methods.
There still remains one copy of the Hook/Unhook code per event type. I think I can get rid of that as well, but that’s for another blog post. Also, I am not yet sure whether it is possible to get rid of the separate TNotifyEventHook class by just merging it with the TSecureNotifyEventHook class. I’ll have to check if/how adding virtual class methods changes the class’ VMT and thus, the memory structure. I want it to stay backwards compatible to the original proposal, even though I haven’t heard back from anybody who is using it (which probably means nobody but myself is using it.)