From Zero To One

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:

1. The USB is inserted.
2. The GUI application is auto-started, or the service detects that the USB was inserted.
3. The GUI application informs the service via IPC that it needs to be elevated and exits immediately.
4. The service (running under SYSTEM account) starts the process with SYSTEM account token.
5. The GUI application detects that is was started by the service.
6. 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:

1. It gets the session token for the currently logged on user with “WtsGetActiveConsoleSessionID“.
2. It gets the user token of the current process,  that is the token for the service under SYSTEM account.
3. It duplicates that user token.
4. It sets the session for the duplicated token to be the session of the logged on user.
5. 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

You start panicking of course

Ok seriously now. You try to fix the problem first. If that doesn’t work then you bring the server back from the backups you are so regularly making. You are aren’t you? And you always make sure that your backup plan is actually working. Don’t you?

About a week ago my virtual Debian server on which this blog is hosted stopped running. The VMware console reported a virtual disk error. I had to shutdown the machine and when I tried to boot it up again it wouldn’t start. There was an error on one of the virtual disks.  Hm so what to do? I had a fresh, few days old backup, so I went for that. But first, let me tell you how my virtual machines are set up. I have a Debian host OS (stable Lenny currently) and on top of that I have v VMware server 2.0.1. Then inside I have a virtual Debian server where this blog is hosted alongside my whole code repository. I have a couple of other virtual machines for development and testing (Windows and Linux). All important virtual machines are backup-ed regularly to the NAS machine. I have written about that a while ago here and here.

Ok so I took my last backup which is a tar that is further compressed with 7-zip for reducing size. At first I only had a tar archive. I tested that and it worked just fine. Then at some point I used 7-zip over the tar and because I lacked time I did not test the archives. No errors were reported so I assumed all is well. What a mistake. All 7-zip archives were partially corrupted. But thanks to Sheree dumb luck I could get the VMDK file that was corrupted from the archive. I replaced that file on the virtual machine (the size was the same) and the server booted again. Hooray! Well not quite. Everything was working but SVN was reporting errors. It could not open the database. After investigating the Apache logs (I use DAV SVN and https) it seemed that “db/current”  file was corrupted. This file holds the info about the last (current) revision in the SVN. I tried “svnadmin recover” to no avail. I tried removing the file and repeating the recover which then failed elsewhere.

After searching the web and finding nothing I almost gave up. But the I found a little gem on one of the forums. A little Python script that solved my problems. I am posting it here if anybody else will have the same misfortune. If the author finds this offensive I will remove the script.

#!/usr/bin/python
 
def dec_to_36(dec):
  key = '0123456789abcdefghijklmnopqrstuvwxyz'
  result = ''
  while 1:
    div = dec / 36
    mod = dec % 36
    dec = div
    result = key[mod] + result
    if dec == 0:
      break
  return result
 
import os, re, sys
 
repo_path = sys.argv[1]
rev_path = os.path.join(repo_path, 'db', 'revs')
current_path = os.path.join(repo_path, 'db', 'current')
 
id_re = re.compile(r'^id:\ ([a-z0-9]+)\.([a-z0-9]+)\.r([0-9]+).*')
 
max_node_id = 0
max_copy_id = 0
max_rev_id = 0
 
for rev in os.listdir(rev_path):
  f = open(os.path.join(rev_path, rev), 'r')
 
  for line in f:
    m = id_re.match(line)
    if m:
      node_id = int(m.group(1), 36)
      copy_id = int(m.group(2), 36)
      rev_id = int(m.group(3), 10)
 
      if copy_id > max_copy_id:
        max_copy_id = copy_id
 
      if node_id > max_node_id:
        max_node_id = node_id
 
      if rev_id > max_rev_id:
        max_rev_id = rev_id
 
f = open(current_path, 'w+b')
f.write("%d %s %s\n" % (max_rev_id, dec_to_36(max_node_id+1),
                        dec_to_36(max_copy_id+1)))
f.close()

This script is a little gem. It goes through all your revisions and reconstructs the “db/current” file. It worked. I lost last 4 or 5 revisions, but that was easily solved as I had them on my computer naturally. So all was well, I made backup of the current state and I was happy. Well that was another false sense of security.

