From Zero To One » Coding

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.

Updated SimpleStorage demos and added IDocument

Iztok Kacin — Mon, 08 Feb 2010 13:17:14 +0000

As I promised, I updated the demos. I added two new demos. One showing how to manipulate collection of documents and the other to show how to Encrypt / Decrypt whole documents.

I also made a change in the “Cromis.SimpleStorage.Collection.pas” unit. There is now a new “IDocument” interface which is very simple:

  IDocument = Interface(IInterface)
  ['{0B2F03BD-9929-43A1-A7E8-62B372D2D96C}']
    function GetPath: string;
    function GetData: ISimpleStorage;
    property Data: ISimpleStorage read GetData;
    property Path: string read GetPath;
  end;

Now instead of the collection returning directly ISimpleStorage interface, it returns the IDocument. The interface holds the storage XML and the additional property, the path of the document. This can be important in certain situations. Here I would also like to clarify that for now the collection can only hold XML documents on file system. They cannot be held directly in memory. This is intentional, because in many cases the collections can be huge and there is no way that all those XML documents would fit into memory. It would also be very time consuming to parse and load all XML documents in advance, before even using them.

You can get the new version and demos from the download page.

What is new in SimpleStorage

Iztok Kacin — Sun, 07 Feb 2010 13:37:18 +0000

As you probably know by now (or not) SimpleStorage is a set of interfaces to ease the manipulation of XML documents. It is based on OmniXML, a wonderful Delphi XML parser. Simple Storage aims to treat XML as a practical data storage and means of data serialization and transportation. I have written about its usage in a series of articles, some time ago. Here are the articles:

From then, the framework has matured and I use it in a lot of my software. It has proven invaluable in terms of time savings and ease of XML manipulation. After all I have written it because I was tired of doing the same XML tasks over and over again. Recently, I upgraded it with two new important units . They cover two aspects of XML manipulation:

Encryption on a document scale
Working with collection of documents

I also did an upgrade of the core IElement interface. The goal was easier node attributes manipulation. I will show examples of all three improvements here. The new version of SimpleStorage can be found on my download page as always.

Encryption on a document scale

I recently had the need to encrypt whole XML documents. Since I already have SimpleStorage and XTEA encryption algorithm in my library, this was a no brainer. Whole documents can now be encrypted with some very simple code:

  EncryptedStorage('MyVeryStrongKey').SaveToFile(StorageFromFile(OpenDialog.FileName), SaveDialog.FileName);

And decrypted just as easily.

  EncryptedStorage('MyVeryStrongKey').LoadFromFile(OpenDialog.FileName).SaveToFile(SaveDialog.FileName);

I have intentionally wrote this in one line, because I always want to show how compact and powerfull the whole framework is. It tends to minimize tedious code and make your life easier. In real apps this should probably be two lines for easy redability.

  Storage := StorageFromFile(OpenDialog.FileName);
  EncryptedStorage('MyVeryStrongKey').SaveToFile(Storage , SaveDialog.FileName);

You can also encrypt / decrypt directly but you can look for that yourself. The code is obvious.

Easier node attributes manipulation

As I said, I strive to make the code compact and clear and attribute manipulation was one thing, that bugged me from the beginning of SimpleStorage. Everything else was very compact, but if you wanted to manipulate attribute “Language” of node “Book”, for instance, you had to write something like the following code. The first line is setting “Language” attribute of the “Book” node, by first getting the “Book” node and the second is setting the “Language” directly from “Book” node.

  CurrentNode.Get('Book').Attributes.Ensure('Language').AsString := 'English';
  CurrentNode.Attributes.Ensure('Language').AsString := 'English';

Which is ok, but it stand out from other SimpleStorage code. So I added “shortcuts” to the IElement interface. Now you can do the same like this:

  CurrentNode.EnsureAttr('Book', 'Language').AsString := 'English';
  CurrentNode.EnsureAttr('Language').AsString := 'English';

It saves a lot of characters on the long run

Working with collection of documents

Until now, SimpleStorage was great if you wanted to manipulate a single XML document. But what if you have lots of those and you wanted to process all of them. You had to write your own code (which is easy of course, but again repetitive work) and work with each document separately. Well no more. You now have “IDocuments“ interface that enables you to work over collections of XML documents. I will show this on a simple example. This was a real task, I had in front of me a few days ago. I had a bunch of XML documents looking like this:

