Tuesday, November 13, 2007

Calculating accurate 'Now'

You may be aware of the fact that Windows functions that return current time with millisecond precision are not accurate to a millisecond. Then, again, you may be not. In any case, I'll show you how to calculate accurate time. Well, maybe not really accurate, but at least it will be miles better than Windows' functions.

Let's start with the system time. If you take a look at the GetSystemTime function, you'll see that it returns a structure containing years, months, hours ... and so on down to milliseconds. The problem is that it is not incremented in millisecond steps. If you fetch the time, wait for two milliseconds and fetch the time again, chances are that both structures would be completely the same. Raymond Chen states in Precision is not the same as accuracy that the accuracy of typical Windows clock is somewhere from 10 to 55 ms. On most computers I've tested, system time accuracy is approximately 15 ms.

To demonstrate this, I've written this 'complicated' code fragment:

procedure TForm6.btnGetSystemTimeClick(Sender: TObject);
i: integer;
st: TSystemTime;
for i := 1 to 15 do begin

imageThe code merely retrieves system time, logs it into TMemo and sleeps for approximately one millisecond. The result (picture on the right) is a little 'jumpy' - most of the time milliseconds stay still and then they are increased by approximately 15 milliseconds.

imageCareful reader would notice that the clock was read less than 16 times between the first '723' result and the first '739' result. That's because Sleep doesn't guarantee that the execution will resume in exactly the specified time.

Similar results (on the left) can be achieved by using GetTickCount instead of GetSystemTime.

If you still think that this doesn't concern you because you're only using Delphi's Now and similar functions, then you're wrong. Delphi calculates Now using GetLocalTime, which exhibits exactly the same symptoms as GetSystemTime.

Can we do better?

Of course we can! Otherwise this blog entry would not exist :)

There is a QueryPerformanceCounter function which returns current value of some Windows' internal counter. Exact interpretation of this value is hardware dependent so you have to use QueryPerformanceFrequency function to determine the speed with which the performace counter is incremented. The accuracy of the performace counter is also hardware-dependant but usually it is much higher than one millisecond.

So here's the plan. We'll take a snapshot of system time and performance counter. When we need an accurate time, we'll query the performance counter and use stored system time, stored performance counter and current performance counter to calculate current system time. The main magic is done in two lines immediately after 'else begin'. The rest of the code just converts milliseconds into the TSystemTime record.

function PerformanceCounterToMS(perfCounter: int64): int64;
if GPerformanceFreq = 0 then
Result := 0
Result := Round(perfCounter / GPerformanceFreq * 1000);
end; { PerformanceCounterToMS }

procedure GetSystemTime_Acc(var systemTime: TSystemTime);
pcDiff : int64;
perfCount: int64;
sum : cardinal;
if GPerformanceFreq = 0 then
else begin
pcDiff := PerformanceCounterToMS(perfCount - GPerfCounterBase); //milliseconds
sum := cardinal(GSystemTimeBase.wMilliseconds) + (pcDiff mod 1000);
systemTime.wMilliseconds := sum mod 1000;
pcDiff := pcDiff div 1000; //seconds
sum := cardinal(GSystemTimeBase.wSecond) + (pcDiff mod 60) + (sum div 1000);
systemTime.wSecond := sum mod 60;
pcDiff := pcDiff div 60; //minutes
sum := cardinal(GSystemTimeBase.wMinute) + (pcDiff mod 60) + (sum div 60);
systemTime.wMinute := sum mod 60;
pcDiff := pcDiff div 60; //hours
sum := cardinal(GSystemTimeBase.wHour) + (pcDiff mod 24) + (sum div 60);
systemTime.wHour := sum mod 24;
pcDiff := pcDiff div 24; //days
DecodeDateFully(GDateBase + pcDiff, systemTime.wYear, systemTime.wMonth,
systemTime.wDay, systemTime.wDayOfWeek);
end; { GetSystemTime_Acc }

Similar but even simpler code deals with GetTickCount. There is also a 64-bit version of GetTickCount, which doesn't have its problems (wrapping around every 49 days or so).

function GetTickCount64_Acc: int64;
perfCount: int64;
if GPerformanceFreq = 0 then
Result := Windows.GetTickCount
else begin
Result := GTickCountBase + PerformanceCounterToMS(perfCount - GPerfCounterBase);
end; { GetTickCount64_Acc }

function GetTickCount_Acc: DWORD;
Result := GetTickCount64_Acc AND $FFFFFFFF;
end; { GetTickCount_Acc }

The only remaining piece of mistery is the initialization code. We have to take a snapshot of system time immediately after it is incremented (to get the most accurate value) and a snapshot of performance counter. We also try to make sure that context switch did not occur between those two measurements.

procedure InitExactTimeBase;
perfCount1: int64;
perfCount2: int64;
st1 : TSystemTime;
st2 : TSystemTime;
if GPerformanceFreq = 0 then
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_HIGHEST);
st1 := st2;
GTickCountBase := Windows.GetTickCount;
until (st1.wMilliseconds <> st2.wMilliseconds) and
(Round(perfCount1 / GPerformanceFreq * 10000) = Round(perfCount2 / GPerformanceFreq * 10000));
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
GPerfCounterBase := perfCount2;
GSystemTimeBase := st2;
GDateBase := EncodeDate(st2.wYear, st2.wMonth, st2.wDay);
end; { InitExactTimeBase }


This code is useful when you want to measure lenght of some operation in the range of few milliseconds. You would not, however, want to use it as a replacement of standard functions when you just need a real-time clock. There is, for example, no resynchronisation - if user or some time-adjusting program changes the system clock, my 'accurate' code will not notice this. On the other hand, this can be useful when performing interval measurements.

You should also keep in mind that performance counter is not necessary problem-free. For example, Microsoft's knowledge base entry #274323 describes performance counter problems on some (admittedly buggy) hardware platforms.

The Code

GpTime web pages are not up yet so for the time being the only access to the source is here. There is also a small test program available.

Things go better with ... Vista

