aboutsummaryrefslogtreecommitdiffstats
path: root/Medley/src/lib/TntUnicodeControls/TntSystem.pas
diff options
context:
space:
mode:
Diffstat (limited to 'Medley/src/lib/TntUnicodeControls/TntSystem.pas')
-rw-r--r--Medley/src/lib/TntUnicodeControls/TntSystem.pas1427
1 files changed, 1427 insertions, 0 deletions
diff --git a/Medley/src/lib/TntUnicodeControls/TntSystem.pas b/Medley/src/lib/TntUnicodeControls/TntSystem.pas
new file mode 100644
index 00000000..e613ce0c
--- /dev/null
+++ b/Medley/src/lib/TntUnicodeControls/TntSystem.pas
@@ -0,0 +1,1427 @@
+
+{*****************************************************************************}
+{ }
+{ Tnt Delphi Unicode Controls }
+{ http://www.tntware.com/delphicontrols/unicode/ }
+{ Version: 2.3.0 }
+{ }
+{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
+{ }
+{*****************************************************************************}
+
+unit TntSystem;
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$INCLUDE TntCompilers.inc}
+
+{*****************************************************************************}
+{ Special thanks go to Francisco Leong for originating the design for }
+{ WideString-enabled resourcestrings. }
+{*****************************************************************************}
+
+interface
+
+uses
+ Windows;
+
+// These functions should not be used by Delphi code since conversions are implicit.
+{TNT-WARN WideCharToString}
+{TNT-WARN WideCharLenToString}
+{TNT-WARN WideCharToStrVar}
+{TNT-WARN WideCharLenToStrVar}
+{TNT-WARN StringToWideChar}
+
+// ................ ANSI TYPES ................
+{TNT-WARN Char}
+{TNT-WARN PChar}
+{TNT-WARN String}
+
+{TNT-WARN CP_ACP} // <-- use DefaultSystemCodePage
+function DefaultSystemCodePage: Cardinal; // implicitly used when converting AnsiString <--> WideString.
+
+{$IFNDEF FPC}
+var
+ WideCustomLoadResString: function(ResStringRec: PResStringRec; var Value: WideString): Boolean;
+{$ENDIF}
+
+{TNT-WARN LoadResString}
+function WideLoadResString(ResStringRec: PResStringRec): WideString;
+{TNT-WARN ParamCount}
+function WideParamCount: Integer;
+{TNT-WARN ParamStr}
+function WideParamStr(Index: Integer): WideString;
+
+// ......... introduced .........
+
+const
+ { Each Unicode stream should begin with the code U+FEFF, }
+ { which the standard defines as the *byte order mark*. }
+ UNICODE_BOM = WideChar($FEFF);
+ UNICODE_BOM_SWAPPED = WideChar($FFFE);
+ UTF8_BOM = AnsiString(#$EF#$BB#$BF);
+
+function WideStringToUTF8(const S: WideString): AnsiString;
+function UTF8ToWideString(const S: AnsiString): WideString;
+
+function WideStringToUTF7(const W: WideString): AnsiString;
+function UTF7ToWideString(const S: AnsiString): WideString;
+
+function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
+function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
+
+function UCS2ToWideString(const Value: AnsiString): WideString;
+function WideStringToUCS2(const Value: WideString): AnsiString;
+
+function CharSetToCodePage(ciCharset: UINT): Cardinal;
+function LCIDToCodePage(ALcid: LCID): Cardinal;
+function KeyboardCodePage: Cardinal;
+function KeyUnicode(CharCode: Word): WideChar;
+
+procedure StrSwapByteOrder(Str: PWideChar);
+
+{$IFDEF USE_SYSTEM_OVERRIDES}
+
+type
+ TTntSystemUpdate =
+ (tsWideResourceStrings
+ {$IFNDEF COMPILER_9_UP}, tsFixImplicitCodePage, tsFixWideStrConcat, tsFixWideFormat {$ENDIF}
+ );
+ TTntSystemUpdateSet = set of TTntSystemUpdate;
+
+const
+ AllTntSystemUpdates = [Low(TTntSystemUpdate)..High(TTntSystemUpdate)];
+
+procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
+
+{$ENDIF USE_SYSTEM_OVERRIDES}
+
+implementation
+
+uses
+ SysUtils, Variants, TntWindows, TntSysUtils;
+
+var
+ GDefaultSystemCodePage: Cardinal;
+
+function DefaultSystemCodePage: Cardinal;
+begin
+ Result := GDefaultSystemCodePage;
+end;
+
+{$IFDEF USE_SYSTEM_OVERRIDES}
+var
+ IsDebugging: Boolean;
+{$ENDIF USE_SYSTEM_OVERRIDES}
+
+function WideLoadResStringDetect(ResStringRec: PResStringRec): WideString;
+var
+ PCustom: PAnsiChar;
+begin
+ // custom string pointer
+ PCustom := PAnsiChar(ResStringRec); { I would like to use PWideChar, but this would break legacy code. }
+ if (StrLen{TNT-ALLOW StrLen}(PCustom) > Cardinal(Length(UTF8_BOM)))
+ and CompareMem(PCustom, PAnsiChar(UTF8_BOM), Length(UTF8_BOM)) then
+ // detected UTF8
+ Result := UTF8ToWideString(PAnsiChar(PCustom + Length(UTF8_BOM)))
+ else
+ // normal
+ Result := PCustom;
+end;
+
+{$IFNDEF FPC}
+
+function WideLoadResString(ResStringRec: PResStringRec): WideString;
+const
+ MAX_RES_STRING_SIZE = 4097; { MSDN documents this as the maximum size of a string in table. }
+var
+ Buffer: array [0..MAX_RES_STRING_SIZE] of WideChar; { Buffer leaves room for null terminator. }
+begin
+ if Assigned(WideCustomLoadResString) and WideCustomLoadResString(ResStringRec, Result) then
+ exit; { a custom resourcestring has been loaded. }
+
+ if ResStringRec = nil then
+ Result := ''
+ else if ResStringRec.Identifier < 64*1024 then
+ SetString(Result, Buffer,
+ Tnt_LoadStringW(FindResourceHInstance(ResStringRec.Module^),
+ ResStringRec.Identifier, Buffer, MAX_RES_STRING_SIZE))
+ else begin
+ Result := WideLoadResStringDetect(ResStringRec);
+ end;
+end;
+
+{$ELSE}
+
+function WideLoadResString(ResStringRec: PResStringRec): WideString;
+begin
+ Result := WideLoadResStringDetect(ResStringRec);
+end;
+
+{$ENDIF}
+
+function WideGetParamStr(P: PWideChar; var Param: WideString): PWideChar;
+var
+ i, Len: Integer;
+ Start, S, Q: PWideChar;
+begin
+ while True do
+ begin
+ while (P[0] <> #0) and (P[0] <= ' ') do
+ Inc(P);
+ if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
+ end;
+ Len := 0;
+ Start := P;
+ while P[0] > ' ' do
+ begin
+ if P[0] = '"' then
+ begin
+ Inc(P);
+ while (P[0] <> #0) and (P[0] <> '"') do
+ begin
+ Q := P + 1;
+ Inc(Len, Q - P);
+ P := Q;
+ end;
+ if P[0] <> #0 then
+ Inc(P);
+ end
+ else
+ begin
+ Q := P + 1;
+ Inc(Len, Q - P);
+ P := Q;
+ end;
+ end;
+
+ SetLength(Param, Len);
+
+ P := Start;
+ S := PWideChar(Param);
+ i := 0;
+ while P[0] > ' ' do
+ begin
+ if P[0] = '"' then
+ begin
+ Inc(P);
+ while (P[0] <> #0) and (P[0] <> '"') do
+ begin
+ Q := P + 1;
+ while P < Q do
+ begin
+ S[i] := P^;
+ Inc(P);
+ Inc(i);
+ end;
+ end;
+ if P[0] <> #0 then Inc(P);
+ end
+ else
+ begin
+ Q := P + 1;
+ while P < Q do
+ begin
+ S[i] := P^;
+ Inc(P);
+ Inc(i);
+ end;
+ end;
+ end;
+
+ Result := P;
+end;
+
+function WideParamCount: Integer;
+var
+ P: PWideChar;
+ S: WideString;
+begin
+ P := WideGetParamStr(GetCommandLineW, S);
+ Result := 0;
+ while True do
+ begin
+ P := WideGetParamStr(P, S);
+ if S = '' then Break;
+ Inc(Result);
+ end;
+end;
+
+function WideParamStr(Index: Integer): WideString;
+var
+ P: PWideChar;
+begin
+ if Index = 0 then
+ Result := WideGetModuleFileName(0)
+ else
+ begin
+ P := GetCommandLineW;
+ while True do
+ begin
+ P := WideGetParamStr(P, Result);
+ if (Index = 0) or (Result = '') then Break;
+ Dec(Index);
+ end;
+ end;
+end;
+
+function WideStringToUTF8(const S: WideString): AnsiString;
+begin
+ Result := UTF8Encode(S);
+end;
+
+function UTF8ToWideString(const S: AnsiString): WideString;
+begin
+ Result := UTF8Decode(S);
+end;
+
+ { ======================================================================= }
+ { Original File: ConvertUTF7.c }
+ { Author: David B. Goldsmith }
+ { Copyright (C) 1994, 1996 Taligent, Inc. All rights reserved. }
+ { }
+ { This code is copyrighted. Under the copyright laws, this code may not }
+ { be copied, in whole or part, without prior written consent of Taligent. }
+ { }
+ { Taligent grants the right to use this code as long as this ENTIRE }
+ { copyright notice is reproduced in the code. The code is provided }
+ { AS-IS, AND TALIGENT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR }
+ { IMPLIED, INCLUDING, BUT NOT LIMITED TO IMPLIED WARRANTIES OF }
+ { MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT }
+ { WILL TALIGENT BE LIABLE FOR ANY DAMAGES WHATSOEVER (INCLUDING, }
+ { WITHOUT LIMITATION, DAMAGES FOR LOSS OF BUSINESS PROFITS, BUSINESS }
+ { INTERRUPTION, LOSS OF BUSINESS INFORMATION, OR OTHER PECUNIARY }
+ { LOSS) ARISING OUT OF THE USE OR INABILITY TO USE THIS CODE, EVEN }
+ { IF TALIGENT HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. }
+ { BECAUSE SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF }
+ { LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES, THE ABOVE }
+ { LIMITATION MAY NOT APPLY TO YOU. }
+ { }
+ { RESTRICTED RIGHTS LEGEND: Use, duplication, or disclosure by the }
+ { government is subject to restrictions as set forth in subparagraph }
+ { (c)(l)(ii) of the Rights in Technical Data and Computer Software }
+ { clause at DFARS 252.227-7013 and FAR 52.227-19. }
+ { }
+ { This code may be protected by one or more U.S. and International }
+ { Patents. }
+ { }
+ { TRADEMARKS: Taligent and the Taligent Design Mark are registered }
+ { trademarks of Taligent, Inc. }
+ { ======================================================================= }
+
+type UCS2 = Word;
+
+const
+ _base64: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
+ _direct: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789''(),-./:?';
+ _optional: AnsiString = '!"#$%&*;<=>@[]^_`{|}';
+ _spaces: AnsiString = #9#13#10#32;
+
+var
+ base64: PAnsiChar;
+ invbase64: array[0..127] of SmallInt;
+ direct: PAnsiChar;
+ optional: PAnsiChar;
+ spaces: PAnsiChar;
+ mustshiftsafe: array[0..127] of AnsiChar;
+ mustshiftopt: array[0..127] of AnsiChar;
+
+var
+ needtables: Boolean = True;
+
+procedure Initialize_UTF7_Data;
+begin
+ base64 := PAnsiChar(_base64);
+ direct := PAnsiChar(_direct);
+ optional := PAnsiChar(_optional);
+ spaces := PAnsiChar(_spaces);
+end;
+
+procedure tabinit;
+var
+ i: Integer;
+ limit: Integer;
+begin
+ i := 0;
+ while (i < 128) do
+ begin
+ mustshiftopt[i] := #1;
+ mustshiftsafe[i] := #1;
+ invbase64[i] := -1;
+ Inc(i);
+ end { For };
+ limit := Length(_Direct);
+ i := 0;
+ while (i < limit) do
+ begin
+ mustshiftopt[Integer(direct[i])] := #0;
+ mustshiftsafe[Integer(direct[i])] := #0;
+ Inc(i);
+ end { For };
+ limit := Length(_Spaces);
+ i := 0;
+ while (i < limit) do
+ begin
+ mustshiftopt[Integer(spaces[i])] := #0;
+ mustshiftsafe[Integer(spaces[i])] := #0;
+ Inc(i);
+ end { For };
+ limit := Length(_Optional);
+ i := 0;
+ while (i < limit) do
+ begin
+ mustshiftopt[Integer(optional[i])] := #0;
+ Inc(i);
+ end { For };
+ limit := Length(_Base64);
+ i := 0;
+ while (i < limit) do
+ begin
+ invbase64[Integer(base64[i])] := i;
+ Inc(i);
+ end { For };
+ needtables := False;
+end; { tabinit }
+
+function WRITE_N_BITS(x: UCS2; n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): Integer;
+begin
+ BITbuffer := BITbuffer or (x and (not (-1 shl n))) shl (32 - n - bufferbits);
+ bufferbits := bufferbits + n;
+ Result := bufferbits;
+end; { WRITE_N_BITS }
+
+function READ_N_BITS(n: Integer; var BITbuffer: Cardinal; var bufferbits: Integer): UCS2;
+var
+ buffertemp: Cardinal;
+begin
+ buffertemp := BITbuffer shr (32 - n);
+ BITbuffer := BITbuffer shl n;
+ bufferbits := bufferbits - n;
+ Result := UCS2(buffertemp);
+end; { READ_N_BITS }
+
+function ConvertUCS2toUTF7(var sourceStart: PWideChar; sourceEnd: PWideChar;
+ var targetStart: PAnsiChar; targetEnd: PAnsiChar; optional: Boolean;
+ verbose: Boolean): Integer;
+var
+ r: UCS2;
+ target: PAnsiChar;
+ source: PWideChar;
+ BITbuffer: Cardinal;
+ bufferbits: Integer;
+ shifted: Boolean;
+ needshift: Boolean;
+ done: Boolean;
+ mustshift: PAnsiChar;
+begin
+ Initialize_UTF7_Data;
+ Result := 0;
+ BITbuffer := 0;
+ bufferbits := 0;
+ shifted := False;
+ source := sourceStart;
+ target := targetStart;
+ r := 0;
+ if needtables then
+ tabinit;
+ if optional then
+ mustshift := @mustshiftopt[0]
+ else
+ mustshift := @mustshiftsafe[0];
+ repeat
+ done := source >= sourceEnd;
+ if not Done then
+ begin
+ r := Word(source^);
+ Inc(Source);
+ end { If };
+ needshift := (not done) and ((r > $7F) or (mustshift[r] <> #0));
+ if needshift and (not shifted) then
+ begin
+ if (Target >= TargetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ target^ := '+';
+ Inc(target);
+ { Special case handling of the SHIFT_IN character }
+ if (r = UCS2('+')) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end;
+ target^ := '-';
+ Inc(target);
+ end
+ else
+ shifted := True;
+ end { If };
+ if shifted then
+ begin
+ { Either write the character to the bit buffer, or pad }
+ { the bit buffer out to a full base64 character. }
+ { }
+ if needshift then
+ WRITE_N_BITS(r, 16, BITbuffer, bufferbits)
+ else
+ WRITE_N_BITS(0, (6 - (bufferbits mod 6)) mod 6, BITbuffer,
+ bufferbits);
+ { Flush out as many full base64 characters as possible }
+ { from the bit buffer. }
+ { }
+ while (target < targetEnd) and (bufferbits >= 6) do
+ begin
+ Target^ := base64[READ_N_BITS(6, BITbuffer, bufferbits)];
+ Inc(Target);
+ end { While };
+ if (bufferbits >= 6) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ end { If };
+ if (not needshift) then
+ begin
+ { Write the explicit shift out character if }
+ { 1) The caller has requested we always do it, or }
+ { 2) The directly encoded character is in the }
+ { base64 set, or }
+ { 3) The directly encoded character is SHIFT_OUT. }
+ { }
+ if verbose or ((not done) and ((invbase64[r] >= 0) or (r =
+ Integer('-')))) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ Break;
+ end { If };
+ Target^ := '-';
+ Inc(Target);
+ end { If };
+ shifted := False;
+ end { If };
+ { The character can be directly encoded as ASCII. }
+ end { If };
+ if (not needshift) and (not done) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ Target^ := AnsiChar(r);
+ Inc(Target);
+ end { If };
+ until (done);
+ sourceStart := source;
+ targetStart := target;
+end; { ConvertUCS2toUTF7 }
+
+function ConvertUTF7toUCS2(var sourceStart: PAnsiChar; sourceEnd: PAnsiChar;
+ var targetStart: PWideChar; targetEnd: PWideChar): Integer;
+var
+ target: PWideChar { Register };
+ source: PAnsiChar { Register };
+ BITbuffer: Cardinal { & "Address Of" Used };
+ bufferbits: Integer { & "Address Of" Used };
+ shifted: Boolean { Used In Boolean Context };
+ first: Boolean { Used In Boolean Context };
+ wroteone: Boolean;
+ base64EOF: Boolean;
+ base64value: Integer;
+ done: Boolean;
+ c: UCS2;
+ prevc: UCS2;
+ junk: UCS2 { Used In Boolean Context };
+begin
+ Initialize_UTF7_Data;
+ Result := 0;
+ BITbuffer := 0;
+ bufferbits := 0;
+ shifted := False;
+ first := False;
+ wroteone := False;
+ source := sourceStart;
+ target := targetStart;
+ c := 0;
+ if needtables then
+ tabinit;
+ repeat
+ { read an ASCII character c }
+ done := Source >= SourceEnd;
+ if (not done) then
+ begin
+ c := Word(Source^);
+ Inc(Source);
+ end { If };
+ if shifted then
+ begin
+ { We're done with a base64 string if we hit EOF, it's not a valid }
+ { ASCII character, or it's not in the base64 set. }
+ { }
+ base64value := invbase64[c];
+ base64EOF := (done or (c > $7F)) or (base64value < 0);
+ if base64EOF then
+ begin
+ shifted := False;
+ { If the character causing us to drop out was SHIFT_IN or }
+ { SHIFT_OUT, it may be a special escape for SHIFT_IN. The }
+ { test for SHIFT_IN is not necessary, but allows an alternate }
+ { form of UTF-7 where SHIFT_IN is escaped by SHIFT_IN. This }
+ { only works for some values of SHIFT_IN. }
+ { }
+ if ((not done) and ((c = Integer('+')) or (c = Integer('-')))) then
+ begin
+ { get another character c }
+ prevc := c;
+ Done := Source >= SourceEnd;
+ if (not Done) then
+ begin
+ c := Word(Source^);
+ Inc(Source);
+ { If no base64 characters were encountered, and the }
+ { character terminating the shift sequence was }
+ { SHIFT_OUT, then it's a special escape for SHIFT_IN. }
+ { }
+ end;
+ if first and (prevc = Integer('-')) then
+ begin
+ { write SHIFT_IN unicode }
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ Target^ := WideChar('+');
+ Inc(Target);
+ end
+ else
+ begin
+ if (not wroteone) then
+ begin
+ Result := 1;
+ end { If };
+ end { Else };
+ ;
+ end { If }
+ else
+ begin
+ if (not wroteone) then
+ begin
+ Result := 1;
+ end { If };
+ end { Else };
+ end { If }
+ else
+ begin
+ { Add another 6 bits of base64 to the bit buffer. }
+ WRITE_N_BITS(base64value, 6, BITbuffer,
+ bufferbits);
+ first := False;
+ end { Else };
+ { Extract as many full 16 bit characters as possible from the }
+ { bit buffer. }
+ { }
+ while (bufferbits >= 16) and (target < targetEnd) do
+ begin
+ { write a unicode }
+ Target^ := WideChar(READ_N_BITS(16, BITbuffer, bufferbits));
+ Inc(Target);
+ wroteone := True;
+ end { While };
+ if (bufferbits >= 16) then
+ begin
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ Break;
+ end;
+ end { If };
+ if (base64EOF) then
+ begin
+ junk := READ_N_BITS(bufferbits, BITbuffer, bufferbits);
+ if (junk <> 0) then
+ begin
+ Result := 1;
+ end { If };
+ end { If };
+ end { If };
+ if (not shifted) and (not done) then
+ begin
+ if (c = Integer('+')) then
+ begin
+ shifted := True;
+ first := True;
+ wroteone := False;
+ end { If }
+ else
+ begin
+ { It must be a directly encoded character. }
+ if (c > $7F) then
+ begin
+ Result := 1;
+ end { If };
+ if (target >= targetEnd) then
+ begin
+ Result := 2;
+ break;
+ end { If };
+ Target^ := WideChar(c);
+ Inc(Target);
+ end { Else };
+ end { If };
+ until (done);
+ sourceStart := source;
+ targetStart := target;
+end; { ConvertUTF7toUCS2 }
+
+ {*****************************************************************************}
+ { Thanks to Francisco Leong for providing the Pascal conversion of }
+ { ConvertUTF7.c (by David B. Goldsmith) }
+ {*****************************************************************************}
+
+resourcestring
+ SBufferOverflow = 'Buffer overflow';
+ SInvalidUTF7 = 'Invalid UTF7';
+
+function WideStringToUTF7(const W: WideString): AnsiString;
+var
+ SourceStart, SourceEnd: PWideChar;
+ TargetStart, TargetEnd: PAnsiChar;
+begin
+ if W = '' then
+ Result := ''
+ else
+ begin
+ SetLength(Result, Length(W) * 7); // Assume worst case
+ SourceStart := PWideChar(@W[1]);
+ SourceEnd := PWideChar(@W[Length(W)]) + 1;
+ TargetStart := PAnsiChar(@Result[1]);
+ TargetEnd := PAnsiChar(@Result[Length(Result)]) + 1;
+ if ConvertUCS2toUTF7(SourceStart, SourceEnd, TargetStart,
+ TargetEnd, True, False) <> 0
+ then
+ raise ETntInternalError.Create(SBufferOverflow);
+ SetLength(Result, TargetStart - PAnsiChar(@Result[1]));
+ end;
+end;
+
+function UTF7ToWideString(const S: AnsiString): WideString;
+var
+ SourceStart, SourceEnd: PAnsiChar;
+ TargetStart, TargetEnd: PWideChar;
+begin
+ if (S = '') then
+ Result := ''
+ else
+ begin
+ SetLength(Result, Length(S)); // Assume Worst case
+ SourceStart := PAnsiChar(@S[1]);
+ SourceEnd := PAnsiChar(@S[Length(S)]) + 1;
+ TargetStart := PWideChar(@Result[1]);
+ TargetEnd := PWideChar(@Result[Length(Result)]) + 1;
+ case ConvertUTF7toUCS2(SourceStart, SourceEnd, TargetStart,
+ TargetEnd) of
+ 1: raise ETntGeneralError.Create(SInvalidUTF7);
+ 2: raise ETntInternalError.Create(SBufferOverflow);
+ end;
+ SetLength(Result, TargetStart - PWideChar(@Result[1]));
+ end;
+end;
+
+function StringToWideStringEx(const S: AnsiString; CodePage: Cardinal): WideString;
+var
+ InputLength,
+ OutputLength: Integer;
+begin
+ if CodePage = CP_UTF7 then
+ Result := UTF7ToWideString(S) // CP_UTF7 not supported on Windows 95
+ else if CodePage = CP_UTF8 then
+ Result := UTF8ToWideString(S) // CP_UTF8 not supported on Windows 95
+ else begin
+ InputLength := Length(S);
+ OutputLength := MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, nil, 0);
+ SetLength(Result, OutputLength);
+ MultiByteToWideChar(CodePage, 0, PAnsiChar(S), InputLength, PWideChar(Result), OutputLength);
+ end;
+end;
+
+function WideStringToStringEx(const WS: WideString; CodePage: Cardinal): AnsiString;
+var
+ InputLength,
+ OutputLength: Integer;
+begin
+ if CodePage = CP_UTF7 then
+ Result := WideStringToUTF7(WS) // CP_UTF7 not supported on Windows 95
+ else if CodePage = CP_UTF8 then
+ Result := WideStringToUTF8(WS) // CP_UTF8 not supported on Windows 95
+ else begin
+ InputLength := Length(WS);
+ OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, nil, 0, nil, nil);
+ SetLength(Result, OutputLength);
+ WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PAnsiChar(Result), OutputLength, nil, nil);
+ end;
+end;
+
+function UCS2ToWideString(const Value: AnsiString): WideString;
+begin
+ if Length(Value) = 0 then
+ Result := ''
+ else
+ SetString(Result, PWideChar(@Value[1]), Length(Value) div SizeOf(WideChar))
+end;
+
+function WideStringToUCS2(const Value: WideString): AnsiString;
+begin
+ if Length(Value) = 0 then
+ Result := ''
+ else
+ SetString(Result, PAnsiChar(@Value[1]), Length(Value) * SizeOf(WideChar))
+end;
+
+{ Windows.pas doesn't declare TranslateCharsetInfo() correctly. }
+function TranslateCharsetInfo(lpSrc: PDWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; external gdi32 name 'TranslateCharsetInfo';
+
+function CharSetToCodePage(ciCharset: UINT): Cardinal;
+var
+ C: TCharsetInfo;
+begin
+ Win32Check(TranslateCharsetInfo(PDWORD(ciCharset), C, TCI_SRCCHARSET));
+ Result := C.ciACP
+end;
+
+function LCIDToCodePage(ALcid: LCID): Cardinal;
+var
+ Buf: array[0..6] of AnsiChar;
+begin
+ GetLocaleInfo(ALcid, LOCALE_IDefaultAnsiCodePage, Buf, 6);
+ Result := StrToIntDef(Buf, GetACP);
+end;
+
+function KeyboardCodePage: Cardinal;
+begin
+ Result := LCIDToCodePage(GetKeyboardLayout(0) and $FFFF);
+end;
+
+function KeyUnicode(CharCode: Word): WideChar;
+var
+ AChar: AnsiChar;
+begin
+ // converts the given character (as it comes with a WM_CHAR message) into its
+ // corresponding Unicode character depending on the active keyboard layout
+ if CharCode <= Word(High(AnsiChar)) then begin
+ AChar := AnsiChar(CharCode);
+ MultiByteToWideChar(KeyboardCodePage, MB_USEGLYPHCHARS, @AChar, 1, @Result, 1);
+ end else
+ Result := WideChar(CharCode);
+end;
+
+procedure StrSwapByteOrder(Str: PWideChar);
+var
+ P: PWord;
+begin
+ P := PWord(Str);
+ While (P^ <> 0) do begin
+ P^ := MakeWord(HiByte(P^), LoByte(P^));
+ Inc(P);
+ end;
+end;
+
+{$IFDEF USE_SYSTEM_OVERRIDES}
+
+//--------------------------------------------------------------------
+// LoadResString()
+//
+// This system function is used to retrieve a resourcestring and
+// return the result as an AnsiString. If we believe that the result
+// is only a temporary value, and that it will be immediately
+// assigned to a WideString or a Variant, then we will save the
+// Unicode result as well as a reference to the original Ansi string.
+// WStrFromPCharLen() or VarFromLStr() will return this saved
+// Unicode string if it appears to receive the most recent result
+// of LoadResString.
+//--------------------------------------------------------------------
+
+
+ //===========================================================================================
+ //
+ // function CodeMatchesPatternForUnicode(...);
+ //
+ // GIVEN: SomeWideString := SSomeResString; { WideString := resourcestring }
+ //
+ // Delphi will compile this statement into the following:
+ // -------------------------------------------------
+ // TempAnsiString := LoadResString(@SSomeResString);
+ // LINE 1: lea edx,[SomeTempAnsiString]
+ // LINE 2: mov eax,[@SomeResString]
+ // LINE 3: call LoadResString
+ //
+ // WStrFromLStr(SomeWideString, TempAnsiString); { SomeWideString := TempAnsiString }
+ // LINE 4: mov edx,[SomeTempAnsiString]
+ // LINE 5: mov/lea eax [@SomeWideString]
+ // LINE 6: call @WStrFromLStr
+ // -------------------------------------------------
+ //
+ // The order in which the parameters are prepared for WStrFromLStr (ie LINE 4 & 5) is
+ // reversed when assigning a non-temporary AnsiString to a WideString.
+ //
+ // This code, for example, results in LINE 4 and LINE 5 being swapped.
+ //
+ // SomeAnsiString := SSomeResString;
+ // SomeWideString := SomeAnsiString;
+ //
+ // Since we know the "signature" used by the compiler, we can detect this pattern.
+ // If we believe it is only temporary, we can save the Unicode results for later
+ // retrieval from WStrFromLStr.
+ //
+ // One final note: When assigning a resourcestring to a Variant, the same patterns exist.
+ //===========================================================================================
+
+function CodeMatchesPatternForUnicode(PLine4: PAnsiChar): Boolean;
+const
+ SIZEOF_OPCODE = 1 {byte};
+ MOV_16_OPCODE = AnsiChar($8B); { we'll assume operand size is 16 bits }
+ MOV_32_OPCODE = AnsiChar($B8); { we'll assume operand size is 32 bits }
+ LEA_OPCODE = AnsiChar($8D); { operand size can be 16 or 40 bits }
+ CALL_OPCODE = AnsiChar($E8); { assumed operand size is 32 bits }
+ BREAK_OPCODE = AnsiChar($CC); {in a breakpoint}
+var
+ PLine1: PAnsiChar;
+ PLine2: PAnsiChar;
+ PLine3: PAnsiChar;
+ DataSize: Integer; // bytes in first LEA operand
+begin
+ Result := False;
+
+ PLine3 := PLine4 - SizeOf(CALL_OPCODE) - 4;
+ PLine2 := PLine3 - SizeOf(MOV_32_OPCODE) - 4;
+
+ // figure PLine1 and operand size
+ DataSize := 2; { try 16 bit operand for line 1 }
+ PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
+ if (PLine1^ <> LEA_OPCODE) and (not (IsDebugging and (PLine1^ = BREAK_OPCODE))) then
+ begin
+ DataSize := 5; { try 40 bit operand for line 1 }
+ PLine1 := PLine2 - DataSize - SizeOf(LEA_OPCODE);
+ end;
+ if (PLine1^ = LEA_OPCODE) or (IsDebugging and (PLine1^ = BREAK_OPCODE)) then
+ begin
+ if CompareMem(PLine1 + SIZEOF_OPCODE, PLine4 + SIZEOF_OPCODE, DataSize) then
+ begin
+ // After this check, it seems to match the WideString <- (temp) AnsiString pattern
+ Result := True; // It is probably OK. (The side effects of being wrong aren't very bad.)
+ end;
+ end;
+end;
+
+threadvar
+ PLastResString: PAnsiChar;
+ LastResStringValue: AnsiString;
+ LastWideResString: WideString;
+
+procedure FreeTntSystemThreadVars;
+begin
+ LastResStringValue := '';
+ LastWideResString := '';
+end;
+
+procedure Custom_System_EndThread(ExitCode: Integer);
+begin
+ FreeTntSystemThreadVars;
+ {$IFDEF COMPILER_10_UP}
+ if Assigned(SystemThreadEndProc) then
+ SystemThreadEndProc(ExitCode);
+ {$ENDIF}
+ ExitThread(ExitCode);
+end;
+
+function Custom_System_LoadResString(ResStringRec: PResStringRec): AnsiString;
+var
+ ReturnAddr: Pointer;
+begin
+ // get return address
+ asm
+ PUSH ECX
+ MOV ECX, [EBP + 4]
+ MOV ReturnAddr, ECX
+ POP ECX
+ end;
+ // check calling code pattern
+ if CodeMatchesPatternForUnicode(ReturnAddr) then begin
+ // result will probably be assigned to an intermediate AnsiString
+ // on its way to either a WideString or Variant.
+ LastWideResString := WideLoadResString(ResStringRec);
+ Result := LastWideResString;
+ LastResStringValue := Result;
+ if Result = '' then
+ PLastResString := nil
+ else
+ PLastResString := PAnsiChar(Result);
+ end else begin
+ // result will probably be assigned to an actual AnsiString variable.
+ PLastResString := nil;
+ Result := WideLoadResString(ResStringRec);
+ end;
+end;
+
+//--------------------------------------------------------------------
+// WStrFromPCharLen()
+//
+// This system function is used to assign an AnsiString to a WideString.
+// It has been modified to assign Unicode results from LoadResString.
+// Another purpose of this function is to specify the code page.
+//--------------------------------------------------------------------
+
+procedure Custom_System_WStrFromPCharLen(var Dest: WideString; Source: PAnsiChar; Length: Integer);
+var
+ DestLen: Integer;
+ Buffer: array[0..2047] of WideChar;
+ Local_PLastResString: Pointer;
+begin
+ Local_PLastResString := PLastResString;
+ if (Local_PLastResString <> nil)
+ and (Local_PLastResString = Source)
+ and (System.Length(LastResStringValue) = Length)
+ and (LastResStringValue = Source) then begin
+ // use last unicode resource string
+ PLastResString := nil; { clear for further use }
+ Dest := LastWideResString;
+ end else begin
+ if Local_PLastResString <> nil then
+ PLastResString := nil; { clear for further use }
+ if Length <= 0 then
+ begin
+ Dest := '';
+ Exit;
+ end;
+ if Length + 1 < High(Buffer) then
+ begin
+ DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Buffer,
+ High(Buffer));
+ if DestLen > 0 then
+ begin
+ SetLength(Dest, DestLen);
+ Move(Pointer(@Buffer[0])^, Pointer(Dest)^, DestLen * SizeOf(WideChar));
+ Exit;
+ end;
+ end;
+ DestLen := (Length + 1);
+ SetLength(Dest, DestLen); // overallocate, trim later
+ DestLen := MultiByteToWideChar(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest),
+ DestLen);
+ if DestLen < 0 then
+ DestLen := 0;
+ SetLength(Dest, DestLen);
+ end;
+end;
+
+{$IFNDEF COMPILER_9_UP}
+
+//--------------------------------------------------------------------
+// LStrFromPWCharLen()
+//
+// This system function is used to assign an WideString to an AnsiString.
+// It has not been modified from its original purpose other than to specify the code page.
+//--------------------------------------------------------------------
+
+procedure Custom_System_LStrFromPWCharLen(var Dest: AnsiString; Source: PWideChar; Length: Integer);
+var
+ DestLen: Integer;
+ Buffer: array[0..4095] of AnsiChar;
+begin
+ if Length <= 0 then
+ begin
+ Dest := '';
+ Exit;
+ end;
+ if Length + 1 < (High(Buffer) div sizeof(WideChar)) then
+ begin
+ DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source,
+ Length, Buffer, High(Buffer),
+ nil, nil);
+ if DestLen >= 0 then
+ begin
+ SetLength(Dest, DestLen);
+ Move(Pointer(@Buffer[0])^, PAnsiChar(Dest)^, DestLen);
+ Exit;
+ end;
+ end;
+
+ DestLen := (Length + 1) * sizeof(WideChar);
+ SetLength(Dest, DestLen); // overallocate, trim later
+ DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Source, Length, Pointer(Dest), DestLen,
+ nil, nil);
+ if DestLen < 0 then
+ DestLen := 0;
+ SetLength(Dest, DestLen);
+end;
+
+//--------------------------------------------------------------------
+// WStrToString()
+//
+// This system function is used to assign an WideString to an short string.
+// It has not been modified from its original purpose other than to specify the code page.
+//--------------------------------------------------------------------
+
+procedure Custom_System_WStrToString(Dest: PShortString; const Source: WideString; MaxLen: Integer);
+var
+ SourceLen, DestLen: Integer;
+ Buffer: array[0..511] of AnsiChar;
+begin
+ if MaxLen > 255 then MaxLen := 255;
+ SourceLen := Length(Source);
+ if SourceLen >= MaxLen then SourceLen := MaxLen;
+ if SourceLen = 0 then
+ DestLen := 0
+ else begin
+ DestLen := WideCharToMultiByte(DefaultSystemCodePage, 0, Pointer(Source), SourceLen,
+ Buffer, SizeOf(Buffer), nil, nil);
+ if DestLen > MaxLen then DestLen := MaxLen;
+ end;
+ Dest^[0] := Chr(DestLen);
+ if DestLen > 0 then Move(Buffer, Dest^[1], DestLen);
+end;
+
+{$ENDIF}
+
+//--------------------------------------------------------------------
+// VarFromLStr()
+//
+// This system function is used to assign an AnsiString to a Variant.
+// It has been modified to assign Unicode results from LoadResString.
+//--------------------------------------------------------------------
+
+procedure Custom_System_VarFromLStr(var V: TVarData; const Value: AnsiString);
+const
+ varDeepData = $BFE8;
+var
+ Local_PLastResString: Pointer;
+begin
+ if (V.VType and varDeepData) <> 0 then
+ VarClear(PVariant(@V)^);
+
+ Local_PLastResString := PLastResString;
+ if (Local_PLastResString <> nil)
+ and (Local_PLastResString = PAnsiChar(Value))
+ and (LastResStringValue = Value) then begin
+ // use last unicode resource string
+ PLastResString := nil; { clear for further use }
+ V.VOleStr := nil;
+ V.VType := varOleStr;
+ WideString(Pointer(V.VOleStr)) := Copy(LastWideResString, 1, MaxInt);
+ end else begin
+ if Local_PLastResString <> nil then
+ PLastResString := nil; { clear for further use }
+ V.VString := nil;
+ V.VType := varString;
+ AnsiString(V.VString) := Value;
+ end;
+end;
+
+{$IFNDEF COMPILER_9_UP}
+
+//--------------------------------------------------------------------
+// WStrCat3() A := B + C;
+//
+// This system function is used to concatenate two strings into one result.
+// This function is added because A := '' + '' doesn't necessarily result in A = '';
+//--------------------------------------------------------------------
+
+procedure Custom_System_WStrCat3(var Dest: WideString; const Source1, Source2: WideString);
+
+ function NewWideString(CharLength: Longint): Pointer;
+ var
+ _NewWideString: function(CharLength: Longint): Pointer;
+ begin
+ asm
+ PUSH ECX
+ MOV ECX, offset System.@NewWideString;
+ MOV _NewWideString, ECX
+ POP ECX
+ end;
+ Result := _NewWideString(CharLength);
+ end;
+
+ procedure WStrSet(var S: WideString; P: PWideChar);
+ var
+ Temp: Pointer;
+ begin
+ Temp := Pointer(InterlockedExchange(Integer(S), Integer(P)));
+ if Temp <> nil then
+ WideString(Temp) := '';
+ end;
+
+var
+ Source1Len, Source2Len: Integer;
+ NewStr: PWideChar;
+begin
+ Source1Len := Length(Source1);
+ Source2Len := Length(Source2);
+ if (Source1Len <> 0) or (Source2Len <> 0) then
+ begin
+ NewStr := NewWideString(Source1Len + Source2Len);
+ Move(Pointer(Source1)^, Pointer(NewStr)^, Source1Len * sizeof(WideChar));
+ Move(Pointer(Source2)^, NewStr[Source1Len], Source2Len * sizeof(WideChar));
+ WStrSet(Dest, NewStr);
+ end else
+ Dest := '';
+end;
+
+{$ENDIF}
+
+//--------------------------------------------------------------------
+// System proc replacements
+//--------------------------------------------------------------------
+
+type
+ POverwrittenData = ^TOverwrittenData;
+ TOverwrittenData = record
+ Location: Pointer;
+ OldCode: array[0..6] of Byte;
+ end;
+
+procedure OverwriteProcedure(OldProcedure, NewProcedure: pointer; Data: POverwrittenData = nil);
+{ OverwriteProcedure originally from Igor Siticov }
+{ Modified by Jacques Garcia Vazquez }
+var
+ x: PAnsiChar;
+ y: integer;
+ ov2, ov: cardinal;
+ p: pointer;
+begin
+ if Assigned(Data) and (Data.Location <> nil) then
+ exit; { procedure already overwritten }
+
+ // need six bytes in place of 5
+ x := PAnsiChar(OldProcedure);
+ if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
+ RaiseLastOSError;
+
+ // if a jump is present then a redirect is found
+ // $FF25 = jmp dword ptr [xxx]
+ // This redirect is normally present in bpl files, but not in exe files
+ p := OldProcedure;
+
+ if Word(p^) = $25FF then
+ begin
+ Inc(Integer(p), 2); // skip the jump
+ // get the jump address p^ and dereference it p^^
+ p := Pointer(Pointer(p^)^);
+
+ // release the memory
+ if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
+ RaiseLastOSError;
+
+ // re protect the correct one
+ x := PAnsiChar(p);
+ if not VirtualProtect(Pointer(x), 6, PAGE_EXECUTE_READWRITE, @ov) then
+ RaiseLastOSError;
+ end;
+
+ if Assigned(Data) then
+ begin
+ Move(x^, Data.OldCode, 6);
+ { Assign Location last so that Location <> nil only if OldCode is properly initialized. }
+ Data.Location := x;
+ end;
+
+ x[0] := AnsiChar($E9);
+ y := integer(NewProcedure) - integer(p) - 5;
+ x[1] := AnsiChar(y and 255);
+ x[2] := AnsiChar((y shr 8) and 255);
+ x[3] := AnsiChar((y shr 16) and 255);
+ x[4] := AnsiChar((y shr 24) and 255);
+
+ if not VirtualProtect(Pointer(x), 6, ov, @ov2) then
+ RaiseLastOSError;
+end;
+
+procedure RestoreProcedure(OriginalProc: Pointer; Data: TOverwrittenData);
+var
+ ov, ov2: Cardinal;
+begin
+ if Data.Location <> nil then begin
+ if not VirtualProtect(Data.Location, 6, PAGE_EXECUTE_READWRITE, @ov) then
+ RaiseLastOSError;
+ Move(Data.OldCode, Data.Location^, 6);
+ if not VirtualProtect(Data.Location, 6, ov, @ov2) then
+ RaiseLastOSError;
+ end;
+end;
+
+function Addr_System_EndThread: Pointer;
+begin
+ Result := @System.EndThread;
+end;
+
+function Addr_System_LoadResString: Pointer;
+begin
+ Result := @System.LoadResString{TNT-ALLOW LoadResString};
+end;
+
+function Addr_System_WStrFromPCharLen: Pointer;
+asm
+ mov eax, offset System.@WStrFromPCharLen;
+end;
+
+{$IFNDEF COMPILER_9_UP}
+function Addr_System_LStrFromPWCharLen: Pointer;
+asm
+ mov eax, offset System.@LStrFromPWCharLen;
+end;
+
+function Addr_System_WStrToString: Pointer;
+asm
+ mov eax, offset System.@WStrToString;
+end;
+{$ENDIF}
+
+function Addr_System_VarFromLStr: Pointer;
+asm
+ mov eax, offset System.@VarFromLStr;
+end;
+
+function Addr_System_WStrCat3: Pointer;
+asm
+ mov eax, offset System.@WStrCat3;
+end;
+
+var
+ System_EndThread_Code,
+ System_LoadResString_Code,
+ System_WStrFromPCharLen_Code,
+ {$IFNDEF COMPILER_9_UP}
+ System_LStrFromPWCharLen_Code,
+ System_WStrToString_Code,
+ {$ENDIF}
+ System_VarFromLStr_Code
+ {$IFNDEF COMPILER_9_UP}
+ ,
+ System_WStrCat3_Code,
+ SysUtils_WideFmtStr_Code
+ {$ENDIF}
+ : TOverwrittenData;
+
+procedure InstallEndThreadOverride;
+begin
+ OverwriteProcedure(Addr_System_EndThread, @Custom_System_EndThread, @System_EndThread_Code);
+end;
+
+procedure InstallStringConversionOverrides;
+begin
+ OverwriteProcedure(Addr_System_WStrFromPCharLen, @Custom_System_WStrFromPCharLen, @System_WStrFromPCharLen_Code);
+ {$IFNDEF COMPILER_9_UP}
+ OverwriteProcedure(Addr_System_LStrFromPWCharLen, @Custom_System_LStrFromPWCharLen, @System_LStrFromPWCharLen_Code);
+ OverwriteProcedure(Addr_System_WStrToString, @Custom_System_WStrToString, @System_WStrToString_Code);
+ {$ENDIF}
+end;
+
+procedure InstallWideResourceStrings;
+begin
+ OverwriteProcedure(Addr_System_LoadResString, @Custom_System_LoadResString, @System_LoadResString_Code);
+ OverwriteProcedure(Addr_System_VarFromLStr, @Custom_System_VarFromLStr, @System_VarFromLStr_Code);
+end;
+
+{$IFNDEF COMPILER_9_UP}
+procedure InstallWideStringConcatenationFix;
+begin
+ OverwriteProcedure(Addr_System_WStrCat3, @Custom_System_WStrCat3, @System_WStrCat3_Code);
+end;
+
+procedure InstallWideFormatFixes;
+begin
+ OverwriteProcedure(@SysUtils.WideFmtStr, @TntSysUtils.Tnt_WideFmtStr, @SysUtils_WideFmtStr_Code);
+end;
+{$ENDIF}
+
+procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
+begin
+ InstallEndThreadOverride;
+ if tsWideResourceStrings in Updates then begin
+ InstallStringConversionOverrides;
+ InstallWideResourceStrings;
+ end;
+ {$IFNDEF COMPILER_9_UP}
+ if tsFixImplicitCodePage in Updates then begin
+ InstallStringConversionOverrides;
+ { CP_ACP is the code page used by the non-Unicode Windows API. }
+ GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
+ end;
+ if tsFixWideStrConcat in Updates then begin
+ InstallWideStringConcatenationFix;
+ end;
+ if tsFixWideFormat in Updates then begin
+ InstallWideFormatFixes;
+ end;
+ {$ENDIF}
+end;
+
+{$IFNDEF COMPILER_9_UP}
+var
+ StartupDefaultUserCodePage: Cardinal;
+{$ENDIF}
+
+procedure UninstallSystemOverrides;
+begin
+ RestoreProcedure(Addr_System_EndThread, System_EndThread_Code);
+ // String Conversion
+ RestoreProcedure(Addr_System_WStrFromPCharLen, System_WStrFromPCharLen_Code);
+ {$IFNDEF COMPILER_9_UP}
+ RestoreProcedure(Addr_System_LStrFromPWCharLen, System_LStrFromPWCharLen_Code);
+ RestoreProcedure(Addr_System_WStrToString, System_WStrToString_Code);
+ GDefaultSystemCodePage := StartupDefaultUserCodePage;
+ {$ENDIF}
+ // Wide resourcestring
+ RestoreProcedure(Addr_System_LoadResString, System_LoadResString_Code);
+ RestoreProcedure(Addr_System_VarFromLStr, System_VarFromLStr_Code);
+ {$IFNDEF COMPILER_9_UP}
+ // WideString concat fix
+ RestoreProcedure(Addr_System_WStrCat3, System_WStrCat3_Code);
+ // WideFormat fixes
+ RestoreProcedure(@SysUtils.WideFmtStr, SysUtils_WideFmtStr_Code);
+ {$ENDIF}
+end;
+
+{$ENDIF USE_SYSTEM_OVERRIDES}
+
+initialization
+ {$IFDEF COMPILER_9_UP}
+ {$DEFINE USE_GETACP}
+ {$ENDIF}
+ {$IFDEF FPC}
+ {$DEFINE USE_GETACP}
+ {$ENDIF}
+ {$IFDEF USE_GETACP}
+ GDefaultSystemCodePage := GetACP;
+ {$ELSE}
+ {$IFDEF COMPILER_7_UP}
+ if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) then
+ GDefaultSystemCodePage := CP_THREAD_ACP // Win 2K/XP/...
+ else
+ GDefaultSystemCodePage := LCIDToCodePage(GetThreadLocale); // Win NT4/95/98/ME
+ {$ELSE}
+ GDefaultSystemCodePage := CP_ACP{TNT-ALLOW CP_ACP};
+ {$ENDIF}
+ {$ENDIF}
+ {$IFDEF USE_SYSTEM_OVERRIDES}
+ {$IFNDEF COMPILER_9_UP}
+ StartupDefaultUserCodePage := DefaultSystemCodePage;
+ {$ENDIF}
+ IsDebugging := DebugHook > 0;
+ {$ENDIF USE_SYSTEM_OVERRIDES}
+
+finalization
+ {$IFDEF USE_SYSTEM_OVERRIDES}
+ UninstallSystemOverrides;
+ FreeTntSystemThreadVars; { Make MemorySleuth happy. }
+ {$ENDIF USE_SYSTEM_OVERRIDES}
+
+end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-18 00:00:21 +0000