18.10.2013

Recent additions to delphi-xe-json

I finally found some time to add two features to my delphi-xe-json library.

I wrote a Formatter for JSON, that doesn't try to read the input into an IJSONArray or IJSONObject. The advantage is, that it even formats invalid JSON, which might make it easier to spot what is wrong with it.
I'm not completely happy with it, because it violates the DRY-Principle twice. I copied a method from TJSONReader and another one from TJSONReadableWriter, but I already have an idea how to fix that.

The other addition is bigger and still a work in progress, which is why I haven't merged the branch back into the master branch. I decided to share it anyway, because it is working with some restrictions and I don't think that the interface is changing a lot in the next time.

The idea was to generate Plain Old Delphi Objects (PODOs) from a JSON string. I utilized the code generator from Jeroen Pluimers which he kindly put under BSD-License in the repository from better-office benelux.

For convenience, I copied the three needed units in the delphi-xe-json repository, but I recommend using the original ones.

The usage is very simple:
var
  jo : IJSONObject;
begin
  jo := TJSON.NewObject({some json string});
  Memo1.Lines.Text := TJSON.GeneratePODOUnit(jo);
end;

JSON-Input:
{
  "Name":"Test",
  "AnswerToLife":42,
  "Items":
  [
    1.41,
    2.72,
    3.13
  ]
}

Generated Unit
unit GeneratedUnit;

interface

uses
  Generics.Collections,
  JSON;

type
  TItemsList = class;
  TGeneratedClass = class;

  TItemsList = class(TList<double>)
  public
  procedure LoadFromFile(aFilename : string);
  procedure SaveToFile(aFilename : string);
  procedure LoadFromJSON(ja : IJSONArray);
  procedure SaveToJSON(ja : IJSONArray);
  end;

  TGeneratedClass = class(TObject)
  strict private
  fItems: TItemsList;
  fAnswerToLife: integer;
  fName: string;
  public
  procedure LoadFromFile(aFilename : string);
  procedure SaveToFile(aFilename : string);
  constructor Create();
  destructor Destroy(); override;
  procedure LoadFromJSON(jo : IJSONObject);
  procedure SaveToJSON(jo : IJSONObject);
  property Items: TItemsList read fItems;
  property AnswerToLife: integer read fAnswerToLife write fAnswerToLife;
  property Name: string read fName write fName;
  end;

implementation

uses
  IOUtils;

{ TItemsList }

procedure TItemsList.LoadFromFile(aFilename : string);
var
  json: IJSONArray;
  s: string;
begin
  s := TFile.ReadAllText(aFilename);
  json := TJSON.NewArray(s);
  LoadFromJSON(json);
end;

procedure TItemsList.SaveToFile(aFilename : string);
var
  json: IJSONArray;
begin
  json := TJSON.NewArray;
  SaveToJSON(json);
  TFile.WriteAllText(aFilename, json.ToString);
end;

procedure TItemsList.LoadFromJSON(ja : IJSONArray);
var
  i: integer;
begin
  for i := 0 to ja.Count - 1 do
  begin
    Items[i] := ja.GetDouble(i);
  end;
end;

procedure TItemsList.SaveToJSON(ja : IJSONArray);
var
  i: integer;
begin
  for i := 0 to ja.Count - 1 do
  begin
    ja.put(Items[i]);
  end;
end;

{ TGeneratedClass }

procedure TGeneratedClass.LoadFromFile(aFilename : string);
var
  json: IJSONObject;
  s: string;
begin
  s := TFile.ReadAllText(aFilename);
  json := TJSON.NewObject(s);
  LoadFromJSON(json);
end;

procedure TGeneratedClass.SaveToFile(aFilename : string);
var
  json: IJSONObject;
begin
  json := TJSON.NewObject;
  SaveToJSON(json);
  TFile.WriteAllText(aFilename, json.ToString);
end;

constructor TGeneratedClass.Create();
begin
  fItems := TItemsList.Create;
end;

destructor TGeneratedClass.Destroy();
begin
  fItems.Free;
  inherited;
end;

procedure TGeneratedClass.LoadFromJSON(jo : IJSONObject);
begin
  fItems.LoadFromJSON(jo.GetJSONArray('Items'));
  fAnswerToLife := jo.GetInteger('AnswerToLife');
  fName := jo.GetString('Name');
end;

procedure TGeneratedClass.SaveToJSON(jo : IJSONObject);
var
  jaItems: IJSONArray;
begin
  jaItems := TJSON.NewArray;
  fItems.SaveToJSON(jaItems);
  jo.Put('Items', jaItems);
  jo.Put('AnswerToLife', fAnswerToLife);
  jo.Put('Name', fName);
