FPC (Windows only) support for TntUnicodeUtils

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/experimental@1638 b956fd51-792f-4845-bead-9b4dfca2ff2c

8 files changed, 280 insertions, 49 deletions

diff --git a/unicode/src/lib/TntUnicodeControls/TntClasses.pas b/unicode/src/lib/TntUnicodeControls/TntClasses.pas
index 5b455c3b..be043421 100644
--- a/unicode/src/lib/TntUnicodeControls/TntClasses.pas
+++ b/unicode/src/lib/TntUnicodeControls/TntClasses.pas
@@ -11,6 +11,10 @@
 
 unit TntClasses;
 
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
 {$INCLUDE TntCompilers.inc}
 
 interface
@@ -502,7 +506,11 @@ var
 begin
   Temp := WideChar(GetOrdProp(FInstance, FPropInfo));
 
+  {$IFNDEF FPC}
   TAccessWriter(Writer).WriteValue(vaWString);
+  {$ELSE}
+  TAccessWriter(Writer).Write(vaWString, SizeOf(vaWString));
+  {$ENDIF}
   L := Length(Temp);
   Writer.Write(L, SizeOf(Integer));
   Writer.Write(Pointer(@Temp[1])^, L * 2);
@@ -592,10 +600,17 @@ end;
 
 { TTntFileStream }
 
+{$IFDEF FPC}
+  {$DEFINE HAS_SFCREATEERROREX}
+{$ENDIF}
+{$IFDEF DELPHI_7_UP}
+  {$DEFINE HAS_SFCREATEERROREX}
+{$ENDIF}
+
 constructor TTntFileStream.Create(const FileName: WideString; Mode: Word);
 var
   CreateHandle: Integer;
-  {$IFDEF DELPHI_7_UP}
+  {$IFDEF HAS_SFCREATEERROREX}
   ErrorMessage: WideString;
   {$ENDIF}
 begin
@@ -603,7 +618,7 @@ begin
   begin
     CreateHandle := WideFileCreate(FileName);
     if CreateHandle < 0 then begin
