Gloegg

Recent additions to delphi-xe-json

2013-10-18T21:37:00.000+02:00

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.

Moving my public repositories

2013-10-11T11:12:00.002+02:00

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

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

2013-08-16T14:28:00.002+02:00

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:

Library Path = Release DCUs
Browsing Path = Source
Debug DCU Path = Debug DCUs

New Repository: Delphi-Helpers

2013-07-16T23:06:00.002+02:00

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

2013-07-16T22:51:00.001+02:00

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/

Delphi XE JSON Update

2013-02-10T16:59:00.000+01:00

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

2013-02-10T16:43:00.001+01:00

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     *        *        *     Zeitberschreitung 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.

Instacode

2013-01-31T16:03:00.001+01:00

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

Delphi and Sleepsort

2013-01-28T21:58:00.000+01:00

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.

Delphi and Redis

2012-02-18T14:10:00.000+01:00

Redis is short for Remote Dictionary Server and it is a NoSQL-Database or more specific, a Key-Value-Store. Since there was no Client for Delphi, I decided to write one by myself.

The project is available on Google Code: http://code.google.com/p/delphi-redis/

It uses the Indy TCP Client by default, but you can use either Constructor or Property Injection to switch to another implementation.

Delphi and JSON

2012-02-01T21:28:00.000+01:00