end;

end. 

11.10.2013

Moving my public repositories

I am moving my public repositories from Google Code to Bitbucket and also from SVN to git. So far these repositories have moved: delphi-xe-json: https://bitbucket.org/Gloegg/delphi-xe-json delphi-redis: https://bitbucket.org/Gloegg/delphi-redis

16.08.2013

How to include source, debug DCUs and release DCUs in the Delphi-Options

Once again, StackOverflow proves to be a source of useful information:
This answer on SO explains how libraries should be included in the Delphi-Options.
In a nutshell:
  1. Library Path = Release DCUs
  2. Browsing Path = Source
  3. Debug DCU Path = Debug DCUs

16.07.2013

New Repository: Delphi-Helpers

I am planning to collect all my little helper units in a single repository.
I'm starting with TSpecialFolder.
  TSpecialFolder = record
  private
    class function GetSpecialFolder(CSIDL: Integer) : string; static;
    class function GetProgramFiles : string; static;
    class function GetProgramFilesX86 : string; static;
    class function GetUserDocuments : string; static;
    class function GetAppData : string; static;
    class function GetCommonAppData : string; static;
    class function getTempPath: string; static;
  public
    class property ProgramFiles : string read GetProgramFiles;
    class property ProgramFilesX86 : string read GetProgramFilesX86;
    class property UserDocuments : string read GetUserDocuments;
    class property UserAppData : string read GetAppData;
    class property CommonAppData : string read GetCommonAppData;
    class property TempPath : string read getTempPath;
  end;

Usage:
procedure Save;
begin
  SaveDialog1.InitialDir := TSpecialFolder.UserDocuments;
  if SaveDialog1.Execute then
  begin
    // Save the file
  end;
end;
You can get the unit from my delphi-helpers git repository https://code.google.com/p/delphi-helpers/

BTW: You can now vote for this blog to be added to DelphiFeeds.com: Vote here

Some concepts for a Delphi Webserver with API versioning

When I began programming at my first company in a practical semester, the very first application I wrote, used TCP/IP to communicate with the existing applications. Almose every application I developed since, was using some kind of network communication to control another application or to be controlled by other applications. Over the years, I added other platforms (iOS and Android), which controlled the delphi applications. In every new project, I tried to tune the server side a little bit, to make my life easier.

Recently, I extended the server part to support multiple versions of an API.

The idea is that there is one IWebAPI interface, which represents the public API. The TAbstractAPI "implements" this interface. The real API classes inherit from this class and implement the methods they want. Having an abstract class between the interface and the implementation releases the real API classes from having to implement every method from the interface.

The API classes register themselves in a TWebAPIFactory, which will instantiate these classes when needed.

An example of an API
unit WebAPI.Version1;

interface // empty interface section, I think Nick Hodges would like this ;-) (http://www.nickhodges.com/post/Getting-Giddy-with-Dependency-Injection-and-Delphi-Spring-5-Delphi-Spring-Basics.aspx)

implementation

uses
  JSON, WebAPI.Abstract, WebAPI.Factory;

type
  TWebAPIVersion1 = class(TAbstractAPI)
    function ReverseString(jo: IJSONObject): string; override;
  end;

{ TWebAPIVersion1 }

function TWebAPIVersion1.ReverseString(jo: IJSONObject): string;
var
  ch: char;
begin
  result := '';
  for ch in jo.GetString('value') do
  begin
    result := ch + result;
  end;
end;

initialization

begin
  TWebAPIFactory.RegisterAPI('1', TWebAPIVersion1);
end;

end.

Another concept, which has been used in my previous applications is that the methods of the api are not called directly. Instead, Rtti is used to invoke the right method.
class function TWebAPIInvoker.Invoke(const aAPI: IWebAPI; const aCommand: string; aParam: IJSONObject): string;
var
  o: TObject;
  ctx: TRttiContext;
  typ: TRttiType;
  m: TRttiMethod;
begin
  o := TObject(aAPI);
  typ := ctx.GetType(o.ClassInfo);
  m := typ.GetMethod(aCommand);
  if assigned(m) then
  begin
    result := m.Invoke(o, [TValue.From<IJSONObject>(aParam)]).AsString;
  end
  else
  raise Exception.Create('Unknown Command: "' + aCommand + '"');
end;
I used the IJSONObject from my JSON-Library as a parameter, because it has been proven to be a reliable format for passing complex data over the borders of applications.

