Ошибка в процедуре _AddRefArray в Delphi 5 и ее исправление

В Delphi 5 есть ошибка в процедуре _AddRefArray в модуле System.pas. Если вы попробуете выполнить следующий код, то получите сообщение об ошибке: Invalid variant operation.

procedure func(p: array of variant);
begin
if Length(p) > -1 then
ShowMessage(p[0]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
func([]);
end

Дело в том, что компилятор Delphi автоматически вставляет в код процедуры func вызов _AddRefArray, а эта процедура не может корректно работать с пустым массивом.

Исправить ошибку несложно, достаточно добавить проверку на количество элементов массива в процедуру _AddRefArray, которая находится в модуле system.pas. Исправленный текст _AddRefArray приведен ниже:

procedure _AddRefArray

{ p: Pointer; typeInfo: Pointer; elemCount: Longint};

asm

{ -> EAX pointer to data to be referenced }
{ EDX pointer to type info describing data }
{ ECX number of elements of that type }

 

PUSH EBX
PUSH ESI
PUSH EDI

TEST ECX,ECX
JZ @@exit

MOV EBX,EAX
MOV ESI,EDX
MOV EDI,ECX

...

Затем надо скомпилировать system.pas с отладочной информацией и без и заменить файлы Delphi5\lib\system.dcu и Delphi5\lib\Debug\system.dcu. Для этого я написал небольшой bat-файл, который надо поместить в каталог Delphi5\Source\Rtl и запустить его на выполнение.

del lib\system.dcu
make
copy lib\system.dcu ..\..\lib\system.dcu
del lib\system.dcu
make -DDEBUG
copy lib\system.dcu ..\..\lib\Debug\system.dcu

Хочу заметить, что для компиляции требуется файл tasm32.exe, который не поставляется с Delphi.

После выполнения этих действий ошибка будет устранена. Однако остается одна нерешенная проблема - в проекте нельзя использовать пакет времени выполнения vcl50.bpl. Если собрать проект с использованием пакетов, то будет использована функция не из исправленного модуля  system.dcu а из пакета vcl50.dcu. Ситуация усугубляется тем, что модуль vcl50.bpl нельзя корректировать.

Другой способ исправления _AddRefArray я нашел на groups.google.com, желающие могут обратиться по следующему адресу:
http://groups.google.com/groups?hl=ru&lr=&ie=UTF-8&inlang=ru&selm=91ra1g%248hi2%40bornews.inprise.com

Идея оказалась очень простой - раз нельзя исправить процедуру _AddRefArray в файле vcl50.bpl, значит ее нужно исправить в памяти программы во время работы. Ниже я привожу исходный текст, который я оставил практически без изменений:

unit PatchAddRefArray;

interface

implementation

uses
Windows;

var
NewAddRefArray: Pointer;
OldAddRefArray: Pointer;

procedure _NewAddRefArray

{ p: Pointer; typeInfo: Pointer; elemCount: Longint};

asm

{ -> EAX pointer to data to be referenced }
{ EDX pointer to type info describing data }
{ ECX number of elements of that type }
{ проверка на количество элементов в массиве}

 TEST ECX, ECX
 JZ @exit

{ старый код затертый командой перехода}

 PUSH EBX
 PUSH ESI
 PUSH EDI
 MOV EBX,EAX
 MOV ESI,EDX

{ продолжить выполнение процедуры _AddRefArray}

 JMP OldAddRefArray
@exit:
end;

type
 TJumpDWord = packed record
 OpCode: Word;
 Distance: Pointer;
end;
 PJumpDWord = ^TJumpDWord;

 PPointer = ^Pointer;

const

// Несколько инструкций из AddRefArray:
// PUSH EBX, PUSH ESI и т.д.

  COrigARACode = $89D689C389575653;

// JMP

CJmpCode = $25FF;

procedure PatchAddRef;
var
 Jmp: TJumpDWord;
 Addr: ^TJumpDWord;
 OldProtect: DWORD;
begin

{Получить адрес процедуры AddRefArray}

 asm
  mov eax, offset System.@AddRefArray
  mov Addr, eax
 end;

{Переход к телу процедуры AddRefArray}

 while Addr^.OpCode = CJmpCode do
  Addr := PPointer(Addr^.Distance)^;

{Сравнить начало процедуры AddRefArray с ее "сигнатурой"
если совпадает, значит это та процедура, которую мы ищем}

 if PInt64(Addr)^ = COrigARACode then
 begin
  OldAddRefArray := Pointer(Integer(Addr) + SizeOf(TJumpDWord) + 1);
  NewAddRefArray := @_NewAddRefArray;
  Jmp.OpCode := CJmpCode;
  Jmp.Distance := @NewAddRefArray;
  VirtualProtect(Addr, SizeOf(TJumpDWord), PAGE_READWRITE, OldProtect);
  Addr^ := Jmp;
  VirtualProtect(Addr, SizeOf(TJumpDWord), OldProtect, OldProtect);
 end;
end;

initialization

PatchAddRef;

end.

Исходный текст  очевиден и не требует дополнительных комментариев.

В заключение я бы хотел заметить, что везде где это возможно при описании входных параметров следует использовать параметр const. Это позволит сэкономить как вычислительные ресурсы так и память.

Автор: Олег Мотов

mailto:olegm@tebuk.parma.ru
http://olegmotov.h1.ru