>
   ID="002694350026014400780050BF3F5173" InBound="23632" OutBound="13092" />
   ID="002694350026012900880050BF3F5173" InBound="14728" OutBound="41084" />
   ID="002694359925017200280050BF3F5173" InBound="22116" OutBound="61808" />
   ID="002694350026013800980050BF3F5173" InBound="15140" OutBound="54612" />
   ID="002694359725014400580050BF3F5173" InBound="13460" OutBound="34064" />
   ID="002694359925013100880050BF3F5173" InBound="16332" OutBound="47120" />
   ID="002694359625013600380050BF3F5173" InBound="14860" OutBound="47752" />
   ID="002694359625014900680050BF3F5173" InBound="6120" OutBound="10852" />
   ID="002694359925016600480050BF3F5173" InBound="11724" OutBound="46016" />
   ID="002694350026011900980050BF3F5173" InBound="6404" OutBound="13540" />
   ID="002694359925013600780050BF3F5173" InBound="7616" OutBound="10376" />
   ID="002694359525017200080050BF3F5173" InBound="3060" OutBound="9996" />
   ID="002694359925012400380050BF3F5173" InBound="460" OutBound="34084" />
   ID="002694359725010700280050BF3F5173" InBound="8228" OutBound="35664" />
   ID="002694350026012000780050BF3F5173" InBound="4076" OutBound="26664" />
>

This is a shortened version, but you get the idea. It is an XML that holds the “InBound” and “OutBound” traffic for mobile devices, over the HTTP protocol. In short, it enables me to see how much traffic my application generates for a single device. The shown XML, is a log for a single month of traffic. And in over two years, quite a few of these files accumulated. It would be easy to make a sum of “InBound” and “OutBound” traffic and report that for a single device over the complete time span in a traditional way. But lets see how we can do that with SimpleStorage. First let me show how to get all log entries for a single device. All XML logs were stored in “s:\bandwidth” directory.

procedure TForm1.Button2Click(Sender: TObject);
var
  Documents: IDocuments;
begin
  Documents := CreateCollection('s:\bandwidth', False);
  Documents.Get('//Device[@ID="3FBF5000735108010E1212674B5D036A"]',
    procedure(const Document: string; const Element: IElement; const Data: Pointer)
    begin
      ListBox1.Items.Add(Document + ' - ' + Element.Attributes.Get('InBound').AsString);
    end
  );
end;

Thats it. Simple isn’t it. Try to do the same with classic MS XML and compare the result. Let me tell you again what I just did in these few lines of code. First I acuired all XML documents in a sinlge directory. Then I enumerated all the documents, but only processed the ones that have a distinct node (based on XPath) in them. Finally I printed some results for the selected nodes. If you dislike the anonymous approach you can also do it with classic callback functions. The interface supports both. the Get function / procedure is overloaded and it returns documents collection or it enumerates nodes over all documents based on XPath.

If you want to filter the collection of documents you have at your disposal you can do it like I have shown in this next example. This is just an example to show you how, it has no real value. In the callback you decide if the document will be included in the result collection or not. Then the code enumerates all documents and prints out a single attribute.

procedure TForm1.Button3Click(Sender: TObject);
var
  Documents: IDocuments;
  Document: ISimpleStorage;
  Element: IElement;
  Subset: IDocuments;
begin
  ListBox1.Clear;
  Randomize;
 
  Documents := CreateCollection('s:\bandwidth', False);
  Subset := Documents.Get('//Device[@ID="3FBF5000735108010E1212674B5D036A"]',
    procedure(const Document: ISimpleStorage; const FileName: string; var Include: Boolean; const Data: Pointer)
    begin
      Include := Random(10) > 5;
    end
  );
 
  for Document in Subset do
  begin
    Element := Document.Get('//Device[@ID="3FBF5000735108010E1212674B5D036A"]');
    ListBox1.Items.Add(Element.GetAttr('InBound').AsString);
  end;
end;

Now finally let me show the real code that helped me sumarize the traffic report. I used a classic callback here for sake of redability.

type
  TDeviceObject = class
    InBound: Int64;
    OutBound: Int64;
  end;
 
procedure TForm1.OnDeviceCallback(const Document: string; const Element: IElement; const Data: Pointer);
var
  DeviceIdx: Integer;
  HashTable: TStringList;
  DeviceObject: TDeviceObject;
