Yanniel's notes

IDERA’s intention for Embarcadero’s development tools

2015-10-22T16:13:00.001-04:00

I just received the email below from IDERA\Embarcadero. Overall it means they plan on moving forward with Delphi and the other development tools in their portfolio.

I wanted to share the news in case you haven’t heard.
_______________________________________________________________________________________________

Customer and Partner Welcome from IDERA

Dear Sir/Madam,

I am Randy Jacops, the CEO of IDERA, Inc. You likely saw the press announcement of IDERA’s recent acquisition of Embarcadero Technologies. Here is a link to the announcement if you have not seen it.

We welcome you to the IDERA family and look forward to continuing Embarcadero’s history of market leading products for data professionals and developers. I’m writing this letter to introduce IDERA and explain why we are excited to own Embarcadero.

IDERA serves over 10,000 customers around the world with performance monitoring solutions for databases, applications and technology infrastructure. We believe database professionals have an outsize impact on overall technology performance and describe our focus as database-centric. Our products enable rapid identification and remediation of performance problems across the technology stack as well as providing unique security and compliance capability.

I became CEO in 2013 and during my tenure have focused the company on long-term customer relationships built on innovation, quality, and ease of use. I strongly believe a successful software company starts with a focus on driving customer success via:

    High quality software – complete testing with significant automated code coverage
    Ease of use – simplified user experience, particularly the install/upgrade process
    Application speed – minimal wait time, robust scalability, and real-time analytics

A software company that delivers these metrics will have generally happy customers. Delivering prioritized innovation and features on a reliable schedule advances the relationship from generally happy to customer success. IDERA prioritizes investment to reflect these goals and we will apply the same philosophy to Embarcadero’s products.

As you know, Embarcadero has two unique product families: 1) heterogeneous database modeling, administration, and performance and 2) application development solutions for multiple platforms. Over the years, Embarcadero also built a roster of over 10,000 customers and millions of users, serving nearly the entire Global 2000. Embarcadero operates globally with offices and partners in nearly every major country.

Embarcadero’s database modeling, administration, and performance tools complement IDERA’s products with minimal overlap in functionality and business purpose. By combining the two businesses, we will offer data professionals a comprehensive solution to manage, deploy, and protect data across the company. We will seek customer feedback on integration between the solutions to ensure we adhere to our core product values of simplicity of use, quality, and scalability.

For Embarcadero’s development tools, we acknowledge this is a new opportunity for IDERA. I have seen some chatter on our community forums and received direct questions from customers on IDERA’s intentions for the product line. I wish to emphasize the tremendous value we perceive in development tools. As applications proliferate across multiple channels and platforms, the need for tools to build the next generation of applications will soar. Concepts such as the Internet of Things or proximity awareness in applications did not exist several years ago. Today, everybody recognizes the opportunity in building applications for equipment that simplifies and advances society. We believe the winners in the application development market will focus on the developer and differentiate with speed to market, ease of use, and pace of change. All of these things perfectly align with IDERA’s view of product and customer success.

To that end, we formed a new leadership team that will focus exclusively on Embarcadero’s development tools and growing the business via innovations and opportunistic M&A. Atanas Popov, a longtime colleague of mine, has joined Embarcadero to lead the team. Atanas will focus his attention on growing the business and investing to attract more customers to our solutions. We believe there is significant opportunity in Embarcadero’s development tools and we look forward to working with you to prioritize our investments.

Finally, Embarcadero invested for years to build a robust and reliable reseller/partner network. Many companies aspire to building such a network but the time and effort required eventually discourages most. However, if a company perseveres and delivers a healthy reseller and partner business, the impact and potential is significant. Embarcadero has dozens of active and significant global partners. Maintaining a healthy reseller/partner network requires more and better product and a steady stream of potential customers interested in buying. We expect to introduce IDERA’s broader product family to Embarcadero’s partners and also plan to leverage IDERA’s talented marketing team to refine messaging and advance dialogue with prospects. We believe some modest changes and investment will expand the universe of opportunities for our partners who serve a global customer base.

From an ongoing communication standpoint, we believe in publishing our product roadmaps to active customers and maintaining dialogue with customers interested in contributing. We believe user communities deliver significant customer value and will continue investing appropriately. We also believe that change facilitates innovation and increases value for our customers. We will remain committed to these principles and look forward to working with you to improve every day and help you capture expected value.

If you have questions, please feel free to contact me directly (randy.jacops@idera.com). With over 20,000 customers, it’s not practical to maintain a direct dialogue with every customer, but we will respond to questions. Most importantly, we will communicate future product roadmap reviews, webinars, and related content you will find interesting. I encourage you to participate in all these sessions to ensure a mutually valuable relationship.

Thank you for your business and I look forward to the future.

Regards,

Randy Jacops
CEO, IDERA, Inc.

The source code history of Free Pascal and Lazarus visualized with Gource

2014-09-11T22:19:00.000-04:00

Gource is a software version control visualization tool. I thought it would be fun to visualize Delphi’s source code with Gource, but that is not possible for obvious reasons. So, I decided to try-out Delphi’s cousins: Free Pascal and Lazarus.

I checked-out the respective code bases and ran them through Gource.

Below are the Gource commands I used:


gource -1280x720 -o C:\\gource\\fpc.ppm -s 0.01 --hide dirnames,filenames,progress,mouse C:\\gource\\fpc



gource -1280x720 -o  C:\\gource\\lazarus.ppm -s 0.01 --hide dirnames,filenames,progress,mouse C:\\gource\\lazarus

Gource shows the filenames and directories of the source code by default; still, I decided to hide them in these videos, because they were overlapping. You can play more with Gource, FPC and Lazarus on your own :-) For a comprehensive list of the command line options and arguments of Gource click HERE.

The above gource calls create two files: fpc.ppm and lazarus.ppm. I guess these are some kind of uncompressed video format. The files were huge: ~60GB and ~100GB respectively.

Then, I used FFmpeg to encode the above .ppm files into .avi files. The FFmpeg commands are below:


ffmpeg -y -r 60 -f image2pipe -vcodec ppm -i C:\\gource\\fpc.ppm -vcodec libx264 -preset ultrafast -pix_fmt yuv420p -crf 1 -threads 0 -bf 0 C:\\gource\\fpc.x264.avi



ffmpeg -y -r 60 -f image2pipe -vcodec ppm -i C:\\gource\\lazarus.ppm -vcodec libx264 -preset ultrafast -pix_fmt yuv420p -crf 1 -threads 0 -bf 0 C:\\gource\\lazarus.x264.avi

Finally, I uploaded fpc.x264.avi and lazarus.x264.avi to YouTube. You can see them below:

Free Pascal source code history visualized with Gource

Lazarus source code history visualized with Gource

If you liked this post; please, show your appreciation but clicking the Google Plus (G+) button at the beginning of the article. Thanks!

HMAC functions in Delphi (HMAC_SHA256, HMAC_SHA1)

2014-04-04T22:27:00.000-04:00

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

Enabling TLang to handle more than 17 translations: a workaround for a regression bug in Delphi XE3

2013-01-13T20:21:00.003-05:00

I recently had to localize a FireMonkey application and for that I aimed to use the TLang component. With TLang you can define a collection of native strings to be localized and the corresponding translations to a particular language. To my surprise the component was allowing to store a maximum of 17 translations for the whole application. So, what about the other strings that need localization?

It seems there’s a regression issue from Delphi XE2 to Delphi XE3 that is preventing TLang to store more than 17 translations. You can even find an entry for this in Embarcadero Quality Central, for which no workaround or fix has been provided up to this date.

I found a programmatic workaround for this issue. Basically, the native strings and the translations could be loaded from text files in which each line will have the form:

NativeString1=Translation1
NativeString2=Translation2
NativeString3=Translation3
…………
NativeStringN=TranslationN

You will need one file containing the native strings and the translations per language. These files can contain as many lines as you which (certainly more than 17). In order to load those files into an existing TLang component you can use the function below:

procedure LoadTranslationsFromFile(aLangCode: string; aFileName: string; aLang: TLang);
var
  Translations: TStrings;
begin
  if (aLangCode <> '') and
     (FileExists(aFileName)) and
     (Assigned(aLang)) then
  begin
    Translations:= TStringList.Create;
    Translations.LoadFromFile(aFileName);
    aLang.Resources.AddObject(aLangCode, Translations);
  end;
end;

For an example of how to use such function see below:

procedure TForm1.Button1Click(Sender: TObject);
begin
  LoadTranslationsFromFile('ES', 'C:\Temp\Lang_Test_ES.txt', Lang1);
  LoadTranslationsFromFile('EN', 'C:\Temp\Lang_Test_EN.txt', Lang1);
end;

Hopefully this bug will be fixed in the near future; but meanwhile you can use this workaround to handle more than 17 translations with the TLang component.

Refactoring to patterns. Yet another TDD example coded in Delphi

2012-12-17T10:47:00.002-05:00

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:

Test Driven Development in Delphi: The Basics

2012-03-08T11:12:00.020-05:00

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:

At the beginning you just write one test, and later on, more tests can be added.
Make sure the initial test fails; this will validate the test harness.
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.
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.
Improve and optimize your code: make it elegant, more efficient, avoid duplications, etc, etc. This is called code refactoring.
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.
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:

Deep copying (cloning) objects in Delphi

2012-02-03T14:26:00.014-05:00

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!

String comparison in Delphi

2012-01-26T15:01:00.016-05:00

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



unit StringComparison;



interface



uses

  Math, Generics.Collections;



type

  TDiff = record

    Character: Char;

    CharStatus: Char;  //Possible values: [+, -, =]

  end;



  TStringComparer = class

  strict private

    type TIntArray = array of array of Integer;

    class function LCSMatrix(X, Y: string): TIntArray;

    class procedure ComputeDifferences(aLCSMatrix: TIntArray;

                                       X, Y: string;

                                       i, j: Integer;

                                       aDifferences: TList<TDiff>);

  public

    class function Compare(aString1, aString2: string): TList<TDiff>;

  end;



