From Zero To One » Coding

How to make a very small windows service executable

Iztok Kacin — Wed, 06 Apr 2011 15:51:19 +0000

I a recent stack overflow question, a user asked how to make a Delphi generated NT Service executable smaller. There was some debate, if Delphi was appropriate to do this and if the executable size it generates was to big. Let me answer those two question as I see them:

The size is not to big. In today desktop environment a megabyte, or few of them don’t matter. The difference between 50K and 1MB executable just doesn’t matter. There is enough RAM and hard drive space, that very few situations need a smaller executable.
And in cases when you need that, you can get to that in Delphi. You don’t need C/C++. Sure you can make the same result there, but why? Even if you only use API calls, you can still reuse some of the low level code you have written in Delphi. And that is a good enough reason to do it in your known IDE and language. You already know your tool and can save a lot of time not writing support code you already have written.

Ok, so I dusted off a very old example I made years back and recompiled it with the Delphi 2006 and Delphi XE compiler. (I have those currently at hand). The result are:

Delphi 2006: 526 KB
Delphi XE: 1018 KB

These are the result of opening a new service application and just clicking build. No settings were adjusted. Then I cleaned that old example a little removed the unneeded code and made sure it works (I tested the service). The results were the following:

Delphi 2006: 22 KB
Delphi XE: 32 KB

~~Here I striped XE version of RTTI as suggested on stack overflow~~ (actually as there is only procedural code the RTTI has no effect whatsoever on the code as noticed by Cris). I left the Delphi 2006 intact. The code I used is posted bellow. It is basically a service skeleton made of two parts. One is the part that installs and controls the service. And the other is the service code itself that spawns a new “service control manager” attached process and then just waits until it is told to stop. It also reports the status to SCM.

And now the challenge. How small can you make a static linked, single c/c++ executable service. It would be fun to know. I will play more with this latter trying different compiler settings and other tricks to see it I can squeeze a byte or two out of my current size

A word of advice. Do not just copy and paste the sample service skeleton. It is just a prototype to show what can be done. It is in no way complete and does not have good error coverage. If enough people finds it important I can finish the code and polish it, but otherwise it is not worth the time.

{
  NT Service  model based completely on API calls. Version 0.1
  Inspired by NT service skeleton from Aphex
  Adapted by Runner
}
 
program PureAPIService;
 
{$APPTYPE CONSOLE}
 
uses
  Windows,
  WinSvc;
 
const
  ServiceName     = 'PureAPIService';
  DisplayName     = 'Pure Windows API Service';
  NUM_OF_SERVICES = 2;
 
var
  ServiceStatus : TServiceStatus;
  StatusHandle  : SERVICE_STATUS_HANDLE;
  ServiceTable  : array [0..NUM_OF_SERVICES] of TServiceTableEntry;
  Stopped       : Boolean;
  Paused        : Boolean;
 
var
  ghSvcStopEvent: Cardinal;
 
procedure OnServiceCreate;
begin
  // do your stuff here;
end;
 
procedure AfterUninstall;
begin
  // do your stuff here;
end;
 
procedure ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD);
begin
  // fill in the SERVICE_STATUS structure.
  ServiceStatus.dwCurrentState := dwCurrentState;
  ServiceStatus.dwWin32ExitCode := dwWin32ExitCode;
  ServiceStatus.dwWaitHint := dwWaitHint;
 
  case dwCurrentState of
    SERVICE_START_PENDING: ServiceStatus.dwControlsAccepted := 0;
    else
      ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;
  end;
 
  case (dwCurrentState = SERVICE_RUNNING) or (dwCurrentState = SERVICE_STOPPED) of
    True: ServiceStatus.dwCheckPoint := 0;
    False: ServiceStatus.dwCheckPoint := 1;
  end;
 
  // Report the status of the service to the SCM.
  SetServiceStatus(StatusHandle, ServiceStatus);
end;
 
