Delphi Implementation for the OpenSubtitles API

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

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

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


unit OpensubtitlesAPI;

interface

uses
  IdHTTP, Classes, SysUtils;

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

implementation

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

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

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

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

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

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

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

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

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

end.

Finally, I present you some sample calls:

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

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

Logging- out (disposing the token):

LogOut('81nt6bgl9vde06l3ptq7v1a7r1');

Search English subtitles for the movie whose ImdbID is 120737

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

Search English subtitles for The Lord of the Rings

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


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

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

Generating Fibonacci numbers in Delphi: Recursive and iterative algorithms

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

CodeProject

Internationalizing your Delphi application: An ABC example

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

• Resourcing
• Unit conversions
• Dynamic messages

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

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

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

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

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

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

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

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

  {read current system locale}
  LangID := GetSystemDefaultLangID;

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

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

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

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

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

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

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

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

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

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

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

CodeProject

Dependency Injection in Delphi: a simple example

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

CodeProject

Decorator Design Pattern in Delphi. Multiple Decorations

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:

1. 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.
2. 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:

CodeProject

Decorator Design Pattern in Delphi. Single decoration

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.

CodeProject

Anonymous Methods in Delphi

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

CodeProject

Hide the utter "Create" constructor of TObject in Delphi

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;

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;

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.

CodeProject

My contributions to the Delphi community at RosettaCode

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:

1. Singleton
2. Primality by trial division
3. Unicode variable names 
4. Date manipulation
5. Draw a sphere
6. MD5
7. XML/Input 
8. XML/Output 
9. Mutual recursion
10. Soundex 
11. Delegates 

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