implementation



{ TStringComparer }



class function TStringComparer.LCSMatrix(X, Y: string): TIntArray;

var

  m, n,

  i, j: Integer;

begin

  m:= Length(X);

  n:= Length(Y);



  //We need one extra column and one extra row to be filled with zeroes

  SetLength(Result, m + 1, n + 1);



  //First column filled with zeros

  for i := 0 to m do

    Result[i, 0] := 0;



  //First row filled with zeros

  for j:= 0 to n do

    Result[0, j]:= 0;



  //Storing the lengths of the longest common subsequences

  //between prefixes of X and Y

  for i:= 1 to m do

    for j:= 1 to n do

      if X[i] = Y[j] then

        Result[i, j] := Result[i-1, j-1] + 1

      else

        Result[i, j]:= Max(Result[i, j-1], Result[i-1, j]);

end;



class procedure TStringComparer.ComputeDifferences(aLCSMatrix: TIntArray;

                                                   X, Y: string;

                                                   i, j: Integer;

                                                   aDifferences: TList<TDiff>);

var

  CharDiff: TDiff;

begin

  if (i > 0) and (j > 0) and (X[i] = Y[j]) then

  begin

    ComputeDifferences(aLCSMatrix, X, Y, i-1, j-1, aDifferences);

    CharDiff.Character:= X[i];

    CharDiff.CharStatus:= '=';   //The character did not change

    aDifferences.Add(CharDiff);

  end

  else

    if (j > 0) and ((i = 0) or (aLCSMatrix[i,j-1] >= aLCSMatrix[i-1,j])) then

    begin

      ComputeDifferences(aLCSMatrix, X, Y, i, j-1, aDifferences);

      CharDiff.Character:= Y[j];

      CharDiff.CharStatus:= '+'; //The character was added

      aDifferences.Add(CharDiff);

    end

    else if (i > 0) and ((j = 0) or (aLCSMatrix[i,j-1] < aLCSMatrix[i-1,j])) then

    begin

      ComputeDifferences(aLCSMatrix, X, Y, i-1, j, aDifferences);

      CharDiff.Character:= X[i];

      CharDiff.CharStatus:= '-'; //The character was removed

      aDifferences.Add(CharDiff);

    end;

end;



//This is a factory method

class function TStringComparer.Compare(aString1, aString2: string): TList<TDiff>;

var

  Matrix: TIntArray;

begin

  Result:= TList<TDiff>.Create;

  Matrix:= LCSMatrix(aString1, aString2);

  ComputeDifferences(Matrix,

                     aString1, aString2,

                     Length(aString1), Length(aString2),

                     Result);

end;



end.

Testing the World Away: Recovery mission

2012-01-17T13:33:00.008-05:00

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.

Mr Beck’s idea is that as you write each bit of code, you should also write a little test to go with it. As the project develops, the library of tests builds up in parallel. After each alteration or addition, you rerun the test suite to discover if you have broken anything. One of the rules - and I think it is an important one - is that the test suite must be able to run all the way through, pass or fail, without operator intervention. So although it is a chore to write the tests, the effort put in is ‘banked’, and it costs very little to rerun them - with the consequence that they do get rerun.

Mr Beck has had brushes with those GUI automated tools that record keystrokes and mouse-clicks into some sort of script and then let you play your actions back at the application to be tested and verify its responses. These look like they are going to do the job from the description on the packet but in practice, as Mr Beck correctly observes, they are not very robust. Remove one edit box, or merely nudge it three pixels to the right, or change the screen resolution - suddenly the whole thing falls flat on its face. Testing code, he decided, should be written at the same level and in the same language as the stuff to be tested.

Tests also need structure. One needs to see results presented in a consistent way, to be able to select specific tests to run and so on. To this end, Mr Beck wrote a library of Smalltalk classes - a framework - called ‘SmalltalkUnit’ or ‘SUnit’. Later on he collaborated with no less than Erich Gamma to produce a Java version called ‘JUnit’. The idea ‘took on’, and now there are versions for an impressive range of languages including C++, Eiffel, Objective-C, Perl, Python, Visual Basic and even Visual Objects. You'll find them all listed at http://www.xprogramming.com/software.htm. If you are familiar with my language prejudices, you will be unsurprised to learn that I am going to discuss a Delphi language version called DUnit. Originally ported from the Java version by Juancarlo Añez, this library is now maintained on an Open Source basis by the DUnit group at SourceForge:

https://sourceforge.net/projects/dunit/. This library makes heavy use of function overloading, so you’ll need Delphi 4 or later to play with it.

Who DUnit?
Figure 1 shows a suite of DUnit tests that have been run using the library’s GUI interface. The top pane lists all the tests available. These are organised in a hierarchy: a suites of tests may contain either individual test cases or other suites - a Composite pattern. In the part of the hierarchy visible, I have set up a suite called ‘SFW COM Library tests’ that, in turn, contains suites subdivided by the class being tested. The TTestDoubleChannel suite operates on a class called TDoubleChannel, and below TTestDoubleChannel are tests on individual methods. There are checkboxes to switch individual tests and parts of the hierarchy on and off; these interact with some useful buttons at the bottom of the dialog to allow speedy selection of all or part of the suite.

Each test is colour-coded by the result of the last run. Green, obviously, indicates success; magenta a ‘failure’, that is that an unexpected result was obtained; red, an ‘error’, that the test threw an exception. The lower pane lists all the failures and errors together with descriptive messages. In between the two panes are progress bars indicating progress through the test suite and success rate.

Figure 2 shows DUnit’s text mode version after running the same test suite as Figure 1, and I hope that you can see it has produced the same results. Although lacking the eye candy and versatility of the GUI test runner, this console version requires no interaction and sets its exit code non-zero on failure. This makes it ideal for placing in a make file, or incorporating into an automated testing procedure. By the way, to make my test suite code run as a console application, I substituted one .DPR file for another - about 10 seconds’ work.

How it works

The key class in DUnit’s framework is TTestCase. All the actual testing code is placed in classes that you derive from it. It’s easiest to see how this works with a snippet of code. Figure 3 shows a trivial example of a program that tests 1 + 1 = 2.

First look at the Project1TestCases.pas unit. TTestCaseFirst is derived from TTestCase, adding one published method testFirst. Three features of this method are important: that it is a parameterless procedure, that it has public scope, and that its name begins ‘test…’. These features enable DUnit to discover and run the method without the need to call it explicitly in hand-generated code. It is sufficient to declare a method of a TTestCase-derived class that follows these rules to get it run.

The implementation of testFirst is a single line: I ‘assert’ that 1 + 1 = 2. (Old Delphi hands and practitioners of design-by-contract may be raising their eyebrows at this strange use of Assert. Please bear with me, explanations and excuses will follow in due course.)

At the bottom of Project1TestCases.pas, in an initialization section, is the call registerTest('', TTestCaseFirst); which registers TTestCaseFirst with the framework. The first parameter is the ‘path’, it controls where a test case appears in the hierarchy. By supplying an empty string I am placing it below the root node.

The project file Project1Test.dpr references DUnit library units TestFrameWork and GUITestRunner as well as Project1TestCases.pas. A single line replaces the standard Delphi GUI project code: GUITestRunner.runTest(TestFramework.registeredTests);

This creates and displays the GUI interface shown in Figure 1. And that’s it. To add further arithmetic tests, just write extra test… methods, for example

procedure TTestCaseFirst.testSecond;
begin
Assert(2 + 2 = 5, 'Oops!');
end;

This mistake will be flagged as a magenta-coloured failure when it is run.

In reality one uses DUnit on classes rather than trivial arithmetic. Instances of classes can be placed as member data in the TTestCase-derived class, and two virtual methods, SetUp and TearDown, can be overridden to create and destroy them around each test method. Figure 4 sketches how this is done. Note that SetUp is called before, and TearDown after, each test method. This isolation of the test methods from each other is deliberate - you shouldn’t build a sequence of tests where one method is dependant on those called before.
I mentioned DUnit’s ability to build up suites from multiple test cases. This is accomplished using the TTestSuite class:
Suite := TTestSuite.create('A suite');
Suite.addTests(TTestCaseFirst);
Suite.addTests(TTestCaseMyClass);
The populated suite can then be passed to registerTest as before.

All About Assert

It’s time to own up to a problem with DUnit. The library’s use of the Assert function to check the test conditions is rather perverse. Assert already has a well-understood role in Delphi code, and this isn’t it. How did it get there? Well, you will recall that DUnit is a port of a Java library called JUnit and the Java language, I am informed, doesn’t have an Assert in the C++/Delphi sense. Unfortunately the ‘Assert’ name was carried across with the rest of JUnit. An easy mistake to make: it has also happened to the people doing a C++ version of JUnit.

However, there is a move afoot among the DUnit developers to change the function's name, probably to Check, and also to add a family of useful overloaded methods with names like CheckEqual, CheckNotEqual and so on. With luck this will have gone through by the time you read this.

DUnit is very much work-in-progress, and there are a number of interesting additions and enhancements coming into view. Two add-ons have just been released - one standalone, one integrated with the IDE enhancer CodeRush - which will generate skeleton test case code from the declaration of a class that is to be tested. As well as extra facilities for test repetition and set-up that I have not covered here, there are also plans to add special support for databases, multi-threading and GUI testing.

No technique can stop testing from being a fag. But I have found that the accumulation of a permanent test suite, and the improved confidence in my code developed in this way make DUnit’s use worthwhile. Go on: pull it down and have a go!