-      {$IFDEF DELPHI_7_UP}
+      {$IFDEF HAS_SFCREATEERROREX}
       ErrorMessage := WideSysErrorMessage(GetLastError);
       raise EFCreateError.CreateFmt(SFCreateErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
       {$ELSE}
@@ -614,7 +629,7 @@ begin
   begin
     CreateHandle := WideFileOpen(FileName, Mode);
     if CreateHandle < 0 then begin
-      {$IFDEF DELPHI_7_UP}
+      {$IFDEF HAS_SFCREATEERROREX}
       ErrorMessage := WideSysErrorMessage(GetLastError);
       raise EFOpenError.CreateFmt(SFOpenErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
       {$ELSE}
@@ -752,11 +767,15 @@ end;
 procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFileEx(const FileName: WideString; CodePage: Cardinal);
 var
   Stream: TStream;
+  Utf8BomPtr: PAnsiChar;
 begin
   Stream := TTntFileStream.Create(FileName, fmCreate);
   try
     if (CodePage = CP_UTF8) then
-      Stream.WriteBuffer(PAnsiChar(UTF8_BOM)^, Length(UTF8_BOM));
+    begin
+      Utf8BomPtr := PAnsiChar(UTF8_BOM);
+      Stream.WriteBuffer(Utf8BomPtr^, Length(UTF8_BOM));
+    end;
     SaveToStreamEx(Stream, CodePage);
   finally
     Stream.Free;
@@ -1721,9 +1740,9 @@ end;
 
 function CompareComponentHelperToTarget(Item, Target: Pointer): Integer;
 begin
-  if Integer(TWideComponentHelper(Item).FComponent) < Integer(Target) then
+  if PtrUInt(TWideComponentHelper(Item).FComponent) < PtrUInt(Target) then
     Result := -1
-  else if Integer(TWideComponentHelper(Item).FComponent) > Integer(Target) then
+  else if PtrUInt(TWideComponentHelper(Item).FComponent) > PtrUInt(Target) then
     Result := 1
   else
     Result := 0;
diff --git a/unicode/src/lib/TntUnicodeControls/TntCompilers.inc b/unicode/src/lib/TntUnicodeControls/TntCompilers.inc
index 39eb95e9..06f4d9ab 100644
--- a/unicode/src/lib/TntUnicodeControls/TntCompilers.inc
+++ b/unicode/src/lib/TntUnicodeControls/TntCompilers.inc
@@ -147,6 +147,10 @@
     {$define DELPHI_1}
   {$endif}
 
+  {$ifdef FPC}
+    {.$define DELPHI}
+  {$endif}
+    
   {$ifdef DELPHI_2}
     {$define DELPHI_2_UP}
   {$endif}
@@ -350,7 +354,25 @@
 {$ENDIF}
 
 {$IFDEF COMPILER_7_UP}
+{$IFDEF FPC}
+  {$DEFINE UNSAFE_WARNINGS_OFF}
+{$ENDIF}
+{$ENDIF}
+
+{$IFDEF UNSAFE_WARNINGS_OFF}
 {$WARN UNSAFE_CODE OFF} { We are not going to be "safe"! }
 {$WARN UNSAFE_TYPE OFF}
 {$WARN UNSAFE_CAST OFF}
-{$ENDIF}
\ No newline at end of file
+{$ENDIF}
+
+{$IFDEF FPC}
+{$HINTS OFF}
+{$ENDIF}
+
+{$IFNDEF FPC}
+  // Delphi system function overrides might (not tested) cause problems on
+  // CPUs with code protection (NX-bit). So disable by default. 
+  {.$DEFINE USE_SYSTEM_OVERRIDES}
+{$ENDIF}
+
+
diff --git a/unicode/src/lib/TntUnicodeControls/TntFormatStrUtils.pas b/unicode/src/lib/TntUnicodeControls/TntFormatStrUtils.pas
index 2b409e4e..c6b65082 100644
--- a/unicode/src/lib/TntUnicodeControls/TntFormatStrUtils.pas
+++ b/unicode/src/lib/TntUnicodeControls/TntFormatStrUtils.pas
@@ -11,6 +11,10 @@
 
 unit TntFormatStrUtils;
 
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
 {$INCLUDE TntCompilers.inc}
 
 interface
@@ -21,11 +25,14 @@ uses
   TntSysUtils;
 
 function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
+
+{$IFNDEF FPC}
 {$IFNDEF COMPILER_9_UP}
 function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
   const Args: array of const
     {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
 {$ENDIF}
+{$ENDIF}
 procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
 function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
 
@@ -268,6 +275,7 @@ begin
   end;
 end;
 
+{$IFNDEF FPC}
 {$IFNDEF COMPILER_9_UP}
 function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
   const Args: array of const
@@ -318,6 +326,7 @@ begin
   end;
 end;
 {$ENDIF}
+{$ENDIF}
 
 procedure GetFormatArgs(const _FormatString: WideString; FormatArgs: TTntStrings);
 var
@@ -376,6 +385,15 @@ begin
   end;
 end;
 
+function FormatSpecToObject(SpecType: TFormatSpecifierType): TObject;
+begin
+  {$IFNDEF FPC}
+  Result := TObject(SpecType);
+  {$ELSE}
+  Result := Pointer(SpecType);
+  {$ENDIF}
+end;
+
 procedure UpdateTypeList(FormatArgs, TypeList: TTntStrings);
 var
   i: integer;
@@ -406,13 +424,13 @@ begin
 
     if TypeList[RunningIndex] <> '' then begin
       // already exists in list, check for compatibility
-      if TypeList.Objects[RunningIndex] <> TObject(SpecType) then
+      if TypeList.Objects[RunningIndex] <> FormatSpecToObject(SpecType) then
         raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
           [RunningIndex, TypeList[RunningIndex], f]);
     end else begin
       // not in list so update it
       TypeList[RunningIndex] := f;
-      TypeList.Objects[RunningIndex] := TObject(SpecType);
+      TypeList.Objects[RunningIndex] := FormatSpecToObject(SpecType);
     end;
   end;
 end;
diff --git a/unicode/src/lib/TntUnicodeControls/TntSysUtils.pas b/unicode/src/lib/TntUnicodeControls/TntSysUtils.pas
index 317f0f12..17084f35 100644
--- a/unicode/src/lib/TntUnicodeControls/TntSysUtils.pas
+++ b/unicode/src/lib/TntUnicodeControls/TntSysUtils.pas
@@ -11,6 +11,10 @@
 
 unit TntSysUtils;
 
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
 {$INCLUDE TntCompilers.inc}
 
 interface
@@ -19,7 +23,7 @@ interface
 { TODO: Consider: string functions from StrUtils. }
 
 uses
-  Types, SysUtils, Windows;
+  Types, SysUtils, Windows, TntWindows;
 
 //---------------------------------------------------------------------------------------------
 //                                 Tnt - Types
@@ -34,6 +38,12 @@ type
   // Like Assert().  An error occured that should never have happened, send me a bug report now!
   ETntInternalError = class(Exception);
 
+{$IFNDEF FPC}
+type
+  PtrInt = LongInt;
+  PtrUInt = LongWord;
+{$ENDIF}
+
 //---------------------------------------------------------------------------------------------
 //                                 Tnt - SysUtils
 //---------------------------------------------------------------------------------------------
@@ -106,6 +116,7 @@ type
 
 // ........ string functions .........
 
+{$IFNDEF FPC}
 {$IFNDEF COMPILER_9_UP}
   //
   // pre-Delphi 9 issues w/ WideFormatBuf, WideFmtStr and WideFormat
@@ -148,6 +159,7 @@ type
   {$ENDIF}
 
 {$ENDIF}
+{$ENDIF}
 
 {TNT-WARN WideUpperCase} // SysUtils.WideUpperCase is broken on Win9x for D6, D7, D9.
 function Tnt_WideUpperCase(const S: WideString): WideString;
@@ -241,7 +253,7 @@ function WideRenameFile(const OldName, NewName: WideString): Boolean;
 {TNT-WARN DeleteFile}
 function WideDeleteFile(const FileName: WideString): Boolean;
 {TNT-WARN CopyFile}
-function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
+function WideCopyFile(const FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
 
 
 {TNT-WARN TFileName}
@@ -333,9 +345,11 @@ var
   Win32PlatformIs2003: Boolean;
   Win32PlatformIsVista: Boolean;
 
+{$IFNDEF FPC}
 {$IFNDEF COMPILER_7_UP}
 function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
 {$ENDIF}
+{$ENDIF}
 function WinCheckH(RetVal: Cardinal): Cardinal;
 function WinCheckFileH(RetVal: Cardinal): Cardinal;
 function WinCheckP(RetVal: Pointer): Pointer;
@@ -343,7 +357,9 @@ function WinCheckP(RetVal: Pointer): Pointer;
 function WideGetModuleFileName(Instance: HModule): WideString;
 function WideSafeLoadLibrary(const Filename: Widestring;
   ErrorMode: UINT = SEM_NOOPENFILEERRORBOX): HMODULE;
+{$IFNDEF FPC}
 function WideLoadPackage(const Name: Widestring): HMODULE;
+{$ENDIF}
 
 function IsWideCharUpper(WC: WideChar): Boolean;
 function IsWideCharLower(WC: WideChar): Boolean;
@@ -385,12 +401,13 @@ implementation
 uses
   ActiveX, ComObj, SysConst,
   {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils,
-  TntSystem, TntWindows, TntFormatStrUtils;
+  TntSystem;//, TntFormatStrUtils;
 
 //---------------------------------------------------------------------------------------------
 //                                 Tnt - SysUtils
 //---------------------------------------------------------------------------------------------
 
+{$IFNDEF FPC}
 {$IFNDEF COMPILER_9_UP}
 
   function _Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
@@ -492,10 +509,16 @@ uses
   {$ENDIF}
 
 {$ENDIF}
+{$ENDIF FPC}
 
 function Tnt_WideUpperCase(const S: WideString): WideString;
 begin
+  {$IFNDEF FPC}
   {$IFNDEF COMPILER_10_UP}
+    {$DEFINE WIDEUPPERCASE_BROKEN}
+  {$ENDIF}
+  {$ENDIF}
+  {$IFDEF WIDEUPPERCASE_BROKEN}
   { SysUtils.WideUpperCase is broken for Win9x. }
   Result := S;
   if Length(Result) > 0 then
@@ -507,7 +530,12 @@ end;
 
 function Tnt_WideLowerCase(const S: WideString): WideString;
 begin
+  {$IFNDEF FPC}
   {$IFNDEF COMPILER_10_UP}
+    {$DEFINE WIDELOWERCASE_BROKEN}
+  {$ENDIF}
+  {$ENDIF}
+  {$IFDEF WIDELOWERCASE_BROKEN}
   { SysUtils.WideLowerCase is broken for Win9x. }
   Result := S;
   if Length(Result) > 0 then
@@ -1064,7 +1092,8 @@ function WideForceDirectories(Dir: WideString): Boolean;
 begin
   Result := True;
   if Length(Dir) = 0 then
-    raise ETntGeneralError.Create(SCannotCreateDir);
+    raise ETntGeneralError.Create(
+      {$IFNDEF FPC} SCannotCreateDir {$ELSE} SCannotCreateEmptyDir {$ENDIF});
   Dir := WideExcludeTrailingBackslash(Dir);
   if (Length(Dir) < 3) or WideDirectoryExists(Dir)
     or (WideExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
@@ -1108,7 +1137,7 @@ begin
   Result := Tnt_DeleteFileW(PWideChar(FileName))
 end;
 
-function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
+function WideCopyFile(const FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
 begin
   Result := Tnt_CopyFileW(PWideChar(FromFile), PWideChar(ToFile), FailIfExists)
 end;
@@ -1190,9 +1219,17 @@ end;
 //==  DATE/TIME STRING PARSING ================================================================
 //=============================================================================================
 
+{$IFDEF FPC}
+const
+  VAR_TIMEVALUEONLY = 1;
+  VAR_DATEVALUEONLY = 2;
+{$ENDIF}
+
 function _IntTryStrToDateTime(Str: WideString; Flags: Integer; out DateTime: TDateTime): HResult;
 begin
-  Result := VarDateFromStr(Str, GetThreadLocale, Flags, Double(DateTime));
+  Result := VarDateFromStr(
+      {$IFDEF FPC} POLECHAR(Str) {$ELSE} Str {$ENDIF},
+      GetThreadLocale, Flags, Double(DateTime));
   if (not Succeeded(Result)) then begin
     if (Flags = VAR_TIMEVALUEONLY)
     and SysUtils.TryStrToTime{TNT-ALLOW TryStrToTime}(Str, DateTime) then
@@ -1279,12 +1316,14 @@ end;
 
 function TntStrToDate(Str: WideString): TDateTime;
 begin
-  Result := _IntStrToDateTime(Str, VAR_DATEVALUEONLY, SInvalidDate);
+  Result := _IntStrToDateTime(Str, VAR_DATEVALUEONLY,
+      {$IFNDEF FPC} SInvalidDate {$ELSE} SInvalidDateTime {$ENDIF});
 end;
 
 function TntStrToTime(Str: WideString): TDateTime;
 begin
-  Result := _IntStrToDateTime(Str, VAR_TIMEVALUEONLY, SInvalidTime);
+  Result := _IntStrToDateTime(Str, VAR_TIMEVALUEONLY,
+      {$IFNDEF FPC} SInvalidTime {$ELSE} SInvalidDateTime {$ENDIF});
 end;
 
 //=============================================================================================
@@ -1312,7 +1351,9 @@ end;
 function TntStrToCurr(const S: WideString): Currency;
 begin
   try
-    OleCheck(VarCyFromStr(S, GetThreadLocale, 0, Result));
+    OleCheck(VarCyFromStr(
+        {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF},
+        GetThreadLocale, 0, Result));
   except
     on E: Exception do begin
       E.Message := E.Message + CRLF + WideFormat(SInvalidCurrency, [S]);
@@ -1325,12 +1366,16 @@ function ValidCurrencyStr(const S: WideString): Boolean;
 var
   Dummy: Currency;
 begin
-  Result := Succeeded(VarCyFromStr(S, GetThreadLocale, 0, Dummy));
+  Result := Succeeded(VarCyFromStr(
+      {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF},
+      GetThreadLocale, 0, Dummy));
 end;
 
 function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency;
 begin
-  if not Succeeded(VarCyFromStr(S, GetThreadLocale, 0, Result)) then
+  if not Succeeded(VarCyFromStr(
+      {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF},
+      GetThreadLocale, 0, Result)) then
     Result := Default;
 end;
 
@@ -1346,17 +1391,31 @@ begin
   Result.LeadingZero := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ILZERO, '1'), 1);
   Result.Grouping := StrToIntDef(Copy(WideGetLocaleStr(GetThreadLocale, LOCALE_SMONGROUPING, '3;0'), 1, 1), 3);
   Currency_DecimalSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONDECIMALSEP, '.');
-  Result.lpDecimalSep := PWideChar(Currency_DecimalSep);
+  Result.lpDecimalSep := {$IFNDEF FPC} PWideChar(Currency_DecimalSep)
+                         {$ELSE}       LPTSTR(PWideChar(Currency_DecimalSep)) {$ENDIF};
   Currency_ThousandSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONTHOUSANDSEP, ',');
-  Result.lpThousandSep := PWideChar(Currency_ThousandSep);
+  Result.lpThousandSep := {$IFNDEF FPC} PWideChar(Currency_ThousandSep)
+                          {$ELSE}       LPTSTR(PWideChar(Currency_ThousandSep)) {$ENDIF};
   Result.NegativeOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_INEGCURR, '0'), 0);
   Result.PositiveOrder := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ICURRENCY, '0'), 0);
   Currency_CurrencySymbol := WideGetLocaleStr(GetThreadLocale, LOCALE_SCURRENCY, '');