I was totally surprised when I tested my unit on Vista and found out that both GetSystemTime and GetLocalTime work with a millisecond accuracy! GetTickCount, however, doesn't and is incremented in old 10-55 ms (depending on the platform) intervals.

As the Now function is calculated using GetLocalTime, it also has 1 ms accuracy on Vista.

The proof is below. From left to right: GetSystemTime, GetTickCount, GetLocalTime, Now.

image image image image

2009 Update

Later I found all those hacks much too much unstable for my likings. Now I’m using this trivial approach:

unit GpTime;


///<summary>Returns current time in milliseconds. Does not have well-defined time base.</summary>
function Now64: int64;



GNowLock : TCriticalSection;
GNowHigh32 : cardinal;
GNowLastLow32: cardinal;

{ exports }

function Now64: int64;
Int64Rec(Result).Lo := timeGetTime;
if Int64Rec(Result).Lo < GNowLastLow32 then
GNowLastLow32 := Int64Rec(Result).Lo;
Int64Rec(Result).Hi := GNowHigh32;
finally GNowLock.Release; end;
end; { Now64 }

GNowLock := TCriticalSection.Create;
GNowHigh32 := 0;
GNowLastLow32 := 0;

Thursday, October 25, 2007

Disabling Aero

Few days ago, David J Taylor started a borland.public.delphi.language.delphi.win32 thread on how to disable Aero interface on Vista programmatically.

Yesterday, he found and published an answer. David, thanks!

I know many are still struggling with old applications and their compatibility with Aero. Maybe this will help.

I have repacked David's function into two functions in the DSiWin32 library (DSiAeroEnable, DSiAeroDisable) and added a third one that checks whether Aero interface is enabled (DSiAeroIsEnabled).

Monday, October 15, 2007

Gp* Update

Months have passed since the last update of my freeware utils so here are new versions...

DSiWin32 1.29

  • Added functions DSiIsAdmin, DSiMoveFile, DSiMoveOnReboot, and DSiGetThreadTimes (two overloaded versions).
  • TDSiTimer properties changed from published to public.  

GpHugeFile 5.04a

  • GetFileSize Win32 call was incorrectly raising exception when file was $FFFFFFFF bytes long.
    (read more: A Case of Mysterious SUnkOSError)
  • SetFilePointer Win32 call was incorrectly raising exception when position was set to $FFFFFFFF absolute.
  • Added TGpHugeFileStream.Flush method.
  • Added a way to disable buffering on the fly in both TGpHugeFile and TGpHugeFileStream.
  • Added bunch of missing Win32Check checks.
  • Better error reporting when application tries to read/write <= 0 bytes.
  • Added optional logging of all Win32 calls to the TGpHugeFile (enabled with /dLogWin32Calls).
  • Added thread concurrency debugging support to TGpHugeFileStream when compiled with /dDEBUG.
  • Don't call MsgWait... in Close if file access is not asynchronous as that causes havoc with MS thread pool execution.

GpLists 1.29

  • Added TStringList helper.
  • Use spinlock for locking. Spinlock implementation kindly provided by Lee_Nover.
  • TGpObjectRingBuffer can put locks around all operations.
  • TGpObjectRingBuffer can trigger an event when buffer is fuller than the specified threshold and another event when buffer is emptier than the (different) threshold.
  • Added missing locks to TGpDoublyLinkedList in multithreaded mode.
  • Disallow Move and Insert operations on sorted lists.
  • Added bunch of 'inline' directives. 

GpSharedMemory 4.11a

  • AllocateHwnd and DeallocateHwnd replaced with thread-safe versions. 
    (read more: AllocateHwnd is not Thread-Safe)
  • TTimer replaced with thread-safer TDSiTimer.

GpStreams 1.13

Interesting things have been going on in the GpStreams unit. TGpBufferedStream class is a stream wrapper which provid read-buffering on any stream. TGpScatteredStream is a stream that provides contiguous access to a scattered data. I plan to write an article on its use soon.

  • Implemented TGpScatteredStream class.
  • Added TGpBufferedStream class. At the moment, only reading is buffered while writing is implemented as a pass-through operation.
  • Added AutoDestroyWrappedStream property to the TGpStreamWindow class.
  • Check for < 0 position in TGpStreamWindow.Seek.
  • Fixed reading/writing of zero bytes in TGpStreamWindow.
  • Added bunch of 'inline' directives.

GpStuff 1.06

  • ReverseCardinal renamed to ReverseDWord.
  • Added function ReverseWord.

Previous updates: New GpLists and other updates

Wednesday, October 10, 2007

A Case of Mysterious SUnkOSError

Or: When INVALID_FILE_POINTER doesn't signal an  error.

I was dealing with an interesting problem today.

A customer reported that our software failed to process some specific file. The logged error was "A call to an OS function failed". Hmmm?

As I'm always logging bunch of redundant information, the problem was quickly tracked to the source. It was triggered from my GpHugeF unit, more specifically from the Win32Check method.

