HMAC functions in Delphi (HMAC_SHA256, HMAC_SHA1)

I came across HMAC (Hash-based message authentication code) functions when developing a RESTful client application in Delphi. The RESTful Web Service API required me to send HMAC_SHA256 signatures (Base64 encoded) with each HTTP request.

HMAC functions take two parameters: a key and a message. The purpose of the HMAC function is to authenticate the message and guarantee the data integrity of the message.

The cryptographic strength of the HMAC function lies on the underlying hashing function that it uses: MD5, SHA1, SHA256, etc.

So, these functions are usually are termed HMAC_SHA256, HMAC_SHA1, HMAC_MD5 to connote the core hashing function being used.

The outcome of a HMAC function is basically an array of bytes, but it is usually represented as a hexadecimal string or encoded as a Base64 string. (The RESTful Web Service API needed the Base64 encoded output).

I Googled around for a bit, but I didn’t get a clean implementation of HMAC_SHA256 in Delphi (encoded as Base64). I glued together the pieces from some questions on StackOverflow and coded an Indy based implementation that uses generics to specify the core hashing function.

Brief description: I created a helper class called THMACUtils. Note that this class uses generics to indicate the hashing algorithm (TIdHMACSHA256, TIdHMACSHA1). Three functions are provided:  the main thing happens in the HMAC(...) function; HMAC_HexStr(...) and HMAC_Base64(...) are simply decorations of the output.

unit HMAC;

interface

uses
  System.SysUtils,
  EncdDecd,
  IdHMAC,
  IdSSLOpenSSL,
  IdHash;

type
  THMACUtils<T: TIdHMAC, constructor> = class
  public
    class function HMAC(aKey, aMessage: RawByteString): TBytes;
    class function HMAC_HexStr(aKey, aMessage: RawByteString): RawByteString;
    class function HMAC_Base64(aKey, aMessage: RawByteString): RawByteString;
  end;

implementation

class function THMACUtils<T>.HMAC(aKey, aMessage: RawByteString): TBytes;
var
  _HMAC: T;
begin
  if not IdSSLOpenSSL.LoadOpenSSLLibrary then Exit;
  _HMAC:= T.Create;
  try
    _HMAC.Key := BytesOf(aKey);
    Result:= _HMAC.HashValue(BytesOf(aMessage));
  finally
    _HMAC.Free;
  end;
end;

class function THMACUtils<T>.HMAC_HexStr(aKey, aMessage: RawByteString): RawByteString;
var
  I: Byte;
begin
  Result:= '0x';
  for I in HMAC(aKey, aMessage) do
    Result:= Result + IntToHex(I, 2);
end;

class function THMACUtils<T>.HMAC_Base64(aKey, aMessage: RawByteString): RawByteString;
var
  _HMAC: TBytes;
begin
  _HMAC:= HMAC(aKey, aMessage);
  Result:= EncodeBase64(_HMAC, Length(_HMAC));
end;

end.

Below there’s an example of how to use the THMACUtils class.

program HMACSample;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  HMAC,
  IdHMACSHA1,
  IdHashMessageDigest;