Will Watts is a programmer and occasional journo who lives in Chiswick. To his pleasure, his Snobol column in Developers Review has not, as far as he knows, been nominated for the Worst IT Journalism 2000 Award.

Books:
Extreme Programming Explained by Kent Beck, pub Addison-Wesley, ISBN 0-201-61641-6. Mr Beck’s philosophy of software development.
Refactoring - Improving the Design of Existing Code by Martin Fowler et al, pub Addison-Wesley, ISBN 0-201-48567-2. Includes good description of JUnit.

Delphi Implementation for the OpenSubtitles API

2012-01-09T18:04:00.011-05:00

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

Request the Google PageRank the Delphi way

2011-12-14T13:18:00.019-05:00

In this post I am implementing the Delphi way to request the Google Toolbar’s PageRank (PR). As an example, if I want to look up the PR of my blog (http://www.yanniel.info/), I will have to query the following URL:

http://toolbarqueries.google.com/tbr?client=navclient-auto&features=Rank&ch=64012521073&q=info:http://www.yanniel.info/

So, if you try



Writeln(Curl('http://toolbarqueries.google.com/tbr?client=navclient-auto&features=Rank&ch=64012521073&q=info:http://www.yanniel.info/'));

You will get the following output:

Rank_1:1:0

Oops, at this moment my PageRank is pathetic (PR = 0). Hopefully it will get better someday ;-)

You can find the implementation of the Curl function in my previous post: Fetching a web page with Delphi.

Now that you get the idea, it’s time to generalize our implementation in order to get the PR of any web page.

In the URL above there are two dynamic parameters that we need to understand:

Parameter q: This is the concatenation of “info:” plus the encoded URL for which we want to get the PR. It is mandatory to lead the encoded URL with “http://”. Don’t forget to put a “/” after the top domain, ei, “.info/”, not “.info”.

Parameter ch: Obtaining this parameter is the tricky part. We have to hash the concatenation of “info:” plus our target URL (ei. http://www.yanniel.info/) using the minimal perfect hashing algorithm invented by Bob Jenkins. The outcome will be a number, which corresponds to the value of our ch parameter. We are hashing something like “info:http://www.yanniel.info/”.

I didn’t have the time (or the desire) to understand and implement the minimal perfect hashing algorithm from scratch. So, I ported this C# implementation into Delphi code.

There’s one detail worth mentioning about the implementation. In the original C# code there’s a switch statement that falls all the way through the different cases. I needed to combine a case statement and some goto statements in order to accomplish the same in Delphi. Really, I tried to avoid the goto, I always do, but I couldn’t find a better and cleaner way of implementation. I was telling myself how bad programmer I was, and then, I read one entry in Delphi Feeds talking about the minimal perfect hashing algorithm, and more than that, highlighting the goto issue. Nick Hodges wrote the post: thank you Nick... now I can sleep again.

It seems that I am not the only one considering this goto usage as an exception to the good practice of “don’t use goto statements”. The funny thing is that I read Nick’s post without the intention of finding anything about the minimal perfect hashing algorithm or about the goto stuff. It’s really a big coincidence that we were considering to write about the minimal perfect hashing algorithm (and the goto gotcha) at the same time.

I wrote the strikeout text above initially; but Brian (first comment below) found a clean way to avoid the goto in this situation. I really thank Brian for his contribution, and next time, I won't quit that easily in removing the goto ;-)

I am putting everything together in the Delphi console application below. I bet you can reuse the BobJenkinsHash function in the Generics.Default.pas unit to make the PR implementation more compact. I didn’t know about the BobJenkinsHash function shipped with Delphi before reading Nick’s post; which is why I am keeping my original implementation.

Finally, this is how you request the Google PageRank in Delphi:

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
System.SysUtils, IdHTTP, IdURI, Classes;

type
TByteArray = array of Byte;

function Curl(aURL: string): string;
const
cUSER_AGENT = 'Mozilla/4.0 (MSIE 6.0; Windows NT 5.1)';
var
IdHTTP: TIdHTTP;
Stream: TStringStream;
begin
Result := '';
IdHTTP := TIdHTTP.Create(nil);
Stream := TStringStream.Create;
try
    IdHTTP.Request.UserAgent := cUSER_AGENT;
    try
      IdHTTP.Get(aURL, Stream);
      Result := Stream.DataString;
    except
      Result := '';
    end;
finally
    Stream.Free;
    IdHTTP.Free;
end;
end;

procedure Hashing(var a, b, c: Integer);
begin
a:= a - b;
a:= a - c;
a:= a xor (c shr 13);
b:= b - c;
b:= b - a;
b:= b xor (a shl 8);
c:= c - a;
c:= c - b;
c:= c xor (b shr 13);
a:= a - b;
a:= a - c;
a:= a xor (c shr 12);
b:= b - c;
b:= b - a;
b:= b xor (a shl 16);
c:= c - a;
c:= c - b;
c:= c xor (b shr 5);
a:= a - b;
a:= a - c;
a:= a xor (c shr 3);
b:= b - c;
b:= b - a;
b:= b xor (a shl 10);
c:= c - a;
c:= c - b;
c:= c xor (b shr 15);
end;

function StrOrd(aValue: string): TByteArray;
var
I: Integer;
begin
SetLength(Result, Length(aValue));
for I:= 1 to Length(aValue) do
Result[I-1]:= Ord(aValue[I]);
end;

function PerfectHash(aURL: string): string;
var
url: TByteArray;
_length,
k, len: Integer;
a, b, c: Integer;

label
One,
Two,
Three,
Four,
Five,
Six,
Seven,
Eight,
Nine,
Ten;

begin
url:= StrOrd(aURL);
_length:= Length(url);
k:= 0;
len:= _length;
a:= $9E3779B9;
b:= $9E3779B9;
c:= $E6359A60;

while (len >= 12) do
begin
a:= a + (url[k + 0] + (url[k + 1] shl 8) +
(url[k + 2] shl 16) + (url[k + 3] shl 24) );

b:= b + (url[k + 4] + (url[k + 5] shl 8) +
(url[k + 6] shl 16) + (url[k + 7] shl 24) );

c:= c+ (url[k + 8] + (url[k + 9] shl 8) +
(url[k + 10] shl 16) + (url[k + 11] shl 24));

    Hashing(a, b, c);
    k:= k + 12;
    len:= len - 12;
end;

c:= c + integer(_length);
case len of
      11: begin
            c:= c + (url[k + 10] shl 24);
            goto Ten;
          end;
      10: begin
            Ten:
            c:= c + (url[k + 9] shl 16);
            goto Nine;
          end;
      9: begin
            Nine:
            c:= c + (url[k + 8] shl 8);
            goto Eight;
          end;
      8: begin
            Eight:
            b:= b + (url[k + 7] shl 24);
            goto Seven;
          end;
      7: begin
            Seven:
            b:= b + (url[k + 6] shl 16);
            goto Six;
          end;
      6: begin
            Six:
            b:= b + (url[k + 5] shl 8);
            goto Five;
          end;
      5: begin
            Five:
            b:= b + (url[k + 4]);
            goto Four;
          end;
      4: begin
            Four:
            a:= a + (url[k + 3] shl 24);
            goto Three;
          end;
      3: begin
            Three:
            a:= a + (url[k + 2] shl 16);
            goto Two;
          end;
      2: begin
            Two:
            a:= a + (url[k + 1] shl 8);
            goto One;
          end;
      1: begin
            One:
            a:= a + (url[k + 0]);
          end;
end;

Hashing(a, b, c);
Result:= Format('6%0:u', [c]);
end;

function GetPageRank(aURL: string): string;
const
cToolbarQueriesURL = 'http://toolbarqueries.google.com/tbr?client=navclient-auto&features=Rank&ch=%0:s&q=%1:s';
var
CH, Q: string;
begin
aURL:= StringReplace(aURL, 'http://', '', []);
if Pos('/', aURL) = 0 then
aURL:= aURL + '/';
aURL:= 'http://' + aURL;

CH:= PerfectHash('info:' + aURL);
Q:= 'info:' + TIdURI.URLEncode(aURL);

Result:= Curl(Format(cToolbarQueriesURL, [CH, Q]));
end;

begin
Writeln(GetPageRank('http://www.yanniel.info/'));
Writeln(GetPageRank('http://www.delphifeeds.com/'));
Writeln(GetPageRank('http://www.google.com/'));
Readln;
end.

Pascal Server Pages – Pascal Script

2011-12-09T11:08:00.013-05:00

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.
 %>
 I am going to use Pascal Script to write a few numbers...
 <% 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

I am going to use Pascal Script to write a few numbers...

1 2 3 4 5 6 7 8 9 10 

</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:

The Web Broker application receives a Web Request.
The Web Broker application finds the corresponding Pascal Server Page and loads its content to a buffer variable.
The content of the buffer variable is parsed in order to find the PS tokens (I will use RegEx to do the parsing).
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).
The output generated from the execution of each PS block replaces its corresponding “<%......%>” block.
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.

unit WebModuleUnit1;

interface

uses System.SysUtils, System.Classes, Web.HTTPApp,
RegularExpressions;

type
TWebModule1 = class(TWebModule)
    procedure WebModule1DefaultHandlerAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
    { Private declarations }
public
    { Public declarations }
    function LoadStrFromFile(aFilename: string): string;
    function ProducePage(aContent: string): string;
    function ExecPascalScript(const Match: TMatch): string;
    function CompileScript(Script: AnsiString; out Bytecode, Messages: AnsiString): Boolean;
    function RunCompiledScript(Bytecode: AnsiString; out RuntimeErrors: AnsiString): Boolean;
end;

var
WebModuleClass: TComponentClass = TWebModule1;

//ScriptOutput is not thread safe.
//ScriptOutput is a global variable.
//We should avoid global variables.
//TODO: Find a better way to store the script output
ScriptOutput: string;

implementation