procedure MainProc;
begin
  // we have to do something or service will stop
  ghSvcStopEvent := CreateEvent(nil, True, False, nil);
 
  if ghSvcStopEvent = 0 then
  begin
    ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
    Exit;
  end;
 
  // Report running status when initialization is complete.
  ReportSvcStatus( SERVICE_RUNNING, NO_ERROR, 0 );
 
  // Perform work until service stops.
  while True do
  begin
    // Check whether to stop the service.
    WaitForSingleObject(ghSvcStopEvent, INFINITE);
    ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
    Exit;
  end;
end;
 
procedure ServiceCtrlHandler(Control: DWORD); stdcall;
begin
  case Control of
    SERVICE_CONTROL_STOP:
      begin
        Stopped := True;
        SetEvent(ghSvcStopEvent);
        ServiceStatus.dwCurrentState := SERVICE_STOP_PENDING;
        SetServiceStatus(StatusHandle, ServiceStatus);
      end;
    SERVICE_CONTROL_PAUSE:
      begin
        Paused := True;
        ServiceStatus.dwcurrentstate := SERVICE_PAUSED;
        SetServiceStatus(StatusHandle, ServiceStatus);
      end;
    SERVICE_CONTROL_CONTINUE:
      begin
        Paused := False;
        ServiceStatus.dwCurrentState := SERVICE_RUNNING;
        SetServiceStatus(StatusHandle, ServiceStatus);
      end;
    SERVICE_CONTROL_INTERROGATE: SetServiceStatus(StatusHandle, ServiceStatus);
    SERVICE_CONTROL_SHUTDOWN: Stopped := True;
  end;
end;
 
procedure RegisterService(dwArgc: DWORD; var lpszArgv: PChar); stdcall;
begin
  ServiceStatus.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
  ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
  ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
  ServiceStatus.dwServiceSpecificExitCode := 0;
  ServiceStatus.dwWin32ExitCode := 0;
  ServiceStatus.dwCheckPoint := 0;
  ServiceStatus.dwWaitHint := 0;
 
  StatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
 
  if StatusHandle <> 0 then
  begin
    ReportSvcStatus(SERVICE_RUNNING, NO_ERROR, 0);
    try
      Stopped := False;
      Paused  := False;
      MainProc;
    finally
      ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
    end;
  end;
end;
 
procedure UninstallService(const ServiceName: PChar; const Silent: Boolean);
const
  cRemoveMsg = 'Your service was removed sucesfuly!';
