path: root/us_maker_edition/src/lib/TntUnicodeControls/TntSysUtils.pas

{*****************************************************************************}
{                                                                             }
{    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 TntSysUtils;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

{$INCLUDE TntCompilers.inc}

interface

{ TODO: Consider: more filename functions from SysUtils }
{ TODO: Consider: string functions from StrUtils. }

uses
  Types, SysUtils, Windows, TntWindows;

//---------------------------------------------------------------------------------------------
//                                 Tnt - Types
//---------------------------------------------------------------------------------------------

// ......... introduced .........
type
  // The user of the application did something plainly wrong.
  ETntUserError = class(Exception);
  // A general error occured. (ie. file didn't exist, server didn't return data, etc.)
  ETntGeneralError = class(Exception);
  // 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
//---------------------------------------------------------------------------------------------

// ......... SBCS and MBCS functions with WideString replacements in SysUtils.pas .........

{TNT-WARN CompareStr}                   {TNT-WARN AnsiCompareStr}
{TNT-WARN SameStr}                      {TNT-WARN AnsiSameStr}
{TNT-WARN SameText}                     {TNT-WARN AnsiSameText}
{TNT-WARN CompareText}                  {TNT-WARN AnsiCompareText}
{TNT-WARN UpperCase}                    {TNT-WARN AnsiUpperCase}
{TNT-WARN LowerCase}                    {TNT-WARN AnsiLowerCase}

{TNT-WARN AnsiPos}  { --> Pos() supports WideString. }
{TNT-WARN FmtStr}
{TNT-WARN Format}
{TNT-WARN FormatBuf}

// ......... MBCS Byte Type Procs .........

{TNT-WARN ByteType}
{TNT-WARN StrByteType}
{TNT-WARN ByteToCharIndex}
{TNT-WARN ByteToCharLen}
{TNT-WARN CharToByteIndex}
{TNT-WARN CharToByteLen}

// ........ null-terminated string functions .........

{TNT-WARN StrEnd}
{TNT-WARN StrLen}
{TNT-WARN StrLCopy}
{TNT-WARN StrCopy}
{TNT-WARN StrECopy}
{TNT-WARN StrPLCopy}
{TNT-WARN StrPCopy}
{TNT-WARN StrLComp}
{TNT-WARN AnsiStrLComp}
{TNT-WARN StrComp}
{TNT-WARN AnsiStrComp}
{TNT-WARN StrLIComp}
{TNT-WARN AnsiStrLIComp}
{TNT-WARN StrIComp}
{TNT-WARN AnsiStrIComp}
{TNT-WARN StrLower}
{TNT-WARN AnsiStrLower}
{TNT-WARN StrUpper}
{TNT-WARN AnsiStrUpper}
{TNT-WARN StrPos}
{TNT-WARN AnsiStrPos}
{TNT-WARN StrScan}
{TNT-WARN AnsiStrScan}
{TNT-WARN StrRScan}
{TNT-WARN AnsiStrRScan}
{TNT-WARN StrLCat}
{TNT-WARN StrCat}
{TNT-WARN StrMove}
{TNT-WARN StrPas}
{TNT-WARN StrAlloc}
{TNT-WARN StrBufSize}
{TNT-WARN StrNew}
{TNT-WARN StrDispose}

{TNT-WARN AnsiExtractQuotedStr}
{TNT-WARN AnsiLastChar}
{TNT-WARN AnsiStrLastChar}
{TNT-WARN QuotedStr}
{TNT-WARN AnsiQuotedStr}
{TNT-WARN AnsiDequotedStr}

// ........ string functions .........

{$IFNDEF FPC}
{$IFNDEF COMPILER_9_UP}
  //
  // pre-Delphi 9 issues w/ WideFormatBuf, WideFmtStr and WideFormat
  //

  {$IFDEF COMPILER_7_UP}
  type
    PFormatSettings = ^TFormatSettings;
  {$ENDIF}

  // SysUtils.WideFormatBuf doesn't correctly handle numeric specifiers.
  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const): Cardinal; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}

  {$IFDEF COMPILER_7_UP}
  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const;
      const FormatSettings: TFormatSettings): Cardinal; overload;
  {$ENDIF}

  // SysUtils.WideFmtStr doesn't handle string lengths > 4096.
  procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const); {$IFDEF COMPILER_7_UP} overload; {$ENDIF}

  {$IFDEF COMPILER_7_UP}
  procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const; const FormatSettings: TFormatSettings); overload;
  {$ENDIF}

  {----------------------------------------------------------------------------------------
    Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
      TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
        will fix WideFormat as well as WideFmtStr.
  ----------------------------------------------------------------------------------------}
  function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}

  {$IFDEF COMPILER_7_UP}
  function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
    const FormatSettings: TFormatSettings): WideString; overload;
  {$ENDIF}

{$ENDIF}
{$ENDIF}

{TNT-WARN WideUpperCase} // SysUtils.WideUpperCase is broken on Win9x for D6, D7, D9.
function Tnt_WideUpperCase(const S: WideString): WideString;
{TNT-WARN WideLowerCase} // SysUtils.WideLowerCase is broken on Win9x for D6, D7, D9.
function Tnt_WideLowerCase(const S: WideString): WideString;

function TntWideLastChar(const S: WideString): WideChar;

{TNT-WARN StringReplace}
{TNT-WARN WideStringReplace} // <-- WideStrUtils.WideStringReplace uses SysUtils.WideUpperCase which is broken on Win9x.
function Tnt_WideStringReplace(const S, OldPattern, NewPattern: WideString;
  Flags: TReplaceFlags; WholeWord: Boolean = False): WideString;

{TNT-WARN AdjustLineBreaks}
type TTntTextLineBreakStyle = (tlbsLF, tlbsCRLF, tlbsCR);
function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;

{TNT-WARN WrapText}
function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
  MaxCol: Integer): WideString; overload;
function WideWrapText(const Line: WideString; MaxCol: Integer): WideString; overload;

// ........ filename manipulation .........

{TNT-WARN SameFileName}           // doesn't apply to Unicode filenames, use WideSameText
{TNT-WARN AnsiCompareFileName}    // doesn't apply to Unicode filenames, use WideCompareText
{TNT-WARN AnsiLowerCaseFileName}  // doesn't apply to Unicode filenames, use WideLowerCase
{TNT-WARN AnsiUpperCaseFileName}  // doesn't apply to Unicode filenames, use WideUpperCase