Last night the blog went down again. This time it could not access the database. It showed that the file system inside the virtual machine was corrupted. I ran “fsck” but frankly I was prepared for the worst. To my surprise all errors were corrected and the server is once again running happily. I am suspecting that the physical hard drive of the host is slowly dying so I will migrate to a new drive in the future. But for now I am truly impressed about how sturdy Debian is. The host and the virtual server both run for about 3 years now without a reinstall. Both were migrated from Etch to Lenny (two stable releases) in live mode (no shutdown) and have survived hardware change (CPU, motherboard and RAM) and file system corruptions. Now do that to your Windows if you dare

As you know, Delphi is now Unicode able, from Delphi 2009 and up. This had caused a lot of headaches to a lot of developers out there. Unicode is not easy, you need to understand how it works and know how to use it. It is maybe simpler for .NET developers because they had it from the beginning (but when they dive in deep, then they are on the same level or even worse).  For Delphi developers, that means they have to migrate old applications and code, or stay with the old ANSI versions of the compiler. These migrations can be very hard in some cases (I would say most of the time it is hard, some of the time it is easy) . And even if you write old code from scratch you may need to provide ANSI compatibility for old compiler versions.

In the previous post I wrote about implementing a XTEA cryptographic algorithm in Delphi. While doing it I found out that this was a perfect example to study, how Unicode should be done in Delphi when dealing with cryptography data. Let me clarify. Under cryptography I do not mean just encryption, but all operations that transform input data to output that has no meaning to humans (it is binary data with some algorithm specific pattern). Encryption, hashing and even ID generators all fall under this category. They all take input data and produce most often some sort of binary output that has no meaning on its own.

I have seen a lot of Unicode implementations of cryptography in Delphi, but most of them were not done correctly. The main problem here is, that older ANSI version of the Delphi compilers worked with ANSI strings. And that ANSI strings were ideal (or so it seemed) for storing binary data (bytes actually). But that was just plain wrong approach. It worked when strings were 1 byte per character, but with Unicode in the picture that world fell apart. This string miss usage is one of the most common reasons why transitions from ANSI to Unicode are so hard sometimes (there is also PChar math etc…). This is also an example why we, developers, must be very careful with things that seem obvious but may have a deeper meaning and why understanding what we do is so important. Remember never “code by coincidence”, always understand what your code does. And I mean every line of it.

While implementing this XTEA algorithm I had three goals to achieve:

• The algorithm must be able to safely encrypt and decrypt data
• It must offer easy way to encrypt strings and streams
• I must be backward compatible with no change

The last one is important. I wrote the code from scratch, but if I already had the code, it should work in Delphi 2010 and Delphi 2009 with just recompile and no changes made to it. And it should handle data from Delphi 2006 with no problems. So how did I do it. First of all I set probably the most important rule:

Cryptography works with binary data and not strings. So all data should be threated as binary

Isn’t that obvious? Am I not saying something that everybody knows? Well no, at least not from the amount of incorrect code out there. Hm, you may ask, but doesn’t this contradict the second goal. At first glance yes, but as I will show it poses no problem at all. If we work with binary data, Unicode and ANSI do not matter at all. Bytes are bytes. So we ensure at a higher level, support functions, to convert strings to binary data and back. And this must be done as transparently as possible. Le me show how the interface section of the XTEA algorithm looks like. It has changed some from the last article.

  //***************************************************
  // tea stream encryption / decryption routines
  //***************************************************
 
  type
    TTeaUnicodeString = {$IFDEF UNICODE} UnicodeString {$ELSE} WideString {$ENDIF};
    TTeaAnsiString = {$IFDEF UNICODE} RawByteString {$ELSE} string {$ENDIF};
    {$IFDEF CLR} TStream = Stream; {$ENDIF}
    TLong2 = array[0.. 1] of Longword;  // 64-bit
    TTeaKey = array[0..3] of Longword;  // 128-bit
    TByte16 = array[0..15] of Byte;     // 128-bit
    TByte4 = array[0..3] of Byte;       // 32-bit
    TTeaData = array of Longword;       // n*32-bit
    TBytes = array of Byte;
 
  // XTEA encryption and decryption function
  function XTeaEncryptBytes(const Data, Key: TBytes): TBytes;
  function XTeaDecryptBytes(const Data, Key: TBytes): TBytes;
 
  procedure XTeaEncryptStream(const InStream, OutStream: TStream; const Key: TBytes);
  procedure XTeaDecryptStream(const InStream, OutStream: TStream; const Key: TBytes);
 
  // support functions for string <-> bytes conversions
  function GetBytesFromUnicodeString(const Value: TTeaUnicodeString): TBytes;
  function GetBytesFromAnsiString(const Value: TTeaAnsiString): TBytes;
 
  function GetUnicodeString(const Value: TBytes): TTeaUnicodeString;
  function GetAnsiString(const Value: TBytes): TTeaAnsiString;

