如果你真的很想修补到以前的行为,你可以使用这样的东西:
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 单元本身,但我个人避免这种解决方案。