These concepts are glued together in the datamodule, that holds an IdHTTPServer.
procedure TdmWebserver.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  if isAPIRequest(ARequestInfo.Document) then
    HandleAPIRequest(AContext, ARequestInfo, AResponseInfo)
  else // Is File Request
    HandleFileRequest(AContext, ARequestInfo, AResponseInfo);
end;

function TdmWebserver.isAPIRequest(const aDocument: string): boolean;
begin
  result := aDocument.StartsWith('/api/');
end;

procedure TdmWebserver.HandleAPIRequest(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  documentParts: TArray<string>;
  version, command: string;
  api: IWebAPI;
  i: integer;
begin
  // e.g. /api/1/ReverseString
  documentParts := ARequestInfo.Document.Split(['/'], TStringSplitOptions.ExcludeEmpty);
  version := documentParts[1];
  command := '';
  for i := 2 to high(documentParts) do
  begin
    command := command + documentParts[i];
  end;
  api := TWebAPIFactory.newAPI(version);
  AResponseInfo.ContentText := TWebAPIInvoker.Invoke(api, command, nil)
end;

It is a work in progess, so use it carefully!
Delphi XE3 is required.

You can get the source code from the git repository at http://code.google.com/p/delphi-webapi/

10.02.2013

Delphi XE JSON Update

I recently updated my JSON-Library. Both, IJSONObject and IJSONArray now have methods to check for the type of the nested items.
IJSONObject = interface
['{D00A665F-3CBB-4DDB-8300-FB8020DA564B}']
  .
  .
  .
  function isJSONObject(aKey : string) : boolean;
  function isJSONArray(aKey : string) : boolean;
  function isString(aKey : string) : boolean;
  function isInteger(aKey : string) : boolean;
  function isBoolean(aKey : string) : boolean;
  function isDouble(aKey : string) : boolean;
end;

IJSONArray = interface
['{B120D59A-1D00-469E-97CE-AE2A635A51ED}']
  .
  .
  .
  function isJSONObject(aIndex : integer) : boolean;
  function isJSONArray(aIndex : integer) : boolean;
  function isString(aIndex : integer) : boolean;
  function isInteger(aIndex : integer) : boolean;
  function isBoolean(aIndex : integer) : boolean;
  function isDouble(aIndex : integer) : boolean;
end;

Usage:
var
  jo : IJSONObject;
begin
  jo := TJSON.NewObject('{"string":"abc", "integer":123}');

  jo.isString('string'); // true
  jo.isInteger('integer'); // true
  jo.isBoolean('string'); // false
end;
The implementation is very strict, e.g. isDouble will return false if the value is an integer and could be accessed as a double. I also included unit tests to cover these methods.

tracert -h 60 obiwan.scrye.net

Someone had fun with the routing at Beaglenetworks
Routenverfolgung zu obiwan.scrye.net [216.81.59.173] über maximal 60 Abschnitte:

  7   137 ms   127 ms   127 ms  10gigabitethernet1-2.core1.atl1.he.net [184.105.213.110] 
  8   126 ms   126 ms   127 ms  216.66.0.26 
  9     *        *        *     Zeitberschreitung der Anforderung.
 10   163 ms   165 ms   164 ms  Episode.IV [206.214.251.1] 
 11   193 ms   166 ms   164 ms  A.NEW.HOPE [206.214.251.6] 
 12   169 ms   164 ms   167 ms  It.is.a.period.of.civil.war [206.214.251.9] 
 13   168 ms   164 ms   166 ms  Rebel.spaceships [206.214.251.14] 
 14   169 ms   163 ms   164 ms  striking.from.a.hidden.base [206.214.251.17] 
 15   169 ms   165 ms   165 ms  have.won.their.first.victory [206.214.251.22] 
 16   165 ms   167 ms   165 ms  against.the.evil.Galactic.Empire [206.214.251.25] 
 17   165 ms   164 ms   168 ms  During.the.battle [206.214.251.30] 
 18   166 ms   164 ms   165 ms  Rebel.spies.managed [206.214.251.33] 
 19   166 ms   167 ms   162 ms  to.steal.secret.plans [206.214.251.38] 
 20   166 ms   165 ms   163 ms  to.the.Empires.ultimate.weapon [206.214.251.41] 
 21   165 ms   163 ms   164 ms  the.DEATH.STAR [206.214.251.46] 
 22   168 ms   166 ms   167 ms  an.armored.space.station [206.214.251.49] 
 23   164 ms   169 ms   167 ms  with.enough.power.to [206.214.251.54] 
 24   164 ms   189 ms   168 ms  destroy.an.entire.planet [206.214.251.57] 
 25   170 ms   168 ms   174 ms  Pursued.by.the.Empires [206.214.251.62] 
 26   166 ms   169 ms   167 ms  sinister.agents [206.214.251.65] 
 27   166 ms   163 ms   166 ms  Princess.Leia.races.home [206.214.251.70] 
 28   168 ms   163 ms   163 ms  aboard.her.starship [206.214.251.73] 
 29   168 ms   171 ms   165 ms  custodian.of.the.stolen.plans [206.214.251.78] 
 30   169 ms   172 ms   168 ms  that.can.save.her [206.214.251.81] 
 31   166 ms     *      165 ms  people.and.restore [206.214.251.86] 
 32   168 ms   167 ms   164 ms  freedom.to.the.galaxy [206.214.251.89] 
 33   166 ms   166 ms   164 ms  0-------------------0 [206.214.251.94] 
 34   165 ms   170 ms   166 ms  0------------------0 [206.214.251.97] 
 35   168 ms   170 ms   164 ms  0-----------------0 [206.214.251.102] 
 36   166 ms   169 ms   168 ms  0----------------0 [206.214.251.105] 
 37   167 ms   168 ms   164 ms  0---------------0 [206.214.251.110] 
 38   163 ms   165 ms   165 ms  0--------------0 [206.214.251.113] 
 39   167 ms   171 ms   166 ms  0-------------0 [206.214.251.118] 
 40   167 ms   166 ms   172 ms  0------------0 [206.214.251.121] 
 41   166 ms   165 ms   165 ms  0-----------0 [206.214.251.126] 
 42   172 ms   169 ms   172 ms  0----------0 [206.214.251.129] 
 43   165 ms   168 ms   166 ms  0---------0 [206.214.251.134] 
 44   168 ms   163 ms   168 ms  0--------0 [206.214.251.137] 
 45   166 ms   167 ms   260 ms  0-------0 [206.214.251.142] 
 46   166 ms   164 ms   173 ms  0------0 [206.214.251.145] 
 47   164 ms   167 ms   165 ms  0-----0 [206.214.251.150] 
 48   168 ms   166 ms   168 ms  0----0 [206.214.251.153] 
 49   166 ms   164 ms   168 ms  0---0 [206.214.251.158] 
 50   184 ms   171 ms   169 ms  0--0 [206.214.251.161] 
 51   168 ms   170 ms   168 ms  0-0 [206.214.251.166] 
 52   165 ms   168 ms   169 ms  00 [206.214.251.169] 
 53   172 ms   169 ms   165 ms  I [206.214.251.174] 
 54   171 ms   169 ms   169 ms  By.Ryan.Werber [206.214.251.177] 
 55   171 ms   168 ms   171 ms  When.CCIEs.Get.Bored [206.214.251.182] 
 56   167 ms   168 ms   173 ms  read.more.at.beaglenetworks.net [206.214.251.185] 
 57   179 ms   170 ms   166 ms  FIN [216.81.59.173] 

Ablaufverfolgung beendet.

31.01.2013

Instacode

Instacode is for developers what Instagram is for hipsters. Just paste your code into the textfield and choose the level of "hipness" to get a nice image of your code. The range of supported languages is amazing and our beloved Delphi is supported as well.

The service is currently not working, due to the heavy load of users, that are trying to "beautify" their code.
Here's an example from the website:


PS: If you are visiting the site with IE, you are in for a treat ;-)

28.01.2013

Delphi and Sleepsort

A while ago, someone on 4chan posted a fun sorting algorithm. It is called Sleepsort and is not recommended to be usedin production. However, I thought it would be fun to implement it in Delphi. Here it is (for your amusement):
program Sleepsort;

var
  items: TArray<integer>;
  i: integer;

begin
  randomize;
  writeln('Random: ');
  setlength(items, 25);
  for i := 0 to High(items) do
  begin
    items[i] := random(length(items) * 4);
    write(IntToStr(items[i]) + ' ');
  end;
  writeln;
  writeln('Sorted: ');
  for i := 0 to high(items) do
  begin
     TSortThread.Create(items[i]);
  end;
  readln;
end.
unit uSortThread;

interface

uses
  Classes;

type
  TSortThread = class (TThread)
  private
    fValue : integer;
  protected
    procedure Execute; override;
  public
    constructor Create(n : integer);
  end;

implementation

uses SysUtils;

constructor TSortThread.Create(n: integer);
begin
  inherited Create;
  fValue := n;
end;

procedure TSortThread.Execute;
begin
  sleep(fValue * 333); // artificial slowdown, to make the process visible for the human eye
  write(IntToStr(fValue)+' ');
end;

end.