This is it. We have core encryption and decryption routines (XTeaEncryptBytes, XTeaDecryptBytes) and they work with bytes. Then we have the stream encryption and decryption routines and support functions. You can see that core routines take in data and key as “array of Byte” and return “array of Byte” also. This is the only correct approach in my opinion.

It is up to the user to encrypt and decrypt the strings how he or she sees fit. This way we make no assumptions upfront of the string content and format, the user is the one that must know with all responsibility, why he or she is treating a string as ANSI or Unicode. Streams are easy here, because they are binary data, so I will not spend time talking about them. Now you might ask, but what if we must “unicodify” a previous ANSI solution and we do not have the liberty of constructing the solution from ground up. Well in that case you have to ensure that your code behaves in the same manner as before on all compiler versions (even Unicode ones). So this means you have to treat all strings as ANSI if not specifically ordered otherwise. Let me write another rule:

All string are ansi strings by default, if not specified otherwise, when dealing with legacy code

Does this make sense? Yes it does. This ensures that code written in older versions of Delphi (non Unicode) will still work without changes in newer version. Because we work with bytes beneath it also ensures that no matter what code page we use, the byte sequence will still be the same (you must be careful with the key however). It can be unreadable if you encode string under Chinese code page and view it under Russian code page, but it will still be exactly the same data if looked as binary data. And this is important as it ensures that data is not affected by the code page (at least not in the core algorithm routines). The code I presented is very flexible and easily adopted for ANSI or Unicode compiler. And that flexibility and transparency is the key here.

I think this is the only correct approach to problems of this kind. I you think I am wrong, or you have some other ideas please drop a comment and I will gladly answer any questions or ideas related to the topic. If you want to see the code and how it works, it is available from the download section.

I have updated the XTEA algorithm implementation and made it available for download. The algorithm works on array of bytes or on streams. You also have support functions that help you encrypt  / decrypt strings. The interface is shown bellow.

  // XTEA encryption and decryption function
  function XTeaEncryptBytes(const Data, Key: TBytes): TBytes;
  function XTeaDecryptBytes(const Data, Key: TBytes): TBytes;
 
  procedure XTeaEncryptStream(const InStream, OutStream: TStream; const Key: TBytes);
  procedure XTeaDecryptStream(const InStream, OutStream: TStream; const Key: TBytes);
 
  // support functions for string <-> bytes conversions
  function GetBytesFromUnicodeString(const Value: TTeaUnicodeString): TBytes;
  function GetBytesFromAnsiString(const Value: TTeaAnsiString): TBytes;
 
  function GetUnicodeString(const Value: TBytes): TTeaUnicodeString;
  function GetAnsiString(const Value: TBytes): TTeaAnsiString;

The algorithm was also optimized so that the .NET compatibility is not a slowdown for Win32 native code anymore. You can download the code and demo app from the download page.

Please leave the comments here, or contact me directly, if you have troubles or questions.

I had fun this weekend. Some time passed since I coded (or better said modified) some low level code like this. I mean really low level, not Win32 API. And encryption in its true form is low level coding (and much more than just coding behind the screen).

The initial problem that led to me to this task, was the need for an encryption algorithm that would work in all Delphi versions I use. BDS 2006 Win32, BDS 2006 .NET, BDS 2006 .NET Compact Framework and RAD 2010. I maintain an application written under BDS 2006 .NET for compact framework. It works just fine, but the users wanted some new features for it. And one of the features was data encryption, so the data would be safe if somebody stole the PDA. Initial search for CF compatible code revealed a CryptoAPI wrrapper. While it worked just fine, it had some problems. I had no desire to play with the C# code. I do not have the environment set up to compile and build it. And the second more serious problem was, that this worked under CF, but not under Win32 (it workes under Win32, .NET and .NET CF as pointed out). My plan was to always have the data encrypted outside the application. So when data is stored on the PDA, it is encrypted and when it is read by the application, it is decrypted. The application communicates with a central server and sends data to the server now and then. The server is written in Delphi Win32. I had two ways to solve this problem:

1. Before sending the data, decrypt it to some temp path, then send it decrypted and delete it afterward.
2. Send the data encrypted and decrypt it on the server side.

I did not like the first approach as the data would be temporarily visible (and would be transferred in plain HTTP over the GPRS). So I opted for second approach. This way I would have to use an algorithm, that would give the same results on all platforms. After some digging around I found a perfect candidate. XTEA is an improved TEA (Tiny Encryption Algorithm) and is very easy to implement and hard enough to break. I looked for solution that has reasonable strength but does not need to be unbreakable. Also the algorithm is very fast and has small memory footprint and that is another bonus on the PDA devices. Happy with this I looked if there already was a Delphi implementation of the algorithm. And I found one such implementation.

It looked promising, no pointers (good for .NET) and simple implementation. So I took this as a base and modified it to work under .NET and CF. I also made it Unicode and Ansi compatible. Yes, encryption is meant to work on raw data not strings, but the reality is that we often have to encrypt strings, text and other similar data that is sensitive to encoding. Doing this I had to think about the correct approach to Unicode handling. If something is encoded as a string under Unicode enabled compiler the I expect the same result on the other side that is Ansi enabled. If I encode something under Delphi 2010 I want the same result under Delphi 2006 and vice verse. Naturally if I encode Chinese text I cannot represent it in the same way on the other side, but that is obvious (unless I use WideStrings). I took the following solution to which I will stick until somebody proves me wrong or I find a better one:

  function XTeaEncryptStr(const Data, Key: string): AnsiString;
  function XTeaDecryptStr(const Data: AnsiString; const Key: string): string;

The idea is that input Data for encryption should always be declared as string (for string encryption that is). We should always get back the AnsiString as this is the actual representation of the encrypted data as bytes. It has no meaning at all. On the other hand decryption is symmetric. It takes AnsiString and returns a string. Key to this is that internally we do UTF8 encoding / decoding (not blind AnsiString casting). This way we will get the same byte representation internally, no matter if we have Delphi 2006 or 2010. Yes not for Chinese characters because we cannot represent them with AnsiString.

All that said, wrapping encryption / decryption should look like this:

function XTeaDecryptStr(const Data: AnsiString; const Key: string): string;
var
  KeyBuf: TTeaKey;
  DataBuf: TTeaData;
  ResultAsUTF8: AnsiString;
begin
  StrToKey(Utf8Encode(Key), KeyBuf);
 
  StrToData(Data, DataBuf);
  XXTeaDecrypt(DataBuf, KeyBuf);
  DataToStr(ResultAsUTF8, DataBuf);
  {$IFDEF UNICODE}
    Result := UTF8ToString(ResultAsUTF8)
  {$ELSE}
    Result := UTF8Decode(ResultAsUTF8);
  {$ENDIF}
end;
 
function XTeaEncryptBytes(const Data: TTeaBytes; const Key: string): TTeaBytes;
var
  KeyBuf: TTeaKey;
  DataBuf: TTeaData;
begin
  StrToKey(Utf8Encode(Key), KeyBuf);
 
  BytesToData(Data, DataBuf);
  XXTeaEncrypt(DataBuf, KeyBuf);
  DataToBytes(Result, DataBuf);
end;
 
function XTeaDecryptBytes(const Data: TTeaBytes; const Key: string): TTeaBytes;
var
  KeyBuf: TTeaKey;
  DataBuf: TTeaData;
begin
  StrToKey(Utf8Encode(Key), KeyBuf);
 
  BytesToData(Data, DataBuf);
  XXTeaDecrypt(DataBuf, KeyBuf);
  DataToBytes(Result, DataBuf);
end;

I also included the raw byte counterparts to be complete. Now all that is left to show is the reminder of the XTEA algorithm:

type
  TLong2 = array[0.. 1] of Longword;  // 64-bit
  TTeaKey = array[0..3] of Longword;  // 128-bit
  TByte16 = array[0..15] of Byte;     // 128-bit
  TByte4 = array[0..3] of Byte;       // 32-bit
  TTeaData = array of TLong2;         // n*64-bit
  TTeaBytes = array of Byte;          // byte array
 
const
  cTeaBlockSize = 4;
 
function CardinalToBytes(const Data: Cardinal): TByte4;
begin
{$IFDEF CLR}
  Result := BitConverter.GetBytes(Data);
{$ELSE}
  Result := TByte4(Data);
{$ENDIF}
end;
 
