aboutsummaryrefslogtreecommitdiffstats
path: root/unicode/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--unicode/src/lib/TntUnicodeControls/TntClasses.pas31
-rw-r--r--unicode/src/lib/TntUnicodeControls/TntCompilers.inc24
-rw-r--r--unicode/src/lib/TntUnicodeControls/TntFormatStrUtils.pas22
-rw-r--r--unicode/src/lib/TntUnicodeControls/TntSysUtils.pas89
-rw-r--r--unicode/src/lib/TntUnicodeControls/TntSystem.pas63
-rw-r--r--unicode/src/lib/TntUnicodeControls/TntWideStrUtils.pas4
-rw-r--r--unicode/src/lib/TntUnicodeControls/TntWideStrings.pas31
-rw-r--r--unicode/src/lib/TntUnicodeControls/TntWindows.pas65
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;
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-11 13:14:37 +0000