begin
  try
    Write('HMAC_SHA1("key", "message")'#9#9'= ');
    Writeln(THMACUtils<TIdHMACSHA1>.HMAC_HexStr('key', 'message' ));
    Writeln;

    Write('HMAC_SHA256("key", "message")'#9#9'= ');
    Writeln(THMACUtils<TIdHMACSHA256>.HMAC_HexStr('key', 'message' ));
    Writeln;

    Write('HMAC_SHA1_Base64("key", "message")'#9'= ');
    Writeln(THMACUtils<TIdHMACSHA1>.HMAC_Base64('key', 'message' ));
    Writeln;

    Write('HMAC_SHA256_Base64("key", "message")'#9'= ');
    Writeln(THMACUtils<TIdHMACSHA256>.HMAC_Base64('key', 'message' ));

    Readln;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

The console application above looks like this:

HMAC Sample Application Delphi

Refactoring to patterns. Yet another TDD example coded in Delphi

Long overdue here is my second article about Test Driven Development (TDD) in Delphi. This is a continuation of TDD in Delphi: The Basics, another post that I wrote a few months earlier. 

I would like to focus in a particular step within the TDD cycle: refactoring the code. Refactoring means optimizing, cleaning, shortening, beautifying, styling (put your own word here) the code without breaking the functionality; that is, without breaking your unit tests.

 
By having unit tests in place before refactoring, you guarantee that the changes to the code are safe. Refactoring can introduce bugs. To avoid those bugs you need your unit tests in place.

Refactoring can introduce something else: refactoring can introduce design patterns into your code. That means you don’t have to introduce the design patterns up-front, since your code can evolve from a “very rustic implementation” to a “pattern oriented implementation”. This is referred as “refactoring to patterns”. If you are interested on the topic, I advise you to read Refactoring To Patterns by Joshua Kerievsky.

I’ll take the chess game as the base to my example. For simplicity, I’ll just refer to a couple of pieces: the knight and the bishop. In this example, I will just focus in refactoring some code with unit tests already in place. A detailed walk-through for the TDD cycle can be found in my previous article, which is also based on the chess game.  

  
The code is easy enough to be self-explanatory: basically, there is a class hierarchy in which TPiece is the base class from which TKnight and TBishop derive. Take a quick look:

unit ChessGame;

interface

type

 TPiece = class
 private
   FX,
   FY: Byte;
 public
   constructor Create(aX, aY: Integer);
   function IsWithinBoard(aX, aY: Integer): Boolean;
 end;

 TBishop = class (TPiece)
 public
   function CanMoveTo(aX, aY: Byte): Boolean;
   function isValidMove(aX, aY: Byte): Boolean;
 end;

 TKnight = class(TPiece)
  public
    function CanMoveTo(aX, aY: Byte): Boolean;
    function isValidMove(aX, aY: Byte): Boolean;
 end;


implementation

{ TPiece }

constructor TPiece.Create(aX, aY: Integer);
begin
  inherited Create;
  // TODO: check that this assignment is valid.
  // Not now, ok? :-)
  FX:= aX;
  FY:= aY;
end;

function TPiece.IsWithinBoard(aX, aY: Integer): Boolean;
begin
  Result:= (aX > 0) and
           (aX < 9) and
           (aY > 0) and
           (aY < 9);
end;

{ TKnight }

function TKnight.isValidMove(aX, aY: Byte): Boolean;
var
  x_diff,
  y_diff: Integer;
begin
  x_diff:= abs(aX - FX) ;
  y_diff:= abs(aY - FY) ;

  Result:= ((x_diff = 2) and (y_diff = 1))
                         or
           ((y_diff = 2) and (x_diff = 1));
end;

function TKnight.CanMoveTo(aX, aY: Byte): Boolean;
begin
  Result:= IsWithinBoard(aX, aY) and
           IsValidMove(aX, aY);
end;

{ TBishop }

function TBishop.isValidMove(aX, aY: Byte): Boolean;
begin
  Result:= abs(aX - FX) = abs(aY - FY);
end;

function TBishop.CanMoveTo(aX, aY: Byte): Boolean;
begin
  Result:= IsWithinBoard(aX, aY) and
           IsValidMove(aX, aY);
end;

end. 


/////////////////////////////////////////////

 
unit TestChessGame;

interface

uses
  TestFramework, ChessGame;

type
  // Test methods for class TPiece
  TestTPiece = class(TTestCase)
  strict private
    FPiece: TPiece;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestIsWithinBoard;
  end;

  // Test methods for class TBishop
  TestTBishop = class(TTestCase)
  strict private
    FBishop: TBishop;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCanMoveTo;
    procedure TestisValidMove;
  end;

  // Test methods for class TKnight
  TestTKnight = class(TTestCase)
  strict private
    FKnight: TKnight;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCanMoveTo;
    procedure TestisValidMove;
  end;

implementation

procedure TestTPiece.SetUp;
begin
  FPiece := TPiece.Create(4, 4);
end;

procedure TestTPiece.TearDown;
begin
  FPiece.Free;
  FPiece := nil;
end;

procedure TestTPiece.TestIsWithinBoard;
begin
  //Test trivial (normal) workflow
  Check(FPiece.IsWithinBoard(4, 4));

  //Tests boundaries
  Check(FPiece.IsWithinBoard(1, 1));
  Check(FPiece.IsWithinBoard(1, 8));
  Check(FPiece.IsWithinBoard(8, 1));
  Check(FPiece.IsWithinBoard(8, 8));

  //Test beyond the boundaries
  CheckFalse(FPiece.IsWithinBoard(3, 15));
  CheckFalse(FPiece.IsWithinBoard(3, -15));
  CheckFalse(FPiece.IsWithinBoard(15, 3));
  CheckFalse(FPiece.IsWithinBoard(15, 15));
  CheckFalse(FPiece.IsWithinBoard(15, -15));
  CheckFalse(FPiece.IsWithinBoard(-15, 3));
  CheckFalse(FPiece.IsWithinBoard(-15, 15));
  CheckFalse(FPiece.IsWithinBoard(-15, -15));
end;

procedure TestTBishop.SetUp;
begin
  FBishop := TBishop.Create(4, 4);
end;

procedure TestTBishop.TearDown;
begin
  FBishop.Free;
  FBishop := nil;
end;

procedure TestTBishop.TestCanMoveTo;
begin
  // Hey developer, indulge me here: believe
  // that I fully wrote the code for this
  // test already before writing anything else.
end;

procedure TestTBishop.TestisValidMove;
begin
  // Hey developer, indulge me here: believe
  // that I fully wrote the code for this
  // test already before writing anything else.
end;

procedure TestTKnight.SetUp;
begin
  FKnight := TKnight.Create(4, 4);
end;

procedure TestTKnight.TearDown;
begin
  FKnight.Free;
  FKnight := nil;
end;

procedure TestTKnight.TestCanMoveTo;
begin
  // Hey developer, indulge me here: believe
  // that I fully wrote the code for this
  // test already before writing anything else.
end;

procedure TestTKnight.TestisValidMove;
begin
  // Hey developer, indulge me here: believe
  // that I fully wrote the code for this
  // test already before writing anything else.
end;

initialization
  // Register any test cases with the test runner
  RegisterTest(TestTPiece.Suite);
  RegisterTest(TestTBishop.Suite);
  RegisterTest(TestTKnight.Suite);
end.

Note that the method CanMoveTo is duplicated in both TKnight  and TBishop; that’s not nice isn’t it? In order to fix this, we can pull-up the CanMoveTo method to the TPiece base class. Note this now: the CanMoveTo has now become a “template method”; because is a general algorithm applicable to all kind of chess pieces (TKnight ,TBishop, etc) .

This general algorithm has deferred some steps to be implemented in the subclasses; I mean, the isValidMove method is still coded in the subclasses. Isn’t this a beauty?  You have now refactored your code and when doing so, you have introduced the Template Method Design Pattern.

What’s even best, (don’t forget this because it is a key part): is that we can guarantee that our fancy refactoring didn’t break our pre-existing functionality. Why? Because we had unit tests in place written a long time ago. Writing unit test from the beginning gives a huge peace of mind to the developer :-) See the new refactored code below:

unit ChessGameRefactored;

interface

type

 TPiece = class
 private
   FX,
   FY: Byte;
 public
   constructor Create(aX, aY: Integer);
   function IsWithinBoard(aX, aY: Integer): Boolean;

   function CanMoveTo(aX, aY: Byte): Boolean;
   function isValidMove(aX, aY: Byte): Boolean; virtual; abstract;
 end;

 TBishop = class (TPiece)
 public
   function isValidMove(aX, aY: Byte): Boolean; override;
 end;

 TKnight = class(TPiece)
  public
    function isValidMove(aX, aY: Byte): Boolean; override;
 end;


implementation

{ TPiece }

constructor TPiece.Create(aX, aY: Integer);
begin
  inherited Create;
  // TODO: check that this assignment is valid.
  // Not now, ok? :-)
  FX:= aX;
  FY:= aY;
end;

function TPiece.IsWithinBoard(aX, aY: Integer): Boolean;
begin
  Result:= (aX > 0) and
           (aX < 9) and
           (aY > 0) and
           (aY < 9);
end;

function TPiece.CanMoveTo(aX, aY: Byte): Boolean;
begin
  Result:= IsWithinBoard(aX, aY) and
           IsValidMove(aX, aY);
end;

{ TKnight }

function TKnight.isValidMove(aX, aY: Byte): Boolean;
var
  x_diff,
  y_diff: Integer;
begin
  x_diff:= abs(aX - FX) ;
  y_diff:= abs(aY - FY) ;

  Result:= ((x_diff = 2) and (y_diff = 1))
                         or
           ((y_diff = 2) and (x_diff = 1));
end;

{ TBishop }

function TBishop.isValidMove(aX, aY: Byte): Boolean;
begin
  Result:= abs(aX - FX) = abs(aY - FY);
end;

end.

Conclusion, in addition to all the cool things of TDD there’s the possibility of refining your design not up-front, but when refactoring your code. Design patterns can be introduced at any time and we know that such introduction, if late, is not going to break our logic, because we have unit tests in place to prevent that from happening.

Some related reading below:

CodeProject

Test Driven Development in Delphi: The Basics

I intend to write a Test Driven Development (TDD) series, targeted for Delphi developers. I will use DUnit, the unit testing framework for Delphi.

Note folks that the purpose of this is NOT to discuss the Pros and Cons of TDD, Unit Testing or whatsoever. The purpose is just to give a few examples. I would love if you help me when the complexity starts climbing.

If needed, for a quick understanding of what TDD or Unit Testing is, refer to the links above, or check out the book at the end of the article.

In TDD you don’t write the application code first, instead you write the test cases first. The TDD cycle is as follows:

1. At the beginning you just write one test, and later on, more tests can be added.
2. Make sure the initial test fails; this will validate the test harness.
3. Write some code to pass the test. Important: don’t over-code. Just add the code needed to pass the test and period. The code does not have to be elegant at this point.
4. Run the test: if it fails, then you have to go back to step 3 and fix your code in order to pass the test. When you succeed, then move on to step 5.
5. Improve and optimize your code: make it elegant, more efficient, avoid duplications, etc, etc. This is called code refactoring.
6. When refactoring your code, maybe, by accident, you break the functionality. How can you be sure that everything is working as it should? Just re-run your test and it will tell you if the previous refactoring introduced a failure or not.
7. Go to step 1 and add a new test if needed.

The example: let’s consider the chess game. The goal will be to implement the code to verify whether a piece is placed in a valid position within the board. We are only going to implement one test: SetPositionTest.

I will number the columns (X coordinate) from 1 to 8 starting at the bottom left-hand corner. In the same way, I will number the rows (Y coordinate) from 1 to 8 starting at the bottom left-hand corner.

8
7
6
5
4
3
2
1 2 3 4 5 6 7 8

For a step by step tutorial of how to use, configure and setup DUnit you can read the English or Chinese versions of the tutorial.

Initially, the testing code should look like this:


unit ChessPiecesTests;

interface

uses
   TestFrameWork;

type
  TPieceTest = class(TTestCase)
  published
    procedure SetPositionTest;
  end;

implementation

uses
  ChessPieces;

{ TPieceTest }

procedure TPieceTest.SetPositionTest;
begin
end;

initialization
  TestFramework.RegisterTest(TPieceTest.Suite);
end.


If you run that test, it will succeed since no checks are being performed within the SetPositionTest procedure.

Each test is composed by one or more checks. I suggest adding the checks little by little. Every time you add a check, you should add business code to pass the corresponding test.

Now, let’s make the test fail on purpose. For that, let’s add one check to the SetPositionTest procedure.


procedure TPieceTest.SetPositionTest;
begin
  Check(True = False, '');
end;


True is never False. So, this test will fail. If it doesn’t fail, then something is wrong with you test harness. Fix it. You can remove this initial check once you run the test and it fails.

Now, let’s add a real check to our test. Something like this:


procedure TPieceTest.SetPositionTest;
var
  Piece: TPiece;
begin
  Piece:= TPiece.Create;
  try
    //Test trivial (normal) workflow
    Check(Piece.SetPosition(4, 4) = True, '');
  finally
    Piece.Free;
  end;
end;


If you run this test, you will get a compilation error! Yes, that’s right. You don’t have business code yet. You just have the test. This is what TDD is all about: test first, business code later. Get the point?

To avoid the compilation error, we will code a separate unit (ChessPieces) and we will add it to the uses clause of our ChessPiecesTests unit.


unit ChessPieces;

interface

type
  TPiece = class
  private
  public
    function SetPosition(aX, aY: Integer): Boolean;
  end;

implementation

{ TPiece }

function TPiece.SetPosition(aX, aY: Integer): Boolean;
begin
end;

end.


Run the test again and now the compilation error is gone. Nonetheless, the test fails, because the Piece.SetPosition(4, 4) evaluates to False.

Let’s add the minimum business code possible to pass this test:


function TPiece.SetPosition(aX, aY: Integer): Boolean;
begin
  Result:= True;
end;

This passes the test. What? Yes, this passes the test, right?

OK, what now? Well, we keep adding new checks to the test and every time this happens, we need to add new business code in order to pass it. It is very important to add checks to test the boundaries of whatever we are trying to code. I think you are getting the point, so I will just add a bunch of checks at once:


procedure TPieceTest.SetPositionTest;
var
  Piece: TPiece;
begin
  Piece:= TPiece.Create;
  try
    //Test trivial (normal) workflow
    Check(Piece.SetPosition(4, 4) = True, '');

    //Tests boundaries
    Check(Piece.SetPosition(1, 1) = True, '');
    Check(Piece.SetPosition(1, 8) = True, '');
    Check(Piece.SetPosition(8, 1) = True, '');
    Check(Piece.SetPosition(8, 8) = True, '');

    //Test beyond the boundaries
    Check(Piece.SetPosition(3, 15) = False, '');
    Check(Piece.SetPosition(3, -15) = False, '');
    Check(Piece.SetPosition(15, 3) = False, '');
    Check(Piece.SetPosition(15, 15) = False, '');
    Check(Piece.SetPosition(15, -15) = False, '');
    Check(Piece.SetPosition(-15, 3) = False, '');
    Check(Piece.SetPosition(-15, 15) = False, '');
    Check(Piece.SetPosition(-15, -15) = False, '');
  finally
    Piece.Free;
end;


The test above is even checking for the attempts of positioning a piece outside the chess board.

To pass that test let’s write some business code:


function TPiece.SetPosition(aX, aY: Integer): Boolean;
begin
  Result:= True;
  if (aY < 1) or (aY > 8) then Result:= False
  else if (aX < 1) or (aX > 8) then Result:= False;
end;


Run the test and see how it passes.

The code above could be refactored or even rewritten. The tests will remain the same, allowing us to catch any bugs introduced with the code change.

For instance, we could write the procedure above as follows:


function TPiece.SetPosition(aX, aY: Integer): Boolean;
begin
  Result:= (aX > 0) and
           (aX < 9) and 
           (aY > 0) and
           (aY < 9);
end;


Run the test, and it will tell you if this refactoring (or reimplementation) works ok.

It’s important to note that a good test should cover all possible scenarios and workflows. Pay special attention to the boundaries. At this point, a good understanding of the requisites is indispensable.

Finally, more and more tests will be needed in a real world application. Each test will have its own checks. Each test will cover one piece of the functionality: this is what unit testing is intended for.

I wrote a second article about TDD, code refactoring and design patterns in Delphi (click here). I would appreciate any comments you could provide about it.

For further reading I recommend you Test Driven Development: By Example by Kent Beck. Check it out just below:

CodeProject

Deep copying (cloning) objects in Delphi

When I first took a look at the prototype design pattern in GoF(years ago), I realized that there was a big obstacle (challenge) to implement it in Delphi: How to write a routine to really clone (not just recreate) an object? In other words, how to perform a deep-copy of a living object in Delphi.

There are approaches out there mimicking the deep copy by simply calling the constructor and reassigning the state of the object by hand (I don’t like it). There are others exposing that a deep copy could be accomplished for the descendants of TPersistent by calling the Assign method (I don’t like it either).

With the new RTTI extensions it seemed to me (and to others) that a deep copy could be accomplished using reflection.

I was reluctant to write the routine myself since the work is not trivial. It could get really nasty because there might be composition, aggregation and God knows what within an arbitrary object.

So I waited….

Just a few days ago, I realized that I could use the JSON marshalling and unmarshalling features introduced in Delphi (2010?) to write the deep copy method. So I came with this:


.....
uses
  DBXJSON, DBXJSONReflect;
.....
 
function DeepCopy(aValue: TObject): TObject;
var
  MarshalObj: TJSONMarshal;
  UnMarshalObj: TJSONUnMarshal;
  JSONValue: TJSONValue;
begin
  Result:= nil;
  MarshalObj := TJSONMarshal.Create;
  UnMarshalObj := TJSONUnMarshal.Create;
  try
    JSONValue := MarshalObj.Marshal(aValue);
    try
      if Assigned(JSONValue) then
        Result:= UnMarshalObj.Unmarshal(JSONValue);
    finally
      JSONValue.Free;
    end;
  finally
    MarshalObj.Free;
    UnMarshalObj.Free;
  end;
end;

You can now use it like this:

.....
var
  MyObject1,
  MyObject2: TMyObject;
begin
  //Regular object construction
  MyObject1:= TMyObject.Create;

  //Deep copying an object
  MyObject2:= TMyObject(DeepCopy(MyObject1));

  try
    //Do something here

  finally
    MyObject1.Free;
    MyObject2.Free;
  end;
end;


I tested it with some complex cases and it seems to be working quite well. Anyhow, if you find any problems or limitations, please, let me know.

Now that you get the idea we can do more crazy things like patching TObject (or any other class hierarchy) by using helpers. Look at this:


.....
interface

uses
   DBXJSON, DBXJSONReflect;

type
  TObjectHelper = class helper for TObject
    function Clone: TObject;
  end;

implementation

function TObjectHelper.Clone: TObject;
var
  MarshalObj: TJSONMarshal;
  UnMarshalObj: TJSONUnMarshal;
  JSONValue: TJSONValue;
begin
  Result:= nil;
  MarshalObj := TJSONMarshal.Create;
  UnMarshalObj := TJSONUnMarshal.Create;
  try
    JSONValue := MarshalObj.Marshal(Self);
    try
      if Assigned(JSONValue) then
        Result:= UnMarshalObj.Unmarshal(JSONValue);
    finally
      JSONValue.Free;
    end;
  finally
    MarshalObj.Free;
    UnMarshalObj.Free;
  end;
end;


All of a sudden, TObject has a Clone method! Call it like this:


.....
var
  MyObject1,
  MyObject2: TMyObject;
begin
  //Regular object construction
  MyObject1:= TMyObject.Create;

  //Cloning an object
  MyObject2:= TMyObject(MyObject1.Clone);

  try
    //Do something here

  finally
    MyObject1.Free;
    MyObject2.Free;
  end;
end;


If you think that helpers are an aberration, you can still create a TCloneable class with a Clone method and inherit from it, right? You can even use the decorator pattern to attach a Clone method to an object. You can do more…Share it with me, please. Thanks!

CodeProject

String comparison in Delphi

Have you ever wondered how utilities like Beyond Compare or DIFF are comparing files? They do it (I guess) by solving the longest common subsequence (LCS) problem.

After reading the Wikipedia article linked above, I obtained an overall view of the problem and I looked at the possible resolutions. So, I decided to implement a Delphi class to do the string comparison trick, which is the base for the text file comparison.

Let me put it as follows: given two strings to be compared, I want to highlight in blue the characters added to the first string and in red the characters removed from it. The common (unchanged) characters will keep the default color.

 
For example:

String 1 = Delphi allows both structural and object oriented programming.

String 2 = Does Delphi allow object oriented programming?

Highlighted differences:

Does Delphi allows both structural and object oriented programming.?

The Delphi class looks like this:

type
  TDiff = record
    Character: Char;
    CharStatus: Char;  //Possible values: [+, -, =]
  end;

  TStringComparer = class
  ……………
  public
    class function Compare(aString1, aString2: string): TList<TDiff>;
  end;


When you call TStringComparer.Compare, a generic list of TDiff records is created. A TDiff record contains a character and whether this character was added (CharStatus = ‘+’), removed (CharStatus = ‘-’) or unchanged (CharStatus = ‘=’) in both strings under comparison.

Let’s drop two edits (Edit1, Edit2), a rich edit (RichEdit1) and a button (Button1) on a Delphi form. To highlight the differences put the following code in the OnClick event of the button:


procedure TForm1.Button1Click(Sender: TObject);
var
  Differences: TList<TDiff>;
  Diff: TDiff;
begin
  //Yes, I know...this method could be refactored ;-)
  Differences:= TStringComparer.Compare(Edit1.Text, Edit2.Text);
  try
    RichEdit1.Clear;
    RichEdit1.SelStart:= RichEdit1.GetTextLen;
    for Diff in Differences do
      if Diff.CharStatus = '+' then
      begin
        RichEdit1.SelAttributes.Color:= clBlue;
        RichEdit1.SelText := Diff.Character;
      end
      else if Diff.CharStatus = '-' then
      begin
        RichEdit1.SelAttributes.Color:= clRed;
        RichEdit1.SelText:= Diff.Character;
      end
      else
      begin
        RichEdit1.SelAttributes.Color:= clDefault;
        RichEdit1.SelText:= Diff.Character;
      end;
  finally
    Differences.Free;
  end;
end;

It looks like in the image below:

For the full implementation read further down. Note that various optimizations could be added to the code below, but I didn’t implement them. Anyway, I hope this helps. Feedback is welcome! Feel free to find and correct bugs ;-)

Testing the World Away: Recovery mission

I was recently reviewing the DUnit website and I noticed there is a broken link to an article titled “Testing The World Away”. It was written by Will Watts for QBS Software. November, 2000.

I said “OK, maybe the article was relocated somewhere else in the QBS Software website”; so I tried a custom Google search "Testing the World Away" site:qbssoftware.com. As you can see the article was either banned from Google or removed completely from the QBS Software website.

Once again I said “OK, maybe there’s a copy of the article somewhere else on the Internet” and I tried a second custom Google search "Testing the World Away". At this point I convinced myself that the article was gone for good.

I am a curious guy, so I tried one final thing: I looked up the broken link[1] in the Internet Archive website and wallah!, they came with an archived version of the article.

I have shared below a copy of the article so that we can take a look. As I said, this article is not mine, and if the author(owner) at some point request me to deleted it from my blog, I will do so.

[1] http://www.qbss.com/html/news/news_body.asp?content=ARTICLE&link=368&zone= 

Testing the World Away (01 November 2000)

Testing the World Away

The software methodology of the hour is Kent Beck’s ‘Extreme Programming’. Mr Beck is a Smalltalk programmer by trade and, I think, a bit of a lad by inclination (evidence: the bibliography of his book Extreme Programming Explained, as well as citing standards such as The Mythical Man-Month and Design Patterns, also recommends Cynthia Heimel’s Sex Tips for Girls. Right on!). I find some of his ideas unconvincing. Pair Programming for example, where one programmer sits at the keyboard and works while the other does something else - possibly flower-arranging, my concentration lapsed at this point in the text as I tried to imagine any manager I’ve met who would permit this exciting way of increasing his costs - seems too beautiful and delicate for our mortal coil. On the other hand his approach to testing, and the free libraries based on his design that are around to back it up, comes much nearer to hitting, as I suppose Ms Heimel might put it, my programming G-spot.

Delphi Implementation for the OpenSubtitles API

OpenSubtitles.org allows searching and hosting subtitles in several formats (SRT, SUB, etc.) and pretty much every language. It currently has a vast database of subtitles (expanding every day). OpenSubtitles.org also exposes a XML-RPC based API that can be used in order to build third party applications with subtitle features.

I am writing a Delphi app to search subtitles in the OpenSubtitles.org database... I thought it would be nice to have a Delphi wrapper for the whole API. Below is my three cents contribution. I will probably implement and share more methods in the future, but feel free to contribute as well.  Take a look at the full API methods list. 

XML-RPC stands for XML Remote Procedure Call. It allows “remote procedure calling using HTTP as the transport and XML as the encoding”. [http://xmlrpc.scripting.com/spec]. XML-RPC is really easy to implement: in the code below I have used formatted strings to conform the XML requests (XML encoding pending) and the Indy TIdHTTP component to send the requests.


unit OpensubtitlesAPI;

interface

uses
  IdHTTP, Classes, SysUtils;

  function LogIn(aUsername, aPassword,
                 aLanguage, aUserAgent: string): string;
  function LogOut(aToken: string): string;
  function SearchSubtitles(aToken, aSublanguageID,
                           aMovieHash: string;
                           aMovieByteSize: Cardinal): string;  overload;
  function SearchSubtitles(aToken, aSublanguageID: string;
                           aImdbID: Cardinal): string; overload;
  function SearchSubtitles(aToken, aSublanguageID,
                           aQuery: string): string;  overload;

implementation

function XML_RPC(aRPCRequest: string): string;
const
  cURL= 'http://api.opensubtitles.org/xml-rpc';
var
  lHTTP: TIdHTTP;
  Source,
  ResponseContent: TStringStream;
begin
  lHTTP := TIdHTTP.Create(nil);
  lHTTP.Request.ContentType := 'text/xml';
  lHTTP.Request.Accept := '*/*';
  lHTTP.Request.Connection := 'Keep-Alive';
  lHTTP.Request.Method := 'POST';
  lHTTP.Request.UserAgent := 'OS Test User Agent';
  Source := TStringStream.Create(aRPCRequest);
  ResponseContent:= TStringStream.Create;
  try
    try
      lHTTP.Post(cURL, Source, ResponseContent);
      Result:= ResponseContent.DataString;
    except
      Result:= '';
    end;
  finally
    lHTTP.Free;
    Source.Free;
    ResponseContent.Free;
  end;
end;

function LogIn(aUsername, aPassword, aLanguage, aUserAgent: string): string;
const
  LOG_IN = '<?xml version="1.0"?>' +
           '<methodCall>' +
           '  <methodName>LogIn</methodName>' +
           '  <params>'   +
           '    <param>'  +
           '      <value><string>%0:s</string></value>' +
           '    </param>' +
           '    <param>'  +
           '      <value><string>%1:s</string></value>' +
           '    </param>' +
           '    <param>'  +
           '      <value><string>%2:s</string></value>' +
           '    </param>' +
           '    <param>'  +
           '      <value><string>%3:s</string></value>' +
           '    </param>' +
           '  </params>'  +
           '</methodCall>';
begin
  //TODO: XML Encoding
  Result:= XML_RPC(Format(LOG_IN, [aUsername, aPassword, aLanguage, aUserAgent]));
end;

function LogOut(aToken: string): string;
const
  LOG_OUT = '<?xml version="1.0"?>' +
           '<methodCall>' +
           '  <methodName>LogOut</methodName>' +
           '  <params>'   +
           '    <param>'  +
           '      <value><string>%0:s</string></value>' +
           '    </param>' +
           '  </params>'  +
           '</methodCall>';
begin
  //TODO: XML Encoding
  Result:= XML_RPC(Format(LOG_OUT, [aToken]));
end;

function SearchSubtitles(aToken, aSublanguageID, aMovieHash: string; aMovieByteSize: Cardinal): string;
const
  SEARCH_SUBTITLES = '<?xml version="1.0"?>' +
                     '<methodCall>' +
                     '  <methodName>SearchSubtitles</methodName>' +
                     '  <params>' +
                     '    <param>' +
                     '      <value><string>%0:s</string></value>' +
                     '    </param>' +
                     '  <param>' +
                     '   <value>' +
                     '    <array>' +
                     '     <data>' +
                     '      <value>' +
                     '       <struct>' +
                     '        <member>' +
                     '         <name>sublanguageid</name>' +
                     '         <value><string>%1:s</string>' +
                     '         </value>' +
                     '        </member>' +
                     '        <member>' +
                     '         <name>moviehash</name>' +
                     '         <value><string>%2:s</string></value>' +
                     '        </member>' +
                     '        <member>' +
                     '         <name>moviebytesize</name>' +
                     '         <value><double>%3:d</double></value>' +
                     '        </member>' +
                     '       </struct>' +
                     '      </value>' +
                     '     </data>' +
                     '    </array>' +
                     '   </value>' +
                     '  </param>' +
                     ' </params>' +
                     '</methodCall>';

begin
  //TODO: XML Encoding
  Result:= XML_RPC(Format(SEARCH_SUBTITLES, [aToken, aSublanguageID, aMovieHash, aMovieByteSize]));
end;

function SearchSubtitles(aToken, aSublanguageID: string;
  aImdbID: Cardinal): string;
const
  SEARCH_SUBTITLES = '<?xml version="1.0"?>' +
                     '<methodCall>' +
                     '  <methodName>SearchSubtitles</methodName>' +
                     '  <params>' +
                     '    <param>' +
                     '      <value><string>%0:s</string></value>' +
                     '    </param>' +
                     '  <param>' +
                     '   <value>' +
                     '    <array>' +
                     '     <data>' +
                     '      <value>' +
                     '       <struct>' +
                     '        <member>' +
                     '         <name>sublanguageid</name>' +
                     '         <value><string>%1:s</string>' +
                     '         </value>' +
                     '        </member>' +
                     '        <member>' +
                     '         <name>imdbid</name>' +
                     '         <value><string>%2:d</string></value>' +
                     '        </member>' +
                     '       </struct>' +
                     '      </value>' +
                     '     </data>' +
                     '    </array>' +
                     '   </value>' +
                     '  </param>' +
                     ' </params>' +
                     '</methodCall>';

begin
  //TODO: XML Encoding
  Result:= XML_RPC(Format(SEARCH_SUBTITLES, [aToken, aSublanguageID, aImdbID]));
end;

function SearchSubtitles(aToken, aSublanguageID,
  aQuery: string): string;
const
  SEARCH_SUBTITLES = '<?xml version="1.0"?>' +
                     '<methodCall>' +
                     '  <methodName>SearchSubtitles</methodName>' +
                     '  <params>' +
                     '    <param>' +
                     '      <value><string>%0:s</string></value>' +
                     '    </param>' +
                     '  <param>' +
                     '   <value>' +
                     '    <array>' +
                     '     <data>' +
                     '      <value>' +
                     '       <struct>' +
                     '        <member>' +
                     '         <name>sublanguageid</name>' +
                     '         <value><string>%1:s</string>' +
                     '         </value>' +
                     '        </member>' +
                     '        <member>' +
                     '         <name>query</name>' +
                     '         <value><string>%2:s</string></value>' +
                     '        </member>' +
                     '       </struct>' +
                     '      </value>' +
                     '     </data>' +
                     '    </array>' +
                     '   </value>' +
                     '  </param>' +
                     ' </params>' +
                     '</methodCall>';

begin
  //TODO: XML Encoding
  Result:= XML_RPC(Format(SEARCH_SUBTITLES, [aToken, aSublanguageID, aQuery]));
end;

end.

Finally, I present you some sample calls:

Logging- in anonymously (empty credentials) and getting the token:

LogIn('', '', 'en', 'OS Test User Agent');

Logging- out (disposing the token):

LogOut('81nt6bgl9vde06l3ptq7v1a7r1');

Search English subtitles for the movie whose ImdbID is 120737

SearchSubtitles(Edit1.Text, 'eng', 120737);

Search English subtitles for The Lord of the Rings

SearchSubtitles(Edit1.Text, 'eng', 'The Lord of the Rings');


Search English subtitles for the movie whose hash is 7d9cd5def91c9432 and size is 735934464.

SearchSubtitles(Edit1.Text, 'eng', '7d9cd5def91c9432', 735934464);CodeProject

Pascal Server Pages – Pascal Script

Without getting too technical, I would define a Pascal Server Page (PSP) as a dynamic web page containing embedded Pascal Script (PS) code.  When a web request is made, the PS code needs to be executed (interpreted) in the server side and outputted into the proper format (HTML, XML, JSON, text, etc). A PSP is commonly stored as a text file in the Web Server and it could be a mixture of PS code plus any other static content.

This is an example of PSP:

<html>
  <head>
    <title>This is a Pascal Server Page</title>
  </head>
  <body>
    <% begin
         Write('Hello World');
       end.
    %>
    <p>I am going to use Pascal Script to write a few numbers...</p>
    <% var
         i: Integer;
       begin
         for i:=1 to 10 do
           Writeln(i); 
       end.
    %>
  </body>
</html>

The code above is an HTML armature containing some PS code. The PS code has been isolated within the “<%” and “%>” tokens. The PS code is executed in the server and the output (if any) is embedded into the HTML template.

So, if a browser asks for the page above, it will actually get plain HTML code as the one below:

<html>

  <head>

    <title>This is a Pascal Server Page</title>

  </head> 

  <body>   

    Hello World

    <p>I am going to use Pascal Script to write a few numbers...</p>

    1<br>2<br>3<br>4<br>5<br>6<br>7<br>8<br>9<br>10<br>

  </body>

</html>

This is all good. The only problem is that the PS code is not going to be magically executed. We need a server side component to do the PS interpretation.

I have seen a couple of intents to build such server side component in the Internet. Anyhow, I bring you my own proposal: create a Web Broker application with Pascal Scripting capabilities. To provide the Web Broker application with the scripting capabilities, I will use Pascal Script from RemObjects. You need to download and install Pascal Script if you want to try my code. 

The workflow goes as follows:

1. The Web Broker application receives a Web Request.
2. The Web Broker application finds the corresponding Pascal Server Page and loads its content to a buffer variable.
3. The content of the buffer variable is parsed in order to find the PS tokens (I will use RegEx to do the parsing).
4. Each PS block is compiled to Bytecode and then executed in the server. (I will use the Pascal Script library from RemObjects for this purpose). 
5. The output generated from the execution of each PS block replaces its corresponding “<%......%>” block.
6. The Web Broker app serves the response.

I developed a VCL standalone Web Broker application as a proof of concept (it could be an ISAPI dll as well). See it in action in the following video:

That application is just a prototype. I really believe that we could build a robust server side component to leverage enterprise Pascal Server Pages. I used Web Broker in this example, but we could also build Apache Modules with Free Pascal.

I am posting below the code of the TWebModule1 class, which is the core of the Web Broker app. The full source code and executable can be downloaded here. (the code was compiled with Delphi XE2). Note that the code is somewhat messy; this was taken directly from my sandbox. Ah, I copy-pasted (and adjusted) the Pascal Script routines from this example: Introduction to Pascal Script.

Salary Guide for Delphi developers: Let’s make it

If you work as an IT professional in North America, you should probably find very useful the 2012 Technology Salary Guide published by Robert Half Technology.

This guide exposes the compensation trends (salary trends) for pretty much every position in Information Technology. It covers the United States of America and Canada, and you could even obtain salary ranges for particular cities.

This guide is useful for both managers and non-managers individuals. In my particular case, I am always curious to know if I am getting paid decently.

The tables below are an excerpt taken from the guide:

 2012 Average Starting Salaries – United States

Job Title	2011	2012	% Change
Software Developer	$ 65,750 - $ 104,250	$ 70,000 - $ 111,000	6.5%

2012 Average Starting Salaries – Canada

Job Title	2011	2012	% Change
Software Developer	$ 56,250 - $ 94,000	$ 59,750 - $ 99,750	6.2%

There are further statistics in the guide about Java, .NET, C++, PHP and other programming languages. You can use that info in order to tune the indicators above even more. There are no details about Delphi in this guide.

I think that we (the Delphi community) could gather some statistics about the salary rates for Delphi Developers. I propose running poll surveys to gather such information. Once the polls are closed, we will publish the outcomes and we can draft our conclusions.

The polls are finally closed. Go to the end of this post and take a look at the outcomes. Thanks a lot to all the participants: 45 in the United States and 30 in Canada. It’s funny how the number of voters was a multiple of 5 in both countries :-)

Take a look at the right column of this page: I have published two polls to collect the information about the salary rates in the United States and Canada. I am only putting together the data for these two countries, because I already have some reference data to compare with. (I am referring to the data in the tables above). It would be really nice if someone else could take ownership of similar polls for other countries.

Important:

• I will kindly ask to vote, IF and ONLY IF, you are (were) working as a Delphi Developer in the United States or Canada during the current year 2011.
• We could make this better if you enroll your coworkers or any other Delphi developers in your area.
• The poll is by nature anonymous: we are just gathering collective information.

Please, in order for this to work we need your vote!

What’s the salary for a Delphi Developer in the United States?

< $ 50,000                               5  (11%)
$ 50,000 - $ 60,000                 2  (4%)
> $ 60,000 - $ 65,000              1  (2%)
> $ 65,000 - $ 75,000              7  (15%)
> $ 75,000 - $ 85,000            12  (26%)
> $ 85,000 - $ 95,000              4  (8%)
> $ 95,000 - $ 105,000            5  (11%)
> $ 105,000 - $ 115,000          4  (8%)
> $ 115,000                             5  (11%)
                                                   
What’s the salary for a Delphi Developer in Canada?
                                                 
< $ 50,000                               6  (20%)
$ 50,000 - $ 60,000                 5  (16%)
> $ 60,000 - $ 65,000              2  (6%)
> $ 65,000 - $ 75,000              3  (10%)
> $ 75,000 - $ 85,000              2  (6%)
> $ 85,000 - $ 95,000              1  (3%)
> $ 95,000 - $ 105,000            5  (16%)
> $ 105,000 - $ 115,000          1  (3%)
> $ 115,000                             5  (16%)

Internationalizing your Delphi application: An ABC example

If you want to make your Delphi application general enough to address multiple locales, then you need to internationalize it. There are three common aspects that I want to emphasize (no necessarily in that order):

• Resourcing
• Unit conversions
• Dynamic messages

We’ll cover the three of them with a very simple example. Consider the following code snipped intended for the en-US locale (English-United States of America):

procedure TForm1.DefineFever;
begin
  ShowMessage('If the body temperature rises above 99°F the person is considered to have a fever.');
end;

Resourcing is the process of removing hard-coded strings from the code by making them resourcestrings instead.

The code above is not localizable because the ShowMessage procedure is taking a hard-coded string. What do you do? Take a look:

procedure TForm1.DefineFever;
resourcestring
  strFeverDefinition = 'If the body temperature rises above 99°F the person is considered to have a fever.';
begin
  ShowMessage(strFeverDefinition);
end;

We defined strFeverDefinition as a resourcestring and used it as a parameter for the ShowMessage procedure. The functionality remains the same, but the function is now localizable.

Unit conversions: In some countries (like the United States and Belize) the temperature is given in the Fahrenheit scale, but in the rest is given in the Celsius scale. In order to internationalize this we can do the following:

function GetFeverTemperature: string;
var
  LangID: LangID;
begin
  //By default
  Result:= '37.2°C';

  {read current system locale}
  LangID := GetSystemDefaultLangID;

  //Assuming that only the United States and Belize use the Fahrenheit scale
  if (LangID = {English - United States} 1033) or        
     (LangID = {English - Belize} 10249) then
  Result:= '99°F';
end;

procedure TForm1.DefineFever;
begin
  ShowMessage('If the body temperature rises above ' + GetFeverTemperature + ' the person is considered to have a fever');
end;

Wait a minute, we managed the unit conversion by introducing a dynamic message, but we reintroduced the hard-coded strings. That’s not good!

Dynamic messages: We consider the ShowMessage above to be a dynamic message, because the parameter depends on the GetFeverTemperature function, which of course can vary. 

To solve the pitfall above we can refactor the DefineFever function as follows:  

procedure TForm1.DefineFever;
resourcestring
  strFeverDefinition = 'If the body temperature rises above %0:s the person is considered to have a fever.';
begin
  ShowMessage(Format(strFeverDefinition, [GetFeverTemperature]));
end;

We are just using a format string (resourcestring) that we can format by using the Format routine. This allows resourcing and handling the dynamic message all at once.

The thing about dynamic messages goes beyond. In Spanish, for instance, the dynamic message would have been coded as follows:

ShowMessage('Se considera que la persona tiene fiebre si la temperatura corporal es superior a ' + GetFeverTemperature);

Note that the GetFeverTemperature is at the end of the ShowMesssage parameter, as opposed to the English implementation that has it in the middle. There’s no way you can localize something like this if you don’t internationalize it first.

So the ABC for Delphi localization is Resourcing, Unit Conversions and Dynamic Messages. 

CodeProject