-  Result.lpCurrencySymbol := PWideChar(Currency_CurrencySymbol);
+  Result.lpCurrencySymbol := {$IFNDEF FPC} PWideChar(Currency_CurrencySymbol)
+                             {$ELSE}       LPTSTR(PWideChar(Currency_CurrencySymbol)) {$ENDIF};
 end;
 
 //=============================================================================================
 
+{$IFDEF FPC}
+function GetLocaleStr(Locale, LocaleType: Integer; const Default: string): string;
+var
+  L: Integer;
+  Buffer: array[0..255] of Char;
+begin
+  L := GetLocaleInfo(Locale, LocaleType, Buffer, SizeOf(Buffer));
+  if L > 0 then SetString(Result, Buffer, L - 1) else Result := Default;
+end;
+{$ENDIF}
+
 function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString;
 var
   L: Integer;
@@ -1458,6 +1517,7 @@ begin
   end;
 end;
 
+{$IFNDEF FPC}
 function WideLoadPackage(const Name: Widestring): HMODULE;
 begin
   Result := WideSafeLoadLibrary(Name);
@@ -1472,6 +1532,7 @@ begin
     raise;
   end;
 end;
+{$ENDIF}
 
 function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word;
 begin
diff --git a/unicode/src/lib/TntUnicodeControls/TntSystem.pas b/unicode/src/lib/TntUnicodeControls/TntSystem.pas
index 60ea9232..e613ce0c 100644
--- a/unicode/src/lib/TntUnicodeControls/TntSystem.pas
+++ b/unicode/src/lib/TntUnicodeControls/TntSystem.pas
@@ -11,6 +11,10 @@
 
 unit TntSystem;
 
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
 {$INCLUDE TntCompilers.inc}
 
 {*****************************************************************************}