{TNT-WARN IncludeTrailingBackslash}
function WideIncludeTrailingBackslash(const S: WideString): WideString;
{TNT-WARN IncludeTrailingPathDelimiter}
function WideIncludeTrailingPathDelimiter(const S: WideString): WideString;
{TNT-WARN ExcludeTrailingBackslash}
function WideExcludeTrailingBackslash(const S: WideString): WideString;
{TNT-WARN ExcludeTrailingPathDelimiter}
function WideExcludeTrailingPathDelimiter(const S: WideString): WideString;
{TNT-WARN IsDelimiter}
function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
{TNT-WARN IsPathDelimiter}
function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
{TNT-WARN LastDelimiter}
function WideLastDelimiter(const Delimiters, S: WideString): Integer;
{TNT-WARN ChangeFileExt}
function WideChangeFileExt(const FileName, Extension: WideString): WideString;
{TNT-WARN ExtractFilePath}
function WideExtractFilePath(const FileName: WideString): WideString;
{TNT-WARN ExtractFileDir}
function WideExtractFileDir(const FileName: WideString): WideString;
{TNT-WARN ExtractFileDrive}
function WideExtractFileDrive(const FileName: WideString): WideString;
{TNT-WARN ExtractFileName}
function WideExtractFileName(const FileName: WideString): WideString;
{TNT-WARN ExtractFileExt}
function WideExtractFileExt(const FileName: WideString): WideString;
{TNT-WARN ExtractRelativePath}
function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;

// ........ file management routines .........