uses
uPSCompiler, uPSRuntime;

{$R *.dfm}

procedure Write(P1: Variant);
begin
//This try...except is ugly.
//TODO: Use a conditional checking instead
try
ScriptOutput:= ScriptOutput + String(P1);
except
ScriptOutput:= '';
end;
end;

procedure Writeln(P1: Variant);
begin
Write(P1);
ScriptOutput:= ScriptOutput + '';
end;

function TWebModule1.LoadStrFromFile(aFilename: string): string;
begin
Result:= '';
if not FileExists(aFilename) then Exit;

with TStringStream.Create do
try
    LoadFromFile(aFilename);
    Result:= DataString;
finally
    Free;
end;
end;

function TWebModule1.ProducePage(aContent: string): string;
var
RegEx: TRegEx;
begin
ScriptOutput:= '';
aContent:= StringReplace(aContent, #13#10, '', [rfReplaceAll]);
RegEx.Create('\<\%(.)*?\%\>');
Result:= regex.Replace(aContent, ExecPascalScript);
end;

function TWebModule1.ExecPascalScript(const Match: TMatch): string;
var
Bytecode,
Messages,
RuntimeErrors: AnsiString;
PS: string;
begin
Result:= '';
Bytecode:= '';
ScriptOutput:= '';
PS:= Match.Value;
PS:= StringReplace(PS, '<%', '', []);
PS:= StringReplace(PS, '%>', '', []);
if CompileScript(PS, Bytecode, Messages) then
if RunCompiledScript(Bytecode, RuntimeErrors) then
Result:= ScriptOutput;
end;

function ExtendCompiler(Compiler: TPSPascalCompiler; const Name: AnsiString): Boolean;
begin
Result := True;
try
    Compiler.AddDelphiFunction('procedure Writeln(P1: Variant);');
    Compiler.AddDelphiFunction('procedure Write(P1: Variant);');
except
    Result := False; // will halt compilation
end;
end;

function TWebModule1.CompileScript(Script: AnsiString; out Bytecode, Messages: AnsiString): Boolean;
var
Compiler: TPSPascalCompiler;
i: Integer;
begin
Bytecode:= '';
Messages:= '';

Compiler:= TPSPascalCompiler.Create;
Compiler.OnUses:= ExtendCompiler;
try
    Result:= Compiler.Compile(Script) and Compiler.GetOutput(Bytecode);
    for i:= 0 to Compiler.MsgCount - 1 do
      if Length(Messages) = 0 then
        Messages:= Compiler.Msg[i].MessageToString
      else
        Messages:= Messages + #13#10 + Compiler.Msg[i].MessageToString;
finally
    Compiler.Free;
end;
end;

procedure ExtendRuntime(Runtime: TPSExec; ClassImporter: TPSRuntimeClassImporter);
begin
Runtime.RegisterDelphiMethod(nil, @Writeln, 'Writeln', cdRegister);
Runtime.RegisterDelphiMethod(nil, @Write, 'Write', cdRegister);
end;

function TWebModule1.RunCompiledScript(Bytecode: AnsiString; out RuntimeErrors: AnsiString): Boolean;
var
Runtime: TPSExec;
ClassImporter: TPSRuntimeClassImporter;
begin
Runtime:= TPSExec.Create;
ClassImporter:= TPSRuntimeClassImporter.CreateAndRegister(Runtime, false);
try
    ExtendRuntime(Runtime, ClassImporter);
    Result:= Runtime.LoadData(Bytecode)
          and Runtime.RunScript
          and (Runtime.ExceptionCode = erNoError);
    if not Result then
      RuntimeErrors:= PSErrorToString(Runtime.LastEx, '');
finally
    ClassImporter.Free;
    Runtime.Free;
end;
end;

procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
HTMLSource,
HTMLPascalScriptEmbedded: string;
begin
//Set up HTMLSource at your convenience
HTMLSource:= GetCurrentDir + '\testPage.htm';
HTMLPascalScriptEmbedded:= LoadStrFromFile(HTMLSource);
Response.Content:= ProducePage(HTMLPascalScriptEmbedded);
end;

end.

Salary Guide for Delphi developers: Let’s make it

2011-12-02T23:41:00.009-05:00

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

Generating Fibonacci numbers in Delphi: Recursive and iterative algorithms

2011-11-30T16:38:00.013-05:00

In this post, I want to implement a function that returns the Nth Fibonacci number. Initially, I will provide a recursive implementation that derives directly from the Fibonacci sequence definition. Afterwards, I will recode the same function using an iterative approach.

Why do I want to do (share) such a thing? Well, firstly for fun :-) and secondly, because I was asked to do something similar in one phone screen interview. Really? Yep, I was asked to code a function to return the factorial of a number and then, I had to read it over the phone. I implemented the recursive algorithm. At this point, I was asked why I decided to use recursion as opposed to iteration. My answer was that I find the recursive implementation easier (and cleaner) to write. The interviewer finally inquired me about the iterative implementation…

This motivated me to resolve similar programming tasks (recursively and iteratively) just as a training exercise.

Well, enough with that blah, blah, blah.

Taken from Wikipedia:

The Fibonacci numbers form a sequence of integers, mathematically defined by

F(0)=0; F(1)=1; F(n) = F(n - 1) + F(n - 2) for n > 1.

This results in the following sequence of numbers:

0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, ...

This simply means that by definition the first Fibonacci number is 0, the second number is 1 and the rest of the Fibonacci numbers are calculated by adding the two previous numbers in the sequence.

Translating that into Delphi code:

function Fibonacci(aNumber: Integer): Integer;

begin
if aNumber < 0 then
raise Exception.Create('The Fibonacci sequence is not defined for negative integers.');

case aNumber of
0: Result:= 0;
1: Result:= 1;
else
Result:= Fibonacci(aNumber - 1) + Fibonacci(aNumber - 2);
end;
end;

The function above is the recursive implementation, which in my opinion fits naturally. Now, the iterative implementation might not be as cleaner as that:

function Fibonacci(aNumber: Integer): Integer;

var
I,
N_1,
N_2,
N: Integer;
begin
if aNumber < 0 then
 raise Exception.Create('The Fibonacci sequence is not defined for negative integers.');

case aNumber of
 0: Result:= 0;
 1: Result:= 1;
else
 begin
 N_1:= 0;
 N_2:= 1;
 for I:=2 to aNumber do
 begin
 N:= N_1 + N_2;
 N_1:= N_2;
 N_2:= N;
 end;
 Result:= N;
 end;
end;
end;

Finally, if you want to produce the first 21 Fibonacci numbers try this out:

program Project2;

{$APPTYPE CONSOLE}

{$R *.res}

uses
System.SysUtils;

var
I: Integer;

function Fibonacci(aNumber: Integer): Integer;
begin
{Your implementation goes here}
end;

begin
for I:=0 to 20 do
Writeln(Fibonacci(I));
Readln;
end.

Hopefully you are not bored to death :-)

Internationalizing your Delphi application: An ABC example

2011-11-25T18:34:00.008-05:00

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.

Multiton Design Pattern in Delphi

2011-11-21T18:34:00.006-05:00

The multiton is somewhat an extension of the singleton pattern. It is referred as registry of singletons by the GOF. I don’t know for sure who appointed the name multiton: it’s an analogy derived from the term singleton. So, singleton = single + ton; while multiton = multi + ton.

The singleton pattern guarantees that a class has only one instance; while the multiton allows keeping multiple instances by maintaining a map of related keys and unique objects. Note that there can be only one instance per key when implementing the multiton pattern. Also, note that the key does not have to be a string value; it can be an object for example. Nonetheless, in our code sniped we will consider the key to be a string.

I am going to tweak my singleton class implementation so that I can make it a multiton instead:



unit Multiton;



interface



uses

  Generics.Collections;



type

  TMultiton = class

  private

    //Private fields and methods here...



     class var _registry: TDictionary<string, TMultiton>;

  protected



  public

    class function Create(aName: string): TMultiton;

    class destructor Destroy;

    class function Lookup(aName: string): TMultiton;

   

    destructor Destroy; override;



    //Other public methods and properties here...   

  end;



implementation



{ TMultiton }



class function TMultiton.Create(aName: string): TMultiton;

begin

  if not Assigned(_registry) then

    _registry:= TDictionary<string, TMultiton>.Create;



  if not _registry.TryGetValue(aName, Result) then

  begin

    Result:= inherited Create as Self;

    _registry.Add(aName, Result);

  end;

end;



class destructor TMultiton.Destroy;

begin

   if Assigned(_registry) then

   begin

     _registry.Values.ToArray[0].Free;      

   end;

end;



class function TMultiton.Lookup(aName: string): TMultiton;

begin

  if Assigned(_registry) then

    _registry.TryGetValue(aName, Result);

end;



destructor TMultiton.Destroy;

var

  _instance: TMultiton;

  ValuesArray: TArray<TMultiton>;          

begin

  if Assigned(_registry) then

  begin

    ValuesArray:= _registry.Values.ToArray;



    _registry.Clear;

    _registry.Free;

    _registry:= nil;



    for _instance in  ValuesArray do

      if _instance <> Self then

        _instance.Free;

  end;



  inherited;

end;



end.

A few things I want you to note:

Instead of a single instance, we are holding a registry of instances. We do so by introducing the class variable _registry of type TDictionary<string, TMultiton>.
We register (create) the different instances by calling the class function Create. This function gets the key name as a parameter. A new instance is only created if no matches to the key name are found in the dictionary. If a match is found, then the corresponding value is returned from the dictionary data structure.
The Lookup class function allows retrieving a particular instance by giving its key name. Note that the Create function can also be used for this purpose, but it feels more natural to call Lookup for the searches, and Create for the registration (creation) of instances.
We have provided a regular destructor that once invoked releases all the memory: not only the current multiton instance, but the whole registry.
We have also provided a class destructor in case that we forget to manually release the memory.