@@ -38,8 +42,10 @@ uses
 {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;
@@ -76,6 +82,8 @@ function KeyUnicode(CharCode: Word): WideChar;
 
 procedure StrSwapByteOrder(Str: PWideChar);
 
+{$IFDEF USE_SYSTEM_OVERRIDES}
+
 type
   TTntSystemUpdate =
     (tsWideResourceStrings
@@ -88,6 +96,8 @@ const
 
 procedure InstallTntSystemUpdates(Updates: TTntSystemUpdateSet = AllTntSystemUpdates);
 
+{$ENDIF USE_SYSTEM_OVERRIDES}
+
 implementation
 
 uses
@@ -101,15 +111,33 @@ 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. }
-  PCustom: PAnsiChar;
 begin
   if Assigned(WideCustomLoadResString) and WideCustomLoadResString(ResStringRec, Result) then
     exit; { a custom resourcestring has been loaded. }
@@ -121,18 +149,19 @@ begin
       Tnt_LoadStringW(FindResourceHInstance(ResStringRec.Module^),
         ResStringRec.Identifier, Buffer, MAX_RES_STRING_SIZE))
   else begin
-    // custom string pointer
-    PCustom := PAnsiChar(ResStringRec.Identifier); { 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;
+    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;
@@ -806,6 +835,8 @@ begin
   end;
 end;
 
+{$IFDEF USE_SYSTEM_OVERRIDES}
+
 //--------------------------------------------------------------------
 //                LoadResString()
 //
@@ -1359,8 +1390,16 @@ begin
   {$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}
@@ -1372,13 +1411,17 @@ initialization
     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.
diff --git a/unicode/src/lib/TntUnicodeControls/TntWideStrUtils.pas b/unicode/src/lib/TntUnicodeControls/TntWideStrUtils.pas
index ede13f30..99f63aea 100644
--- a/unicode/src/lib/TntUnicodeControls/TntWideStrUtils.pas
+++ b/unicode/src/lib/TntUnicodeControls/TntWideStrUtils.pas
@@ -11,6 +11,10 @@
 
 unit TntWideStrUtils;
 
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
 {$INCLUDE TntCompilers.inc}
 
 interface
diff --git a/unicode/src/lib/TntUnicodeControls/TntWideStrings.pas b/unicode/src/lib/TntUnicodeControls/TntWideStrings.pas
index ea5b7b0a..75132d22 100644
--- a/unicode/src/lib/TntUnicodeControls/TntWideStrings.pas
+++ b/unicode/src/lib/TntUnicodeControls/TntWideStrings.pas
@@ -11,6 +11,10 @@
 
 unit TntWideStrings;
 
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
 {$INCLUDE TntCompilers.inc}
 
 interface
@@ -54,6 +58,17 @@ type
     property Current: WideString read GetCurrent;
   end;
 
+{$IFDEF FPC}
+  TStringsDefined = set of (
+    sdDelimiter, sdQuoteChar, sdNameValueSeparator, sdLineBreak,
+    sdStrictDelimiter);
+{$ENDIF}
+
+{$DEFINE NAMEVALUESEPARATOR_RW}
+{$IFNDEF COMPILER_7_UP}
+  {$UNDEF NAMEVALUESEPARATOR_RW}
+{$ENDIF}
+
 { TWideStrings class }
 
   TWideStrings = class(TPersistent)
@@ -61,7 +76,7 @@ type
     FDefined: TStringsDefined;
     FDelimiter: WideChar;
     FQuoteChar: WideChar;
-    {$IFDEF COMPILER_7_UP}
+    {$IFDEF NAMEVALUESEPARATOR_RW}
     FNameValueSeparator: WideChar;
     {$ENDIF}
     FUpdateCount: Integer;
@@ -81,7 +96,7 @@ type
     function GetQuoteChar: WideChar;
     procedure SetQuoteChar(const Value: WideChar);
     function GetNameValueSeparator: WideChar;
-    {$IFDEF COMPILER_7_UP}
+    {$IFDEF NAMEVALUESEPARATOR_RW}
     procedure SetNameValueSeparator(const Value: WideChar);
     {$ENDIF}
     function GetValueFromIndex(Index: Integer): WideString;
@@ -142,7 +157,7 @@ type
     property QuoteChar: WideChar read GetQuoteChar write SetQuoteChar;
     property Values[const Name: WideString]: WideString read GetValue write SetValue;
     property ValueFromIndex[Index: Integer]: WideString read GetValueFromIndex write SetValueFromIndex;
-    property NameValueSeparator: WideChar read GetNameValueSeparator {$IFDEF COMPILER_7_UP} write SetNameValueSeparator {$ENDIF};
+    property NameValueSeparator: WideChar read GetNameValueSeparator {$IFDEF NAMEVALUESEPARATOR_RW} write SetNameValueSeparator {$ENDIF};
     property Strings[Index: Integer]: WideString read Get write Put; default;
     property Text: WideString read GetTextStr write SetTextStr;
     property StringsAdapter: IWideStringsAdapter read FAdapter write SetStringsAdapter;
@@ -243,7 +258,7 @@ begin
     try
       Clear;
       FDefined := TWideStrings(Source).FDefined;
-      {$IFDEF COMPILER_7_UP}
+      {$IFDEF NAMEVALUESEPARATOR_RW}
       FNameValueSeparator := TWideStrings(Source).FNameValueSeparator;
       {$ENDIF}
       FQuoteChar := TWideStrings(Source).FQuoteChar;
@@ -258,7 +273,7 @@ begin
     BeginUpdate;
     try
       Clear;
-      {$IFDEF COMPILER_7_UP}
+      {$IFDEF NAMEVALUESEPARATOR_RW}
       FNameValueSeparator := WideChar(TStrings{TNT-ALLOW TStrings}(Source).NameValueSeparator);
       {$ENDIF}
       FQuoteChar := WideChar(TStrings{TNT-ALLOW TStrings}(Source).QuoteChar);
@@ -282,7 +297,7 @@ begin
     TStrings{TNT-ALLOW TStrings}(Dest).BeginUpdate;
     try
       TStrings{TNT-ALLOW TStrings}(Dest).Clear;
-      {$IFDEF COMPILER_7_UP}
+      {$IFDEF NAMEVALUESEPARATOR_RW}
       TStrings{TNT-ALLOW TStrings}(Dest).NameValueSeparator := AnsiChar(NameValueSeparator);
       {$ENDIF}
       TStrings{TNT-ALLOW TStrings}(Dest).QuoteChar := AnsiChar(QuoteChar);
@@ -790,7 +805,7 @@ end;
 
 function TWideStrings.GetNameValueSeparator: WideChar;
 begin
-  {$IFDEF COMPILER_7_UP}
+  {$IFDEF NAMEVALUESEPARATOR_RW}
   if not (sdNameValueSeparator in FDefined) then
     NameValueSeparator := '=';
   Result := FNameValueSeparator;
@@ -799,7 +814,7 @@ begin
   {$ENDIF}
 end;
 
-{$IFDEF COMPILER_7_UP}
+{$IFDEF NAMEVALUESEPARATOR_RW}
 procedure TWideStrings.SetNameValueSeparator(const Value: WideChar);
 begin
   if (FNameValueSeparator <> Value) or not (sdNameValueSeparator in FDefined) then
diff --git a/unicode/src/lib/TntUnicodeControls/TntWindows.pas b/unicode/src/lib/TntUnicodeControls/TntWindows.pas
index 3ae9133a..8fd7ec88 100644
--- a/unicode/src/lib/TntUnicodeControls/TntWindows.pas
+++ b/unicode/src/lib/TntUnicodeControls/TntWindows.pas
@@ -11,6 +11,10 @@
 
 unit TntWindows;
 
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
 {$INCLUDE TntCompilers.inc}
 
 interface
@@ -107,6 +111,10 @@ const
 //------------------------------------------------------------------------------------------
 {$IFNDEF COMPILER_9_UP}
 type
+  {$IFDEF FPC}
+  TStartupInfoA = STARTUPINFO;
+  TStartupInfoW = STARTUPINFO;
+  {$ELSE}
   TStartupInfoA = _STARTUPINFOA;
   TStartupInfoW = record
     cb: DWORD;
@@ -128,6 +136,7 @@ type
     hStdOutput: THandle;
     hStdError: THandle;
   end;
+  {$ENDIF}
 
 function CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
   lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
@@ -136,6 +145,15 @@ function CreateProcessW{TNT-ALLOW CreateProcessW}(lpApplicationName: PWideChar;
   var lpProcessInformation: TProcessInformation): BOOL; stdcall; external kernel32 name 'CreateProcessW';
 
 {$ENDIF}
+
+{$IFDEF FPC}
+type
+  TCurrencyFmtA = CURRENCYFMT;
+  TCurrencyFmtW = CURRENCYFMT;
+  PCurrencyFmtA = ^TCurrencyFmtA;
+  PCurrencyFmtW = ^TCurrencyFmtW;
+{$ENDIF}
+
 //------------------------------------------------------------------------------------------
 
 {TNT-WARN SetWindowText}
@@ -342,6 +360,12 @@ function Tnt_GetStringTypeExW(Locale: LCID; dwInfoType: DWORD;
 {TNT-WARN LoadStringW}
 function Tnt_LoadStringW(hInstance: HINST; uID: UINT; lpBuffer: PWideChar; nBufferMax: Integer): Integer;
 
+{$IFDEF FPC}
+type
+  TMenuItemInfoW   = TMENUITEMINFO;
+  tagMenuItemINFOW = tagMENUITEMINFO;
+{$ENDIF}
+
 {TNT-WARN InsertMenuItem}
 {TNT-WARN InsertMenuItemA}
 {TNT-WARN InsertMenuItemW}
@@ -395,6 +419,24 @@ function Tnt_VerQueryValueW(pBlock: Pointer; lpSubBlock: PWideChar;
   var lplpBuffer: Pointer; var puLen: UINT): BOOL;
 
 type
+{$IFDEF FPC}
+  PSHNAMEMAPPINGA = ^SHNAMEMAPPINGA;
+  SHNAMEMAPPINGA = record
+    pszOldPath : LPSTR;
+    pszNewPath : LPSTR;
+    cchOldPath : longint;
+    cchNewPath : longint;
+  end;
+
+  PSHNAMEMAPPINGW = ^SHNAMEMAPPINGW;
+  SHNAMEMAPPINGW = record
+    pszOldPath : LPWSTR;
+    pszNewPath : LPWSTR;
+    cchOldPath : longint;
+    cchNewPath : longint;
+  end;
+{$ENDIF}
+
   TSHNameMappingHeaderA = record
    cNumOfMappings: Cardinal;
    lpNM: PSHNAMEMAPPINGA;
@@ -474,7 +516,7 @@ end;
 procedure _MakeWideWin32FindData(var WideFindData: TWIN32FindDataW; AnsiFindData: TWIN32FindDataA);
 begin
   CopyMemory(@WideFindData, @AnsiFindData,
-    Integer(@WideFindData.cFileName) - Integer(@WideFindData));
+    PtrUInt(@WideFindData.cFileName) - PtrUInt(@WideFindData));
   WStrPCopy(WideFindData.cFileName, AnsiFindData.cFileName);
   WStrPCopy(WideFindData.cAlternateFileName, AnsiFindData.cAlternateFileName);
 end;
@@ -966,7 +1008,9 @@ var
   AnsiBuff: AnsiString;
 begin
   if Win32PlatformIsUnicode then
-    Result := GetCurrencyFormatW{TNT-ALLOW GetCurrencyFormatW}(Locale, dwFlags, lpValue, lpFormat, lpCurrencyStr, cchCurrency)
+    Result := GetCurrencyFormatW{TNT-ALLOW GetCurrencyFormatW}(Locale, dwFlags, lpValue,
+        {$IFNDEF FPC} lpFormat {$ELSE} PCurrencyFmt(lpFormat) {$ENDIF},
+        lpCurrencyStr, cchCurrency)
   else begin
     if lpFormat = nil then
       PAnsiFormat := nil
@@ -1175,10 +1219,12 @@ end;
 function Tnt_InsertMenuItemW(hMenu: HMENU; uItem: DWORD; fByPosition: BOOL; lpmii: TMenuItemInfoW): BOOL;
 begin
   if Win32PlatformIsUnicode then
-    Result := InsertMenuItemW{TNT-ALLOW InsertMenuItemW}(hMenu, uItem, fByPosition, lpmii)
+    Result := InsertMenuItemW{TNT-ALLOW InsertMenuItemW}(hMenu, uItem, fByPosition,
+        {$IFDEF FPC}@{$ENDIF}lpmii)
   else begin
     TMenuItemInfoA(lpmii).dwTypeData := PAnsiChar(AnsiString(lpmii.dwTypeData));
-    Result := InsertMenuItemA{TNT-ALLOW InsertMenuItemA}(hMenu, uItem, fByPosition, TMenuItemInfoA(lpmii));
+    Result := InsertMenuItemA{TNT-ALLOW InsertMenuItemA}(hMenu, uItem, fByPosition,
+        {$IFDEF FPC}@{$ENDIF}TMenuItemInfoA(lpmii));
   end;
 end;
 
@@ -1197,10 +1243,11 @@ function Tnt_ExtractAssociatedIconW(hInst: HINST; lpIconPath: PWideChar;
   var lpiIcon: Word): HICON;
 begin
   if Win32PlatformIsUnicode then
-    Result := ExtractAssociatedIconW{TNT-ALLOW ExtractAssociatedIconW}(hInst, lpIconPath, lpiIcon)
+    Result := ExtractAssociatedIconW{TNT-ALLOW ExtractAssociatedIconW}(hInst,
+      lpIconPath, {$IFDEF FPC}@{$ENDIF}lpiIcon)
   else
     Result := ExtractAssociatedIconA{TNT-ALLOW ExtractAssociatedIconA}(hInst,
-      PAnsiChar(AnsiString(lpIconPath)), lpiIcon)
+      PAnsiChar(AnsiString(lpIconPath)), {$IFDEF FPC}@{$ENDIF}lpiIcon)
 end;
 
 function Tnt_GetFileVersionInfoSizeW(lptstrFilename: PWideChar; var lpdwHandle: DWORD): DWORD;
