Delphi XE2 FormatDateTime 传递 -693594

Question

我们这里有点问题。我们已经从 Delphi 2006 升级到 Delphi XE2，并且正在转换我们的代码。

问题是，我们通过我们的应用程序和数据库记录使用值 -693594 来表示无日期（零日期）。在 Delphi 2006 中，FormatDateTime 函数会正确地将其格式化为 00/00/0000（假设日期格式为 dd/mm/yyyy）。

但是在 Delphi XE2 中，他们在 System.SysUtils 的 DateTImeToTimeStamp 函数中添加了对 ValidateTimeStampDate 的调用，这会引发错误“无效的浮点运算”。传递大于 -693594 的任何值，例如 -693593，都可以正常工作。

还有其他人遇到过这个问题和/或有人知道解决方法吗？

Answer 1

如果你真的很想修补到以前的行为，你可以使用这样的东西：

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 的调用重新路由到本单元中实现的版本。本单元中的代码只是 XE2 源代码中的PUREPASCAL 版本。

满足 cmets 中列出的需求的唯一其他方法是修改和重新编译 SysUtils 单元本身，但我个人避免使用这种解决方案。