This code was compiled with Delphi XE2, but it should also work for all versions above Delphi 2009. Comments, corrections and suggestions are most welcome.

Consider reading these books about design patterns if you haven’t yet:

Dependency Injection in Delphi: a simple example

2011-11-03T11:18:00.015-04:00

I want to give a fairly simple Delphi example that will expose the dependency injection pattern. No framework, no third-party library will be needed here: just plain Delphi code.

I won’t dig into the different forms of dependency injection. I will explain the idea of the pattern as simple as possible.

Instead of giving you bunch of definitions, I will present you with some code. The need to inject a dependency will come naturally. You’ll see:

type

IDependency = interface

['{618030A2-DB17-4532-81D0-D5AA6F73DC66}']

procedure GetType;

end;

TDependencyA = class(TInterfacedObject, IDependency)

public

procedure GetType;

end;

TDependencyB = class(TInterfacedObject, IDependency)

public

procedure GetType;

end;

TConsumer = class

private

FDependency: IDependency;

public

constructor Create(aDependencyClassName: string);

procedure GetDependencyType;

end;

implementation

{ TDependencyA }

procedure TDependencyA.GetType;

begin

WriteLn('Instance of type TDependencyA');

end;

{ TDependencyB }

procedure TDependencyB.GetType;

begin

WriteLn('Instance of type TDependencyB');

end;

{ TConsumer }

constructor TConsumer.Create(aDependencyClassName: string);

begin

if aDependencyClassName = 'TDependencyA' then

FDependency:= TDependencyA.Create

else if aDependencyClassName = 'TDependencyB' then

FDependency:= TDependencyB.Create;

end;

procedure TConsumer.GetDependencyType;

begin

if FDependency <> nil then

FDependency.GetType;

end;

It is a good and recommended practice in OOP to decrease coupling as much as possible. This means that each component (class) should avoid knowing implementation details of the other components (classes).

In our example, the TConsumer class has a dependency of type IDependency. So far so good, since we are abstracting any implementation specifics by using an interface (contract). The problem becomes obvious when you take a look at the constructor of TConsumer.

TConsumer.Create is instantiating the concrete classes TDependencyA or TDependencyB depending on the string parameter aDependencyClassName. As you can see, the design is not well decupled here, because the consumer class (TConsumer) is hard-coding implementation details about its dependency.

The question is: can we decuple this design even more? Yes, the dependency injection pattern will do it for us.

It’s now time to refactor our code a little bit. We’ll start by changing the signature of the constructor of the TConsumer class:

constructor TConsumer.Create(aDependency: IDependency);

begin

FDependency:= aDependency;

end;

Instead of choosing the concrete dependency to instantiate within the constructor, we are now injecting the dependency trough the aDependency parameter. Now the class TConsumer is completely independent of the dependency concrete class.

Ok, ok, but we still need to create the concrete dependency instance somewhere, right? Yes, we do. For that we will create a new class TDependencyInjector whose only purpose is to return the right dependency instance. This class will use reflection in order to create the right instance of IDependency. It will use just a string parameter that contains the dependency class name.

uses

RTTI,

Dependencies;

type

TDependencyInjector = class

public

class function GetDependency(aDependencyClassName: string): IDependency;

end;

implementation

{ TDependencyInjector }

class function TDependencyInjector.GetDependency(aDependencyClassName: string): IDependency;

var

RttiContext: TRttiContext;

RttiType: TRttiInstanceType;

begin

RttiType := RttiContext.FindType(aDependencyClassName) as TRttiInstanceType;

if RttiType <> nil then

Result:= RttiType.GetMethod('Create').Invoke(RttiType.MetaclassType, []).AsInterface as IDependency;

end;

Finally, let's put all the pieces together. Consider this console application that puts all the pieces in place:

program DependencyInjection;

{$APPTYPE CONSOLE}

{$R *.res}

uses

...

var

SomeConsumerObj: TConsumer;

Dependency: IDependency;

begin

Dependency:= TDependencyInjector.GetDependency('Dependencies.TDependencyA');

//Dependency:= TDependencyInjector.GetDependency('Dependencies.TDependencyB');

SomeConsumerObj:= TConsumer.Create(Dependency);

try

SomeConsumerObj.GetDependencyType;

finally

SomeConsumerObj.Free;

end;

Readln;

end.

In the code above we get the Dependency instance at runtime by using the TDependencyInjector class. Then we inject that dependency using the constructor of the class TConsumer. We have got a more decoupled design by using dependency injection. Don't you agree? ;-)

Get the full source code of this example here (written in Delphi XE 2).

Decorator Design Pattern in Delphi. Multiple Decorations

2011-09-22T12:25:00.023-04:00

In my previous post I introduced the decorator design pattern to you. I used a fairly simple example (a silly example if you wish) in order to give you a flavour of the pattern. I wrote Delphi code for that matter and I focused in having ONE, and only ONE, decorator class.

This was the situation in the original example: we implemented a TConsole class with a Write method that writes a text to the standard output. Then, we used a TUpperCaseConsole class to decorate a TConsole object. The decoration itself was simple: uppercasing the text to be shown.

Now I want to add a second decoration, which is framing the text to be shown within a rectangle of asterisks (*). For that I will create a new decorator class: TFramedConsole.

Let’s present a raw piece of code: (We will refine and refactor the code later)

var

MyConsole: TConsole;

begin

MyConsole:= TConsole.Create;

MyConsole:= TUpperCaseConsole.Create(MyConsole); //first decoration

MyConsole:= TFramedConsole.Create(MyConsole); //second decoration

try

MyConsole.Write('Hello World!');

finally

MyConsole.Free;

end;

Readln;

end.

In the code above we added a second decoration. The output for that code should be something like this:

**********************
** HELLO WORLD! **
**********************

This is cool: We can even add the same decoration several times. For example, to provide a double frame we would do something like this:

var

MyConsole: TConsole;

begin

MyConsole:= TConsole.Create;

MyConsole:= TUpperCaseConsole.Create(MyConsole); //first decoration

MyConsole:= TFramedConsole.Create(MyConsole); //second decoration

MyConsole:= TFramedConsole.Create(MyConsole); //third decoration

try

MyConsole.Write('Hello World!');

finally

MyConsole.Free;

end;

Readln;

end

Can you guess the output now? It’s like this:

**********************
**********************
** HELLO WORLD! **
**********************
**********************

How are the decorated and decorator classes put together when multiple decorations are needed? There are two key things to remember:

The different concrete decorators (TUpperCaseConsole and TFramedConsole) must inherit from a base decorator class. We will introduce the TDecoratedConsole class as the common ancestor for our decorators.
The base decorator class forwards the calls to its Write method to the decorated object’s Write method.

The code looks like this:

interface

uses

SysUtils, Windows;

type

TConsole = class

private

FText: string;

public

procedure Write(aText: string); virtual;

end;

TDecoratedConsole = class(TConsole) //Base Decorator

private

FConsole: TConsole;

public

constructor Create(aConsole: TConsole);

destructor Destroy; override;

procedure Write(aText: string); override;

end;

TUpperCaseConsole = class(TDecoratedConsole) //Concrete Decorator

public

procedure Write(aText: string); override;

end;

TFramedConsole = class(TDecoratedConsole) //Concrete Decorator

private

procedure CreateFrame(var aText: string);

public

procedure Write(aText: string); override;

end;

implementation

{ TConsole }

procedure TConsole.Write(aText: string);

begin

FText:= aText;

Writeln(FText);

end;

{ TDecoratedConsole }

constructor TDecoratedConsole.Create(aConsole: TConsole);

begin

inherited Create;

FConsole:= aConsole;

end;

destructor TDecoratedConsole.Destroy;

begin

FConsole.Free;

inherited;

end;

procedure TDecoratedConsole.Write(aText: string);

begin

FConsole.Write(aText);

end;

{ TUpperCaseConsole }

procedure TUpperCaseConsole.Write(aText: string);

begin

aText:= UpperCase(aText);

inherited Write(aText);

end;

{ TFramedConsole }

procedure TFramedConsole.CreateFrame(var aText: string);

var

TextLength: Integer;

AsteriskLine: string;

RealText: string;

begin

if Pos('*', aText) = 0 then

aText:= '** ' + aText + ' **';

RealText:= Trim(StringReplace(aText, '*', '', [rfReplaceAll]));

TextLength:= Length(RealText);

AsteriskLine:= StringOfChar('*', TextLength + 10);

aText:= AsteriskLine + #13#10 +

aText + #13#10 + AsteriskLine;

end;

procedure TFramedConsole.Write(aText: string);

begin

CreateFrame(aText);

inherited Write(aText);

end;

I know you are dying to say: the code above is awful because the decorators are bounded to a specific implementation of the decorated class. Indeed, we are going to fix that by introducing a TAbstractConsole class, which will be the common ancestor of the decorated and decorator classes. The TAbstractConsole class is abstract, meaning it has no implementation. You could have used an Interface type instated, something like IAbstractConsole. I’ll leave that to you.

Finally, I present you the consuming code plus the class definition code:

//Consuming code

var

MyConsole: TAbstractConsole;

begin

MyConsole:= TConsole.Create;

MyConsole:= TUpperCaseConsole.Create(MyConsole); //first decoration

MyConsole:= TFramedConsole.Create(MyConsole); //second decoration

MyConsole:= TFramedConsole.Create(MyConsole); //third decoration

try

MyConsole.Write('Hello World!');

finally

MyConsole.Free;

end;

Readln;

end

//Class definition code

interface

uses

SysUtils, Windows;

type

TAbstractConsole = class //Abstract class ==> Interface

public

procedure Write(aText: string); virtual; abstract;

end;

TConsole = class(TAbstractConsole) //Concrete class