@@ -1298,7 +1345,8 @@ begin
     else
       AnsiFileOp.pTo := PAnsiChar(AnsiString(ExtractStringArrayStr(lpFileOp.pTo)));
     AnsiFileOp.lpszProgressTitle := PAnsiChar(AnsiString(lpFileOp.lpszProgressTitle));
-    Result := SHFileOperationA{TNT-ALLOW SHFileOperationA}(AnsiFileOp);
+    Result := SHFileOperationA{TNT-ALLOW SHFileOperationA}(
+        {$IFDEF FPC}@{$ENDIF}AnsiFileOp);
     // return struct results
     lpFileOp.fAnyOperationsAborted := AnsiFileOp.fAnyOperationsAborted;
     lpFileOp.hNameMappings := nil;
@@ -1364,7 +1412,8 @@ begin
     AnsiInfo.lpszTitle := PAnsiChar(AnsiString(lpbi.lpszTitle));
     if lpbi.pszDisplayName <> nil then
       AnsiInfo.pszDisplayName := AnsiBuffer;
-    Result := SHBrowseForFolderA{TNT-ALLOW SHBrowseForFolderA}(AnsiInfo);
+    Result := SHBrowseForFolderA{TNT-ALLOW SHBrowseForFolderA}(
+        {$IFDEF FPC}@{$ENDIF}AnsiInfo);
     if lpbi.pszDisplayName <> nil then
       WStrPCopy(lpbi.pszDisplayName, AnsiInfo.pszDisplayName);
     lpbi.iImage := AnsiInfo.iImage;