procedure TGpHugeFile.Win32Check(condition: boolean; method: string);
if not condition then begin
hfWindowsError := GetLastError;
if hfWindowsError <> ERROR_SUCCESS then
raise EGpHugeFile.CreateFmtHelp(sFileFailed+
[method, FileName, hfWindowsError, SysErrorMessage(hfWindowsError)],
raise EGpHugeFile.CreateFmtHelp(sFileFailed+
[method, FileName], hcHFUnknownWindowsError);
end; { TGpHugeFile.Win32Check }

This is a simple wrapper around Win32 API calls in the GpHugeF unit and somehow it got called with condition set to False while GetLastError returned ERROR_SUCCESS. Hmmm again?

A little more tracing showed that in this case Win32Check was wrapped around GetFileSize call. So how could it happen that GetFileSize returned error when there was no error?

GetFileSize is one of weirder Win32 API functions. It takes one parameter, which is an address of a DWORD and returns a DWORD. Lower 32 bits of the file size are returned in the function result while higher 32 bits are stored in the parameter passed via reference. Delphi declars this API as

function GetFileSize(hFile: THandle; lpFileSizeHigh: Pointer): DWORD; stdcall;

If you only need file sizes up to 4294967294 ($FFFFFFFE) bytes, you can pass nil in gthe lpFileSizeHigh parameter. But to be fully compliant with brave new world, you'll better pass an address of some DWORD variable here.

That's all good and well unless GetFileSize needs to signal a problem. Most of Win32 functions that return some integer number (functions that open files, create synchronisation primitives etc) return special value $FFFFFFFF when an error is encountered. Application can then call GetLastError to get more info about the problem.

Do you see the problem yet? $FFFFFFFF is a valid file size. Heck, even $10FFFFFFFF (where $10 is returned in lpFileSizeHigh^ and $FFFFFFFF as a function result) is a valid file size. If GetFileSize returns $FFFFFFFF, how would you know if there was an error or not?

It turns out that you should check GetLastError to be really sure. From the Microsoft's documentation:

If the function succeeds, the return value is the low-order doubleword of the file size, and, if lpFileSizeHigh is non-NULL, the function puts the high-order doubleword of the file size into the variable pointed to by that parameter.

If the function fails and lpFileSizeHigh is NULL, the return value is INVALID_FILE_SIZE. To get extended error information, call GetLastError. When lpFileSizeHigh is NULL, the results returned for large files are ambiguous, and you will not be able to determine the actual size of the file. It is recommended that you use GetFileSizeEx instead.

If the function fails and lpFileSizeHigh is non-NULL, the return value is INVALID_FILE_SIZE and GetLastError will return a value other than NO_ERROR.

So that was my problem. I incorrectly checked for error code. And it's even worse - when I was writing GpHugeF, I was fully aware of this problem but my error checking code was coded incorrectly :( In my defense I should state that the code in question was written in 1998 when it was really hard to test operation on 4 GB files.

I solved the problem with two simple wrappers that return False on failure (two because SetFilePointer API also has this feature).

function TGpHugeFile.HFGetFileSize(handle: THandle; var size: TLargeInteger): boolean;
size.LowPart := GetFileSize(handle, @size.HighPart);
Result := (size.LowPart <> INVALID_FILE_SIZE) or (GetLastError = NO_ERROR);
end; { TGpHugeFile.HFGetFileSize }

function TGpHugeFile.HFSetFilePointer(handle: THandle; var distanceToMove: TLargeInteger;
moveMethod: DWORD): boolean;
distanceToMove.LowPart := SetFilePointer(handle, longint(distanceToMove.LowPart),
@distanceToMove.HighPart, moveMethod);
Result := (distanceToMove.LowPart <> INVALID_SET_FILE_POINTER) or (GetLastError = NO_ERROR);
end; { TGpHugeFile.HFSetFilePointer }

The only remaining question was how they stumbled upon a file that was exactly 4294967295 bytes long. It turned out that they downloaded this file from another location with ftp. File was originally 4,6 GB long but Vista's excellent ftp client truncated it at $FFFFFFFF bytes. So my bug was only found and fixed because of Microsoft's buggy code. Thanks for that bug, Microsoft!

[New version of GpHugeF will be released soon. Really soon. That's a promise!]

Why You Should *Always* Use SQL Parameters



XKCD is just great.

Thursday, July 19, 2007

Hardware Project Completed

[ no Delphi content here, go away! ;) ]

Months ago, I posted a coffee table design on this blog. Now I'm happy to say that the damned thing is finally completed and installed in my friends' apartment.

This is it - 58 kilos of solid ash, painted with very watered-down white and finished with two layers of wax. Walnut veneer was used for the inset.

finished coffee table 

More photos in my gallery, including details of the build process.

Friday, July 13, 2007

What I Tell You Three Times is True

When I was young and stupid, I made modifications to my code at will. A little here, a little there, a little everywhere. And I always knew what I changed and what I have to undo and what is still missing. Unless I forgot.

When I was a little older, I started marking changes that had to be undone with comments.

Then Borland (or was it Inprise at that time? Who cares) added TODO support to the editor and since then I'm writing

  // TODO 1 -oPrimoz Gabrijelcic : only for debugging, remove!

This makes a nice entry in my TODO list, which is visible at all times.

Later I started adding warnings that don't show in the TODO list, but in the Messages window:

{$IFDEF LogSomething}
{$MESSAGE WARN 'logging of Something enabled'}

An added bonus of this approach is that $MESSAGE messages are shown by the command-line compiler. I always write code that contains no hints nor warnings and such messages really stand up from the normal compiler output.

Recently, however, I started to doubt my sanity. I caught myself writing

// TODO 1 -oPrimoz Gabrijelcic : testing, remove!
{$MESSAGE WARN 'An important module is disabled'}
rrEventLogger.LogEvent('An important module is disabled!', svWarning);
// Process;

(In reality, messages were more descriptive.) First line is warning me to remove this code before creating a release version of the program. Second line warns me when I'm compiling the code and the third one logs a warning into program's log. I had a reason for all this - I had to run this version at a customer for debugging purposes but I didn't want it to be used anywhere else.

Still, I'm asking myself since this day - am I being overprotective to myself?

Wednesday, June 20, 2007

Spell-checking in Windows Live Writer

For all non-en-US users that have been missing Tools/Check Spelling menu and inline spell checker in the latest Windows Live Writer beta, here is the solution.

Great thanks to JTB for this!

Technorati tags: ,

Wednesday, June 13, 2007

AllocateHwnd is not Thread-Safe

[This article also serves as announcement of DSiWin32 1.26.]

[Update: Reported as QC #47559. Vote for it!]

You're probably asking yourself - what's that AllocateHwnd anyway? And why must it be thread-safe?

As the Google is guick to tell (BTW, Steve, thanks for the search filter!), AllocateHwnd is used to create a hidden window which you can use to receive messages in non-windowed components. Of course, you can use it outside of any component to set up simple and easy messaging subsystem anywhere in your application. If you need more communication channels, just call AllocateHwnd many times.

I won't bother you with the usage pattern - if you want to use AllocateHwnd and don't know how, use the search link above. You'll find many examples, including this one from DelphiDabbler, which Steve's searcher lists on the first place.

An example of a very popular component using AllocateHwnd internally is Delphi's TTimer.

That should answer the first question, but what about thread-safety?

Well, many programmers use AllocateHwnd in threaded code to create hidden windows where messages are processed. Many are also using TTimer inside threads without knowing the first thing about AllocateHwnd. But almost nobody knows that this is totally unsafe and may lead to rare and obscure crashes. AllocateHwnd was written with single-threaded VCL applications in mind and you can use it from a thread only if you take special precaution.

Why is AllocateHwnd dangerous

Let's see how the AllocateHwnd is implemented. Following code was copied from D2007's Classes.pas (in very old Delphis, AllocateHwnd was implemented in Forms.pas):

UtilWindowClass: TWndClass = (
style: 0;
lpfnWndProc: @DefWindowProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: 'TPUtilWindow');

function AllocateHWnd(Method: TWndMethod): HWND;
TempClass: TWndClass;
ClassRegistered: Boolean;
UtilWindowClass.hInstance := HInstance;
UtilWindowClass.lpfnWndProc := @DefWindowProc;
ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
if ClassRegistered then
Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
'', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
if Assigned(Method) then
SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));