private

FText: string;

public

procedure Write(aText: string); override;

end;

TDecoratedConsole = class(TAbstractConsole) //Base Decorator

private

FConsole: TAbstractConsole;

public

constructor Create(aConsole: TAbstractConsole);

destructor Destroy; override;

procedure Write(aText: string); override;

end;

TUpperCaseConsole = class(TDecoratedConsole) //Concrete Decorator

public

procedure Write(aText: string); override;

end;

TFramedConsole = class(TDecoratedConsole) //Concrete Decorator

private

procedure CreateFrame(var aText: string);

public

procedure Write(aText: string); override;

end;

implementation

{ TConsole }

procedure TConsole.Write(aText: string);

begin

FText:= aText;

Writeln(FText);

end;

{ TDecoratedConsole }

constructor TDecoratedConsole.Create(aConsole: TAbstractConsole);

begin

inherited Create;

FConsole:= aConsole;

end;

destructor TDecoratedConsole.Destroy;

begin

FConsole.Free;

inherited;

end;

procedure TDecoratedConsole.Write(aText: string);

begin

FConsole.Write(aText);

end;

{ TUpperCaseConsole }

procedure TUpperCaseConsole.Write(aText: string);

begin

aText:= UpperCase(aText);

inherited Write(aText);

end;

{ TFramedConsole }

procedure TFramedConsole.CreateFrame(var aText: string);

var

TextLength: Integer;

AsteriskLine: string;

RealText: string;

begin

if Pos('*', aText) = 0 then

aText:= '** ' + aText + ' **';

RealText:= Trim(StringReplace(aText, '*', '', [rfReplaceAll]));

TextLength:= Length(RealText);

AsteriskLine:= StringOfChar('*', TextLength + 10);

aText:= AsteriskLine + #13#10 +

aText + #13#10 + AsteriskLine;

end;

procedure TFramedConsole.Write(aText: string);

begin

CreateFrame(aText);

inherited Write(aText);

end;

I hope this was useful and I am definitely waiting for you feedback. Corrections and suggestions are welcome in the comment section below. Thanks!

For further reading about design patterns get your hands on these classics:

Decorator Design Pattern in Delphi. Single decoration

2011-08-26T12:48:00.017-04:00

Decorator (also referred as Wrapper) is classified by GoF as a structural pattern. Its purpose is to:

“Attach additional responsibilities to an object dynamically. Decorators provide a flexible alternative to subclassing for extending functionality.”

Both inheritance and the decorator pattern aim towards extending the functionality. This is what they have in common.

There are a couple of remarkable differences:

Inheritance extends the functionality at compilation time (statically). The decorator pattern extends the functionality at runtime (dynamically).
Inheritance extends the functionality of a whole class (all objects of the extended class get the extended functionality). The decorator pattern allows extending the functionality of a selected object (or group of objects) without affecting the remaining objects.

You can think of the decorator pattern as a way to add make-up to an object or even as a way to attach accessories to that object. All this is done on the fly after the object itself has been created.

Let’s walk through a simple task to get the idea. This example might sound silly. I want it silly so that you can focus on the decorator implementation, avoiding any extra complexity.

Please, be aware that this design is somewhat unfinished, since we are only covering the case for a single decoration (just one functionality to be extended). In real life, we will need multiple decorators in order to add multiple responsibilities. As this is a controlled example (just for the purpose of this discussion), I am enforcing that only ONE responsibility is going to be extended. This means, we will have ONE decorator class. Because of that, I have made some simplifications to the design; so that you get a taste of the decorator pattern in its simplest expression.

Later on, in other post, we’ll see how to add multiple responsibilities (with multiple decorator classes). For that, we’ll need a more complex design to overcome the shortcomings of this initial example. For now, just get the idea...we'll come back later to the multiple decorations scenario.

If you get some time, take a look at the discussion in the comments section.

Subtask 1: Let’s create a TConsole class which purpose is to output a given text to the standard output. The code might be something like this:



interface

type

  TConsole = class

  public

    procedure Write(aText: string);

  end;



implementation



procedure TConsole.Write(aText: string);

begin

  Writeln(aText);

end;

Subtask 2: Let’s use the TConsole class to printout “Hello World!”. The following code snipped does it:



var

  MyConsole: TConsole; 

begin

  MyConsole:= TConsole.Create;

  try

    MyConsole.Write('Hello World!');

  finally

    MyConsole.Free;

  end;

  Readln;

end.

This is how the output looks like:

Hello World!

Subtask 3: Now, let’s decorate the object referenced by MyConsole (only that object, not the whole class). What I want is to upper case every text to be printed out. We need to define a decorator class TUpperCaseConsole for that purpose. See the code:



interface



uses

  SysUtils;



type

  TConsole = class

  public

    procedure Write(aText: string); virtual;

  end;



  //Decorator 

  TUpperCaseConsole = class(TConsole)

  private

    FConsole: TConsole;

  public

    constructor Create(aConsole: TConsole);

    destructor Destroy; override;



    procedure Write(aText: string); override;

  end;



implementation



{ TConsole }



procedure TConsole.Write(aText: string);

begin

  Writeln(aText);

end;



{ TUpperCaseConsole }



constructor TUpperCaseConsole.Create(aConsole: TConsole);

begin

  inherited Create;

  FConsole:= aConsole;

end;



destructor TUpperCaseConsole.Destroy;

begin

  FConsole.Free;

  inherited;

end;



procedure TUpperCaseConsole.Write(aText: string);

begin

  aText:= UpperCase(aText);

FConsole.

Write(aText);

end;

Notice in the code above that the decorator class (TUpperCaseConsole) inherits from the decorated class (TConsole). This makes both the decorated and the decorator objects to share the same public interface. Furthermore, the TUpperCaseConsole class Has-A field of the TConsole type. We’ll use this field to forward the printing functionality to the TConsole class, once we have applied the cosmetic (upper case transformation) to the text.

Subtask 4: Let’s now create some consuming code to decorate one TConsole object on the fly. Note how the TUpperCaseConsole constructor wraps (decorates) the object referenced by MyConsole.



var

  MyConsole: TConsole;

begin

  MyConsole:= TConsole.Create;

  MyConsole:= TUpperCaseConsole.Create(MyConsole);

  try

    MyConsole.Write('Hello World!');

  finally

    MyConsole.Free;

  end;

  Readln;

end.

This is how the output looks like after the decorator has been applied:

HELLO WORLD!

In real life, you’ll have to judge whether the decorator pattern is the best alternative to be applied to solve a particular problem. Not always it the right way to go with. For more details get your hands on these classic books.

Anonymous Methods in Delphi

2011-08-19T13:25:00.013-04:00

Under the scope of Delphi, an anonymous method is either a procedure or function that’s unattached to an identifier. In other words, anonymous methods don’t have names, which is why they are called “anonymous”.

Basically, you can assign a block of code (in the form of a procedure or function) directly to a variable.

I am going to give you a simplistic example. I am going to Keep it simple, Stupid! to avoid distracting you with any complexity.

This is the wording of the task: create a console application which prints “Hello world” and “Good bye” to the standard output. Constraint: use the Writeln function just once in the code.

To accomplish such reckless task in the old days (before the introduction of anonymous methods) you could do this:



program Project1;



{$APPTYPE CONSOLE}



procedure PrintString(aText: string);

begin

 Writeln(aText);

end;



begin

  PrintString('Hello world');

  PrintString('Good bye');

  Readln;

end.

How to do the same with anonymous methods? Take a look at the following code:



program Project1;



{$APPTYPE CONSOLE}



type

  TMyAnonymousProcedureType = reference to procedure(aText: string);



var

  A: TMyAnonymousProcedureType;



begin

  A:= procedure(aText: string) //No semicolon here

                begin

                  Writeln(aText);

                end;

  A('Hello world');

  A('Good bye');

  Readln;

end.

As you can see in the example above, we have assigned code directly to the variable A. Then, we called A with parameters, and Voilà!: we have accomplished our reckless task with anonymous methods as well.

Pay attention to this: if you are tented to declare variable A like this:



var

  A: reference to procedure(aText: string);

Don’t! That shortcut doesn’t work. You’ll get a compilation error…like this:

Undeclared identifier: ‘reference’

So, you do need to declare:



type  

   TMyAnonymousProcedureType = reference to procedure(aText: string);

Only later you can define the type of variable A.

You might be asking by now: why to bother with all this? What's the benefit? Well, in the previous example there’s little or none benefit present.

Generally speaking, anonymous methods are handy in the following cases:

You have been trying to name a local method for hours. You cannot think of a name for it. Well, think no more: use anonymous methods. Don’t put a tasteless name like Foo(), XXX(), Aux(), etc.
You create a function that is called just once(it’s just called from one spot).
You can use anonymous methods to provide elegant and simpler implementations. This is the case when combining generics types with anonymous methods for example. I should write about this shortly. Subscribe to my feed and stay tuned :-)

With this post I wanted to introduce anonymous methods to you. It’s OK if you don’t see the benefits clearly right now. You’ll get there :-)

Hide the utter "Create" constructor of TObject in Delphi

2011-08-15T12:11:00.010-04:00

In Delphi, constructors can be inherited; this doesn’t happen in Java, C# and C++ for example. Furthermore, constructors in Delphi can have multiple and different names; usually they are called Create, but this is just a convention, since you can define a constructor with whatever name you choose.

In addition to all this, all classes in Delphi inherit ultimately from TObject, which contains a public parameterless constructor, named Create.

Due to the facts above, it‘s easy to understand that all classes in Delphi have a public Create parameterless constructor, that has been inherited from TObject.

I am not going to discuss here whether this is bad or good. What I want to show you is a way to hide the public Create parameterless constructor of TObject in case you need to do so.