function BytesToCardinal(const Data: TByte4): Cardinal;
begin
{$IFDEF CLR}
  Result := BitConverter.ToUInt32(Data, 0);
{$ELSE}
  Result := Cardinal(Data);
{$ENDIF}
end;
 
{$OVERFLOWCHECKS OFF}
procedure XTeaEncrypt(var Data: TLong2; const Key: TTeaKey; N: Longword = 32);
var
  y,z,sum,limit: Longword;
begin
  limit := Delta * N;
  y := Data[0];
  z := Data[1];
  sum := 0;
 
  while sum <> limit do
  begin
    Inc(y, (((z shl 4) xor (z shr 5)) + z) xor (sum + Key[sum and 3]));
    Inc(sum, Delta);
    Inc(z, (((y shl 4) xor (y shr 5)) + y) xor (sum + Key[(sum shr 11) and 3]));
  end;
 
  Data[0] := y;
  Data[1] := z
end;
 
procedure XTeaDecrypt(var Data: TLong2; const Key: TTeaKey; N: Longword = 32);
var
  y,z,sum: Longword;
begin
  y := Data[0];
  z := Data[1];
  sum:= Delta * N;
 
  while sum <> 0 do
  begin
    Dec(z, (((y shl 4) xor (y shr 5)) + y) xor (sum + key[(sum shr 11) and 3]));
    Dec(sum, Delta);
    Dec(y, (((z shl 4) xor (z shr 5)) + z) xor (sum + key[sum and 3]));
  end;
 
  Data[0] := y;
  Data[1] := z
end;
 
procedure XXTeaEncrypt(var Data: TTeaData; const Key: TTeaKey);
var
  I: Integer;
begin
  for I := 0 to Length(Data) - 1 do
    XTeaEncrypt(Data[I], Key);
end;
 
procedure XXTeaDecrypt(var Data: TTeaData; const Key: TTeaKey);
var
  I: Integer;
begin
  for I := 0 to Length(Data) - 1 do
    XTeaDecrypt(Data[I], Key);
end;
{$OVERFLOWCHECKS ON}
 
function SameKey(const Key1, Key2: TTeaKey): Boolean;
var
  I: Integer;
begin
  Result := False;
 
  for I := 0 to 3 do
    if Key1[I] <> Key2[I] then
      Exit;
 
  Result := True;
end;
 
procedure StrToKey(const S: AnsiString; var Key: TTeaKey);
var
  TempBytes: TByte4;
  I, N, K: Integer;
  SB: AnsiString;
begin
  SB := UTF8Encode(StringOfChar(' ', 16));
  N := Min(Length(S), 16);
 
  for I := 1 to N do
    SB[I] := S[I];
 
  for I := 0 to 3 do
  begin
    TempBytes := CardinalToBytes(Key[I]);
 
    for K := 0 to 3 do
      TempBytes[K] := Ord(SB[I * cTeaBlockSize + K + 1]);
 
    Key[I] := BytesToCardinal(TempBytes);
  end;
end;
 
function KeyToStr(const Key: TTeaKey): AnsiString;
var
  I, K: integer;
  TempBytes: TByte4;
begin
  SetLength(Result, 16);
 
  for I := 0 to 3 do
  begin
    TempBytes := CardinalToBytes(Key[I]);
 
    for K := 0 to 3 do
      Result[I * cTeaBlockSize + K + 1] := AnsiChar(Chr(TempBytes[K]));
  end;
end;
 
procedure StrToData(S: AnsiString; var Data: TTeaData);
var
  I, N, M: integer;
  TempBytes1: TByte4;
  TempBytes2: TByte4;
begin
  N := Length(S) div (cTeaBlockSize * 2);
  M := Length(S) mod (cTeaBlockSize * 2);
 
  if M <> 0 then
  begin
    Inc(N);
    S := S + AnsiString(StringOfChar(' ', (cTeaBlockSize * 2) - M));
  end;
 
  if N < 2 then  // n = 1
  begin
    N := 2;
    S := S + AnsiString(StringOfChar(' ', cTeaBlockSize * 2));
  end;
 
  // set buffer length
  SetLength(Data, N);
 
  for I := 0 to Length(Data) - 1 do
  begin
    for M := 0 to 3 do
    begin
      TempBytes1[M] := Ord(S[(I * 2) * cTeaBlockSize + M + 1]);
      TempBytes2[M] := Ord(S[(I * 2) * cTeaBlockSize + M + 1 + cTeaBlockSize]);
    end;
 
    // put data to longword and back to buffer
    Data[I][0] := BytesToCardinal(TempBytes1);
    Data[I][1] := BytesToCardinal(TempBytes2);
  end;