Basically, the code registers window class if necessary, creates a new window of that class, and sets window procedur for that window to MakeObjectInstance(Method). Nothing special, except this last step. Can you tell why it is necessary at all?

The reason lies in the discrepancy between Delphi's object model and Win32 API, which is not object oriented. The TWndMethod parameter passed to the AllocateHwnd is not just an address of code, but contains also the address of the object this method belongs to.

On the other hand, Win32 API wants to call a simple method anytime it has to deliver a message to a window.

MakeObjectInstance bridges this gap. It manages a linked list of methods together with a dynamically generated code preamble (address of which is returned from the MakeObjectInstance function). When Windows calls this code preamble, it makes sure that correct method is called on the correct object.

MakeObjectInstance is complicated, but it works. That is, until you call it from two threads at the same time. You see, MakeObjectInstance does nothing to lock its internal list while it is being manipulated. If you do this from two threads running on two CPUs, or even if you have only one CPU and context switch occurs at a bad time, internal instance list can get corrupted. Later, this may lead to crashes, bad program behaviour, you name it. And you'll never find the true culprit.

Admittedly, there is only a small window - few instructions - which are problematic. In most applications such problems will never occur. But if you're running 24/7 server which calls AllocateHwnd/DeallocateHwnd constantly from multiple threads, you can be sure that sooner or later it will crash.


There are two possible solutions to the problem - one is to wrap all AllocateHwnd and DeallocateHwnd in some sort of critical section, spinlock or mutex that will allow only one instance to be called at the same time and other is to write a better and thread-safe AllocateHwnd. First solution is somewhat clumsy to implement in production code while the second can be hard to write.

Actually, I search the net wide and deep and found only two alternative AllocateHwnd implementations (references below). I'm sure there are more. I just couldn't find them. None of them was really suitable for my needs so I created a third one using ideas from both of them. My version — DSiAllocateHwnd, DSiDeallocateHwnd and TDSiTimer — has been published as a part of the DSiWin32 library.

This is the current version of my AllocateHwnd alternative:
GWL_METHODCODE = SizeOf(pointer) * 0;
GWL_METHODDATA = SizeOf(pointer) * 1;

CDSiHiddenWindowName = 'DSiUtilWindow';

GDSiWndHandlerCritSect: TRTLCriticalSection;
GDSiWndHandlerCount: integer;

function DSiClassWndProc(Window: HWND; Message, WParam, LParam: longint): longint; stdcall;
instanceWndProc: TMethod;
msg : TMessage;
instanceWndProc.Code := Pointer(GetWindowLong(Window, GWL_METHODCODE));
instanceWndProc.Data := Pointer(GetWindowLong(Window, GWL_METHODDATA));
if Assigned(TWndMethod(instanceWndProc)) then
msg.msg := Message;
msg.wParam := WParam;
msg.lParam := LParam;
Result := msg.Result
Result := DefWindowProc(Window, Message, WParam,LParam);
end; { DSiClassWndProc }

