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.