var
  SCManager: SC_HANDLE;
  Service: SC_HANDLE;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then
    Exit;
  try
    Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);
    ControlService(Service, SERVICE_CONTROL_STOP, ServiceStatus);
    DeleteService(Service);
    CloseServiceHandle(Service);
    if not Silent then
      MessageBox(0, cRemoveMsg, ServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
  finally
    CloseServiceHandle(SCManager);
    AfterUninstall;
  end;
end;
 
procedure InstallService(const ServiceName, DisplayName, LoadOrder: PChar;
  const FileName: string; const Silent: Boolean);
const
  cInstallMsg = 'Your service was Installed sucesfuly!';
  cSCMError = 'Error trying to open SC Manager';
var
  SCMHandle  : SC_HANDLE;
  SvHandle   : SC_HANDLE;
begin
  SCMHandle := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
 
  if SCMHandle = 0 then
  begin
    MessageBox(0, cSCMError, ServiceName, MB_ICONERROR or MB_OK or MB_TASKMODAL or MB_TOPMOST);
    Exit;
  end;
 
  try
    SvHandle := CreateService(SCMHandle,
                              ServiceName,
                              DisplayName,
                              SERVICE_ALL_ACCESS,
                              SERVICE_WIN32_OWN_PROCESS,
                              SERVICE_AUTO_START,
                              SERVICE_ERROR_IGNORE,
                              pchar(FileName),
                              LoadOrder,
                              nil,
                              nil,
                              nil,
                              nil);
    CloseServiceHandle(SvHandle);
 
    if not Silent then
      MessageBox(0, cInstallMsg, ServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
  finally
    CloseServiceHandle(SCMHandle);
  end;
end;
 
procedure WriteHelpContent;
begin
  WriteLn('To install your service please type  /install');
  WriteLn('To uninstall your service please type  /remove');
  WriteLn('For help please type  /? or /h');
end;
 
begin
  if (ParamStr(1) = '/h') or (ParamStr(1) = '/?') then
    WriteHelpContent
  else if ParamStr(1) = '/install' then
    InstallService(ServiceName, DisplayName, 'System Reserved', ParamStr(0), ParamStr(2) = '/s')
  else if ParamStr(1) = '/remove' then
    UninstallService(ServiceName, ParamStr(2) = '/s')
  else if ParamCount = 0 then
  begin
    OnServiceCreate;
 
    ServiceTable[0].lpServiceName := ServiceName;
    ServiceTable[0].lpServiceProc := @RegisterService;
    ServiceTable[1].lpServiceName := nil;
    ServiceTable[1].lpServiceProc := nil;
 
    StartServiceCtrlDispatcher(ServiceTable[0]);
  end
  else
    WriteLn('Wrong argument!');
end.

Contact on the blog

Iztok Kacin — Wed, 16 Mar 2011 21:52:17 +0000

If you tried to contact me via the contact page in the last few days, I was not reachable. The reason is, that I changed my gmail account password and forgot to change it in wordpress SMTP plugin. So if you did not receive a response, please try again and sorry for the inconvenience.

New version of SimpleStorage and other updates

Iztok Kacin — Tue, 15 Mar 2011 19:33:56 +0000

Quite a lot of new code got piled up so without further ado here are the news.

(You can get all new releases from the download page)

SimpleStorage

This a new major release (1.7.3) of SimpleStorage. And sadly also a breaking one. At least if you were writing your own filters and adapters. There was no other way around if I wanted to write a good and clean code. All changes that were made revolve around filters and adapters. Here is the list of important changes

Filters were extended to the document level. This means you can now compress and encrypt XML nodes or whole document in a transparent manner.
Chaining was introduced to filters. This means you can now encrypt and compress a document in a single step or if you like, in a single line of code
Encryption and compression are now integral part of SimpleStorage and no third party components are needed anymore.
Adapters and Filter now use cleaner approach, so no more strings as identifiers, to specify which filter or adapter you want.

Let me give you some examples:

Compressing and the encrypting a whole document.

NormalXML.Filter(ZLIB).Filter(XTEA('MyStrongKey')).SaveToFile(FilteredXMLFileTwo);

The same but using a document fiter chain interface.

DocumentFilterChain := CreateDocumentFilterChain;
DocumentFilterChain.AddFilter(CompressedStorage);
DocumentFilterChain.AddFilter(EncryptedStorage('MyStrongKey'));
NormalXML := DocumentFilterChain.LoadFromFile(FilteredXMLFileOne);
NormalXML.SaveToFile(NormalXMLFileOne);

Compressing using the compressed storage interface.

CompressedStorage.SaveToFile(DecompressedXML, CompressedXMLFileOne);

Compressing using the build in ZLIB filter.

DecompressedXML.Filter(ZLIB).SaveToFile(CompressedXMLFileTwo);

Do you see how simple it is to compress and encrypt a XML document. The other change is in the adapter code. There are no more strings to specify which adapter to use. It looks like this:

  SS.Ensure('MemTable').Adapter(DataSet).Load(ClientDS);

and

  SS.Get('MemTable').Adapter(DataSet).Save(ClientDS);

There are other smaller changes, but this are the major ones. Just a warning here. If you were writing adapters or filters (your own) then this is a breaking release and you will have to update your code to the new specifications. The examples that come withe the library are clear enough that it should be a breeze. For normal user nothing changes and the code will stay the same. I also left the old version of SimpleStorage available for download if people don’t want to upgrade right away.

Also I would like to announce that I will begin writing basic documentation for SimpleStorage.

ISAPIServer

This is a new component in the library. It is a standalone ISAPI server capable of processing Delphi ISAPI modules. You don’t need Apache or IIS. And it is build in the way, that you can use your favorite HTTP library to use it. It comes with already made bindings for Indy, but it would be equally simple to do bindings for Synapse or ICS. This is possible because it is designed in a very modular way. If any of you are interested in that, you can contact me and I can help with it. I am posting the whole ISAPI request code for Indy as an example:

procedure TfMain.HTTPServerCommandGet({$IFDEF Indy9}
                                        AThread: TIdPeerThread;
                                      {$ELSE}
                                        AContext: TIdContext;
                                      {$ENDIF}
                                      ARequestInfo: TIdHTTPRequestInfo;
                                      AResponseInfo: TIdHTTPResponseInfo);
var
  ECB: TECBData;
  Port: string;
  TempStr: string;
  PathStr: string;
  RootDir: string;
  DDLFileName: string;
begin
  TempStr := Copy(ARequestInfo.Document, 2, Length(ARequestInfo.Document));
  RootDir := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
  PathStr := '/' + StrAfter('/', TempStr);
  DDLFileName := StrBefore('/', TempStr);
 
  {$IFDEF Indy9}
    Port := IntToStr(AThread.Connection.Socket.Binding.Port);
  {$ELSE}
    Port := IntToStr(AContext.Binding.Port);
  {$ENDIF}
 
  ECB := ECBDataList.AcquireNewECB;
  try
    FillECBFromRequest(ECB, HTTPServer.KeepAlive, ARequestInfo, RootDir, DDLFileName, Port, PathStr);
    try
      FISAPIServer.Execute(DDLFileName, ECB);
    finally
      FillResponseFromECB(ECB, AResponseInfo);
    end;
  finally
    ECBDataList.DeleteECB(ECB.ECB.ConnID);
  end;
end;

RoboMailer

This is also a new component. It is intended as a simplified mass mailer component. It can also be used to send a single mail easily with no worries on how to set everything up correctly. It comes with a demo application, which can send mass mails. You can personify each mail with the data you provide. Maybe it will be of use to somebody. It uses ICS as an engine.

Threading unit

This unit got two interesting additions. First one is a lock free stack based on the windows API. No home made code here, just a wrapper around windows API. And the second one is a thread safe queue. It uses critical sections but tries to lock as little as possible. I have done some tests and it is very fast. In fact it is almost as fast as a lock free one, but the code is much much simpler. There is very little difference in speed in fact it is negligible in real world problems.

ChangleLog:

1.4.0
- Added TLockFreeStack based on Windows SLISTS
- Added TThreadSafeQueue based on linked lists
1.3.7
- Added ShutdownTimeout (INFINITE by default)
- Wait for all tasks to finish then shutting down the task pool

CRON Scheduler

Change Log:

2.0.3
- added HasValue function for TChronEntry

SimpleLog

Change Log:

1.2.0
- Use the new rewritten Cromis.Exceptions
- Log file limit is now working correctly

XTEA

Change Log:

1.1.0
- Added overloaded procedures for stream and file encryption / decryption

TValue and other “Variants” like implementation tests

Iztok Kacin — Tue, 16 Mar 2010 11:51:30 +0000

The recent post from Mason Wheeler about TValue speed was very interesting. I always had the impression, that variants were slow, but never tested that. So this was a surprise to me. But how fast the variants really are? There are other “variants” like implementations out there, so I decided to test them in a common test. At least the ones I know that exist. The record implicit operator allows for some very flexible operations on different data types. So I tested 5 different approaches to “variant” implementation.

Variants (build in Delphi as long as I can remember )
TValue (new in Delphi 2010)
TAnyValue (recently added to my library)
TOmniValue (part of OmniThreadLibrary)
Bare-bone variant record implementation for comparison.

Here is the code I tested on. It is just a little changed version of Masons. It forces the compiler to include all lines (by calling Writeln on resulting values) and it averages over integers, strings and floating point values. Just integers seemed unfair to me. After all in real life we would use all possible combinations of data. The test also has range and overflow checks turned on.

The results:

Iterations: 10000000

Times are in milliseconds

Type	Variants	TValue	TAnyValue	TOmniValue	TVariableRec
j := I	255	4070	916	128	175
j := I/5	332	4081	1400	3265	313
j := IntToStr(I)	4548	11051	7873	6429	2795
ALL	4905	18847	9932	9654	3255

And here is the test code:

program ValuesTest;
 
{$APPTYPE CONSOLE}
uses
  SysUtils,
  rtti,
  diagnostics,
  OtlCommon,
  Cromis.AnyValue;
 
const
  HUNDRED_MILLION = 10000000;
 
type
  TVariableRec = record
  private
    FFLoat: Extended;
    FString: string;
    FInteger: Integer;
    function GetAsFloat: Extended;
    procedure SetAsFloat(const Value: Extended);
    function GetAsInteger: Integer;
    procedure SetAsInteger(const Value: Integer);
    function GetAsString: string;
    procedure SetAsString(const Value: string);
  public
    class operator Implicit(const Value: string): TVariableRec;
    class operator Implicit(const Value: Integer): TVariableRec;
    class operator Implicit(const Value: Extended): TVariableRec;
    class operator Implicit(const Value: TVariableRec): string;
    class operator Implicit(const Value: TVariableRec): Integer;
    class operator Implicit(const Value: TVariableRec): Extended;
    property AsFloat: Extended read GetAsFloat write SetAsFloat;
    property AsString: string read GetAsString write SetAsString;
    property AsInteger: Integer read GetAsInteger write SetAsInteger;
  end;
 
procedure tryTValue;
var
  i: integer;
  j: TValue;
  value1: Integer;
  value2: Extended;
  value3: string;
begin
  for I := 1 to HUNDRED_MILLION do
  begin
    j := I;
    value1 := j.AsInteger;
    j := I / 5;
    value2 := j.AsExtended;
    j := IntToStr(I);
    value3 := j.AsString;
  end;
 
  Writeln(value1);
  Writeln(value2);
  Writeln(value3);
end;
 
procedure tryAnyValue;
var
  i: integer;
  j: TAnyValue;
  value1: Integer;
  value2: Extended;
  value3: string;
begin
  for I := 1 to HUNDRED_MILLION do
  begin
    j := I;
    value1 := j.AsInteger;
    j := I / 5;
    value2 := j.AsFloat;
    j := IntToStr(I);
    value3 := j.AsString;
  end;
 
  Writeln(value1);
  Writeln(value2);
  Writeln(value3);
end;
 
procedure tryOmniValue;
var
  i: integer;
  j: TOmniValue;
  value1: Integer;
  value2: Extended;
  value3: string;
begin
  for I := 1 to HUNDRED_MILLION do
  begin
    j := I;
    value1 := j.AsInteger;
    j := I / 5;
    value2 := j.AsExtended;
    j := IntToStr(I);
    value3 := j.AsString;
  end;
 
  Writeln(value1);
  Writeln(value2);
  Writeln(value3);
end;
 
procedure tryVariants;
var
  i: integer;
  j: variant;
  value1: Integer;
  value2: Extended;
  value3: string;
begin
  for I := 1 to HUNDRED_MILLION do
  begin
    j := I;
    value1 := j;
    j := I / 5;
    value2 := j;
    j := IntToStr(I);
    value3 := j;
  end;
 
  Writeln(value1);
  Writeln(value2);
  Writeln(value3);
end;
 
procedure tryVarRec;
var
  i: integer;
  j: TVariableRec;
  value1: Integer;
  value2: Extended;
  value3: string;
begin
  for I := 1 to HUNDRED_MILLION do
  begin
    j := I;
    value1 := j.AsInteger;
    j := I / 5;
    value2 := j.AsFloat;
    j := IntToStr(I);
    value3 := j.AsString;
  end;
 
  Writeln(value1);
  Writeln(value2);
  Writeln(value3);
end;
 
var
  stopwatch: TStopWatch;
 
{ TVariableRec }
 
class operator TVariableRec.Implicit(const Value: Extended): TVariableRec;
begin
  Result.AsFloat := Value;
end;
 
function TVariableRec.GetAsFloat: Extended;
begin
  Result := FFLoat;
end;
 
function TVariableRec.GetAsInteger: Integer;
begin
  Result := FInteger;
end;
 
function TVariableRec.GetAsString: string;
begin
  Result := FString;
end;
 
class operator TVariableRec.Implicit(const Value: Integer): TVariableRec;
begin
  Result.AsInteger := Value;
end;
 
class operator TVariableRec.Implicit(const Value: TVariableRec): Integer;
begin
  Result := Value.AsInteger;
end;
 
class operator TVariableRec.Implicit(const Value: TVariableRec): Extended;
begin
  Result := Value.AsFloat;
end;
 
class operator TVariableRec.Implicit(const Value: string): TVariableRec;
begin
  Result.AsString := Value;
end;
 
class operator TVariableRec.Implicit(const Value: TVariableRec): string;
begin
  Result := Value.AsString;
end;
 
procedure TVariableRec.SetAsFloat(const Value: Extended);
begin
  FFLoat := Value;
end;
 
procedure TVariableRec.SetAsInteger(const Value: Integer);
begin
  FInteger := Value;
end;
 
procedure TVariableRec.SetAsString(const Value: string);
begin
  FString := Value;
end;
 
begin
  try
    stopwatch := TStopWatch.StartNew;
    tryVariants;
    stopwatch.Stop;
    writeln('Variants: ', stopwatch.ElapsedMilliseconds);
    stopwatch := TStopWatch.StartNew;
    tryTValue;
    stopwatch.Stop;
    writeln('TValue: ', stopwatch.ElapsedMilliseconds);
    stopwatch := TStopWatch.StartNew;
    tryAnyValue;
    stopwatch.Stop;
    writeln('TAnyValue: ', stopwatch.ElapsedMilliseconds);
    stopwatch := TStopWatch.StartNew;
    tryOmniValue;
    stopwatch.Stop;
    writeln('TOmniValue: ', stopwatch.ElapsedMilliseconds);
    stopwatch := TStopWatch.StartNew;
    tryVarRec;
    stopwatch.Stop;
    writeln('TVariableRec: ', stopwatch.ElapsedMilliseconds);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
 
  readln;
end.

It is obvious and expected that bare-bone record is the fastest. But Variants are not far behind and in real world the difference is negligible. My TAnyValue and TOmniValue from Primož are on the same level. But in most cases his implementation is faster because I use an interface to store the data in a class (because of my other code that uses interface based IAnyValue) and he stores most of the data as numeric type (only some as interface based class). I could speed up my implementation but I find it fast enough in most cases. And I will take elegance over speed if the difference is small enough. But TValue is slow, to slow probably to be used a lot. They should work on it in the future. It is a shame to throw it away since it brings quite a lot of power with it. I wonder if it is necessary for internal data to be stored as generics array

For those of you who don’t like to use variants or want so more flexibility you can look for TAnyValue (which was inspired upon looking at TOmniValue implementation) or TOmniValue. They both work under older version of Delphi as far as I know (Delphi 2005 and up).

If I missed something or if you know of another “variant” like implementation, please let me know. The purpose of this post is to explore this area as well as possible.

Build your XML the LinqToXML style in native code – Part I.

Iztok Kacin — Tue, 09 Mar 2010 09:12:19 +0000

A lot of you probably already know SimpleStorage. For those who don’t:

I read a blog entry recently about LinqToXML and while I was exploring the possibilities that it has, I wondered. Can something like this be done with Delphi and native code? Now SimpleStorage already enables you to write XML in a very compact and efficient way, but it still lacks some elegance on the more native XML building approach. Ok there is a question why would you even want to write XML code inside the IDE editor? But sometimes it is viable, maybe just a wrapper XML shell for something that gets dynamically injected into it. Nevertheless I was intrigued if it can be done. Primož Gabrijelčič has done it and blogged about it:

It was a nice display what fluent interfaces approach can do, but I was not happy completely. I was aiming at code that would get rid of the “Here, Back…” functions to navigate in the document, because you don’t need them. You always build your document in one swoop and maybe access single elements latter. I know why they were used in that approach and that is why I think with fluent interfaces alone it is hard to achieve the wanted result. SimpleStorage uses an approach similar to that, but not to full extent. The second reason was I wanted to implement it using SimpleStorage, because my aim is to evolve it to be a great and all around tool for XML and data manipulation.

The goal I wanted to achieve was that the Delphi code written inside IDE would match the actual XML as closely as possible and with as little boilerplate code as possible. This way you get the benefit of seeing the resulting XML before it is even created. Without further delay let me show you the results.

First the XML we are trying to construct.

>
  >
    >Novak>
    >Gazvoda>
    >Dežela>
    >Medved>
  >
  >
     Name="Marija">Gorenjska>
     Name="Tanja">Notranjska>
     Name="Maja">Primorska>
     Name="Tadeja">Pomurje>
     Name="Irma">Posočje>
     Name="Marija">Notranjska>
  > 
>

And now the code that does it

procedure TfMain.btnExample2Click(Sender: TObject);
var
  MyStorage: ISimpleStorage;
begin
  MyStorage := CreateStorage('Demografija');
 
  CreateBuilder(MyStorage).Construct(
  [
    AddElement('Males',
    [
      AddElement('Janez', 'Novak'),
      AddElement('Darko', 'Gazvoda'),
      AddElement('Mitja', 'Dežela'),
      AddElement('Tilen', 'Medved')
    ]),
    AddElement('Females',
    [
      AddElement('Person', ['Name', 'Marija'], 'Gorenjska'),
      AddElement('Person', ['Name', 'Tanja'], 'Notranjska'),
      AddElement('Person', ['Name', 'Maja'], 'Primorska'),
      AddElement('Person', ['Name', 'Tadeja'], 'Pomurje'),
      AddElement('Person', ['Name', 'Irma'], 'Posočje'),
      AddElement('Person', ['Name', 'Marija'], 'Notranjska')
    ])
  ]);
end;

And for the second example let me show how to inject the actual dynamically generated XML into the given builder template. The target XML is like this

>
  >
    >
       Difficulty="High">5>
       Difficulty="Low">0>
       Difficulty="Medium">8>
       Difficulty="Low">4>
       Difficulty="High">8>
      >
         Difficulty="High">4>
         Difficulty="Low">3>
      >
    >
    >
      >2>
      >2>
      >8>
    >
  >
>

And the code that does it looks like this

procedure TfMain.btnExample1Click(Sender: TObject);
var
  MyStorage: ISimpleStorage;
begin
  MyStorage := CreateStorage('Books');
 
  CreateBuilder(MyStorage).Construct(
  [
    AddElement('English',
    [
      AddElement('Science',
      [
        AddElement('Mathematics', ['Difficulty', 'High'], 5),
        AddElement('Physics', ['Difficulty', 'Low'], 0),
        AddElement('Computers', ['Difficulty', 'Medium'], 8),
        AddElement('Engineering', ['Difficulty', 'Low'], 4),
        AddElement('Electoronics', ['Difficulty', 'High'], 8),
        AddElement('Biology',
        [
          AddElement('Microbiology', ['Difficulty', 'High'], 4),
          AddElement('Undefined', ['Difficulty', 'Low'], 3),
          Add(
            procedure(const Element: IElement)
            begin
              // add few elements here
              Element.Append('InsertedNode').AsInteger := 1;
              Element.Append('InsertedNode').AsInteger := 2;
              Element.Append('InsertedNode').AsInteger := 3;
            end
          )
        ])
      ]),
      AddElement('Musical',
      [
        AddElement('Classic', 2),
        AddElement('Etno', 2),
        AddElement('Pop', 8)
      ])
    ])
  ]);
end;

The result is easily readable dont’ you think? I would really like to hear your opinion on the code. Maybe you have a suggestion or idea, or you simply have a comment about how it all sucks The code can already be downloaded from my download page, but be warned, it is still in early development and it will change. It only works in Delphi 2010 (should in 2009) opposed to other parts of SimpleStorage that work in Delphi 2006 and up. Also I use Variants for values for now and that will change. I will replace them with records and implicit operator overloads.