Delphi compatibility restored
A recent update to my GpLists unit broke compatibility with all Delphi versions that don't have enumerator support. Sorry :(
This has now been fixed.
Labels: Delphi, programming, source code, utilities
random ramblings on Delphi, programming, and all the rest
A recent update to my GpLists unit broke compatibility with all Delphi versions that don't have enumerator support. Sorry :(
This has now been fixed.
Labels: Delphi, programming, source code, utilities
TGpInt64List.Move was totally broken. Great thanks go to 'Intra' for noticing it.
Labels: Delphi, programming, source code, utilities
The recent discussion in comments to my latest articles (Fun with enumerators - Walking the (integer) list, On bad examples and smelly code) caused a shift in my perspective. I was always treating my TGpIntegerObjectList and TGpInt64ObjectList as lists with some baggage attached, but in practice I'm almost never using them that way. Most of the time I treat them as a background storage for key-value pairs.
What's the difference? Most of the time, I don't care about item indices. When I use my lists as containers, I never need to know where in the list some (Key, Value) pair is stored. OK, almost never. When I'm deleting from the list, I sometimes use the index, just for the performance purposes. And when I access the Value part, I have to find the index with IndexOf and then use it to reference the Objects property. There are probably other cases too - but that's something that you just have to take into account if you want to use a list as a storage media.
From time to time I'm extending lists in my GpLists unit with small wrappers that help me not to use list indices in some specific situation. Today, I used the new Walk enumerator in some code and asked myself: "Why does it have to return list index? Why couldn't it return a (Key, Value) pair?"
Good question. Why couldn't it? It turns out that it could.
Let's set up some assumptions first. Assume that I have this pointless list.
il := TGpIntegerObjectList.Create;Further assume that I want to walk over it and display both number and text for each item. I can do this with a standard loop.
il.AddObject(1, TGpString.Create('one'));
il.AddObject(2, TGpString.Create('two'));
il.AddObject(3, TGpString.Create('three'));
for idx := 0 to il.Count - 1 doOr with my index-returning walker.
Log('%d: %s', [il[idx], TGpString(il.Objects[idx]).Value]);
for idx in il.Walk doBut what I'd really like to do is.
Log('%d: %s', [il[idx], TGpString(il.Objects[idx]).Value]);
for kv in il.WalkKV doOr even better.
Log('%d: %s', [kv.Key, TGpString(kv.Value).Value]);
for kv in il.WalkKV do
Log('%d: %s', [kv.Key, kv.StrValue]);
In other words, I want to return not a single item, but a pair of items from the enumerator. Of course, Delphi expressions can only return a single result and not a tuple so we have to provide a wrapper for enumerated (Key, Value) pairs. We have to pack them in a record, class or interface.
My first idea was to return an interface to a key-value object from the enumerator.
IGpKeyValue = interface
function GetKey: int64;
function GetValue: TObject;
property Key: int64 read GetKey;
property Value: TObject read GetValue;
end; { IGpKeyValue }
TGpKeyValue = class(TInterfacedObject, IGpKeyValue)
private
kvKey: int64;
kvValue: TObject;
protected
function GetKey: int64;
function GetValue: TObject;
public
constructor Create(key: int64; value: TObject);
property Key: int64 read GetKey;
property Value: TObject read GetValue;
end; { TGpKeyValue }
TGpIntegerObjectListWalkKVEnumerator = class
//...
function GetCurrent: IGpKeyValue;
property Current: IGpKeyValue read GetCurrent;
end; { TGpIntegerObjectListWalkKVEnumerator }
function TGpIntegerObjectListWalkKVEnumerator.GetCurrent: IGpKeyValue;
var
idx: integer;
begin
idx := wkeListEnumerator.GetCurrent;
Result := TGpKeyValue.Create(wkeListEnumerator.List[idx],
TGpIntegerObjectList(wkeListEnumerator.List).Objects[idx]);
end; { TGpIntegerObjectListWalkKVEnumerator.GetCurrent }
That surely works fine, but guess what - it's incredibly slow. I wouldn't expect anything else - after all an object is allocated for every enumerated value, plus all that complications with interface reference counting...
I did some testing, of course. Thousand iterations over a list with 10.000 elements. Results are quite interesting. 5 milliseconds for a standard for loop. 50 milliseconds for my Walk enumerator. 5 seconds for interface-based WalkKV. Ouch! Let's return to the drawing board...
My next idea was to return not an interface, but an object. When you return an object, you actually return a pointer to the object data, which is quite fast. It would not help much if I would recreate this object every time the GetCurrent is called, but luckily there is no real reason to do that. I can create the object when enumerator is created and destroy it when enumerator is destroyed.
TGpKeyValue = class
private
kvKey : int64;
kvValue: TObject;
public
property Key: int64 read kvKey write kvKey;
property Value: TObject read kvValue write kvValue;
end; { TGpKeyValue }
TGpIntegerObjectListWalkKVEnumerator = class
private
wkeCurrentKV: TGpKeyValue;
wkeListEnumerator: TGpIntegerListWalkEnumerator;
public
constructor Create(aList: TGpIntegerObjectList; idxFrom, idxTo: integer);
destructor Destroy; override;
//...
function GetCurrent: TGpKeyValue;
property Current: TGpKeyValue read GetCurrent;
end; { TGpIntegerObjectListWalkKVEnumerator }
constructor TGpIntegerObjectListWalkKVEnumerator.Create(aList: TGpIntegerObjectList;
idxFrom, idxTo: integer);
begin
inherited Create;
wkeListEnumerator := TGpIntegerListWalkEnumerator.Create(aList, idxFrom, idxTo);
wkeCurrentKV := TGpKeyValue.Create;
end; { TGpIntegerObjectListWalkKVEnumerator.Create }
destructor TGpIntegerObjectListWalkKVEnumerator.Destroy;
begin
FreeAndNil(wkeCurrentKV);
FreeAndNil(wkeListEnumerator);
inherited;
end; { TGpIntegerObjectListWalkKVEnumerator.Destroy }
function TGpIntegerObjectListWalkKVEnumerator.GetCurrent: TGpKeyValue;
var
idx: integer;
begin
idx := wkeListEnumerator.GetCurrent;
wkeCurrentKV.Key := wkeListEnumerator.List[idx];
wkeCurrentKV.Value := TGpIntegerObjectList(wkeListEnumerator.List).Objects[idx];
Result := wkeCurrentKV;
end; { TGpIntegerObjectListWalkKVEnumerator.GetCurrent }
BTW, you can see another trick in this implementation - enumeration by delegation. I'm reusing my Walk enumerator to do the actual walking.
That works much faster than the interface-based version - 300 ms for my test case. It's still six times slower than the Walk enumerator, though, and it is not really obvious why the difference is so big. Leave that be, for a moment.
The third approach would be to use a record to store the current (Key, Value) pair. Then there is no allocation/deallocation at all, but resulting code is not faster. Record-based enumerator needs about 500 ms to run the test case.
This slowdown occurs because record is not returned as a pointer, but as a full copy. In the class-based scenario, GetCurrent returns a pointer to the TGpKeyValue object and that pointer is passed in a register. In the record version, GetCurrent returns not a pointer to the record, but the record itself - it copies full record to the stack so the caller can use this copy - and that is waaaay slower.
Let's return to that major speed difference between Walk and WalkKV. I looked at the code, but couldn't find any good reason. Then I turned to the CPU view and it was evident. The problem lied not in the enumerator, but in my poorly designed benchmarking code :(
You see, I was timing multiple repetitions of these three loops:
for idx := 1 to 10000 do
;
for idx in il.Walk do
;
for kv in il.WalkKV do
;
Three empty loops, so I'm timing just the enumeration, yes? No!
First loop just runs from 1 to 10000. Trivial job and compiler will generate great code.
Second loop does the same, but with more overhead.
Third loop does much more than that. It also accesses il[] and il.Objects[] (inside the GetCurrent).
In reality, code inside the for statement in the first two cases would have to access il[] and il.Objects[] by itself. The code inside the third for statement has no need for that - it gets data neatly prepared in kv.Key and kv.Value.
I changed the loops to:
for idx := 0 to il.Count - 1 do begin
il[idx];
obj := il.Objects[idx];
end;
for idx in il.Walk do begin
il[idx];
obj := il.Objects[idx];
end;
for kv in il.WalkKV do begin
kv.Key;
obj := kv.Value;
end;
I'm just accessing and throwing the Items[]/Key information away and then I copy the Objects[]/Value information into the local variable. All loops are now running comparable jobs.
Results are now significantly different. Simple for loop needs 300 ms to run the test, Walk version needs 310 ms (really small difference) and WalkKV version needs 470 ms. It is still slower, but by less than the factor of two. If there would be a real code inside the for loop, the difference would be unnoticeable.
Morale? You should benchmark, but you should also check that you're benchmarking the right thing!
The generic version of WalkKV only supports this kind of code:
for kv in il.WalkKV do
Log('%d: %s', [kv.Key, TGpString(kv.Value).Value]);
But there's a really neat trick to change this into
for kv in il.WalkKV do
Log('%d: %s', [kv.Key, kv.StrValue]);
without modifying the WalkKV itself. Can you guess it? Class helpers, of course.
You just have to declare a simple helper in the WalkKV consumer (no need to change the WalkKV itself) and you can use the StrValue instead of TGpString(kv.Value).Value.
TGpKeyStrValue = class helper for TGpKeyValue
public
function StrValue: string; inline;
end; { TGpKeyStrValue }
function TGpKeyStrValue.StrValue: string;
begin
Result := TGpString(Self.Value).Value;
end;
Conclusion: class helpers are great. Key-value walker is useful. Enumerator-induced performance loss is negligible. Enumerators are fun.
---
I've tagged this and all previous enumerator-related articles with the enumerators label so you can now access them all at once via this simple link.
Labels: best practices, Delphi, enumerators, programming, source code, utilities
Do you hate such code?
idx := 0;
while idx < il.Count do
if ShouldBeRemoved(il[idx]) then
il.Delete(idx)
else
Inc(idx);If you do, read on!
TGpIntegerList [For the purpose of this blog entry, TGpIntegerList token is redefined to implicitly expands to "TGpIntegerList, TGpInt64List, and all classes derived from them."] included enumeration support since Delphi 2005 times. You could, for example, write
il := TGpIntegerList.Create([1, 3, 5, 7]);
try
for i in il do
Log('%d', [i]);
finally FreeAndNil(il); end;
and get numbers 1, 3, 5, and 7 in the log.
Recently, I've extended TGpIntegerList with two additional enumerators, both (of course) springing from practice. I've noticed that I still write lots of 'old school' for loops because I want to do something special with the first element. For example, take this simple code fragment that finds a maximum element in the list.
max := il[0];
for idx := 1 to il.Count - 1 do
if il[idx] > max then
max := il[idx];
To do such thing with for-each, you have to introduce a boolean flag.
gotMax := false;
for i in il do
if not gotMax then begin
max := i;
gotMax := true;
end
else if i > max then
max := i;
Ugly.
Much nicer implementation can be written with the new Slice() enumerator.
max := il[0];
for i in il.Slice(1) do
if i > max then
max := i;
Slice takes two parameters representing starting and ending index in the list and returns all values between them (indices are inclusive). Ending index can be omitted in which case it will default to Count-1 (i.e. to the end of the list).
Slice enumerator is implemented in a traditional manner - with the enumerator factory. For more details see my older articles and GpLists source code.
The second and much more interesting enumerator solves the problem shown in the introduction to this article. I noticed that I write lots of code that iterates over some list and removes some entries while keeping others intact. Typical scenario: removing timed-out clients from the server's list.
Something like that is impossible to do with the TGpIntegerList default enumerator. Firstly because this enumerator returns list elements and not list indices (and we typically have to access the object stored in the .Objects[] part of the list during the process) and secondly because the enumerator does not work correctly if enumerated list is modified behind its back. The second issue also prevents the use of standard for loop.
To solve both problems at once, I've introduced the Walk enumerator. It returns list indices instead of list elements and functions correctly if Add, Insert or Delete are used on the list while enumerator is active. (The second part is implemented by using TGpIntegerList internal notification mechanism, introduced just for this purpose.)
Now I can write:
for idx in il.Walk do
if ShouldBeRemoved(il[idx]) then
il.Delete(idx);
Implementation? Check the source, Luke. It's not complicated.
Now if only I could add such enumerator to the TObjectList ...
Labels: Delphi, enumerators, programming, source code, utilities
for idx in list.Walk do
if SomeCondition(list[idx]) then
list.Delete(idx);
Labels: Delphi, open source, programming, source code, utilities
Fredrik Loftheim made an interesting observation to my previous article on TWinControl.Controls enumerator - namely that the enumerator factory doesn't have to be interface based. It can be replaced by a record. Source is almost the same as before, but we can skip the interface declaration. Generated code is simpler as the enumerator factory is simply allocated from the stack and automatically destroyed when it goes out of scope. No interface support and no reference counting is required. Simpler and faster, that's the way to go.
interface
type
TControlEnumerator = record
strict private
ceClass : TClass;
ceIndex : integer;
ceParent: TWinControl;
public
constructor Create(parent: TWinControl; matchClass: TClass);
function GetCurrent: TControl;
function MoveNext: boolean;
property Current: TControl read GetCurrent;
end; { TControlEnumerator }
TControlEnumeratorFactory = record
strict private
cefClass : TClass;
cefParent: TWinControl;
public
constructor Create(parent: TWinControl; matchClass: TClass);
function GetEnumerator: TControlEnumerator;
end; { TControlEnumeratorFactory }
function EnumControls(parent: TWinControl; matchClass: TClass = nil): TControlEnumeratorFactory;
implementation
function EnumControls(parent: TWinControl; matchClass: TClass = nil): TControlEnumeratorFactory;
begin
Result := TControlEnumeratorFactory.Create(parent, matchClass);
end; { EnumControls }
{ TControlEnumerator }
constructor TControlEnumerator.Create(parent: TWinControl; matchClass: TClass);
begin
ceParent := parent;
ceClass := matchClass;
ceIndex := -1;
end; { TControlEnumerator.Create }
function TControlEnumerator.GetCurrent: TControl;
begin
Result := ceParent.Controls[ceIndex];
end; { TControlEnumerator.GetCurrent }
function TControlEnumerator.MoveNext: boolean;
begin
Result := false;
while ceIndex < (ceParent.ControlCount - 1) do begin
Inc(ceIndex);
if (ceClass = nil) or (ceParent.Controls[ceIndex].InheritsFrom(ceClass)) then begin
Result := true;
break; //while
end;
end; //while
end; { TControlEnumerator.MoveNext }
{ TControlEnumeratorFactory }
constructor TControlEnumeratorFactory.Create(parent: TWinControl; matchClass: TClass);
begin
cefParent := parent;
cefClass := matchClass;
end; { TControlEnumeratorFactory.Create }
function TControlEnumeratorFactory.GetEnumerator: TControlEnumerator;
begin
Result := TControlEnumerator.Create(cefParent, cefClass);
end; { TControlEnumeratorFactory.GetEnumerator }
The new version of the TWinControl.Controls enumerator plus some other stuff is available at http://gp.17slon.com/gp/files/gpvcl.zip.
Labels: Delphi, enumerators, programming, source code, utilities
I'm still having fun with enumerators. The latest I wrote is a filtering enumerator for TWinControl.Controls[] that allows me to write code like this:
var
control: TControl;
for control in EnumControls(pnlAttributes, TSpeedButton) do
TSpeedButton(control).Enabled := false;
I found it interesting that Borland built a Components[] enumerator in the VCL, but not a Controls[] enumerator.
The EnumControls interface is simple. It takes a starting point for enumeration and an optional class filter. By specifying the latter, you tell the enumerator that you're only interested in child controls of a specified class.
function EnumControls(parent: TWinControl;
matchClass: TClass = nil): IControlEnumeratorFactory;
As it is used in a for..in loop, EnumControl must return a class or interface that implements GetEnumerator function and that is exactly what it does. GetEnumerator, on the other hand, creates an instance of the TControlEnumerator class, which implements the actual enumeration.
type
TControlEnumerator = class
strict private
ceClass : TClass;
ceIndex : integer;
ceParent: TWinControl;
public
constructor Create(parent: TWinControl; matchClass: TClass);
function GetCurrent: TControl;
function MoveNext: boolean;
property Current: TControl read GetCurrent;
end; { TControlEnumerator }
IControlEnumeratorFactory = interface
function GetEnumerator: TControlEnumerator;
end; { IControlEnumeratorFactory }
On the implementation side, EnumControls creates an instance of the TControlEnumeratorFactory class, which implements the IControlEnumeratorFactory interface.
function EnumControls(parent: TWinControl; matchClass: TClass = nil): IControlEnumeratorFactory;
begin
Result := TControlEnumeratorFactory.Create(parent, matchClass);
end; { EnumControls }
type
TControlEnumeratorFactory = class(TInterfacedObject, IControlEnumeratorFactory)
strict private
cefClass: TClass;
cefParent: TWinControl;
public
constructor Create(parent: TWinControl; matchClass: TClass);
function GetEnumerator: TControlEnumerator;
end; { GetEnumerator }
TControlEnumeratorFactory just stores parent and matchClass parameters for later use in the GetEnumerator function.
constructor TControlEnumeratorFactory.Create(parent: TWinControl; matchClass: TClass);
begin
cefParent := parent;
cefClass := matchClass;
end; { TControlEnumeratorFactory.Create }
function TControlEnumeratorFactory.GetEnumerator: TControlEnumerator;
begin
Result := TControlEnumerator.Create(cefParent, cefClass);
end; { TControlEnumeratorFactory.GetEnumerator }
GetEnumerator creates an instance of the TControlEnumerator class, which implements the actual enumeration in a pretty standard manner. Only the MoveNext method is slightly more complicated than usual because it must optionally check the matchClass parameter.
constructor TControlEnumerator.Create(parent: TWinControl; matchClass: TClass);
begin
inherited Create;
ceParent := parent;
ceClass := matchClass;
ceIndex := -1;
end; { TControlEnumerator.Create }
function TControlEnumerator.GetCurrent: TControl;
begin
Result := ceParent.Controls[ceIndex];
end; { TControlEnumerator.GetCurrent }
function TControlEnumerator.MoveNext: boolean;
begin
Result := false;
while ceIndex < (ceParent.ControlCount - 1) do begin
Inc(ceIndex);
if (ceClass = nil) or (ceParent.Controls[ceIndex].InheritsFrom(ceClass)) then begin
Result := true;
break; //while
end;
end; //while
end; { TControlEnumerator.MoveNext }
It's instructive to see how all those parts play together when the code fragment from the beginning of this blog entry is executed.
for control in EnumControls(pnlAttributes, TSpeedButton) do
TSpeedButton(control).Enabled := false;
The TWinControl.Controls enumerator plus some other stuff is available at http://gp.17slon.com/gp/files/gpvcl.zip.
Labels: Delphi, enumerators, programming, source code, utilities
Delphi is a good language and Delphi IDE is a good development environment and together they make a good pair, but admit it - Delphi language is missing some modern language constructs (parameterized types, for example) and Delphi IDE can be rough at the edges. We can't do much about the former, but Delphi IDE can be greatly enhanced by installing third party add-ons (and great thanks to Borland/CodeGear for enabling us to do so).
Recently I've noticed that I can't really function well on a bare-bones IDE. I'm heavily dependent on three IDE extensions - GExperts, DDevExtensions, and ModelMaker Code Explorer. I decided to dedicate some blog space to them and describe what they do and why I like them.
It would take too much space to describe every aspect of those three add-ons, so I decided to focus on a navigation in a broad sense - moving inside unit, between units, between code and design view etc. Even more, I won't cover every navigational helper in those three, I'll just focus on the features I'm using regularly.
Delphi IDE has some neat navigation tools built in. First, there are markers. You can drop ten markers by pressing <Ctrl><Shift>number, where number is a numeric key from 0 to 9 (you don't have to use numeric keyboard keys, standard keyboard numbers will work just fine). By pressing <Ctrl>number you'll be transferred to the line containing the marker. To delete a marker you just press <Ctrl><Shift>number while the caret is positioned in the line containing the marker.
Another neat feature of the Delphi IDE is the ability to jump from method implementation to its declaration and back. The shortcut for this operation is <Ctrl><Shift><UpArrow> or <Ctrl><Shift><DownArrow> (both work the same).
When you want to find where some identifier is used (in current unit and in the rest of the project), you can use find references (<Ctrl><Shift><Enter>) command. I'm mentioning it here because you can also use it to jump to the place where the identifier is used.
I'm also using the unit list (<Ctrl><F12>) and form list (<Shift><F12>) regularly. First shows the list of units in the project and second the list of forms. Just double-click the unit/form or select it and press <Enter> and it will open in the IDE.
GExperts is a set of freeware experts that enhance Delphi IDE in various ways. Only small subset is connected to the navigation.
One of the most useful helpers is open file expert. Press the key (I have it configured to <Ctrl><Shift><Alt>O) and up pops a list of all files that are accessible from the current project. You can select the unit and press <Enter> to open it (alternatively you can double-click that unit) but before that you can - and that's even more important - start typing in the filter box and the expert will remove all non-matching units.
Another useful tool is procedure list expert. As the name suggests, it presents a list of methods in the current unit, which you can, of course, filter by typing. Double-click or <Enter> will beam you to the selected method.
GExperts also offers bunch of helpful editor experts. Locate matching delimiter (<Ctrl><Alt><LeftArrow>/<RightArrow>) jumps to a matching delimiter - from left to right bracket, from begin to end, from implementation to interface and so on. Locate previous/next identifier (<Ctrl><Alt><UpArrow>/<DownArrow>) locates previous/next occurrence of the identifier under the caret.
The last navigational help in the GExperts is hidden in the form designer pop-up menu. It is extended with the find component reference command. Right-click on a component or control and select this option and GExperts will bring up the editor, focused on the part where this component/control is declared. Or used for the first time in the code. Sometimes former and sometimes latter and I can never guess which one it will be.
DDevExtensions is developed by Andreas Hausladen, author of well-known DelphiSpeedUp. I'm mostly using it because it reconfigures the <Tab> key to indent a block of code and <Shift><Tab> to unindent it, but that's not a navigational extension so you can pretend you didn't hear that from me. It also implements smart home functionality. First time you press the <Home> key, caret will jump to the first column in the row. If you press the <Home> button again, caret will jump to the first non-blank character in that line. Useful.
DDevExtensions also redefines unit list and form list keyboard shortcuts so that display a list that can be filtered - similar to the GExeperts' open file expert.
ModelMaker Code Explorer (or MMX as it is usually called between loving users) is one of the largest Delphi IDE add-ons on the market. Its most important functionality is refactoring - creating classes, fields, properties, and methods becomes lightingly fast with MMX - but it also offers some navigational functionality. MMX is not free like GExperts and DDevExtensions but I can assure you that it's worth every cent.
An important part of MMX interface is the Explorer window. It lists every class and method in the current unit, has movements synchronized with the editor and is filterable.
Similar to Delphi's find reference is find in module command (<Ctrl><Shift><Alt>F). It locates all occurrences of the identifier in the current module and uses tabbed interface to store old searches. Great advantage of MMX over Delphi is that it works in older IDEs and that it works on a non-compilable code.
MMX also offers extended up/down navigation. Delphi's shortcuts <Ctrl><Shift><UpArrow>/<DownArrow> are redefined to jump (in addition to the default behaviour) between propery declaration, its getter and setter, between constructors and destructors and between overloaded methods. Highly useful.
The last enhancement on my today's list is global history. MMX will automatically remember any method where you spent more than a few seconds. When you press the keyboard shortcut (I have it set to <Ctrl>` - the latter being the key left to the '0' key), MMX displays pop-up menu with most recently edited methods. Click one and you're instantly transferred there.
That's all by me, I've exhausted my knowledge. Here's where you, dear reader, can help. If you know a trick that I didn't mention or a helpful expert that I don't have installed, do tell me about it in the comments. You'll help me and other Delphi programmers.
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);
var
i: integer;
st: TSystemTime;
begin
for i := 1 to 15 do begin
Windows.GetSystemTime(st);
outLog.Lines.Add(IntToStr(st.wMilliseconds));
Sleep(1);
end;
end;
The 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.
Careful 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.
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;
begin
if GPerformanceFreq = 0 then
Result := 0
else
Result := Round(perfCounter / GPerformanceFreq * 1000);
end; { PerformanceCounterToMS }
procedure GetSystemTime_Acc(var systemTime: TSystemTime);
var
pcDiff : int64;
perfCount: int64;
sum : cardinal;
begin
if GPerformanceFreq = 0 then
Windows.GetSystemTime(systemTime)
else begin
QueryPerformanceCounter(perfCount);
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;
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;
var
perfCount: int64;
begin
if GPerformanceFreq = 0 then
Result := Windows.GetTickCount
else begin
QueryPerformanceCounter(perfCount);
Result := GTickCountBase + PerformanceCounterToMS(perfCount - GPerfCounterBase);
end;
end; { GetTickCount64_Acc }
function GetTickCount_Acc: DWORD;
begin
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;
var
perfCount1: int64;
perfCount2: int64;
st1 : TSystemTime;
st2 : TSystemTime;
begin
if GPerformanceFreq = 0 then
Exit;
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_HIGHEST);
Sleep(0);
Windows.GetSystemTime(st2);
repeat
st1 := st2;
QueryPerformanceCounter(perfCount1);
Windows.GetSystemTime(st2);
GTickCountBase := Windows.GetTickCount;
QueryPerformanceCounter(perfCount2);
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.
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.
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.

Labels: Delphi, open source, programming, source code, utilities, Win32
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).
Labels: Delphi, source code, utilities, Win32
Months have passed since the last update of my freeware utils so here are new versions...
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.
Previous updates: New GpLists and other updates
Labels: Delphi, open source, source code, utilities
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);
begin
if not condition then begin
hfWindowsError := GetLastError;
if hfWindowsError <> ERROR_SUCCESS then
raise EGpHugeFile.CreateFmtHelp(sFileFailed+
{$IFNDEF D6PLUS}SWin32Error{$ELSE}SOSError{$ENDIF},
[method, FileName, hfWindowsError, SysErrorMessage(hfWindowsError)],
hcHFWindowsError)
else
raise EGpHugeFile.CreateFmtHelp(sFileFailed+
{$IFNDEF D6PLUS}SUnkWin32Error{$ELSE}SUnkOSError{$ENDIF},
[method, FileName], hcHFUnknownWindowsError);
end;
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;
begin
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;
begin
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!]
Labels: Delphi, open source, source code, utilities