TDM#4: Delphi 4 Bugs and Fixes
Delphi 4, released in the summer of 1998, was one of the most notorious Delphi releases ever. The initial release contained a large number of serious bugs, and it later became clear that the release date had been pushed by management and/or marketing and not sanctioned by technical and R&D.
While all of this is water under the bridge, one very visible bug, the so-called TListBox ItemIndex bug, called for an interesting patching technique that has since been employed numerous times (by me and others) to fix RTL and VCL issues at runtime.
Dave Jewell and myself both contributed to the TDM article named Delphi 4 Bugs and Fixes, published in the September 1998 issue. I have Dave's permission to publish our joint effort here [Thanks, Dave!].
The gist of the problem was:
"Cause
With the release of Delphi4, Inprise changed the implementation of TCustomListBox’s ItemIndex property. The implementation of the access methods in Delphi 3 was [like this]:
function TCustomListBox.GetItemIndex: Integer;
begin
Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
end;
function TCustomListBox.GetSelCount: Integer;
begin
Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
end;
This was changed in Delphi 4 build 5.3 into [this]code:
function TCustomListBox.GetItemIndex: Integer;
begin
if not MultiSelect then
Result := SendMessage(Handle, LB_GETCARETINDEX, 0, 0) else
Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
end;
procedure TCustomListBox.SetItemIndex(Value: Integer);
begin
if GetItemIndex <> Value then
if MultiSelect then
SendMessage(Handle, LB_SETCARETINDEX, Value, 0) else
SendMessage(Handle, LB_SETCURSEL, Value, 0);
end;
The change has an obvious bug, in TCustomListBox.GetItemIndex the if statement should have been:
if MultiSelect then
instead of:
if not MultiSelect
"
And indeed, that is how the method looks like in current Delphis. The solution to the problem was:
"a small unit that patches the code in TCustomListBox.GetItemIndex at runtime. It can handle both statically linked and packaged VCL.
unit FixupLB;
// Simple unit that patches the StdCtrls.TCustomListBox.GetItemIndex
// method in Delphi 4.0 (build 5.37)
//
// July 1998, by Hallvard Vassbotn (hallvard@falcon.no)
interface
implementation
uses
Windows,
TypInfo,
StdCtrls;
type
PPGetItemIndex = ^PGetItemIndex;
PGetItemIndex = ^TGetItemIndex;
TGetItemIndex = packed record
PUSH_EBX : byte;
MOV_EBX_EAX : word;
CMP_BYTE_PTR : word;
ADDR_Offset : Cardinal;
False_ZERO : byte;
JNZ : byte;
ELSE_REL_ADDR : byte;
PUSH_LParam : word;
PUSH_WParam : word;
PUSH_Msg : byte;
Msg_Const : Cardinal;
MOV_EAX_EBX : word;
CALL : byte;
end;
PGetItemIndexInPackage = ^TGetItemIndexInPackage;
TGetItemIndexInPackage = packed record
JMP_DWORD: word;
ActualGetItemIndex : PPGetItemIndex;
end;
TBytes = array[0..3] of byte;
const
OpCode_JNZ = $75;
OpCode_JZ = $74;
OpCode_JMP_DWORD = $25FF;
function IsBuggyCode(var GetItemIndex: PGetItemIndex): boolean;
var
GetItemIndexInPackage: PGetItemIndexInPackage absolute GetItemIndex;
begin
// Verify that this is a static method
Result := (TBytes(GetItemIndex)[3] < $FE);
if Result then
begin
// Handle the case when TCustomList.GetItemIndex is in a package
if (GetItemIndexInPackage^.JMP_DWORD = OpCode_JMP_DWORD) then
GetItemIndex := GetItemIndexInPackage^.ActualGetItemIndex^;
with GetItemIndex^ do
begin
Result :=
// The buggy instruction, should have been OpCode_JZ
(JNZ = OpCode_JNZ) and
// Check the other instructions as well, just to be sure
(PUSH_EBX = $53) and
(MOV_EBX_EAX = $D88B) and
(CMP_BYTE_PTR = $BB80) and
(False_ZERO = $00) and
(ELSE_REL_ADDR= $18) and
(PUSH_LParam = $006A) and
(PUSH_WParam = $006A) and
(PUSH_Msg = $68) and
(Msg_Const = $19f) and
(MOV_EAX_EBX = $C38B) and
(CALL = $E8) ;
end;
end;
end;
procedure WriteCodeByte(CodeAddress: pointer; Value: byte);
var
WrittenBytes: Cardinal;
begin
// Must use WriteProcessMemory or VirtualProtect to write to code segment
WriteProcessMemory(GetCurrentProcess, CodeAddress, @Value, SizeOf(Value), WrittenBytes);
end;
type
// Publish ItemIndex to easily get address of GetItemIndex method
TPublishedListBox = class(TCustomListBox)
published
property ItemIndex;
end;
procedure Fix_TCustomListBox_GetItemIndex_Bug;
var
PropInfo : PPropInfo;
GetItemIndex: PGetItemIndex;
begin
// Get the property information for the newly published ItemIndex property
PropInfo := TypInfo.GetPropInfo(TPublishedListBox.ClassInfo, 'ItemIndex');
if Assigned(PropInfo) then
begin
// Get the get-property method address
GetItemIndex := PropInfo^.GetProc;
// Now check that the buggy code is there
if IsBuggyCode(GetItemIndex) then
// Patch in the correction, voilà!
// Same as GetItemIndex^.JNZ := OpCode_JZ, without the AV...
WriteCodeByte(@GetItemIndex^.JNZ, OpCode_JZ);
end;
end;
initialization
Fix_TCustomListBox_GetItemIndex_Bug;
end.
...
When you get hold of and install the Delphi 4 update, the fix unit will silently find out that the code in GetItemIndex has changed and cause no harm. However,at that time you should remove the fix unit from the project anyway: it is better not to have self-modifying code in your project if you can avoid it."
The full PDF article and code are available for download.