begin
  HashTable := TStringList(Data);
  DeviceIdx := HashTable.IndexOf(Element.GetAttr('ID').AsString);
 
  if DeviceIdx = -1 then
    DeviceIdx := HashTable.AddObject(Element.GetAttr('ID').AsString, TDeviceObject.Create);
 
  DeviceObject := TDeviceObject(HashTable.Objects[DeviceIdx]);
  DeviceObject.InBound := DeviceObject.InBound + Element.GetAttr('InBound').AsInteger;
  DeviceObject.OutBound := DeviceObject.OutBound + Element.GetAttr('OutBound').AsInteger;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  HashTable: TStringList;
  Documents: IDocuments;
  OutputData: TStringList;
  DeviceObject: TDeviceObject;
begin
  HashTable := TStringList.Create;
  try
    Documents := CreateCollection('s:\bandwidth', False);
    Documents.Get('//Device', OnDeviceCallback, HashTable);
 
    OutputData := TStringList.Create;
    try
      for I := 0 to HashTable.Count - 1 do
      begin
       DeviceObject := TDeviceObject(HashTable.Objects[I]);
       OutputData.Add(Format('%s,%d,%d', [HashTable[I], DeviceObject.InBound, DeviceObject.OutBound]));
      end;
 
      OutputData.SaveToFile('S:\bandwidth\Bandwidth.txt');
    finally
      OutputData.Free;
    end;
  finally
    HashTable.Free;
  end;
end;

The result is a CSV file ready for excel.

How to start a GUI process from service, under Windows Vista/7

Iztok Kacin — Wed, 13 Jan 2010 22:14:12 +0000

Today I had a interesting challenge in front of me. I had to start a GUI application under Windows Vista or 7 with elevated privileges. And I had to start it from a restricted account. Why? Because the process was meant to start from a USB drive and act as a data synchronization tool. So in order to do some more complicated things, it has to have enough privileges. But it has to be started from a restricted user account, as this will be the account that will synchronize the data via the USB.

After some debating, the decision was, to use a service that will start the GUI application. It goes like this:

The USB is inserted.
The GUI application is auto-started, or the service detects that the USB was inserted.
The GUI application informs the service via IPC that it needs to be elevated and exits immediately.
The service (running under SYSTEM account) starts the process with SYSTEM account token.
The GUI application detects that is was started by the service.
The GUI application has all possible privileges and does its job.

Let me say here, that I am aware of the security risks involved in such procedure. But with proper approach this can be made safe. OK the theory is looking fine. And it works with no problems under Windows 2000/XP. But under Vista/7 it is a different story altogether. Here is the Microsoft paper on the topic:

http://msdn.microsoft.com/en-us/library/ms683502%28VS.85%29.aspx

To make it short, the service running under SYSTEM account is running in an non-interactive window station. In other words, that means, that it cannot interact with the desktop. This was tightened in Windows Vista. You have to specify the “Interactive service” flag which is discouraged and can even be nullified in the registry (no interactive services). So starting a process from service, makes the process invisible because it is not running in the correct (logged on user) session.

What if we could just get a session for the logged on user, or even the user token and start the new process in the correct session. But wait we can do that, let me show you how. I found a good example at the code project:

http://www.codeproject.com/KB/vista-security/VistaSessions.aspx

I started there. I ported the code to Delphi, cleaned it and removed the parts that are not needed. Here is the result:

function LaunchAppIntoDifferentSession(const FileName, Params: string; const WaitFor: Boolean): Cardinal;
var
  PI: PROCESS_INFORMATION;
  SI: STARTUPINFO;
  bResult: Boolean;
  LaucherApp: string;
  dwSessionId: DWORD;
  hUserTokenDup, hPToken: THANDLE;
  dwCreationFlags: DWORD;
  CommandLine: string;
  Directory: string;
  tp: TOKEN_PRIVILEGES;
  pEnv: Pointer;
  LD: LUID;
