1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
| unit URidlFix;
interface
implementation
uses
Windows, SysUtils, Math;
function GetWinProcAddr(const aLib, aProcName: PChar): Pointer;
var
hLib: HMODULE;
begin
hLib := LoadLibrary(aLib);
if hLib = 0 then
Result := nil
else
begin
Result := GetProcAddress(hLib, aProcName);
FreeLibrary(hLib);
end;
end;
const
RidlFormatSettings: TFormatSettings = (
CurrencyString: '¤';
CurrencyFormat: 0; // '$1'
CurrencyDecimals: 2;
DateSeparator: '/';
TimeSeparator: ':';
ListSeparator: ',';
ShortDateFormat: 'MM/DD/YYYY';
LongDateFormat: 'dddd, d MMMM yyyy';
TimeAMString: 'AM';
TimePMString: 'PM';
ShortTimeFormat: 'hh:mm';
LongTimeFormat: 'h:mm:ss ampm';
ShortMonthNames: ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
LongMonthNames: ('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December');
ShortDayNames: ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
LongDayNames: ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday');
ThousandSeparator: ',';
DecimalSeparator: '.';
TwoDigitYearCenturyWindow: 80;
NegCurrFormat: 0; // '(¤1)'
);
function RidlDateToStr(const aDateTime: TDateTime): String;
begin
if Floor(aDateTime) = 0 then
Result := TimeToStr(aDateTime, RidlFormatSettings)
else
Result := DateTimeToStr(aDateTime, RidlFormatSettings);
Result := '"' + Result + '"';
end;
procedure RidlVarToUStr(var S: UnicodeString; const V: TVarData);
begin
if V.VType = varDate then
S := RidlDateToStr(V.VDate)
else
S := Variant(V);
end;
procedure x86CodeGen_SetRelativeOffset(var aRelativeAddress: Integer; aTo: PAnsiChar);
begin
aRelativeAddress := aTo - @aRelativeAddress - SizeOf(aRelativeAddress);
end;
function BeginWrite(const aCode: Pointer; aSize: Integer): Cardinal;
begin
if not VirtualProtect(aCode, aSize, PAGE_EXECUTE_READWRITE, @Result) then
RaiseLastOSError;
end;
procedure EndWrite(const aCode: Pointer; aSize: Integer; aOldProtect: Cardinal);
begin
if not VirtualProtect(aCode, aSize, aOldProtect, @aOldProtect) then
RaiseLastOSError;
if ((aOldProtect or PAGE_EXECUTE) <> 0) and not FlushInstructionCache(GetCurrentProcess, aCode, aSize) then
RaiseLastOSError;
end;
procedure x86CodeGen_RelativeOffset(var aCode: Integer; aJmpTo: Pointer);
var
aOldProtect: Cardinal;
begin
aOldProtect := BeginWrite(@aCode, SizeOf(aCode));
x86CodeGen_SetRelativeOffset(aCode, aJmpTo);
EndWrite(@aCode, SizeOf(aCode), aOldProtect);
end;
procedure Install;
var
aAddr: PAnsiChar;
begin
aAddr := GetWinProcAddr('tlib160.bpl', '@Idlwrite@VarArgToString$qqrrx10tagVARIANT');
if aAddr = nil then
exit;
inc(aAddr, 38);
if aAddr^ <> #$E8 then
exit;
x86CodeGen_RelativeOffset(PInteger(aAddr+1)^, @RidlVarToUStr);
end;
initialization
Install;
end. |