function DSiAllocateHWnd(wndProcMethod: TWndMethod): HWND;
alreadyRegistered: boolean;
tempClass : TWndClass;
utilWindowClass : TWndClass;
Result := 0;
FillChar(utilWindowClass, SizeOf(utilWindowClass), 0);
alreadyRegistered := GetClassInfo(HInstance, CDSiHiddenWindowName, tempClass);
if (not alreadyRegistered) or (tempClass.lpfnWndProc <> @DSiClassWndProc) then begin
if alreadyRegistered then
Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
utilWindowClass.lpszClassName := CDSiHiddenWindowName;
utilWindowClass.hInstance := HInstance;
utilWindowClass.lpfnWndProc := @DSiClassWndProc;
utilWindowClass.cbWndExtra := SizeOf(TMethod);
if Windows.RegisterClass(utilWindowClass) = 0 then
raise Exception.CreateFmt('Unable to register DSiWin32 hidden window class. %s',
Result := CreateWindowEx(WS_EX_TOOLWINDOW, CDSiHiddenWindowName, '', WS_POPUP,
0, 0, 0, 0, 0, 0, HInstance, nil);
if Result = 0 then
raise Exception.CreateFmt('Unable to create DSiWin32 hidden window. %s',
SetWindowLong(Result, GWL_METHODDATA, Longint(TMethod(wndProcMethod).Data));
SetWindowLong(Result, GWL_METHODCODE, Longint(TMethod(wndProcMethod).Code));
finally LeaveCriticalSection(GDSiWndHandlerCritSect); end;
end; { DSiAllocateHWnd }

procedure DSiDeallocateHWnd(wnd: HWND);
if GDSiWndHandlerCount <= 0 then
Windows.UnregisterClass(CDSiHiddenWindowName, HInstance);
finally LeaveCriticalSection(GDSiWndHandlerCritSect); end;
end; { DSiDeallocateHWnd }

There are many differences between this code and Delphi version.

  • My code uses custom DefWindowProc method - DSiClassWndProc.
  • It reserves four extra bytes in each window of the DSiUtilWindow class (utilWindowClass.cbWndExtra setting).
  • It writes both parts of TMethod (code and data) directly into those four bytes of the hidden window's user data.
  • DSiClassWndProc retrieves those four bytes, reconstructs TMethod and calls it directly.
  • When all hidden windows are closed, window class gets unregistered (in DSiDeallocateHwnd).

I admit that this approach to message dispatching is slower than the Delphi's version, but usually that is not a problem - custom windows are usually created to process some small subset of messages only.


The AllocateHwnd problem is not something I have found by myself. It has been documented for years, but is not well known.

I'd like to thank to:

  • Arno Garrels on the ICS mailing list, who described the problem to me.
  • Francois Piette for providing ICS source code with custom AllocateHwnd solution. My approach is partially based on the Francois' code.
  • Alexander Grischenko, who wrote this solution from which I stole the idea of storing TMethod directly in window's extra data.

Tuesday, May 29, 2007

Stream Me a River

Recently, I have uploaded new open source unit to my web pages - GpStreams. It contains a mix of TStream descendants, enhancers and helpers I have written over the last few years.

Stream Window

TGpStreamWindow is a TStream descendant which provides a window into another stream.

Sometimes you want to pass just a part of a stream to some method. For example, you have a stream containing a header and data and you want to pass it to a method that expects only data. If you can't change the method in question to ignore the header (maybe it's not a method you have written), then you would normally have to copy the data part to another stream and pass the copy to that method.

Alternatively, you can wrap the stream into TGpStreamWindow and set limits to exclude the header, then pass the TGpStreamWindow instance to the method. TGpStreamWindow doesn't copy data but overrides Read, Write, and Seek methods.

Relevant part of the interface:

  TGpStreamWindow = class(TStream)
constructor Create(baseStream: TStream); overload;
constructor Create(baseStream: TStream; firstPos, lastPos: int64); overload;
procedure SetWindow(firstPos, lastPos: int64);
property FirstPos: int64 read srFirstPos;
property LastPos: int64 read srLastPos;
end; { TGpStreamWindow }


procedure DoSomethingWithData(dataStream: TStream);

procedure ProcessStream(headerAndData: TStream);
dataStream: TGpStreamWindow;
// first 512 bytes contain the header - ignore!
dataStream := TGpStreamWindow.Create(headerAndData, 513, headerAndData.Size - 1);
finally FreeAndNil(dataStream); end;

Streamed Memory Buffer

TGpFixedMemoryStream is a TStream descendant which provides  streamed access to a memory buffer. In a way, it is similar to the TStringStream except that the underlying data is stored in a constant-size memory buffer.


  TGpFixedMemoryStream = class(TStream)
constructor Create; overload;
constructor Create(const data; size: integer); overload;
constructor Create(const data: string); overload;
procedure SetBuffer(const data; size: integer);
property Memory: pointer read fmsBuffer;
end; { TGpFixedMemoryStream }

Stream enhancers

TGpStreamEnhancer class contains various small helpers for the TStream class. Because of the technology used (class helpers), it can only be used in D2005 and newer. Also because of the technology used, TGpStreamEnhancer extends functionality of TStream and all descendant classes.

TGpStreamEnhancer contains:

  • Big endian (Motorola) readers/writers - Methods to read/write numbers in Motorola (big endian) format.
  • Little endian (Intel) readers/writers - Methods to read/write numbers in Intel (little endian) format.
  • Tagged readers/writers - Methods to read/write tagged data.
  • Text file emulator - Write(string) and Writeln.
  • Other helpers - Save/load stream to/from file, format stream as string or hex string, empty the stream.

Stream Wrappers

Two stream wrappers are included. Both are implemented with interfaces and use the fact that Delphi automatically destroy interfaces when they go out of scope to achieve some 'automagic' functionality.

AutoDestroyStream automatically destroys a stream, when the wrapper goes out of scope.

For example, ProcessStream example above could be rewritten with AutoDestroyStream to:

procedure ProcessStream(headerAndData: TStream);
// first 512 bytes contain the header - ignore!
TGpStreamWindow.Create(headerAndData, 513, headerAndData.Size)).Stream);

KeepStreamPosition wrapper automatically resets stream position to the original value when wrapper is destroyed.

Other Utilities

Few 'unclassified' utilities are also included in the GpStreams unit.

SafeCreateFileStream is a wrapper around TFileStream.Create that maps exception into function result.

DestroyFileStreamAndDeleteFile destroys TFileStream and deletes the file that was used as a stream source.

Technorati tags: , , , ,

Monday, May 28, 2007

New GpLists and other updates

It's been quite some time since I last updated my Delphi freeware stuff so here's the list of latest changes:

DSiWin32 1.24

GpLists 1.26

  • Added TGpReal class.
  • Added TGpCountedIntegerList class.
  • Added TGpCountedInt64List class.
  • Added CustomSort method to the TGpIntegerList and TGpInt64List classes.
  • Added EqualTo method to the TGpIntegerList class.
  • Added ValuesIdx to the TGpObjectMap class.
  • Compiles with Delphi 6 again. Big thanks to Tao Lin and Erik Berry for reporting, diagnosing and fixing the problem.
  • Older articles: Sir! Do you need a list? Cheap, just for you!

GpHugeFile 5.01a

  • Fixed a bug where internal and external file pointer got out of sync in buffered write mode.
  • Exposed underlying file's handle as a Handle property from the TGpHugeFileStream class.
  • Added support for asynchronous writing.
  • Older articles: GpHugeFile 4.0

GpStructuredStorage 1.12a

GpSync 1.20

  • New class TGpCircularBuffer.

GpStuff 1.05

  • Newly published on the web, contains some small utilities. See the source.

GpStreams 1.13

  • Collection of stream helpers, stream descendants and stream utilities. I'm preparing a more detailed description which should be published soon.

Previous updates: Bulk update

Technorati tags: , , ,

Friday, May 11, 2007