begin
  try
    LaucherApp := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + cLauncherApp;
    dwCreationFlags := NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE;
    CommandLine := Format('%s "%s" "%s"', [LaucherApp,
                                           FileName,
                                           Params]);
    Directory := ExtractFilePath(LaucherApp);
 
    // get the current active session and the token
    dwSessionId := WtsGetActiveConsoleSessionID;
    //WTSQueryUserToken(dwSessionId, &hUserToken);
 
    // initialize startup info
    FillChar(SI, SizeOf(SI), #0);
    SI.cb := SizeOf(STARTUPINFO);
    SI.lpDesktop := PChar('winsta0\Default');
    SI.dwFlags := STARTF_USESHOWWINDOW;
    SI.wShowWindow := SW_SHOWNORMAL;
 
    if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or
                                           TOKEN_QUERY or
                                           TOKEN_DUPLICATE or
                                           TOKEN_ASSIGN_PRIMARY or
                                           TOKEN_ADJUST_SESSIONID or
                                           TOKEN_READ or
                                           TOKEN_WRITE,
                                           &hPToken) then
    begin
      if LookupPrivilegeValue(nil, SE_DEBUG_NAME, LD) then
      begin
        tp.PrivilegeCount := 1;
        tp.Privileges[0].Luid := LD;
        tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
 
        DuplicateTokenEx(hPToken, MAXIMUM_ALLOWED, nil, SecurityIdentification, TokenPrimary, &;hUserTokenDup);
        SetTokenInformation(hUserTokenDup, TokenSessionId, @dwSessionId, SizeOf(DWORD));
 
        if CreateEnvironmentBlock(pEnv, hUserTokenDup, True) then
          dwCreationFlags := dwCreationFlags or CREATE_UNICODE_ENVIRONMENT
        else
          pEnv := nil;
 
        // Launch the process in the client's logon session.
        bResult := CreateProcessAsUser(hUserTokenDup,      // client's access token
                                       nil,                // file to execute
                                       PChar(CommandLine), // command line
                                       nil,                // pointer to process SECURITY_ATTRIBUTES
                                       nil,                // pointer to thread SECURITY_ATTRIBUTES
                                       False,              // handles are not inheritable
                                       dwCreationFlags,    // creation flags
                                       pEnv,               // pointer to new environment block
                                       PChar(Directory),   // name of current directory
                                       &si,                // pointer to STARTUPINFO structure
                                       &pi);               // receives information about new process
 
        if not bResult then
        begin
          Result := GetLastError;
          Exit;
        end;
      end
      else
      begin
        Result := GetLastError;
        Exit;
      end;
    end
    else
    begin
      Result := GetLastError;
      Exit;
    end;
 
    if WaitFor then
    begin
      WaitForSingleObject(PI.hProcess, INFINITE);
      GetExitCodeProcess(PI.hProcess, Result);
    end;
  finally
    // close all handles
    CloseHandle(hUserTokenDup);
    CloseHandle(PI.hProcess);
    CloseHandle(PI.hThread);
    CloseHandle(hPToken);
  end;
end;

The code is still not properly cleaned up, especially the error conditions, but it gives you the idea how it is done. In short it does the following:

It gets the session token for the currently logged on user with “WtsGetActiveConsoleSessionID“.
It gets the user token of the current process, that is the token for the service under SYSTEM account.
It duplicates that user token.
It sets the session for the duplicated token to be the session of the logged on user.
It launches the process with CreateProcessAsUser passing the duplicated, adjusted user token.

Quite simple, but really powerful. What we get is a process with SYSTEM account privileges, but running in the logged on user session. At first I could not get the new process to be shown on the top of the desktop. It was started, I could see it in the taskbar, but I had to manually click on it to restore it to the original (non minimized) state . This is probably the side effect of the “hack “, because of two different sessions. But I had an Idea. What if I first create a “launcher” process, just a simple pascal “program” that just gets some parameters and then starts the real GUI application. This way my process will be started by process that is already running in the correct session. It tried the approach and now it worked perfectly. I get a process with all the priveleges, but it behaves just as any other GUI process. The launcher process is very simple:

program GetMeUpLauncher;
 
uses
  Windows,
  SysUtils,
  ShellAPI;
 
begin
  ShellExecute(0, 'Open', PChar(ParamStr(1)), '/ADMIN', nil, SW_SHOWNORMAL);
end.

The “ADMIN” parameter tells the GUI application that it was started by the service with elevated privileges. I just want to mention another interesting function which is commented in the above example. “WTSQueryUserToken” can get the user token of the currently logged on user. It is a really powerful function. It means we can get the token from a service for the current user and do things in his/her name. This only works if it is called from a process under SYSTEM account. As it is not needed in my example I commented it.

You can get the complete example with the service, launcher and demo client from my downloads page. But you will need my IPC and Jedi JWA in order to compile it. This is why I included precompiled binaries if you want to try it out.

EDIT:

One of the readers pointed out that it would be better, if the service was doing the actual synchronization. I agree with him. It is always better to use standard and supported techniques than to use hacks or undocumented features. Troubles are always around the next corner in such cases. However, as it usually happenes, we were under severe time constraint and had and already working application, that all of a sudden had to do some more. The easiest and fastest way was to do what we did. But in the future we will probably redesign it to a more standard solution, where the service will do the actual synchronization and the app will only act as the progress monitor.

The “hack” is still worth blogging about through