Safe event hooking for Delphi IDE plugins revisited

 Delphi, GExperts  Comments Off on Safe event hooking for Delphi IDE plugins revisited
Mar 282016
 

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.)

If your OnePlus One won’t turn on but only vibrates

 Android  Comments Off on If your OnePlus One won’t turn on but only vibrates
Mar 192016
 

Note to self: If your OnePlus One smartphone won’t turn on but only vibrates for a short time when you press the power button, that probably means the battery is dead. If it has already been on the charger for some time, make sure that you didn’t plug the charging cable upside down into the charger (it fits both ways but only one way works). If that isn’t the problem, try a different cable and/or charger.

Calculating Offsets into the Delphi editor buffer

 Delphi, GExperts  Comments Off on Calculating Offsets into the Delphi editor buffer
Mar 122016
 

I have already mentioned the AutoTodo wizard for Delphi when I was trying to contact the Author Peter Laman. He hasn’t responded and nobody could give me any contact information. (Peter, if you ever read this, please contact me using my Google+ profile.)

The animated GIF in that post shows how the new AutoTodo expert in GExperts works. Unfortunately it turned out later that, again, I had overlooked a Unicode issue. If the editor buffer contains any Unicode characters, the offsets for inserting the todos where off by one for each of these characters, so the todos were inserted in the middle of the source code rather than at the empty blocks.

unit bla;
// ä <--- beware, there's a Unicode character here!
interface

implementation

procedure blub;
begi  //TODO 5 -otwm -cEmpty Structure : blub (begin/end in procedure)n
end;

end.

The reason, of course is that starting with Delphi 8 the IDE uses UTF-8 for its editor buffers, so any offsets into these buffers have to take characters into account that take up more than one byte.

The easiest way to do that is not using offsets at all but Line/CharIndex positions as stored in the TOTACharPos record. IOTAEditView provides two methods for converting a TOTACharPos to a buffer offset and vice versa:

type
  IOTAEditView40 = interface(IInterface)
    // ...
    { Converts a linear buffer offset position to a CharPos }
    function PosToCharPos(Pos: Longint): TOTACharPos;
    { Convert a CharPos to a linear buffer offset }
    function CharPosToPos(CharPos: TOTACharPos): Longint;
    // ...
  end;

So, if you want to store any positions, never use the buffer offset but use the CharPos instead.

But what if your algorithm only works with offsets? And if these offsets are not into UTF-8 strings but into Unicode strings? You need a way to calculate the CharPos from your offset and then use CharPosToPos to calculate the buffer offset.

In this case, the algorithm of the AutoTodo wizard which I used as a base for the GExperts AutoTodo Expert generated a TStringList with text to insert into the source code where the Objects[] property stored the character index into the source code string:

  // get the source code from the current editor window into the
  // string Source and pass it to the AutoTodo handler:
  Patches := TStringList.Create;
  Handler.Execute(Source, Patches);
  // and now what?

I am a lazy basterd™, so the first thing I looked for was some existing source code for converting the character index to a line index / character position. I found nothing in the TStringList interface and nothing in the Delphi RTL. A Google search didn’t give me any useful results (I might have used the wrong search terms.). Even the Google+ Delphi Developer community refused to support my lazyness by pointing me to a ready made algorithm. So I had to roll my own.

This class takes a StringList (TGXUnicodeStringList is just a regular StringList for most purposes) with a multi line string and calculates the offsets for the first characters of all lines. These offsets are stored in the FOffsets array. After this is done, it can easily and reasonably efficient calculate the line index and the character position in that line from the character position in the multi line string stored in the StringList.

type
  TOffsetToCursorPos = class
  private
    FOffsets: array of integer;
  public
    constructor Create(_sl: TGXUnicodeStringList);
    function CalcCursorPos(_Offset: integer): TPoint;
  end;


{ TOffsetToCursorPos }

constructor TOffsetToCursorPos.Create(_sl: TGXUnicodeStringList);
var
  cnt: integer;
  i: Integer;
  CrLfLen: integer;
  Ofs: Integer;
begin
  inherited Create;
{$IFDEF GX_VER190_up}
  CrLfLen := Length(_sl.LineBreak);
{$ELSE}
  // Delphi < 2007 does not have the LineBreak property
  CrLfLen := 2;
{$ENDIF}
  cnt := _sl.Count;
  SetLength(FOffsets, cnt);
  Ofs := 1;
  for i := 0 to _sl.Count - 1 do begin
    FOffsets[i] := Ofs;
    Inc(Ofs, Length(_sl[i]) + CrLfLen);
  end;
end;

function TOffsetToCursorPos.CalcCursorPos(_Offset: integer): TPoint;
var
  i: integer;
begin
  i := 0;
  while (i < Length(FOffsets)) and (_Offset >= FOffsets[i]) do begin
    Inc(i);
  end;
  Result.Y := i - 1;
  Result.X := _Offset - FOffsets[Result.Y] + 1;
end;

Not too complicated, but let my tell you: It took me quite a while to get it right and make it compile with all affected Delphi versions.

The while loop in CalcCursorPos could probably be replaced with a binary search because the FOffsets array by definition is sorted.

Now, all I had to do was passing the offsets from the patch array to CalcCursorPos and then use CharPosToPos to calculate the buffer offset.

Easy, isn’t it?

Problem accessing a Windows XP share from a Windows 7 PC

 Windows, Windows 7  Comments Off on Problem accessing a Windows XP share from a Windows 7 PC
Mar 092016
 

Today a problem drove me crazy: I tried to map a share on a PC running Windows XP from another computer running Windows 7. I kept getting the error that the username or password are invalid. On the other hand, accessing a share on the Windows 7 PC from the Windows XP PC worked fine. I could also use Remote Desktop on the Windows 7 PC to access the Windows XP PC so I know the credentials were fine.

It turned out that the cause for this was the system time of these two computers being off by more than an hour. Adjusting the time solved the problem for me.