I am currently developing my own JSON Library for Delphi. There are already libraries for that, but none of them suited my needs.
There is the built-in DBXJSON, which is used in the DataSnap part of Delphi. However, it is a bit of a hassle to work with.
There is TlkJSON from Simon Stuart, which has (or had, I don't know the current status) some problems with Umlauts (ä,ö,ü,ß, etc.)
There is the Delphi Web Utils from Jose Fabio N Almeida, which has some memory issues and other bugs, and most importantly, does not work well under XE2. It also hasn't been updated for a while.
And there is the SuperObject which is very powerful, but it has IMO a horrible syntax.

Since I was using the Delphi Web Utils before and I didn't want to rewrite all my other code when switching libraries, I designed my Interfaces and Classes in a similar way, e.g. the objects and array have methods named "Put" and "GetString".

I have released my library on Google Code. You can check it out via subversion or you can download the zipfile. Any feedback or help is appreciated. It uses Generics, Rtti (for TValue) and Regular Expressions, which is why it is targeted only for newer versions of Delphi (XE and XE2).

Delphi and RTTI / Class Helper

2011-10-23T10:43:00.000+02:00

In many of my applications I have some data-objects which look something like this:

type
  TMyObject = class
  private
    fInt: integer;
    fDouble: double;
    fBool: boolean;
  public
    property IntegerProp : integer read fInt write fInt;
    property DoubleProp : double read fDouble write fDouble;
    property BoolProp : boolean read fBool write fBool;
  end;

Writing a SaveToFile and LoadFromFile for each is tedious work and if I change the object I have to change the two procedures as well. With Delphis support for RTTI and class helpers we can get rid of the tedious work. I am using a class helper for TObject, so technically its possible to do this with every object.

  TSerialHelper = class helper for TObject
  private
    function isPublicProperty(aProperty : TRttiProperty): boolean;
  public
    function Serialize(aHumanreadable : boolean = true) : string;
    procedure Deserialize(const text : string);
  end;

And here is the implementation:

function TSerialHelper.Serialize(aHumanreadable : boolean = true): string;
var
  context : TRttiContext;
  typ : TRttiType;
  prop : TRttiProperty;
  soJSON : ISuperObject;
  value : TValue;
begin
  context := TRttiContext.Create;
  try
    typ := context.GetType(self.ClassType);
    soJSON := SO; // Get Superobject Interface
    for prop in typ.GetProperties do
    begin
      if isPublicProperty(prop) and prop.IsWritable then
      begin
        value := prop.GetValue(self);
        case value.Kind of
          tkInteger, tkInt64 :
            soJSON.I[prop.Name] := value.AsInteger;
          tkEnumeration:
            if value.IsType<boolean> then
              soJSON.B[prop.Name] := value.AsBoolean;
          tkFloat:
            soJSON.D[prop.Name] := value.AsExtended;
          tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
            soJSON.S[prop.Name] := value.AsString;
        end;
      end;
    end;
    result := soJSON.AsJSon(aHumanreadable);
  finally
    context.Free;
  end;
end;

procedure TSerialHelper.Deserialize(const text: string);
var
  context : TRttiContext;
  typ : TRttiType;
  prop : TRttiProperty;
  soJSON : ISuperObject;
begin
  context := TRttiContext.Create;
  try
    soJSON := SO(text); // Init the Superobject Interface
    typ := context.GetType(self.ClassType);
    for prop in typ.GetProperties do
    begin
      if isPublicProperty(prop) and prop.IsWritable then
      begin
        case prop.PropertyType.TypeKind of
          tkInteger, tkInt64 :
            prop.SetValue(self, TValue.From<int64>(soJSON.I[prop.Name]));
          tkEnumeration:
            if prop.GetValue(self).IsType<boolean> then
              prop.SetValue(self, TValue.From<boolean>(soJSON.B[prop.Name]));
          tkFloat:
            prop.SetValue(self, TValue.From<double>(soJSON.D[prop.Name]));
          tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
            prop.SetValue(self, TValue.From<string>(soJSON.S[prop.Name]));
        end;
      end;
    end;
  finally
    context.Free;
  end;
end;

function TSerialHelper.isPublicProperty(aProperty: TRttiProperty): boolean;
begin
  result := aProperty.Visibility in [mvPublic, mvPublished];
end;

It is not finished, since it can't serialize sets, arrays or childobjects, but so far it works for simple objects.

You can download the unit here.
This unit uses the SuperObject by Henri Gourvest

Delphi and TPropertyObserver

2011-07-24T21:41:00.000+02:00

In Delphi you can use RTTI (RunTime Type Information) to get information about objects at runtime without knowing about them at compile time. To find out more about RTTI, you should check out these articles by Robert Love.

I used the RTTI to make an observer, that informs me, whenever a specific property gets changed. It is far from being complete, there are a lot of TypeKinds that I didn't implement a compare for. The observer could also be extended to support multiple properties.

uses
  Rtti, Classes;

type
  TProc = reference to procedure;
  TPropertyObserver = class
  private
    fTerminated : boolean;
  public
    constructor Create(aInstance : TObject; aPropertyName : string; aOnChange : TProc);
    procedure Terminate;
  end;

implementation

uses
  SysUtils, TypInfo;

{ TPropertyObserver }

constructor TPropertyObserver.Create(aInstance: TObject; aPropertyName: string; aOnChange : TProc);
begin
  TThread.CreateAnonymousThread(procedure
  var
    ctx : TRttiContext;
    t : TRttiType;
    oldValue, curValue : TValue;
    b : boolean;
    p : TRttiProperty;
  begin
    ctx := TRttiContext.Create;
    try
      t := ctx.GetType(aInstance.ClassType);
      p := t.GetProperty(aPropertyName);
      oldValue := p.GetValue(aInstance);
      while not fTerminated do
      begin
        curValue := p.GetValue(aInstance);
        b := false;
        case curValue.Kind of
          tkInt64,
          tkEnumeration,
          tkInteger: b := oldValue.AsOrdinal = curValue.AsOrdinal;
          tkWChar,
          tkLString,
          tkWString,
          tkString,
          tkUString,
          tkChar: b := oldValue.AsString = curValue.AsString;
          tkFloat: b := oldValue.AsExtended = curValue.AsExtended;
          // Some of these should get a compare, too
          tkUnknown: ;
          tkSet: ;
          tkClass: ;
          tkMethod: ;
          tkVariant: ;
          tkArray: ;
          tkRecord: ;
          tkInterface: ;
          tkDynArray: ;
          tkClassRef: ;
          tkPointer: ;
          tkProcedure: ;
        end;
        if not b then
        begin
          aOnChange;
          oldValue := curValue;
        end;
        sleep(10);
      end;
      finally
      ctx.Free;
    end;
  end).Start;
end;

procedure TPropertyObserver.Terminate;
begin
  fTerminated := true;
end;

And how it is used:

procedure TForm1.FormCreate(Sender: TObject);
begin
  fObserver := TPropertyObserver.Create(self,'Left',procedure
  begin
    TThread.Synchronize(TThread.CurrentThread,procedure // Changing the VCL has to be done in the main thread
    begin
      edit1.Text := IntToStr(self.Left);
    end);
  end);
end;

Download is available here.

Delphi and TAppSettings

2011-07-17T18:36:00.000+02:00

Delphi has had Inifle-Support for as long as I can remember. Inifiles are great for storing Application- and Usersettings, but I found myself doing the same things in each Application I wrote. Retrieve an appropiate directory for storing the actual file, creating and freeing the TInifile-Object.
I wanted something that I can just add to my project to store and retrieve simple values in a TInifile-like manner. Here is the result: TAppSettings. It relies on the aforementioned JSON-Library "Delphi Web Utils".

type
  TAppSettings = class
  protected
    fFilename : string;
    fSaveOnFree: boolean;
    fSettings : TJSONObject;
    function createOrGetSection(aSection : string) : TJSONObject;
  public
    constructor Create(aFilename : string);
    destructor Destroy; override;
    procedure Save;

    function getInteger(aSection, aKey : string; aDefault : integer) : integer;
    function getString(aSection, aKey : string; aDefault : string) : string;
    function getFloat(aSection, aKey : string; aDefault : double ) : double;
    function getBool(aSection, aKey : string; aDefault : boolean) : boolean;

    procedure setValue(aSection, aKey : string; aValue : integer); overload;
    procedure setValue(aSection, aKey : string; aValue : string); overload;
    procedure setValue(aSection, aKey : string; aValue : double); overload;
    procedure setValue(aSection, aKey : string; aValue : boolean); overload;

    property SaveOnFree : boolean read fSaveOnFree write fSaveOnFree;
    procedure OpenPathInExplorer;
  end;

As an example the getter and setter for integer:

function TAppSettings.getInteger(aSection, aKey: string;
  aDefault: integer): integer;
var
  section : TJSONObject;
begin
  result := aDefault;
  section := fSettings.optJSONObject(aSection);
  if section <> nil then result := section.optInt(aKey);
end;

function TAppSettings.createOrGetSection(aSection: string): TJSONObject;
begin
  result := fSettings.optJSONObject(aSection);
  if result = nil then
  begin
    result := TJSONObject.create;
    fSettings.put(aSection,result);
  end;
end;

procedure TAppSettings.setValue(aSection, aKey: string; aValue: integer);
var
  section : TJSONObject;
begin
  section := createOrGetSection(aSection);
  section.put(aKey, aValue);
end;

This alone doesn't help with the initial problem, it just changes the format of the file. The interesting part is at the bottom of the unit.

interface

const
  COMPANY_NAME = 'MyCompany';

[...]

var
  AppSettings, UserSettings : TAppSettings;

[...]

function GetSpecialFolder(Folder: Integer): String;
var
  Path: array[0..MAX_PATH] of char;
begin
  If SHGetSpecialFolderPath(0, @Path, Folder, false)
    then Result:=Path
    else Result:='';
end;

function GetApplicationName : string;
begin
  result := ExtractFilename(ParamStr(0));
  delete(result,length(result)-3,4);
end;

initialization
begin
  ForceDirectories(GetSpecialFolder(CSIDL_COMMON_APPDATA)+'\'+COMPANY_NAME+'\'+GetApplicationName);
  ForceDirectories(GetSpecialFolder(CSIDL_APPDATA)+'\'+COMPANY_NAME+'\'+GetApplicationName);
  AppSettings := TAppSettings.Create(GetSpecialFolder(CSIDL_COMMON_APPDATA)+'\'+COMPANY_NAME+'\'+GetApplicationName+'\settings.json');
  UserSettings := TAppSettings.Create(GetSpecialFolder(CSIDL_APPDATA)+'\'+COMPANY_NAME+'\'+GetApplicationName+'\settings.json');
end;

finalization
begin
  AppSettings.Free;
  UserSettings.Free;
end;

Adding this unit to your project automatically creates two Objects of TAppSettings, one for UserSettings and one for ApplicationSettings. Before I wrote TAppSettings I always had two procedures "LoadIni" and "SaveIni" in my application where I would load and save all my application settings, because that were the only places I could access the settings. Now I just use the settings wherever I need them.

You can download the complete unit here.

Delphi and TTaskList

2011-07-09T17:20:00.002+02:00

I was reading about some of the new features in Delphi XE in the new book from Marco Cantu, Delphi XE Handbook. (He also told me about them earlier this year in Frankfurt on the Delphi Developer Days, but I didn't found time to play around with it until now)
The newest Delphi comes with anonymous Threads, which are a very easy way to make your application multithreaded, which is very useful to make some big calculations in the background, while the UI is still responding. However, sometimes you need things to be done in order. Enter TTasklist:

type
  TProc = reference to procedure;
  TTaskList = class
  private
    fTasks : TThreadedQueue<TProc>;
    fTerminated : boolean;
    procedure start;
  public
    constructor Create;
    destructor Destroy; override;
    procedure addTask(aTask : TProc);
    procedure Terminate;
  end;

TTaskList uses a ThreadSafe Queue to store the tasks, which are basically anonymous methods. The constructor creates the queue and starts a new thread which executes one task after another.

constructor TTaskList.Create;
begin
  fTasks := TThreadedQueue<TProc>.Create;
  fTerminated := false;
  start;
end;

procedure TTaskList.addTask(aTask: TProc);
begin
  fTasks.PushItem(aTask);
end;

procedure TTaskList.start;
begin
  TThread.CreateAnonymousThread(
  procedure
  begin
    while not fTerminated do
    begin
      if fTasks.QueueSize > 0 then fTasks.PopItem.Invoke;
    end;
  end
  ).Start;
end;

procedure TTaskList.Terminate;
begin
  fTerminated := true;
end;

destructor TTaskList.Destroy;
begin
  Terminate;
  fTasks.Free;
  inherited;
end;

Download is available here.

Delphi and Geocoding

2011-06-19T11:21:00.000+02:00

Google has some powerful APIs. One of them is the Maps API which is capable of geocoding an address to longitude and latitude information.

It is pretty easy to use this functionality from Delphi. All you need is TIdHttp and a JSON library. (I'm using the Delphi Web Utils)

TLocationType = (ltRooftop, ltRangeInterpolated, ltGeometricCenter, ltApproximate);
  TAddress = class
  private
    fAddress : string;
    fLatitude: double;
    fLongitude: double;
    fLocationType: TLocationType;
  public
    constructor Create(aAddress : string; aHttp : TIdHttp = nil);
    property Address : string read fAddress write fAddress;
    property Latitude : double read fLatitude;
    property Longitude : double read fLongitude;
    property LocationType : TLocationType read fLocationType;
    procedure Geocode(aHttp : TIdHttp);
  end;

The Google API returns a JSON structure with a couple of fields. However, I just grab the longitude and latitude information as well as the location_type, to determine the quality of the coordinates.

procedure TAddress.GeoCode(aHttp: TIdHttp);
var
  url : string;
  jo, location, geometry : TJSONObject;
  sc : TStringCase;
begin
  url := TIdURI.URLEncode('http://maps.google.com/maps/api/geocode/json?address='+fAddress+'&sensor=false');
  jo := TJSONObject.create(aHttp.Get(url));
  if jo.getString('status') = 'OK' then
  begin
    geometry := jo.getJSONArray('results').getJSONObject(0).getJSONObject('geometry');
    location := geometry.getJSONObject('location');
    fLongitude := location.getDouble('lng');
    fLatitude := location.getDouble('lat');

    sc := TStringCase.Create;
    try
      sc.addEntry('ROOFTOP',procedure
      begin
        fLocationType := ltRooftop;
      end);
      sc.addEntry('RANGE_INTERPOLATED',procedure
      begin
        fLocationType := ltRangeInterpolated;
      end);
      sc.addEntry('GEOMETRIC_CENTER',procedure
      begin
        fLocationType := ltGeometricCenter;
      end);
      sc.addEntry('APPROXIMATE',procedure
      begin
        fLocationType := ltApproximate;
      end);
    finally
      sc.switch(geometry.getString('location_type'));
    end;
    sc.Free;
  end
  else raise Exception.Create(jo.getString('status'));
  jo.Free;
end;

I used this and TGoMaps to create a simple application which takes a list of addresses, geocodes them and displays them on a GoogleMap.

Source and binary are available here.

TAddress uses TStringCase from the previous post.

Delphi and TStringCase

2011-06-18T21:00:00.000+02:00

Delphi's Case <X> of statement works with everything that is Ordinal. integer, char, enumerations, it even works with boolean.

case b of
  true : MakeSomething;
  false : DoNotMakeSomething;
end;

However, it does not work with strings. And I've come across some places where it would be very handy to have a Case <String> of.

Luckily, with Delphi 2010 came anonymous methods and with the combination of a Dictionary we can finally have something that works as a Case <String> of.

type
  TProc = reference to procedure;
  TCase<T> = class
  private
    fDict : TDictionary<T,TProc>;
    fElse: TProc;
  public
    constructor Create;
    destructor Destroy; override;
    procedure addEntry(aKey : T; aProc :TProc);
    procedure addEntries(const aKeys : array of T; aProc : TProc);
    procedure switch(aKey : T);
    property ElseCase : TProc read fElse write fElse;
  end;
  TStringCase = TCase<string>;

TStringCase is the type, that will be used the most, but with the generic TCase, (almost) everything can be used for a Case statement.

The implementation is very simple:

procedure TCase<T>.addEntries(const aKeys: array of T; aProc: TProc);
var
  key : T;
begin
  for key in aKeys do
    addEntry(key,aProc);
end;

procedure TCase<T>.addEntry(aKey: T; aProc: TProc);
begin
  fDict.Add(aKey, aProc);
end;

constructor TCase<T>.Create;
begin
  fDict := TDictionary<T,TProc>.Create;
end;

destructor TCase<T>.Destroy;
begin
  fDict.Free;
  inherited;
end;

procedure TCase<T>.switch(aKey: T);
var
  p : TProc;
begin
  if fDict.TryGetValue(aKey, p) then
    p()
  else
    if assigned(fElse) then fElse();
end;

And this is how it's used:

procedure UseStringCase;
var
  sc : TStringCase;
begin
  sc :=TStringCase.Create;
  try
    // setup the case
    sc.addEntry('STRING1',procedure
    begin
      Label1.Caption := 'First Option';
    end);

    sc.addEntry('STRING1',procedure
    begin
      Label1.Caption := 'Second Option';
    end);

    sc.addEntries(['STRING3','STRING4','STRING5'],procedure
    begin
      Label1.Caption := 'one of three options';
    end);

    sc.ElseProc := procedure
    begin
      Label1.Caption := 'Something else';
    end;

    sc.switch(Edit1.Text); // execute the right procedure
  finally
    sc.Free;
  end;

end;

The usage has some overhead compared to the standard case, but I think it is still prettier than a bunch of if-then-else's.

procedure UseIfThenElse;
var
  s : string;
begin
  s := Edit1.Text;
  if s = 'STRING1' then
  begin
    Label1.Caption := 'First Option';
  end
  else if s = 'STRING2' then
  begin
    Label1.Caption := 'Second Option';
  end
  else if (s = 'STRING3') or (s = 'STRING4') or (s = 'STRING5') then
  begin
    Label1.Caption := 'one of three options';
  end
  else
  begin
    Label1.Caption := 'Something else';
  end;
end;

Download is available here.

Delphi and Barcode scanning

2011-06-13T14:02:00.001+02:00

Todays example uses a dll to access a Barcode Scanner. The used Barcode Scanner is the CS1504 (SDK available here).

The CS1504 has a buffer where it stores all scanned barcodes and this buffer can be accessed via a COM-Port. Luckily, the SDK has a dll which takes care of the communication. The only problem is, that the header is written in C/C++. I translated it (in parts) to Delphi, you can grab the file here.

Now we could just use it as is, but it would be much nicer if we had a class to wrap it all up.

We need some object to store the data, which is really simple:

TBarcode = class
  private
    fTimestamp : TDateTime;
    fCode : string;
  public
    constructor Create(aTimestamp : TDateTime; aCode : string);
    property TimeStamp : TDateTime read fTimestamp;
    property Code : string read fCode;
  end;

And now the class that does all the work:

TScanner = class
  private
    fPort : integer;
    fReady : boolean;
    fHasData: boolean;
    function TimestampToDateTime(aTimestamp : Ansistring) : TDateTime;
  public
    constructor Create(aPort : integer);
    destructor Destroy; override;
    function getBarcodes : TList<TBarcode>;
    procedure clearBarcodes;
    property IsReady : boolean read fReady;
    property HasData : boolean read fHasData;
    procedure setDateTime(aDateTime : TDateTime);
    function getDateTime : TDateTime;
  end;

The TScanner class returns a generic TList<TBarcode> with all the Barcodes from the device.

The most important function is of course getBarcodes.

function TScanner.getBarcodes: TList<TBarcode>;
var
  bc : TBarcode;
  i, count, pl : integer;
  buffer : array[0..63] of AnsiChar;
  dt : TDateTime;
  s : string;
begin
  result := TList<TBarcode>.Create;
  begin
    count := csp2ReadData;
    for i := 0 to count -1 do
    begin
      FillChar(buffer,64,#0);
      pl := csp2GetPacket(@buffer,i,63);

      // The Last 4 Bytes hold the timestamp
      dt := TimestampToDateTime(copy(buffer,pl-3,4));

      s := copy(buffer,3,pl-6);
      bc := TBarcode.Create(dt,s);
      result.Add(bc);
    end;
  end;
end;

The implementation is pretty much straight forward, the trickiest part was to convert the 4-byte timestamp from each barcode to TDateTime. They crammed the six values for year, month, day, hour, minute and second into 4 bytes. (seriously, a SD Card that has the size of my fingernail can hold easily 4 GB and they worry about 2 bytes per scanned barcode)

function TScanner.TimestampToDateTime(aTimestamp: Ansistring): TDateTime;
var
  i1,i2,i3,i4,i5,i6 : integer;
  qb : T4Bytes;
  y,m,d,h,n,s : word;
begin
  // CharToByte
  qb.Bytes[3] := Ord(aTimestamp[1]);
  qb.Bytes[2] := Ord(aTimestamp[2]);
  qb.Bytes[1] := Ord(aTimestamp[3]);
  qb.Bytes[0] := Ord(aTimestamp[4]);

  // split up the bits
  i1 := qb.Total and $fc000000; // 6 Bit
  i2 := qb.Total and $03f00000; // 6 Bit
  i3 := qb.Total and $000f8000; // 5 Bit
  i4 := qb.Total and $00007c00; // 5 Bit
  i5 := qb.Total and $000003c0; // 4 Bit
  i6 := qb.Total and $0000003f; // 6 Bit

  // Shift right to align the bits
  s := i1 shr 26;
  n := i2 shr 20;
  h := i3 shr 15;
  d := i4 shr 10;
  m := i5 shr 6;
  y := i6;

  result := EncodeDate(y+2000,m,d) + EncodeTime(h,n,s,0);
end;

This uses T4Bytes which is a packed record.

T4Bytes = packed record
   case Integer of
    0: (Bytes: array[0..3] of Byte);
    1: (Total: Cardinal);
  end;

The bytes are accessible indivudually and as the resulting 4-Byte Cardinal.

Full Sourcecode is available here.

Delphi and Generics

2011-06-13T00:44:00.000+02:00

In this first developer-themed post, I am going to describe some basic stuff, before I delve into some real-world applications.

Delphi 2009 brought Generics to the Delphi-World. And since then, they are found in all of my Applications. Especially Generics.Collections are heavily used by me.

Before Generics.Collections I had to implement a TList for each Class I would like to store a variable amount of Objects. (Or I could use Contnrs.TObjectList and cast to TAnimal everytime I need one, but I don't find that very desirable)

interface

uses
  Classes;

type
  TAnimal = class
  private
    fName : string;
  public
    property Name : string read fName write fName;
  end;
  
  TAnimalList = class (TList)
  private
  procedure putAnimal(Index : integer; Value : TAnimal);
  function getAnimal(Index : integer) : TAnimal;
  public  
    property Items [Index : integer] : TAnimal read getAnimal write setAnimal;
  end;
  
implementation

procedure TAnimalList.putAnimal(Index : integer; Value : TAnimal);
begin
  inherited put(Index, Value);
end;

function TAnimalList.getAnimal(Index : integer) : TAnimal;
begin
  result := (TAnimal) inherited get(Index);
end;

And this is just for TAnimal, if there are any other classes, I would have to copy&paste the code for the List and replace the data types.

With Generics.Collections the same thing looks like this:

interface

uses
  Generics.Collections;

type
  TAnimal = class
  private
    fName : string;
  public
    property Name : string read fName write fName;
  end;

  TAnimalList = TList<TAnimal>

And I don't even need the alias "TAnimalList", I could use "TList<TAnimal>" instead.

Also, it is not limited to Classes, it can hold every datatype like integer, double, boolean and even records. In my case it is even better to use TObjectList<TAnimal>, which automatically frees its containing objects if it is freed.

Since all the Generics.Collectionshave an Enumerator the following is possible:

var
  fAnimals : TList<TAnimal>

procedure init;
var
  a : TAnimal;
begin
  for a in fAnimals do
  begin
    a.DoSomething;
  end;
end;

Generics.Collections has more then some simple Lists up its sleeve. There are also TQueue, which uses FIFO and TStack which uses LIFO to store its contents.

TDictionary is a little different, because its taking two type parameters. One for the key, one for the Value.
A case that I often stumble upon is to store (and recieve) some object or value for a specific string. And then I always use a TDictionary<String,TValue>

There's also a TObjectDictionary, which takes care of memory of the keys, the values or even both.

procedure init;
var
  ownsKeys, ownsValues, ownsBoth : TObjectDictionary<TKey, TValue>
begin
  ownsKeys := TObjectDictionary<TKey, TValue>.Create([doKeys]);
  ownsValues := TObjectDictionary<TKey, TValue>.Create([doValues]);
  ownsBoth := TObjectDictionary<TKey, TValue>.Create([doKeys, doValues]);
end;

That's it for today.

Level Up

2011-06-12T23:41:00.000+02:00

Time for another Level Up. In this week I became a certified Delphi Developer. There is also the Delphi Master Certification, but since this certification deals a lot with DataSnap, which I have not used very much, I don't think I'll take it anytime soon.

I think this is a good opportunity to blog about some techniques I am using in my every day work. Which may help some fellow Delphi Developers, who can learn a thing or two and also give me feedback to improve my work.

For those interested in these kind of posts, you can grab the feed for the "Developer"-Posts right here

DOSPad

2010-11-11T22:20:00.000+01:00

Nachdem die guten Leute von dospad ihren Quellcode veröffentlicht haben, konnte ich ohne Jailbreak den DOSBox-Port fürs iPad installieren. Und das öffnet natürlich eine Reihe von Möglichkeiten.
Aber ich lass erstmal ein paar Bilder für sich sprechen:

Xenon2

Monkey Island 1

Civilization 1

Desweiteren hatte ich noch Crystal Caves, Ascendancy und Doom ausprobiert. Davon läuft aber nur Crystal Caves einigermaßen flüssig. Doom ist unspielbar und Ascendancy mag er garnicht starten.

Wegen der eingeschränkten Tastatur sind Spiele mit hohem Geschicklichkeitsfaktor leider noch schwieriger als sie normalerweise sind. Desweiteren ist es schade, das es den Rechtsklick nicht im Fullscreenmodus gibt. Soweit ich weiß gibt es auch noch keine Unterstützung für externe Tastaturen, die soll aber noch kommen.

Fazit: Als Spielerei ganz nett, aber echte iPhone-Varianten von Spielen sind deutlich einfacher zu handlen.

PS: Als nächstes könnte man mal Win 3.11 probieren...

Studienbücher

2010-11-08T14:17:00.000+01:00

Gestern überkam es mich und ich habe tatsächlich mein Bücherregal aufgeräumt. Und schweren Herzens habe ich mich entschlossen ein paar alte Studienbücher von mir zu versteigern.

Von den folgenden vier konnte ich mich trennen:

Mathematik für Ingenieure und Naturwissenschaftler 1 - Lothar Papula
Mathematik für Ingenieure und Naturwissenschaftler 2 - Lothar Papula
Taschenbuch der Physik - Horst Kuchling
Taschenbuch der Elektrotechnik und Elektronik - Helmut Lindner, Harry Brauer, Constans Lehmann

Alle Bücher sind in einem guten bis Top-Zustand.

Hier der Link zu den eBay-Auktionen: http://shop.ebay.de/real_gloegg/m.html

Not my president

2010-06-02T10:07:00.002+02:00

Nur weil 'gefühlt' jedes zweite Kind in Deutschland aus ihrer Lende kam, ist sie noch lange nicht als "Mutter der Nation" qualifiziert.

Wer das Volk belügt, darf nicht Bundespräsidentin werden!
Link 1
Link 2

Chips mit Geschmack

2010-05-21T10:18:00.000+02:00

Ich bin ja durchaus ein Freund von speziellen Chipssorten. Gut das Walkers momentan gleich 5 ausgefallene Sorten im Angebot hat.

Die German Bratwurst schmeckt tatsächlich nicht schlecht und auch der American Cheeseburger ist lecker. Die restlichen Sorten werden dann beim Mittag verköstigt.

Warum ich Oracle hasse

2010-04-21T15:03:00.000+02:00

Grund #4312

CREATE TABLE T (
  id number,
  value float)
INSERT INTO T (id, value) VALUES (1, 3.3)
SELECT * FROM T
ID    Value
 1    3.29999981356

q.e.d.