Case .. else raise, again

Yesterday I used a really bad example which got most of my readers thinking about how most of the code could be optimized away. As that was not the idea behing my post, I decided to give a better example. This one is straight from the production code:

case mafWorkerOwner.PostToThread(MSG_AF_SCHEDULE_VIDEO, clonedBuffer) of
Result := ClearError;
'Timeout while sending message to the worker thread');
'Cannot send message to the worker thread - queue full');
else raise Exception.Create('TMXFAsyncFilter.ScheduleVideo: Unexpected PostToThread result');
end; //case PostToThread

Am I making more sense now?

Technorati tags: , ,

Thursday, May 10, 2007

Case .. else raise

I believe in safe programming. In my book that means that my programs should fail whenever I do something wrong. Even better - they should automatically detect my future stupidities and warn me when I make them.

For example, take this completely made-up example:

TEnumeration = (enOne, enTwo, enThree);

function DoSomethingWith(enum: TEnumeration): integer;
case enum of
enOne: Result := 1;
enTwo: Result := 2;
enThree: Result := 3;

Pretty typical, huh? We'll, I won't write it like that. Never.

Let's say that in the future TEnumeration gets extended to include enFour. Now you have to hunt all places where it is used and adapt the code. Maybe you'll miss one or two, maybe not. I usually do :(

At least in fragments like the one above, a little planning can save you hours of debugging. By adding just one line, you can be automatically reminded that you failed to update the code at this very place:

TEnumeration = (enOne, enTwo, enThree);

function DoSomethingWith(enum: TEnumeration): integer;
case enum of
enOne: Result := 1;
enTwo: Result := 2;
enThree: Result := 3;
else raise Exception.Create('DoSomethingWith: Unexpected value');

(For commenters: Yes, I'm aware that this is simply a precondition check.)


Technorati tags: , ,

Monday, April 23, 2007

When changing semantics, make sure that existing code will break

This is something I learned the hard way - by many times making the same mistake.

Let's say you have a function AdjustBitrate that accepts one parameter representing new bitrate in kb/s (whatever that may mean).  It's prototype is simple:

procedure TBaseClass.AdjustBitrate(newBitrate_kb_s: integer);

Due to a changed requirements, you have to redesign this function so that it will take not a new bitrate, but a bitrate increase (relative to the existing bitrate). What do you do?

procedure TBaseClass.AdjustBitrate(bitrateIncrease_kb_s: integer);

Wrong! Just the mistake I was talking about. You changed the semantics of a method without breaking existing code!

Just think of what is your next task - you have to find all places where AdjustBitrate is called and fix them to pass bitrate increase as a parameter instead of target bitrate. Without the help of the compiler you'll surely miss one or two. True, Ctrl-Shift-Enter (or Search, Find References) in new IDEs can help a lot, but it is still not perfect. It won't show you other projects by your colleagues, which are unaware of this change in the semantics. Or even worse - what if this is a part of some 3rd party library that many other programmers are using? How will you force them all to update?

The answer is simple - your change must break existing code. In this case, the simplest solution is to rename the method:

procedure TBaseClass.AdjustBitrateBy(bitrateIncrease_kb_s: integer);

That's all. The compiler will warn all programmers using your code that AdjustBitrate does not exist and then they'll find AdjustBitrateBy and notice the change in parameters (hope, hope).

Sometimes you're completely sure that no code outside the current project can be using the method you're working on (maybe it is a private method). In that case, I usually rename the method (for example, Add becomes xAdd), fix all call sites for this method (compiler will report errors everywhere I'm trying to use Add), and then rename it back (xAdd -> Add).

Technorati tags: , ,

Friday, April 20, 2007

Using descriptive variable names

If I've learned something in my programming career, it is a fact that your coding style changes all the time. [Not all the time for the better, I have to admit - there was a weird phase when if..then..else alignment ... no, I'm not yet able to discuss this. Too scary.] It is not only alignment that is affected (hanging begin..end etc) but the way how you split stuff into classes, units, and methods, and how you name entities.

Recently I made a change in the latter. I'm a big fan of using long entity names (even my 'for' variables are usually named iSomething), but recently noticed that I cannot always pack enough meaning into a name. I was doing some DVB transport stream manipulations and noticed that most of the time entity names only conveyed half of their real-world semantics. For example, I had an originalBitrate variable but there was no way of telling if this bitrate is specified in bits per second, bytes per millisecond or maybe kilobits per second. Or I had a VideoStart property and I had no idea if it is specified in milliseconds or PCR units (basic time unit in transport streams) or even as a byte offset from the start of the transport stream. I had to look into my documentation or even into the code to see how the entity in question was initialized.

That was clearly Not Good and I needed a better way. I started decorating names with descriptive suffixes.

Nowadays I'm using originalBitrate_kb_s and VideoStart_PCR and I can immediately tell that former is stored in kilobytes per second and latter in PCR units. I'm using this approach any time that simple entity name is not enough to describe its contents. For example, I'm using _pct suffix when variable holds a percentage of something and _UTC when TDateTime field contents are stored not as a local but as an universal time and even _ref when a pointer/object variable is not an owner of some data but only holds and external reference to it.

While suffixes are good for documenting purposes they also improve the code readability. I can immediately tell that assignment bitrate_b_ms := someOtherBitrate_B_s is wrong and that someTime := otherTime_UTC is wrong or suspicious. I can even tell that the formula Result := base_PCR + MSToPCR(offset_B / bitrate_B_ms) makes some sense. [B] / [B/ms]  gives [ms], which MSToPCR somehow converts to [PCR] units which are then added to some base timestamp, also stored in [PCR] format. Check.

Decorators can be helpful, but still you should use them sparingly. Using a variable bitrate_kb_s_unverified_data_reported_from_external_dll is not such a good idea. Comments are still useful when you have to document that level of semantics. 

Technorati tags: , ,

Wednesday, April 11, 2007

The most important Delphi setting

I have my favourite Delphi setting. A setting that is not enabled by default, but which I always turn on. A setting that many developer's don't use and many can't live without. A setting that you should use. Always.

I'm not telling you which setting this is. Yet.

Look at this code fragment first.

  i := 1;                
while (s[i] <> s[i+1]) and (i < Length(s)) do
i := i + 1;
There is a problem in this code. Can you spot it?

This small fragment accesses s[Length(s) + 1], which is an undefined value and may even lie outside of allocated virtual memory and cause an Access Violation during program execution. This happens because of a simple bug - tests in the while loop should be reversed so that i < Length(s) proposition is tested first.

  i := 1;                
while (i < Length(s)) and (s[i] <> s[i+1]) do
i := i + 1;

The really big problem with this code is that Delphi doesn't report any error when you run it. At least with default settings it doesn't.

And now we came to my favourite Delphi setting - Range checking.

Select Project.Options and check Range checking.

Click OK and rebuild the project. Run it again.

See! Delphi can find such errors, it just needs a little motivation!

I strongly recommend to enable range checking for all new projects. Close all projects in Delphi, then select Projects.Default Options.Delphi for Win32 and check Range checking (in BDS 2006; instructions for other IDE versions may differ).

If range checking is so good, then why is it not turned on by default? I suspect that it was originally disabled because of speed issues on slow CPUs. Range checking can quickly add 10% to the execution time if your code uses string and array indices a lot. Nowadays this is hardly noticeable but by enabling range checking, old code may break in very interesting ways. Especially if it contains some range-related bugs ...

If you want to execute some time-critical code without range checking, you can put {$R-} before it (to disable rangle checking) and {$R+} after. Or, if you like more self-descriptive commands, {$RANGECHECKS OFF} and {$RANGECHECKS ON}. And please don't try to guess what the time-critical part of your program is, use a profiler.


Technorati tags: , ,

Friday, April 06, 2007

Sunday, March 25, 2007

Inside the Windows Vista Kernel

If you want to do serious (non-GUI :) ) programming on Vista, I heartily recommend following three-part series on Vista Kernel written by one-and-only Mark Russinovich:

Inside the Windows Vista Kernel: Part 1 (thread priority and scheduling, file-based symbolic links, canceling I/O operations)

Inside the Windows Vista Kernel: Part 2 (memory management, startup and shutdown, power management)

Inside the Windows Vista Kernel: Part 3 (reliability, recovery, security)

Friday, March 16, 2007

Delphi 2007 is here!

Delphi 2007 has gone gold and will be available for download soon (in some countries, it already is). Read more at Steve Trefethen's blog.

If you can't decide whether you want to buy it or not, check BetaBlogger blogs. We've written quite some words on D2007 (blogs are sorted alphabetically, posts chronologically):

(If I forgot to link anybody, it wasn't on purpose. Please post any additional URLs in the comments.)

Thursday, March 15, 2007

Default array properties - There Can Be Only One. Not!

I was in total awe today when I found out that there can be more than one default array property in a single class. And I thought that I know everything about Object Pascal!

I also come across a great way to use records and Implicit operator.

And what's the best - I learned both things in a single blog entry - Overloading array properties in Delphi/Win32! Recommended!

Monday, March 12, 2007

Glassy Delphi

In Fun with enumerators, part 5 I wrote

"Class helpers offer us a way to extend classes that we cannot touch otherwise. For example, they are used inside Delphi 2007's VCL to add glass support to TCustomForm (it was impossible to extend TCustomForm itself as D2007 is a non-breaking release)."

For all interested - Hallvard just published nice description of how glass support was added to the TCustomForm.

Sunday, March 11, 2007

Fun with enumerators

Boy, was this an interesting trip.

For the last six days I was writing a series of articles on Delphi enumerators, one day each. In some way, this was very similar to something else I like to do - writing magazine articles on computer-related topics. So similar that I planned this series exactly as I'm planning an article. In some other way, it was also very different. Later posts I adapted based on feedback from earlier ones. For example, Part 6 was not included in the original article outline. This topic came to my mind while I was reading reader comments. In a way, it was like working with a very eager editor who is checking every chapter immediately I'm finished with it. Or, if you want, it was similar to pair programming.

In a way, writing this series was more like writing a book. If that's so, I have something more to write - a table of contents. It will help new readers to read whole series or just find the part they are interested in. So without further ado, here is the

Table of Contents

Part 1 - Introduction

Contains a short introduction on Delph iterators (for..in statement) and describes Delphi support for iterator extensibility.

Part 2 - Additional enumerators

Shows how to add an additional enumerator to a class that already contains one.

Part 3 - Parameterized enumerators

This chapter takes Part 2 topic one level further by introducing enumerator parameters.

Part 4 - External enumerators

In this chapter you'll learn how to create enumerators without changing the class they are enumerating.

Part 5 - Class helper enumerators

Shows how to create additional enumerators using class helpers and how to use same technique to add enumerators to classes that don't have one.

Part 6 - Generators

The last chapter shows how to write enumerators that work on their own data, not on some external structure. It also includes full source code of a demo program and all enumerators described in the series.

Make sure you'll also read comments to those posts - some quite interesting ideas are hidden there.

[If you liked my articles, feel free to tell others about them. Thanks!]

Updated 2007-11-13

Hallvard Vassbotn posted interesting observations on enumerator performance in More fun with Enumerators.

Allen Bauer found a new use of the enumerator pattern in Stupid Enumerator Tricks - And now for something completely different.

Technorati tags: , ,

Saturday, March 10, 2007

Fun with enumerators, part 6 - generators

[Part 1 - Introduction, Part 2 - Additional enumerators, Part 3 - Parameterized enumerators, Part 4 - External enumerators, Part 5 - Class helper enumerators.]

This was a long and interesting trip but it has to end some day. And it will end today. Just one last small topic to cover ...

in Part 4 I mentioned that we could abuse enumerators to the point where they are not working on any external structure. My example for such generator which is providing its own enumeration data was

for i in Fibonacci(10) do

and I promised to show you how to write it.

Again, we will start with a 'standard' enumerator factory, the one that we used a lot in parts 4 and 5.

  IEnumFibonacciFactory = interface
function GetEnumerator: TEnumFibonacci;

TEnumFibonacciFactory = class(TInterfacedObject, IEnumFibonacciFactory)
FUpperBound: integer;
constructor Create(upperBound: integer);
function GetEnumerator: TEnumFibonacci;

function Fibonacci(upperBound: integer): IEnumFibonacciFactory;

Enumerator is slightly trickier this time - it prepares requested data in the constructor and uses MoveNext to move over this data.

  TEnumFibonacci = class
FFibArray: array of integer;
FIndex: integer;
constructor Create(upperBound: integer);
function GetCurrent: integer;
function MoveNext: boolean;
property Current: integer read GetCurrent;

constructor TEnumFibonacci.Create(upperBound: integer);
i: integer;
SetLength(FFibArray, upperBound);
if upperBound >= 1 then
FFibArray[0] := 1;
if upperBound >= 2 then
FFibArray[1] := 1;
for i := 2 to upperBound - 1 do
FFibArray[i] := FFibArray[i-1] + FFibArray[i-2];
FIndex := -1;

function TEnumFibonacci.GetCurrent: integer;
Result := FFibArray[FIndex];

function TEnumFibonacci.MoveNext: boolean;
Result := FIndex < High(FFibArray);
if Result then

Test code follows the well-learned pattern.

procedure TfrmFunWithEnumerators.btnFibonacciClick(Sender: TObject);
i : integer;
ln: string;
ln := '';
for i in Fibonacci(10) do begin
if ln <> '' then
ln := ln + ', ';
ln := ln + IntToStr(i);
lbLog.Items.Add('Generator: ' + ln);

And now it really is a time to say goodbye. At least to this series - I intend to write many more blog entries. It was an interesting experience for me and I hope an interesting reading for you, dear reader. If you liked it, tell that to others so that they may enjoy it too.

[A full source code of the demo program including all enumerators is available at http://17slon.com/blogs/gabr/files/FunWithEnumerators.zip]

Technorati tags: , ,

Friday, March 09, 2007

Fun with enumerators, part 5 - class helper enumerators

[Part 1 - Introduction, Part 2 - Additional enumerators, Part 3 - Parameterized enumerators, Part 4 - External enumerators.]

Last time we saw how to add enumeration to the classes we cannot modify by using global functions. Today I'll show you another way - enumerators can be added by using class helpers.

Class helpers offer us a way to extend classes that we cannot touch otherwise. For example, they are used inside Delphi 2007's VCL to add glass support to TCustomForm (it was impossible to extend TCustomForm itself as D2007 is a non-breaking release and must keep compatibility with D2006 DCUs and BPLs).

Class helpers are actually a heavy compiler trickstery. When you declare a class helper, you're not extending original virtual method table, you just get a new global function that takes a hidden parameter to 'Self' and uses it when calling other class helpers or methods from the original class. It's quite confusing and I don't want to dig much deeper in this direction. Suffice to say that class helpers allow you to create a very strong make-beliefe that new method was added to an existing class. (Some more data on class helpers can be found in Delphi help.)

Instead of writing new enumerator we'll be reusing existing TStringsEnumReversed and TStringsEnumReversedFactory from Part 4. We'll just add new class helper that will replace the EnumReversed global function.

  TStringsEnumReversedHelper = class helper for TStrings
function EnumReversed: IStringsEnumReversedFactory;

function TStringsEnumReversedHelper.EnumReversed: IStringsEnumReversedFactory;
Result := TStringsEnumReversedFactory.Create(Self);

Believe it or not, that's it. We can now use EnumReversed as if it was a method of the TStrings class.

procedure TfrmFunWithEnumerators.btnReverseLogWithCHClick(Sender: TObject);
s : string;
sl: TStringList;
sl := TStringList.Create;
for s in lbLog.Items.EnumReversed do

That looks good, but what I'll show you next will be even better.

procedure TfrmFunWithEnumerators.btnClassHelperClick(Sender: TObject);
b : TBits;
ln: string;
i : integer;
b := TBits.Create;
b[1] := true; b[3] := true; b[5] := true;
ln := '';
for i in b do
ln := ln + IntToStr(i);
lbLog.Items.Add('Class helper enumerator: ' + ln);

Here we created an instance of the TBits class and then used standard enumeration pattern (check it out - it says for i in b do - no extra properties or functions are hiding here!) to get all set bits (1, 3, and 5). And what's so great here? Check the TBits definition in Classes.pas - it doesn't contain any enumerator!

Again, a class helper did the magic.

  TBitsEnumHelper = class helper for TBits
function GetEnumerator: TBitsEnum;

function TBitsEnumHelper.GetEnumerator: TBitsEnum;
Result := TBitsEnum.Create(Self);

This time we injected GetEnumerator function directly into the base class. That removed the need for intermediate factory interface/class.

There are no special tricks in the enumerator definition.

  TBitsEnum = class
FOwner: TBits;
FIndex: integer;
constructor Create(owner: TBits);
function GetCurrent: integer;
function MoveNext: boolean;
property Current: integer read GetCurrent;

constructor TBitsEnum.Create(owner: TBits);
FOwner := owner;
FIndex := -1;

function TBitsEnum.GetCurrent: integer;
Result := FIndex;

function TBitsEnum.MoveNext: boolean;
Result := false;
while FIndex < (FOwner.Size-1) do begin
if FOwner[FIndex] then begin
Result := true;
break; //while

Admit it, class helpers are great. They can also be great source of problems. Class helpers were introduced mainly for internal CodeGear use and they have one big limitation - at any given moment, there can be at most one helper active for a given class.

You can define and associate multiple class helpers with a single class type. However, only zero or one class helper applies in any specific location in source code. The class helper defined in the nearest scope will apply. Class helper scope is determined in the normal Delphi fashion (i.e. right to left in the unit's uses clause). [excerpt from Delphi help]

IOW, if Delphi already includes class helper for a class and you write another, you'll loose the Delphi-provided functionality. (You can inherit from the Delphi class helper though - read more in Delphi help.) Use class helpers with care!

Technorati tags: , ,