end;
 
procedure BytesToData(S: TTeaBytes; var Data: TTeaData);
var
  I, N, M: integer;
  TempBytes1: TByte4;
  TempBytes2: TByte4;
begin
  N := Length(S) div (cTeaBlockSize * 2);
  M := Length(S) mod (cTeaBlockSize * 2);
 
  if M <> 0 then
  begin
    Inc(N);
    SetLength(S, Length(S) + (cTeaBlockSize * 2) - M);
  end;
 
  if N < 2 then  // n = 1
  begin
    N := 2;
    SetLength(S, Length(S) + cTeaBlockSize * 2);
  end;
 
  // set buffer length
  SetLength(Data, N);
 
  for I := 0 to Length(Data) - 1 do
  begin
    for M := 0 to 3 do
    begin
      TempBytes1[M] := S[(I * 2) * cTeaBlockSize + M];
      TempBytes2[M] := S[(I * 2) * cTeaBlockSize + M + cTeaBlockSize];
    end;
 
    // put it back to longword
    Data[I][0] := BytesToCardinal(TempBytes1);
    Data[I][1] := BytesToCardinal(TempBytes2);
  end;
end;
 
procedure DataToStr(var S: AnsiString; const Data: TTeaData);
var
  TempBytes1: TByte4;
  TempBytes2: TByte4;
  I, N, M: integer;
begin
  N := Length(Data);
  SetLength(S, N * (cTeaBlockSize * 2));
 
  for I := 0 to N - 1 do
  begin
    TempBytes1 := CardinalToBytes(Data[I][0]);
    TempBytes2 := CardinalToBytes(Data[I][1]);
 
    for M := 0 to 3 do
    begin
      S[(I * 2) * cTeaBlockSize + M + 1] := AnsiChar(Chr(TempBytes1[M]));
      S[(I * 2) * cTeaBlockSize + M + 1 + cTeaBlockSize] := AnsiChar(Chr(TempBytes2[M]));
    end;
  end;
 
  S := AnsiString(Trim(string(S)));
end;
 
procedure DataToBytes(var S: TTeaBytes; const Data: TTeaData);
var
  TempBytes1: TByte4;
  TempBytes2: TByte4;
  I, N, M: integer;
begin
  N := Length(Data);
  SetLength(S, N * (cTeaBlockSize * 2));
 
  for I := 0 to N - 1 do
  begin
    TempBytes1 := CardinalToBytes(Data[I][0]);
    TempBytes2 := CardinalToBytes(Data[I][1]);
 
    for M := 0 to 3 do
    begin
      S[(I * 2) * cTeaBlockSize + M] := TempBytes1[M];
      S[(I * 2) * cTeaBlockSize + M + cTeaBlockSize] := TempBytes2[M];
    end;
  end;
end;

I had to turn overflow checks off for the portion of the code, because I don’t know how to avoid them. The XTEA code is designed to work this way I think. It is also important to mention that the algorithm works with 8 byte aligned blocks of data. So if the actual data is not a multiple of 8 bytes in length, we have to pad it. This can be a problem, because this way we introduce noise into the data which is decrypted on the other side. I could write the actual data size as the first 8 bytes (1 block). Then on the other side I could read that and trim the noise from the data. But the algorithm would not be XTEA compatible anymore. I still have to think about this and what to do. Another interesting problem was a Cardinal to Bytes conversion and vice verse. I had problems with that in .NET. By asking on SO I proved that you have to think outside the box sometimes and that there are always people out there that know the problem better than you do

Well quite a lot of work yes, but now I have a fast cross Delphi platform encryption algorithm.

Edit:

The CryptoAPI works on Win32, .NET and .NET Compact Framework platforms, so there is no problem with cross platform (windows that is) encryption. I did not know that at the time of the writing. But this still makes XTEA an excellent choice for Compact Framework because of its speed and simplicity. After all the mobile devices are not as powerful as other devices with Windows installed. But it is a viable solution for the next time I need encryption services.