Делфи XE2 в функция formatdatetime прохождения -693594

Question

Делфи XE2 в функция formatdatetime прохождения -693594

У нас тут небольшая проблема. Мы перешли с Delphi 2006 на Delphi XE2 и находимся в процессе преобразования нашего кода.

Проблема в том, что мы используем значение -693594 в наших записях приложений и баз данных для обозначения отсутствия даты (нулевой даты). В Delphi 2006 функция FormatDateTime правильно форматировала бы это как 00/00/0000 (учитывая формат даты dd / mm/yyyy).

Однако в Delphi XE2 они добавили вызов ValidateTimeStampDate в DateTImeToTimeStamp функция в системе.SysUtils, который вызывает ошибку "недопустимая операция с плавающей запятой". передача чего-либо большего, чем -693594, например -693593, работает нормально.

У кого-нибудь еще была эта проблема и/или кто-нибудь знает обходной путь?

1 3

delphi delphi-2006 delphi-xe2

1 ответ:

David Heffernan · Accepted Answer · 2012-02-14 01:15:31

Если вы действительно отчаянно хотите вернуться к предыдущему поведению, вы можете использовать что-то вроде этого:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
const
  FMSecsPerDay: Single = MSecsPerDay;
  IMSecsPerDay: Integer = MSecsPerDay;
var
  LTemp, LTemp2: Int64;
begin
  LTemp := Round(DateTime * FMSecsPerDay);
  LTemp2 := (LTemp div IMSecsPerDay);
  Result.Date := DateDelta + LTemp2;
  Result.Time := Abs(LTemp) mod IMSecsPerDay;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(FormatDateTime('dd/mm/yyyy', -693594));
end;

initialization
  RedirectProcedure(@System.SysUtils.DateTimeToTimeStamp, @DateTimeToTimeStamp);

end.
Это будет работать для 32-битного кода. Он также будет работать для 64-битного кода при условии, что как старые, так и новые функции находятся в одном исполняемом модуле. В противном случае расстояние прыжка может превышать диапазон 32-битного целого числа. Он также не будет работать, если ваш RTL находится в пакете времени выполнения. Оба эти ограничения могут быть легко устранены.

Вот что делает этот код: перенаправьте все вызовы в SysUtils.DateTimeToTimeStamp на версию, реализованную в этом блоке. Код в этом блоке - это просто версия PUREPASCAL из источника XE2.
Единственный другой подход, который отвечает потребностям, изложенным в ваших комментариях, - это изменение и повторная компиляция самого блока SysUtils, но я лично избегаю такого решения.