{TNT-WARN ExpandFileName}
function WideExpandFileName(const FileName: WideString): WideString;
{TNT-WARN ExtractShortPathName}
function WideExtractShortPathName(const FileName: WideString): WideString;
{TNT-WARN FileCreate}
function WideFileCreate(const FileName: WideString): Integer;
{TNT-WARN FileOpen}
function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
{TNT-WARN FileAge}
function WideFileAge(const FileName: WideString): Integer; overload;
function WideFileAge(const FileName: WideString; out FileDateTime: TDateTime): Boolean; overload;
{TNT-WARN DirectoryExists}
function WideDirectoryExists(const Name: WideString): Boolean;
{TNT-WARN FileExists}
function WideFileExists(const Name: WideString): Boolean;
{TNT-WARN FileGetAttr}
function WideFileGetAttr(const FileName: WideString): Cardinal;
{TNT-WARN FileSetAttr}
function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
{TNT-WARN FileIsReadOnly}
function WideFileIsReadOnly(const FileName: WideString): Boolean;
{TNT-WARN FileSetReadOnly}
function WideFileSetReadOnly(const FileName: WideString; ReadOnly: Boolean): Boolean;
{TNT-WARN ForceDirectories}
function WideForceDirectories(Dir: WideString): Boolean;
{TNT-WARN FileSearch}
function WideFileSearch(const Name, DirList: WideString): WideString;
{TNT-WARN RenameFile}
function WideRenameFile(const OldName, NewName: WideString): Boolean;
{TNT-WARN DeleteFile}
function WideDeleteFile(const FileName: WideString): Boolean;
{TNT-WARN CopyFile}
function WideCopyFile(const FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;


{TNT-WARN TFileName}
type
  TWideFileName = type WideString;

{TNT-WARN TSearchRec} // <-- FindFile - warning on TSearchRec is all that is necessary
type
  TSearchRecW = record
    Time: Integer;
    Size: Int64;
    Attr: Integer;
    Name: TWideFileName;
    ExcludeAttr: Integer;
    FindHandle: THandle;
    FindData: TWin32FindDataW;
  end;
function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
function WideFindNext(var F: TSearchRecW): Integer;
procedure WideFindClose(var F: TSearchRecW);

{TNT-WARN CreateDir}
function WideCreateDir(const Dir: WideString): Boolean;
{TNT-WARN RemoveDir}
function WideRemoveDir(const Dir: WideString): Boolean;
{TNT-WARN GetCurrentDir}
function WideGetCurrentDir: WideString;
{TNT-WARN SetCurrentDir}
function WideSetCurrentDir(const Dir: WideString): Boolean;


// ........ date/time functions .........

{TNT-WARN TryStrToDateTime}
function TntTryStrToDateTime(Str: WideString; out DateTime: TDateTime): Boolean;
{TNT-WARN TryStrToDate}
function TntTryStrToDate(Str: WideString; out DateTime: TDateTime): Boolean;
{TNT-WARN TryStrToTime}
function TntTryStrToTime(Str: WideString; out DateTime: TDateTime): Boolean;

{ introduced }
function ValidDateTimeStr(Str: WideString): Boolean;
function ValidDateStr(Str: WideString): Boolean;
function ValidTimeStr(Str: WideString): Boolean;

{TNT-WARN StrToDateTime}
function TntStrToDateTime(Str: WideString): TDateTime;
{TNT-WARN StrToDate}
function TntStrToDate(Str: WideString): TDateTime;
{TNT-WARN StrToTime}
function TntStrToTime(Str: WideString): TDateTime;
{TNT-WARN StrToDateTimeDef}
function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
{TNT-WARN StrToDateDef}
function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
{TNT-WARN StrToTimeDef}
function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;

{TNT-WARN CurrToStr}
{TNT-WARN CurrToStrF}
function TntCurrToStr(Value: Currency; lpFormat: PCurrencyFmtW = nil): WideString;
{TNT-WARN StrToCurr}
function TntStrToCurr(const S: WideString): Currency;
{TNT-WARN StrToCurrDef}
function ValidCurrencyStr(const S: WideString): Boolean;
function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency;
function GetDefaultCurrencyFmt: TCurrencyFmtW;

// ........ misc functions .........

{TNT-WARN GetLocaleStr}
function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString;
{TNT-WARN SysErrorMessage}
function WideSysErrorMessage(ErrorCode: Integer): WideString;

// ......... introduced .........

function WideLibraryErrorMessage(const LibName: WideString; Dll: THandle; ErrorCode: Integer): WideString;

const
  CR = WideChar(#13);
  LF = WideChar(#10);
  CRLF = WideString(#13#10);
  WideLineSeparator = WideChar($2028);

var
  Win32PlatformIsUnicode: Boolean;
  Win32PlatformIsXP: Boolean;
  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;

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;
function IsWideCharDigit(WC: WideChar): Boolean;
function IsWideCharSpace(WC: WideChar): Boolean;
function IsWideCharPunct(WC: WideChar): Boolean;
function IsWideCharCntrl(WC: WideChar): Boolean;
function IsWideCharBlank(WC: WideChar): Boolean;
function IsWideCharXDigit(WC: WideChar): Boolean;
function IsWideCharAlpha(WC: WideChar): Boolean;
function IsWideCharAlphaNumeric(WC: WideChar): Boolean;

function WideTextPos(const SubStr, S: WideString): Integer;

function ExtractStringArrayStr(P: PWideChar): WideString;
function ExtractStringFromStringArray(var P: PWideChar; Separator: WideChar = #0): WideString;
function ExtractStringsFromStringArray(P: PWideChar; Separator: WideChar = #0): TWideStringDynArray;

function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
function IsWideStringMappableToAnsi(const WS: WideString): Boolean;
function IsRTF(const Value: WideString): Boolean;

function ENG_US_FloatToStr(Value: Extended): WideString;
function ENG_US_StrToFloat(const S: WideString): Extended;

//---------------------------------------------------------------------------------------------
//                                 Tnt - Variants
//---------------------------------------------------------------------------------------------

// ........ Variants.pas has WideString versions of these functions .........
{TNT-WARN VarToStr}
{TNT-WARN VarToStrDef}

var
  _SettingChangeTime: Cardinal;

implementation

uses
  ActiveX, ComObj, SysConst,
  {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils,
  TntSystem, TntFormatStrUtils;

//---------------------------------------------------------------------------------------------
//                                 Tnt - SysUtils
//---------------------------------------------------------------------------------------------

{$IFNDEF FPC}
{$IFNDEF COMPILER_9_UP}

  function _Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const
      {$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings {$ENDIF}): Cardinal;
  var
    OldFormat: WideString;
    NewFormat: WideString;
  begin
    SetString(OldFormat, PWideChar(@FormatStr), FmtLen);
    { The reason for this is that WideFormat doesn't correctly format floating point specifiers.
      See QC#4254. }
    NewFormat := ReplaceFloatingArgumentsInFormatString(OldFormat, Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
    {$IFDEF COMPILER_7_UP}
    if FormatSettings <> nil then
      Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
        Length(NewFormat), Args, FormatSettings^)
    else
    {$ENDIF}
      Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
        Length(NewFormat), Args);
  end;

  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const): Cardinal;
  begin
    Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
  end;

  {$IFDEF COMPILER_7_UP}
  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;
  begin
    Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args, @FormatSettings);
  end;
  {$ENDIF}

  procedure _Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const{$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings{$ENDIF});
  var
    Len, BufLen: Integer;
    Buffer: array[0..4095] of WideChar;
  begin
    BufLen := Length(Buffer); // Fixes buffer overwrite issue. (See QC #4703, #4744)
    if Length(FormatStr) < (Length(Buffer) - (Length(Buffer) div 4)) then
      Len := _Tnt_WideFormatBuf(Buffer, Length(Buffer) - 1, Pointer(FormatStr)^,
        Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF})
    else
    begin
      BufLen := Length(FormatStr);
      Len := BufLen;
    end;
    if Len >= BufLen - 1 then
    begin
      while Len >= BufLen - 1 do
      begin
        Inc(BufLen, BufLen);
        Result := '';          // prevent copying of existing data, for speed
        SetLength(Result, BufLen);
        Len := _Tnt_WideFormatBuf(Pointer(Result)^, BufLen - 1, Pointer(FormatStr)^,
          Length(FormatStr), Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
      end;
      SetLength(Result, Len);
    end
    else
      SetString(Result, Buffer, Len);
  end;

  procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const);
  begin
    _Tnt_WideFmtStr(Result, FormatStr, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
  end;

  {$IFDEF COMPILER_7_UP}
  procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const; const FormatSettings: TFormatSettings);
  begin
    _Tnt_WideFmtStr(Result, FormatStr, Args, @FormatSettings);
  end;
  {$ENDIF}

  {----------------------------------------------------------------------------------------
    Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
      TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
        will fix WideFormat as well as WideFmtStr.
  ----------------------------------------------------------------------------------------}
  function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString;
  begin
    Tnt_WideFmtStr(Result, FormatStr, Args);
  end;

  {$IFDEF COMPILER_7_UP}
  function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
    const FormatSettings: TFormatSettings): WideString;
  begin
    Tnt_WideFmtStr(Result, FormatStr, Args, FormatSettings);
  end;
  {$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
    Tnt_CharUpperBuffW(PWideChar(Result), Length(Result));
  {$ELSE}
  Result := SysUtils.WideUpperCase{TNT-ALLOW WideUpperCase}(S);
  {$ENDIF}
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
    Tnt_CharLowerBuffW(PWideChar(Result), Length(Result));
  {$ELSE}
  Result := SysUtils.WideLowerCase{TNT-ALLOW WideLowerCase}(S);
  {$ENDIF}
end;

function TntWideLastChar(const S: WideString): WideChar;
var
  P: PWideChar;
begin
  P := WideLastChar(S);
  if P = nil then
    Result := #0
  else
    Result := P^;
end;

function Tnt_WideStringReplace(const S, OldPattern, NewPattern: WideString;
  Flags: TReplaceFlags; WholeWord: Boolean = False): WideString;

  function IsWordSeparator(WC: WideChar): Boolean;
  begin
    Result := (WC = WideChar(#0))
           or IsWideCharSpace(WC)
           or IsWideCharPunct(WC);
  end;

var
  SearchStr, Patt, NewStr: WideString;
  Offset: Integer;
  PrevChar, NextChar: WideChar;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := Tnt_WideUpperCase(S);
    Patt := Tnt_WideUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := Pos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end; // done

    if (WholeWord) then
    begin
      if (Offset = 1) then
        PrevChar := TntWideLastChar(Result)
      else
        PrevChar := NewStr[Offset - 1];

      if Offset + Length(OldPattern) <= Length(NewStr) then
        NextChar := NewStr[Offset + Length(OldPattern)]
      else
        NextChar := WideChar(#0);

      if (not IsWordSeparator(PrevChar))
      or (not IsWordSeparator(NextChar)) then
      begin
        Result := Result + Copy(NewStr, 1, Offset + Length(OldPattern) - 1);
        NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
        SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
        continue;
      end;
    end;

    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;

function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
var
  Source, SourceEnd: PWideChar;
begin
  Source := Pointer(S);
  SourceEnd := Source + Length(S);
  Result := Length(S);
  while Source < SourceEnd do
  begin
    case Source^ of
      #10, WideLineSeparator:
        if Style = tlbsCRLF then
          Inc(Result);
      #13:
        if Style = tlbsCRLF then
          if Source[1] = #10 then
            Inc(Source)
          else
            Inc(Result)
        else
          if Source[1] = #10 then
            Dec(Result);
    end;
    Inc(Source);
  end;
end;

function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;
var
  Source, SourceEnd, Dest: PWideChar;
  DestLen: Integer;
begin
  Source := Pointer(S);
  SourceEnd := Source + Length(S);
  DestLen := TntAdjustLineBreaksLength(S, Style);
  SetString(Result, nil, DestLen);
  Dest := Pointer(Result);
  while Source < SourceEnd do begin
    case Source^ of
      #10, WideLineSeparator:
        begin
          if Style in [tlbsCRLF, tlbsCR] then
          begin
            Dest^ := #13;
            Inc(Dest);
          end;
          if Style in [tlbsCRLF, tlbsLF] then
          begin
            Dest^ := #10;
            Inc(Dest);
          end;
          Inc(Source);
        end;
      #13:
        begin
          if Style in [tlbsCRLF, tlbsCR] then
          begin
            Dest^ := #13;
            Inc(Dest);
          end;
          if Style in [tlbsCRLF, tlbsLF] then
          begin
            Dest^ := #10;
            Inc(Dest);
          end;
          Inc(Source);
          if Source^ = #10 then Inc(Source);
        end;
    else
      Dest^ := Source^;
      Inc(Dest);
      Inc(Source);
    end;
  end;
end;

function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
  MaxCol: Integer): WideString;

  function WideCharIn(C: WideChar; SysCharSet: TSysCharSet): Boolean;
  begin
    Result := (C <= High(AnsiChar)) and (AnsiChar(C) in SysCharSet);
  end;

const
  QuoteChars = ['''', '"'];
var
  Col, Pos: Integer;
  LinePos, LineLen: Integer;
  BreakLen, BreakPos: Integer;
  QuoteChar, CurChar: WideChar;
  ExistingBreak: Boolean;
begin
  Col := 1;
  Pos := 1;
  LinePos := 1;
  BreakPos := 0;
  QuoteChar := ' ';
  ExistingBreak := False;
  LineLen := Length(Line);
  BreakLen := Length(BreakStr);
  Result := '';
  while Pos <= LineLen do
  begin
    CurChar := Line[Pos];
    if CurChar = BreakStr[1] then
    begin
      if QuoteChar = ' ' then
      begin
        ExistingBreak := WideSameText(BreakStr, Copy(Line, Pos, BreakLen));
        if ExistingBreak then
        begin
          Inc(Pos, BreakLen-1);
          BreakPos := Pos;
        end;
      end
    end
    else if WideCharIn(CurChar, BreakChars) then
    begin
      if QuoteChar = ' ' then BreakPos := Pos
    end
    else if WideCharIn(CurChar, QuoteChars) then
    begin
      if CurChar = QuoteChar then
        QuoteChar := ' '
      else if QuoteChar = ' ' then
        QuoteChar := CurChar;
    end;
    Inc(Pos);
    Inc(Col);
    if not (WideCharIn(QuoteChar, QuoteChars)) and (ExistingBreak or
      ((Col > MaxCol) and (BreakPos > LinePos))) then
    begin
      Col := Pos - BreakPos;
      Result := Result + Copy(Line, LinePos, BreakPos - LinePos + 1);
      if not (WideCharIn(CurChar, QuoteChars)) then
        while Pos <= LineLen do
        begin
          if WideCharIn(Line[Pos], BreakChars) then
            Inc(Pos)
          else if Copy(Line, Pos, Length(sLineBreak)) = sLineBreak then
            Inc(Pos, Length(sLineBreak))
          else
            break;
        end;
      if not ExistingBreak and (Pos < LineLen) then
        Result := Result + BreakStr;
      Inc(BreakPos);
      LinePos := BreakPos;
      ExistingBreak := False;
    end;
  end;
  Result := Result + Copy(Line, LinePos, MaxInt);
end;

function WideWrapText(const Line: WideString; MaxCol: Integer): WideString;
begin
  Result := WideWrapText(Line, sLineBreak, [' ', '-', #9], MaxCol); { do not localize }
end;

function WideIncludeTrailingBackslash(const S: WideString): WideString;
begin
  Result := WideIncludeTrailingPathDelimiter(S);
end;

function WideIncludeTrailingPathDelimiter(const S: WideString): WideString;
begin
  Result := S;
  if not WideIsPathDelimiter(Result, Length(Result)) then Result := Result + PathDelim;
end;

function WideExcludeTrailingBackslash(const S: WideString): WideString;
begin
  Result := WideExcludeTrailingPathDelimiter(S);
end;

function WideExcludeTrailingPathDelimiter(const S: WideString): WideString;
begin
  Result := S;
  if WideIsPathDelimiter(Result, Length(Result)) then
    SetLength(Result, Length(Result)-1);
end;

function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
begin
  Result := False;
  if (Index <= 0) or (Index > Length(S)) then exit;
  Result := WStrScan(PWideChar(Delimiters), S[Index]) <> nil;
end;

function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
begin
  Result := (Index > 0) and (Index <= Length(S)) and (S[Index] = PathDelim);
end;

function WideLastDelimiter(const Delimiters, S: WideString): Integer;
var
  P: PWideChar;
begin
  Result := Length(S);
  P := PWideChar(Delimiters);
  while Result > 0 do
  begin
    if (S[Result] <> #0) and (WStrScan(P, S[Result]) <> nil) then
      Exit;
    Dec(Result);
  end;
end;

function WideChangeFileExt(const FileName, Extension: WideString): WideString;
var
  I: Integer;
begin
  I := WideLastDelimiter('.\:',Filename);
  if (I = 0) or (FileName[I] <> '.') then I := MaxInt;
  Result := Copy(FileName, 1, I - 1) + Extension;
end;

function WideExtractFilePath(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := WideLastDelimiter('\:', FileName);
  Result := Copy(FileName, 1, I);
end;

function WideExtractFileDir(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := WideLastDelimiter(DriveDelim + PathDelim,Filename);
  if (I > 1) and (FileName[I] = PathDelim) and
    (not (FileName[I - 1] in [WideChar(PathDelim), WideChar(DriveDelim)])) then Dec(I);
  Result := Copy(FileName, 1, I);
end;

function WideExtractFileDrive(const FileName: WideString): WideString;
var
  I, J: Integer;
begin
  if (Length(FileName) >= 2) and (FileName[2] = DriveDelim) then
    Result := Copy(FileName, 1, 2)
  else if (Length(FileName) >= 2) and (FileName[1] = PathDelim) and
    (FileName[2] = PathDelim) then
  begin
    J := 0;
    I := 3;
    While (I < Length(FileName)) and (J < 2) do
    begin
      if FileName[I] = PathDelim then Inc(J);
      if J < 2 then Inc(I);
    end;
    if FileName[I] = PathDelim then Dec(I);
    Result := Copy(FileName, 1, I);
  end else Result := '';
end;

function WideExtractFileName(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := WideLastDelimiter('\:', FileName);
  Result := Copy(FileName, I + 1, MaxInt);
end;

function WideExtractFileExt(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := WideLastDelimiter('.\:', FileName);
  if (I > 0) and (FileName[I] = '.') then
    Result := Copy(FileName, I, MaxInt) else
    Result := '';
end;

function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
var
  BasePath, DestPath: WideString;
  BaseLead, DestLead: PWideChar;
  BasePtr, DestPtr: PWideChar;

  function WideExtractFilePathNoDrive(const FileName: WideString): WideString;
  begin
    Result := WideExtractFilePath(FileName);
    Delete(Result, 1, Length(WideExtractFileDrive(FileName)));
  end;

  function Next(var Lead: PWideChar): PWideChar;
  begin
    Result := Lead;
    if Result = nil then Exit;
    Lead := WStrScan(Lead, PathDelim);
    if Lead <> nil then
    begin
      Lead^ := #0;
      Inc(Lead);
    end;
  end;

begin
  if WideSameText(WideExtractFileDrive(BaseName), WideExtractFileDrive(DestName)) then
  begin
    BasePath := WideExtractFilePathNoDrive(BaseName);
    DestPath := WideExtractFilePathNoDrive(DestName);
    BaseLead := Pointer(BasePath);
    BasePtr := Next(BaseLead);
    DestLead := Pointer(DestPath);
    DestPtr := Next(DestLead);
    while (BasePtr <> nil) and (DestPtr <> nil) and WideSameText(BasePtr, DestPtr) do
    begin
      BasePtr := Next(BaseLead);
      DestPtr := Next(DestLead);
    end;
    Result := '';
    while BaseLead <> nil do
    begin
      Result := Result + '..' + PathDelim;             { Do not localize }
      Next(BaseLead);
    end;
    if (DestPtr <> nil) and (DestPtr^ <> #0) then
      Result := Result + DestPtr + PathDelim;
    if DestLead <> nil then
      Result := Result + DestLead;     // destlead already has a trailing backslash
    Result := Result + WideExtractFileName(DestName);
  end
  else
    Result := DestName;
end;

function WideExpandFileName(const FileName: WideString): WideString;
var
  FName: PWideChar;
  Buffer: array[0..MAX_PATH - 1] of WideChar;
begin
  SetString(Result, Buffer, Tnt_GetFullPathNameW(PWideChar(FileName), MAX_PATH, Buffer, FName));
end;

function WideExtractShortPathName(const FileName: WideString): WideString;
var
  Buffer: array[0..MAX_PATH - 1] of WideChar;
begin
  SetString(Result, Buffer, Tnt_GetShortPathNameW(PWideChar(FileName), Buffer, MAX_PATH));
end;

function WideFileCreate(const FileName: WideString): Integer;
begin
  Result := Integer(Tnt_CreateFileW(PWideChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0))
end;

function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := Integer(Tnt_CreateFileW(PWideChar(FileName), AccessMode[Mode and 3],
    ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL, 0));
end;

function WideFileAge(const FileName: WideString): Integer;
var
  Handle: THandle;
  FindData: TWin32FindDataW;
  LocalFileTime: TFileTime;
begin
  Handle := Tnt_FindFirstFileW(PWideChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi, LongRec(Result).Lo) then
        Exit
    end;
  end;
  Result := -1;
end;

function WideFileAge(const FileName: WideString; out FileDateTime: TDateTime): Boolean;
var
  Handle: THandle;
  FindData: TWin32FindDataW;
  LSystemTime: TSystemTime;
  LocalFileTime: TFileTime;
begin
  Result := False;
  Handle := Tnt_FindFirstFileW(PWideChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      Result := True;
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      FileTimeToSystemTime(LocalFileTime, LSystemTime);
      with LSystemTime do
        FileDateTime := EncodeDate(wYear, wMonth, wDay) +
          EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
    end;
  end;
end;

function WideDirectoryExists(const Name: WideString): Boolean;
var
  Code: Cardinal;
begin
  Code := WideFileGetAttr(Name);
  Result := (Code <> INVALID_FILE_ATTRIBUTES) and ((FILE_ATTRIBUTE_DIRECTORY and Code) <> 0);
end;

function WideFileExists(const Name: WideString): Boolean;
var
  Code: Cardinal;
begin
  Code := WideFileGetAttr(Name);
  Result := (Code <> INVALID_FILE_ATTRIBUTES) and ((FILE_ATTRIBUTE_DIRECTORY and Code) = 0);
end;

function WideFileGetAttr(const FileName: WideString): Cardinal;
begin
  Result := Tnt_GetFileAttributesW(PWideChar(FileName));
end;

function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
begin
  Result := Tnt_SetFileAttributesW(PWideChar(FileName), Attr)
end;

function WideFileIsReadOnly(const FileName: WideString): Boolean;
begin
  Result := (Tnt_GetFileAttributesW(PWideChar(FileName)) and faReadOnly) <> 0;
end;

function WideFileSetReadOnly(const FileName: WideString; ReadOnly: Boolean): Boolean;
var
  Flags: Integer;
begin
  Result := False;
  Flags := Tnt_GetFileAttributesW(PWideChar(FileName));
  if Flags = -1 then Exit;
  if ReadOnly then
    Flags := Flags or faReadOnly
  else
    Flags := Flags and not faReadOnly;
  Result := Tnt_SetFileAttributesW(PWideChar(FileName), Flags);
end;

function WideForceDirectories(Dir: WideString): Boolean;
begin
  Result := True;
  if Length(Dir) = 0 then
    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.
  Result := WideForceDirectories(WideExtractFilePath(Dir));
  if Result then
    Result := Tnt_CreateDirectoryW(PWideChar(Dir), nil)
end;

function WideFileSearch(const Name, DirList: WideString): WideString;
var
  I, P, L: Integer;
  C: WideChar;
begin
  Result := Name;
  P := 1;
  L := Length(DirList);
  while True do
  begin
    if WideFileExists(Result) then Exit;
    while (P <= L) and (DirList[P] = PathSep) do Inc(P);
    if P > L then Break;
    I := P;
    while (P <= L) and (DirList[P] <> PathSep) do
      Inc(P);
    Result := Copy(DirList, I, P - I);
    C := TntWideLastChar(Result);
    if (C <> DriveDelim) and (C <> PathDelim) then
      Result := Result + PathDelim;
    Result := Result + Name;
  end;
  Result := '';
end;

function WideRenameFile(const OldName, NewName: WideString): Boolean;
begin
  Result := Tnt_MoveFileW(PWideChar(OldName), PWideChar(NewName))
end;

function WideDeleteFile(const FileName: WideString): Boolean;
begin
  Result := Tnt_DeleteFileW(PWideChar(FileName))
end;

function WideCopyFile(const FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
begin
  Result := Tnt_CopyFileW(PWideChar(FromFile), PWideChar(ToFile), FailIfExists)
end;

function _WideFindMatchingFile(var F: TSearchRecW): Integer;
var
  LocalFileTime: TFileTime;
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not Tnt_FindNextFileW(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
    Size := (Int64(FindData.nFileSizeHigh) shl 32) + FindData.nFileSizeLow;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;

function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
const
  faSpecial = faHidden or faSysFile {$IFNDEF COMPILER_9_UP} or faVolumeID {$ENDIF} or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := Tnt_FindFirstFileW(PWideChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := _WideFindMatchingFile(F);
    if Result <> 0 then WideFindClose(F);
  end else
    Result := GetLastError;
end;

function WideFindNext(var F: TSearchRecW): Integer;
begin
  if Tnt_FindNextFileW(F.FindHandle, F.FindData) then
    Result := _WideFindMatchingFile(F) else
    Result := GetLastError;
end;

procedure WideFindClose(var F: TSearchRecW);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(F.FindHandle);
    F.FindHandle := INVALID_HANDLE_VALUE;
  end;
end;

function WideCreateDir(const Dir: WideString): Boolean;
begin
  Result := Tnt_CreateDirectoryW(PWideChar(Dir), nil);
end;

function WideRemoveDir(const Dir: WideString): Boolean;
begin
  Result := Tnt_RemoveDirectoryW(PWideChar(Dir));
end;

function WideGetCurrentDir: WideString;
begin
  SetLength(Result, MAX_PATH);
  Tnt_GetCurrentDirectoryW(MAX_PATH, PWideChar(Result));
  Result := PWideChar(Result);
end;

function WideSetCurrentDir(const Dir: WideString): Boolean;
begin
  Result := Tnt_SetCurrentDirectoryW(PWideChar(Dir));
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(
      {$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
      Result := S_OK // SysUtils seems confident (works for date = "dd.MM.yy" and time = "H.mm.ss")
    else if (Flags = VAR_DATEVALUEONLY)
    and SysUtils.TryStrToDate{TNT-ALLOW TryStrToDate}(Str, DateTime) then
      Result := S_OK // SysUtils seems confident
    else if (Flags = 0)
    and SysUtils.TryStrToDateTime{TNT-ALLOW TryStrToDateTime}(Str, DateTime) then
      Result := S_OK // SysUtils seems confident
  end;
end;

function TntTryStrToDateTime(Str: WideString; out DateTime: TDateTime): Boolean;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, 0, DateTime));
end;

function TntTryStrToDate(Str: WideString; out DateTime: TDateTime): Boolean;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, VAR_DATEVALUEONLY, DateTime));
end;

function TntTryStrToTime(Str: WideString; out DateTime: TDateTime): Boolean;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, VAR_TIMEVALUEONLY, DateTime));
end;

function ValidDateTimeStr(Str: WideString): Boolean;
var
  Temp: TDateTime;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, 0, Temp));
end;

function ValidDateStr(Str: WideString): Boolean;
var
  Temp: TDateTime;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, VAR_DATEVALUEONLY, Temp));
end;

function ValidTimeStr(Str: WideString): Boolean;
var
  Temp: TDateTime;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, VAR_TIMEVALUEONLY, Temp));
end;

function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
begin
  if not TntTryStrToDateTime(Str, Result) then
    Result := Default;
end;

function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
begin
  if not TntTryStrToDate(Str, Result) then
    Result := Default;
end;

function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;
begin
  if not TntTryStrToTime(Str, Result) then
    Result := Default;
end;

function _IntStrToDateTime(Str: WideString; Flags: Integer; ErrorFormatStr: WideString): TDateTime;
begin
  try
    OleCheck(_IntTryStrToDateTime(Str, Flags, Result));
  except
    on E: Exception do begin
      E.Message := E.Message + CRLF + WideFormat(ErrorFormatStr, [Str]);
      raise EConvertError.Create(E.Message);
    end;
  end;
end;

function TntStrToDateTime(Str: WideString): TDateTime;
begin
  Result := _IntStrToDateTime(Str, 0, SInvalidDateTime);
end;

function TntStrToDate(Str: WideString): TDateTime;
begin
  Result := _IntStrToDateTime(Str, VAR_DATEVALUEONLY,
      {$IFNDEF FPC} SInvalidDate {$ELSE} SInvalidDateTime {$ENDIF});
end;

function TntStrToTime(Str: WideString): TDateTime;
begin
  Result := _IntStrToDateTime(Str, VAR_TIMEVALUEONLY,
      {$IFNDEF FPC} SInvalidTime {$ELSE} SInvalidDateTime {$ENDIF});
end;

//=============================================================================================
//==  CURRENCY STRING PARSING =================================================================
//=============================================================================================

function TntCurrToStr(Value: Currency; lpFormat: PCurrencyFmtW = nil): WideString;
const
  MAX_BUFF_SIZE = 64; // can a currency string actually be larger?
var
  ValueStr: WideString;
begin
  // format lpValue using ENG-US settings
  ValueStr := ENG_US_FloatToStr(Value);
  // get currency format
  SetLength(Result, MAX_BUFF_SIZE);
  if 0 = Tnt_GetCurrencyFormatW(GetThreadLocale, 0, PWideChar(ValueStr),
    lpFormat, PWideChar(Result), Length(Result))
  then begin
    RaiseLastOSError;
  end;
  Result := PWideChar(Result);
end;

function TntStrToCurr(const S: WideString): Currency;
begin
  try
    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]);
      raise EConvertError.Create(E.Message);
    end;
  end;
end;

function ValidCurrencyStr(const S: WideString): Boolean;
var
  Dummy: Currency;
begin
  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(
      {$IFDEF FPC} POLECHAR(S) {$ELSE} S {$ENDIF},
      GetThreadLocale, 0, Result)) then
    Result := Default;
end;

threadvar
  Currency_DecimalSep: WideString;
  Currency_ThousandSep: WideString;
  Currency_CurrencySymbol: WideString;

function GetDefaultCurrencyFmt: TCurrencyFmtW;
begin
  ZeroMemory(@Result, SizeOf(Result));
  Result.NumDigits := StrToIntDef(WideGetLocaleStr(GetThreadLocale, LOCALE_ICURRDIGITS, '2'), 2);
  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 := {$IFNDEF FPC} PWideChar(Currency_DecimalSep)
                         {$ELSE}       LPTSTR(PWideChar(Currency_DecimalSep)) {$ENDIF};
  Currency_ThousandSep := WideGetLocaleStr(GetThreadLocale, LOCALE_SMONTHOUSANDSEP, ',');
  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 := {$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;
begin
  if (not Win32PlatformIsUnicode) then
    Result := GetLocaleStr{TNT-ALLOW GetLocaleStr}(LocaleID, LocaleType, Default)
  else begin
    SetLength(Result, 255);
    L := GetLocaleInfoW(LocaleID, LocaleType, PWideChar(Result), Length(Result));
    if L > 0 then
      SetLength(Result, L - 1)
    else
      Result := Default;
  end;
end;

function WideSysErrorMessage(ErrorCode: Integer): WideString;
begin
  Result := WideLibraryErrorMessage('system', 0, ErrorCode);
end;

function WideLibraryErrorMessage(const LibName: WideString; Dll: THandle; ErrorCode: Integer): WideString;
var
  Len: Integer;
  AnsiResult: AnsiString;
  Flags: Cardinal;
begin
  Flags := FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS or FORMAT_MESSAGE_ARGUMENT_ARRAY;
  if Dll <> 0 then
    Flags := Flags or FORMAT_MESSAGE_FROM_HMODULE;
  if Win32PlatformIsUnicode then begin
    SetLength(Result, 256);
    Len := FormatMessageW(Flags, Pointer(Dll), ErrorCode, 0, PWideChar(Result), Length(Result), nil);
    SetLength(Result, Len);
  end else begin
    SetLength(AnsiResult, 256);
    Len := FormatMessageA(Flags, Pointer(Dll), ErrorCode, 0, PAnsiChar(AnsiResult), Length(AnsiResult), nil);
    SetLength(AnsiResult, Len);
    Result := AnsiResult;
  end;
  if Trim(Result) = '' then
    Result := WideFormat('Unspecified error (%d) from %s.', [ErrorCode, LibName]);
end;

{$IFNDEF COMPILER_7_UP}
function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
begin
  Result := (Win32MajorVersion > AMajor) or
            ((Win32MajorVersion = AMajor) and
             (Win32MinorVersion >= AMinor));
end;
{$ENDIF}

function WinCheckH(RetVal: Cardinal): Cardinal;
begin
  if RetVal = 0 then RaiseLastOSError;
  Result := RetVal;
end;

function WinCheckFileH(RetVal: Cardinal): Cardinal;
begin
  if RetVal = INVALID_HANDLE_VALUE then RaiseLastOSError;
  Result := RetVal;
end;

function WinCheckP(RetVal: Pointer): Pointer;
begin
  if RetVal = nil then RaiseLastOSError;
  Result := RetVal;
end;

function WideGetModuleFileName(Instance: HModule): WideString;
begin
  SetLength(Result, MAX_PATH);
  WinCheckH(Tnt_GetModuleFileNameW(Instance, PWideChar(Result), Length(Result)));
  Result := PWideChar(Result)
end;

function WideSafeLoadLibrary(const Filename: Widestring; ErrorMode: UINT): HMODULE;
var
  OldMode: UINT;
  FPUControlWord: Word;
begin
  OldMode := SetErrorMode(ErrorMode);
  try
    asm
      FNSTCW  FPUControlWord
    end;
    try
      Result := Tnt_LoadLibraryW(PWideChar(Filename));
    finally
      asm
        FNCLEX
        FLDCW FPUControlWord
      end;
    end;
  finally
    SetErrorMode(OldMode);
  end;
end;

{$IFNDEF FPC}
function WideLoadPackage(const Name: Widestring): HMODULE;
begin
  Result := WideSafeLoadLibrary(Name);
  if Result = 0 then
  begin
    raise EPackageError.CreateFmt(sErrorLoadingPackage, [Name, WideSysErrorMessage(GetLastError)]);
  end;
  try
    InitializePackage(Result);
  except
    FreeLibrary(Result);
    raise;
  end;
end;
{$ENDIF}

function _WideCharType(WC: WideChar; dwInfoType: Cardinal): Word;
begin
  Win32Check(Tnt_GetStringTypeExW(GetThreadLocale, dwInfoType, PWideChar(@WC), 1, Result))
end;

function IsWideCharUpper(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and C1_UPPER) <> 0;
end;

function IsWideCharLower(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and C1_LOWER) <> 0;
end;

function IsWideCharDigit(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and C1_DIGIT) <> 0;
end;

function IsWideCharSpace(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and C1_SPACE) <> 0;
end;

function IsWideCharPunct(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and C1_PUNCT) <> 0;
end;

function IsWideCharCntrl(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and C1_CNTRL) <> 0;
end;

function IsWideCharBlank(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and C1_BLANK) <> 0;
end;

function IsWideCharXDigit(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and C1_XDIGIT) <> 0;
end;

function IsWideCharAlpha(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and C1_ALPHA) <> 0;
end;

function IsWideCharAlphaNumeric(WC: WideChar): Boolean;
begin
  Result := (_WideCharType(WC, CT_CTYPE1) and (C1_ALPHA + C1_DIGIT)) <> 0;
end;

function WideTextPos(const SubStr, S: WideString): Integer;
begin
  Result := Pos(Tnt_WideUpperCase(SubStr), Tnt_WideUpperCase(S));
end;

function FindDoubleTerminator(P: PWideChar): PWideChar;
begin
  Result := P;
  while True do begin
    Result := WStrScan(Result, #0);
    Inc(Result);
    if Result^ = #0 then begin
      Dec(Result);
      break;
    end;
  end;
end;

function ExtractStringArrayStr(P: PWideChar): WideString;
var
  PEnd: PWideChar;
begin
  PEnd := FindDoubleTerminator(P);
  Inc(PEnd, 2); // move past #0#0
  SetString(Result, P, PEnd - P);
end;

function ExtractStringFromStringArray(var P: PWideChar; Separator: WideChar = #0): WideString;
var
  Start: PWideChar;
begin
  Start := P;
  P := WStrScan(Start, Separator);
  if P = nil then begin
    Result := Start;
    P := WStrEnd(Start);
  end else begin
    SetString(Result, Start, P - Start);
    Inc(P);
  end;
end;

function ExtractStringsFromStringArray(P: PWideChar; Separator: WideChar = #0): TWideStringDynArray;
const
  GROW_COUNT = 256;
var
  Count: Integer;
  Item: WideString;
begin
  Count := 0;
  SetLength(Result, GROW_COUNT);
  Item := ExtractStringFromStringArray(P, Separator);
  While Item <> '' do begin
    if Count > High(Result) then
      SetLength(Result, Length(Result) + GROW_COUNT);
    Result[Count] := Item;
    Inc(Count);
    Item := ExtractStringFromStringArray(P, Separator);
  end;
  SetLength(Result, Count);
end;

function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
var
  UsedDefaultChar: BOOL;
begin
  WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(@WC), 1, nil, 0, nil, @UsedDefaultChar);
  Result := not UsedDefaultChar;
end;

function IsWideStringMappableToAnsi(const WS: WideString): Boolean;
var
  UsedDefaultChar: BOOL;
begin
  WideCharToMultiByte(DefaultSystemCodePage, 0, PWideChar(WS), Length(WS), nil, 0, nil, @UsedDefaultChar);
  Result := not UsedDefaultChar;
end;

function IsRTF(const Value: WideString): Boolean;
const
  RTF_BEGIN_1  = WideString('{\RTF');
  RTF_BEGIN_2  = WideString('{URTF');
begin
  Result := (WideTextPos(RTF_BEGIN_1, Value) = 1)
         or (WideTextPos(RTF_BEGIN_2, Value) = 1);
end;

{$IFDEF COMPILER_7_UP}
var
  Cached_ENG_US_FormatSettings: TFormatSettings;
  Cached_ENG_US_FormatSettings_Time: Cardinal;

function ENG_US_FormatSettings: TFormatSettings;
begin
  if Cached_ENG_US_FormatSettings_Time = _SettingChangeTime then
    Result := Cached_ENG_US_FormatSettings
  else begin
    GetLocaleFormatSettings(MAKELCID(MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US)), Result);
    Result.DecimalSeparator := '.'; // ignore overrides
    Cached_ENG_US_FormatSettings := Result;
    Cached_ENG_US_FormatSettings_Time := _SettingChangeTime;
  end;
 end;

function ENG_US_FloatToStr(Value: Extended): WideString;
begin
  Result := FloatToStr(Value, ENG_US_FormatSettings);
end;

function ENG_US_StrToFloat(const S: WideString): Extended;
begin
  if not TextToFloat(PAnsiChar(AnsiString(S)), Result, fvExtended, ENG_US_FormatSettings) then
    Result := StrToFloat(S); // try using native format
end;

{$ELSE}

function ENG_US_FloatToStr(Value: Extended): WideString;
var
  SaveDecimalSep: AnsiChar;
begin
  SaveDecimalSep := SysUtils.DecimalSeparator;
  try
    SysUtils.DecimalSeparator := '.';
    Result := FloatToStr(Value);
  finally
    SysUtils.DecimalSeparator := SaveDecimalSep;
  end;
end;

function ENG_US_StrToFloat(const S: WideString): Extended;
var
  SaveDecimalSep: AnsiChar;
begin
  try
    SaveDecimalSep := SysUtils.DecimalSeparator;
    try
      SysUtils.DecimalSeparator := '.';
      Result := StrToFloat(S);
    finally
      SysUtils.DecimalSeparator := SaveDecimalSep;
    end;
  except
    if SysUtils.DecimalSeparator <> '.' then
      Result := StrToFloat(S) // try using native format
    else
      raise;
  end;
end;
{$ENDIF}

//---------------------------------------------------------------------------------------------
//                                 Tnt - Variants
//---------------------------------------------------------------------------------------------

initialization
  Win32PlatformIsUnicode := (Win32Platform = VER_PLATFORM_WIN32_NT);
  Win32PlatformIsXP := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1))
                    or  (Win32MajorVersion > 5);
  Win32PlatformIs2003 := ((Win32MajorVersion = 5) and (Win32MinorVersion >= 2))
                    or  (Win32MajorVersion > 5);
  Win32PlatformIsVista := (Win32MajorVersion >= 6);

finalization
  Currency_DecimalSep := ''; {make memory sleuth happy}
  Currency_ThousandSep := ''; {make memory sleuth happy}
  Currency_CurrencySymbol := ''; {make memory sleuth happy}

end.