Burn this out: you cannot hide any member (field, method, constructor, destructor) in Delphi by decreasing the level of visibility. If a member in a superclass is public, you cannot hide it in a child class by changing the visibility to protected or private. Once public you are always public. This means, you cannot hide the public Create parameterless constructor of TObject by lowering its visibility in an inheriting class.

So, how can we hide the Create constructor of TObject? Is there even a way for doing so? Yes, there is a way. We came to the solution in the LinkedIn’s Delphi Professionals group. I thought it would be worthy to share this with the rest of the Delphi community.

Basically, you can hide the public Create parameterless constructor of TObject with another public method having the same Create name. For example:

Class definition snipped:

TSomeClass = class(TObject)

public

//this constructor takes two parameters, and hides the TObject.Create()

constructor Create(aParameter1: string; aParameter2: Integer );

end;

Consuming code snipped:

var

SomeObject: TSomeClass;

begin

SomeObject:= TSomeClass.Create; //This does not compile!

//This compiles. Uncomment and try...

// SomeObject:= TSomeClass.Create('Hello People!', 12);

try

//TODO

finally

SomeObject.Free;

end;

See, in the code above the TObject.Create() has been hidden :-)

There is another consideration though: What happens if we overload the Create constructor?

TSomeClass = class(TObject)

public

//this one takes two parameters, and hides the TObject.Create()

constructor Create(aParameter1: string; aParameter2: Integer ); overload;

constructor Create(aThisTakesAChar: Char); overload;

constructor Create(aThisTakesAnInteger: Integer); overload;

end;

By overloading the Create constructor we have made the TObject.Create() visible again. If we want to keep it hidden, then we should avoid overloading. For that, you can simply use a different name for the new constructors being added. Something like this:

TSomeClass = class(TObject)

public

//this one takes two parameters, and hides the TObject.Create()

constructor Create(aParameter1: string; aParameter2: Integer );

constructor Create2(aThisTakesAChar: Char);

constructor Create3(aThisTakesAnInteger: Integer);

end;

Now the TObject.Create() constructor is hidden again.

Consuming code:

var

SomeObject: TSomeClass;

begin

SomeObject:= TSomeClass.Create; //This does not compile!

//This compiles. Uncomment and try...

// SomeObject:= TSomeClass.Create('Hello People!', 12);

//This compiles. Uncomment and try...

// SomeObject:= TSomeClass.Create1('H');

//This compiles. Uncomment and try...

// SomeObject:= TSomeClass.Create2(12);

try

//TODO

finally

SomeObject.Free;

end;

Why would someone want to hide the TObject.Create() anyway? It depends on the situation. I have found this very useful when implementing a singleton class in Delphi. For details refer to: Singleton class in Delphi.

As a conclusion, you can hide the TObject.Create() constructor by defining a new public method with the name Create in the inheriting class. You cannot hide TObject.Create() by lowering the visibility to protected, private, etc.

My contributions to the Delphi community at RosettaCode

2011-08-07T18:59:00.012-04:00

RosettaCode is a wiki site that gathers a collection of programming tasks being resolved in as many programming languages as possible.

You can post solutions to a particular task using a particular language (Delphi, Java, C++, C#, Ruby, the list goes and goes). All solutions to the same task are coded in the same page, allowing a fast knowledge transfer from one language to the other. Also, you can compare how suitable is a particular language for a particular task.

Furthermore, you can add programming languages to be considered for implementation and of course, you can suggest new tasks to be resolved.

There is very little about Delphi at RosettaCode. I encourage the Delphi community to fill the pending tasks for Delphi and suggest new tasks as well.

Delphi is very powerful, let’s share it with everybody.

These are my contributions so far:

Finally, I want to highlight that RosettaCode is about all programming languages. Resolving tasks in a single language is not enough. Don’t be shy, add the solutions in all the languages you can :-)

Parameterized Factory Method in Delphi

2011-07-13T17:24:00.045-04:00

Factory Method is a creational design pattern, whose intent (according to Design Patterns: Elements of Reusable Object-Oriented Software) is to:

“Define an interface for creating an object, but let subclasses decide which class to instantiate. Factory Method lets a class defer instantiation to subclasses.”

Do you want to know more about design patterns? Check reference [1] at the bottom for extra reading.

In this post we will consider a variation of the pattern referred as parameterized factory method. This variation just refers to the first part of the intent, that is, “define an interface for creating an object”. Why is that? What about the rest of the intent? Well, there are times in which sub-classing is not possible or not suitable; nonetheless, it is useful to define a factory method to encapsulate the creation of an object.

Let’s proceed with the example we used in our previous post (template design pattern); that is: Design an application that allows drawing different styles of houses (ei. country house, city house) using ASCII art.

The GUI of our app contains some VCL components as you can see in the images below. Clicking the buttons will result in an ASCII house printed out in the memo area. Depending on the Draw… button being clicked, the house will look differently: it can be a country house or a city house.

Figure1 A Country House (Draw Country House button was clicked)

Figure 2 A City House (Draw City House button was clicked)

Behind the scenes, assume that we have implemented the following class hierarchy:

THouse is an abstract class that defines several methods for displaying the different parts of the house [2] or the house as a whole [3].

TCountryHouse and TCityHouse are two concrete (non-abstract) classes that actually override some of the methods of its superclass, allowing this way different look-and-feel; that is, a house in the country and a house in the city look differently.

When a button is clicked, the corresponding OnClick event is triggered. We have to provide logic (source code) to define what the button is going to do in response to the OnClick event. Using fancy words, we have to implement the event handler for the OnClick event. I have created the following event handler which is going to be shared by both buttons [4]:



//OnClick event handler for the buttons

procedure TfrmMain.btnDrawGenericHouseClick(Sender: TObject);

var

  House: THouse;

begin

  //If the "Sender" object is not a button do nothing

  if not(Sender is TButton) then Exit;



  //The concrete house object being created depends

  //on the button being clicked

  if TButton(Sender).Name = 'btnDrawCountryHouse' then
     House:= TCountryHouse.Create
   else if TButton(Sender).Name = 'btnDrawCityHouse' then
     House:= TCityHouse.Create;



  with House do

  begin

    //cmbHasChimney is a combo box (TComboBox) that allows

    //to decide whether to add a chimney or not to the house

    case cmbHasChimney.ItemIndex of

      0: HasChimney:= True;

      1: HasChimney:= False;

    end;

    //"memFrame" is a memo (TMemo) used to print out the house.

    memFrame.Text:= BuildIt;

    Free;

  end;

end;

This works of course, but it lacks flexibility. What happens if we want to add a third button, or a fourth, or a five in order to add new types of houses? In that case, you will have to rework the code above and the fragment in blue will grow up big as new house types are added. You will end coding something like this:



  if TButton(Sender).Name = 'btnDrawCountryHouse' then

    House:= TCountryHouse.Create

  else if TButton(Sender).Name = 'btnDrawCityHouse' then

House

:= TCityHouse.Create

else if TButton(Sender).Name = 'btnDrawDogHouse' then

House

:= TDogHouse.Create

else if TButton(Sender).Name = 'btnDrawTreeHouse' then

House

:= TTreeHouse.Create

else if TButton(Sender).Name = 'btnDrawGhostHouse' then

House

:= TGhostHouse.Create;

That is the only part changing within the method. Why don’t we take that chunk of code and place it somewhere else? For that, we can create a factory method. The factory method will take one parameter to decide the concrete house type to instantiate [4]. The return type of the factory method will be THouse, because THouse enfolds all the other house subtypes. What about this?



function TfrmMain.MakeHouse(Sender: TObject): THouse;

begin

  if TButton(Sender).Name = 'btnDrawCountryHouse' then

    Result:= TCountryHouse.Create

  else if TButton(Sender).Name = 'btnDrawCityHouse' then

Result

:= TCityHouse.Create

else if TButton(Sender).Name = 'btnDrawDogHouse' then

Result

:= TDogHouse.Create

else if TButton(Sender).Name = 'btnDrawTreeHouse' then

Result

:= TTreeHouse.Create

else if TButton(Sender).Name = 'btnDrawGhostHouse' then

Result

:= TGhostHouse.Create;

end;

MakeHouse is a parameterized factory method. It is called factory because its only purpose in life is to create an object. It is adorned with the parameterized term, because it takes a parameter (Sender) to decide the concrete class to instantiate.

What does this mean to our previous code (event handler method)? Well, see it by yourself:



//OnClick event handler for the buttons

procedure TfrmMain.btnDrawGenericHouseClick(Sender: TObject);

var

  House: THouse;

begin

  //If the "Sender" object is not a button do nothing

  if not(Sender is TButton) then Exit;



  //The concrete house object being created depends

  //on the button being clicked

  House:= MakeHouse(Sender); //See our factory method in action



  with House do

  begin

    //cmbHasChimney is a combo box (TComboBox) that allows

    //to decide whether to add a chimney or not to the house

    case cmbHasChimney.ItemIndex of

      0: HasChimney:= True;

      1: HasChimney:= False;

    end;

    //"memFrame" is a memo (TMemo) used to print out the house.

    memFrame.Text:= BuildIt;

    Free;

  end;

end;

Now, as you can see, the event handler will remain the same no matter how many different subtypes of houses we have (add). Everything about the creation of a house object is isolated in the factory method.

One final comment: Delphi is a hybrid programming language, allowing both structured and object oriented programming. In Delphi, we can have functions outside all classes’ scope. That’s not very Object Oriented. Isn’t? Besides, you can’t do that in languages like Java, Python, Ruby or C#.

In general, you should have a Factory class containing the factory method. In this particular Delphi example you might argue that we are just adding code for nothing. Yes, I give you that. But there are cases, in which having a hierarchy of factory classes comes naturally and the subfactories decide the concrete object to be created. We’ll cover that scenario in future posts :-)

Notes:

[1] Books about Design Patterns:

[2] BuildFloor(), BuildWalls(), BuildRoof(), BuildChimney(). These methods draw out the floor, walls, roof and chimney (if any) respectively.

[3] BuildIt(): this method calls the methods in [2] and as a result it draws the whole house.

[4] You can define the event handler for the buttons at design time using Delphi’s Object Inspector

Template Method Design Pattern in Delphi. A working example

2011-06-24T15:44:00.125-04:00

The Template Method Pattern is very easy to understand and implement. Here’s the definition borrowed from Design Patterns: Elements of Reusable Object-Oriented Software book:

“Define the skeleton of an algorithm in an operation, deferring some steps to subclasses. Template Method lets subclasses redefine certain steps of an algorithm without changing the algorithm's structure.”

Let’s try to understand the pattern walking through a simple example. For implementing the solution we’ll use Delphi XE, but it should work for previous versions as well.

This is the wording of the example:

Design an application that allows drawing different styles of houses (ei. country house, city house) using ASCII art [1].

In the following image there’s a prototype of the user interface.

The GUI is composed by a form, a memo [2], two buttons, a label and a combo box. Using the combo box you can choose whether your house will have a chimney or not. Clicking the buttons will result in an ASCII house printed out in the memo area. In the example above, the Draw Country House was clicked. If you click the other button, you will get city house like the one below:

What happens if you select “No” in the combo box? Try it and let me know :-) Here’s the link to the EXE. This EXE is harmless; I am not a bad guy: no Trojans, no viruses, just Delphi :-)

Now, what classes do we need to make this work? Take a look at the following class diagram and try to make sense of it:

We have an abstract superclass THouse, which contains four abstract (pure virtual) methods: BuildFloor, BuildWalls, BuildRoof and BuildChimney. These methods are implemented in the descending classes TCountryHouse and TCityHouse. Pay special attention to the method BuildIt in THouse. This method is an instance method that is inherited by both concrete subclasses: TCountryHouse and TCityHouse.

I want to be more detailed:

The BuildIt method is implemented just once in the class THouse. The subclasses TCountryHouse and TCityHouse don’t have to implement the BuildIt method.

The BuildFloor, BuildWalls, BuildRoof and BuildChimney methods have no implementation under the THouse class. The TCountryHouse has one implementation of these methods, while TCityHouse have a different implementation of them.

This is how the BuildIt method looks like:

function THouse.BuildIt: string;

begin

Result:= BuildRoof + //Step 1

BuildWalls + //Step 2

BuildFloor; //Step 3

if FHasChimney then

Result:= BuildChimney+ Result; //Step 4 (conditional)

end;

This method defines a general algorithm to build a house…it doesn’t take into consideration the kind of house that’s been built. Notice that the steps for building the roof, walls, floor and chimney (if any) have been deferred to the subclasses. The BuildIt method is known as a template method that gives the name to this pattern.

Let me give you an idea of the implementation of the BuildFloor method. This method is implemented directly by the subclasses. Take a look:

function TCountryHouse.BuildFloor: string;

begin

Result:=

'~~~~~" "~~~~~~~~~~~~~~~~~~~~~~~~ ';

end;

function TCityHouse.BuildFloor: string;

begin

Result:=

'******************____****************'#13#10 +

'**************************************';

end;

Notice that the implementation of the BuildFloor method is different in both subclasses TCountryHouse and TCityHouse.

For the implementation of the remaining methods refer to reference [5]. For the full source code refer to [3].

In conclusion, the template method pattern needs an abstract superclass to implement a template method (common for all subclasses). The steps within this template method are deferred into methods that are implemented by the concrete subclasses. Did you get it? :-)

Do you want to know more about design patterns? The books in reference [4] are just what you need.

References:

[1] I am borrowing the ASCII designs from Asciiworld.com : House.

[2] Make sure to use a fixed-width font (Courier, Monaco, Courier New, Lucida Console, etc.) for the memo, otherwise the drawing will look fuzzy.

[3] Get the full source code of this example here.

[4] Books on Design Patterns:

[5] The full source code of the unit:

unit TemplatePatternExample;



interface

type

  THouse = class

  private

    FHasChimney: Boolean;

  public

    constructor Create;



    property HasChimney: Boolean read  FHasChimney

                                 write FHasChimney;



    function BuildFloor: string;   virtual; abstract;

    function BuildWalls: string;   virtual; abstract;

    function BuildRoof: string;    virtual; abstract;

    function BuildChimney: string; virtual; abstract;



    function BuildIt: string;

  end;



  TCountryHouse = class(THouse)

  public

    function BuildFloor: string;   override;

    function BuildWalls: string;   override;

    function BuildRoof: string;    override;

    function BuildChimney: string; override;

  end;



  TCityHouse = class(THouse)

  public

    function BuildFloor: string;   override;

    function BuildWalls: string;   override;

    function BuildRoof: string;    override;

    function BuildChimney: string; override;

  end;



implementation



{ THouse }



constructor THouse.Create;

begin

  inherited Create;

  FHasChimney:= True;

end;



function THouse.BuildIt: string;

begin

  Result:= BuildRoof  +  //Step 1

           BuildWalls +  //Step 2

           BuildFloor;   //Step 3



  if FHasChimney then

    Result:= BuildChimney+ Result;  //Step 4 (conditional)

end;



{ TCountryHouse }



function TCountryHouse.BuildChimney: string;

begin

  Result:=



  '              (   )                '#13#10 +

  '             (    )                '#13#10 +

  '              (    )               '#13#10 +

  '             (    )                '#13#10 +

  '               )  )                '#13#10 +

  '              (  (                 '#13#10 +

  '               (_)                 '#13#10 +

  '               [ ]                 '#13#10;

end;



function TCountryHouse.BuildRoof: string;

begin

  Result:=



  '       ___________________       '#13#10 +

  '      /\        ______    \      '#13#10 +

  '     //_\       \    /\    \     '#13#10 +

  '    //___\       \__/  \    \    '#13#10 +

  '   //_____\       \ |[]|     \   '#13#10 +

  '  //_______\       \|__|      \  '#13#10 +

  ' /XXXXXXXXXX\                  \ '#13#10 +

  '/_I_II  I__I_\__________________\'#13#10;

end;



function TCountryHouse.BuildWalls: string;

begin

  Result:=



  '  I_I|  I__I_____[]_|_[]_____I'#13#10 +

  '  I_II  I__I_____[]_|_[]_____I'#13#10 +

  '  I II__I  I     XXXXXXX     I'#13#10;

end;



function TCountryHouse.BuildFloor: string;

begin

  Result:=



  '~~~~~"   "~~~~~~~~~~~~~~~~~~~~~~~~  ';

end;



{ TCityHouse }



function TCityHouse.BuildChimney: string;

begin

  Result:=



  '                           ====  '#13#10 +

  '                           !!!!  '#13#10;

end;



function TCityHouse.BuildRoof: string;

begin

  Result:=



  '      ==========================      '#13#10 +

  '    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%    '#13#10 +

  '  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  '#13#10 +

  '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'#13#10;

end;



function TCityHouse.BuildWalls: string;

begin

  Result:=



  '  ||      _____          _____    ||'#13#10 +

  '  ||      | | |          | | |    ||'#13#10 +

  '  ||      |-|-|          |-|-|    ||'#13#10 +

  '  ||      #####          #####    ||'#13#10 +

  '  ||                              ||'#13#10 +

  '  ||      _____   ____   _____    ||'#13#10 +

  '  ||      | | |   @@@@   | | |    ||'#13#10 +

  '  ||      |-|-|   @@@@   |-|-|    ||'#13#10 +

  '  ||      #####   @@*@   #####    ||'#13#10 +

  '  ||              @@@@            ||'#13#10;

end;



function TCityHouse.BuildFloor: string;

begin

  Result:=



  '******************____****************'#13#10 +

  '**************************************';

end;



end.

New certifications available for Delphi Developers

2011-06-22T21:04:00.012-04:00

Last June 12th, 2011, I received an Embarcadero Community Newsletter pointing out that “certification exams are now available for Delphi developers. Embarcadero's Delphi Certification Program offers two levels: Delphi Certified Developer and Delphi Certified Master Developer. “

I just passed the Delphi Developer Certification exam and thus I became a Certified Delphi Developer.

Now, I want you to become certified as well :-) So, mind this:

This exam is conducted over the Internet without supervision. That means you can take the exam at home (or wherever you prefer) at your own pace. You don’t need to go to a particular place to take the exam: you just need an Internet connection and that’s pretty much it.
The exam is cheap. It only costs $49USD.Consider for example that the prices for .NET or Java certifications are much higher.
You can pay for the exam code online (you need an exam code to take the certification exam). Theoretically, you can pay it using VISA, MasterCard and Paypal. Warning: I tried with my VISA and Master Card cards and it didn’t work. It seems that there is (was) something wrong with the payment system. At the end, I managed to perform the payment through Paypal.
The exam contains 60 questions to be answered in 60 minutes. The time is plenty; so, don’t worry about it.
Be careful with the syntax questions: even if you are an experienced Delphi programmer, I would advise you to review the syntactical elements of the language before taking the test. Most times our memory becomes dusty after too much time relaying on the code completion features of the IDE.
Take a look at the Delphi Developer Certification Study Guide. Make sure you cover all the topics targeted for the exam. Remember: all topics go under examination.

I wanted to take the Delphi Master Developer Certification exam as well, but guess what? - This exam is supervised and I would need to travel to USA to take it. I think I will wait until it becomes available (hopefully) in Canada.

I belief the introduction of these certification programs is proof that Embarcadero is willing to gain a good portion of the programming market. By taking the exams you become part of the effort of bringing Delphi to the arena once more…I believe it’s worthy.

I recently found this Delphi Certification Webinar video by Andreano Lanusse.