FPC 2.4.0 compatibility fix:

- some TntUnicodeControls routines had to be updated
- For the TWriter.Write() issue in TntClasses.pas see http://wiki.freepascal.org/User_Changes_2.4.0#Passing_ordinal_constants_to_formal_const_parameters

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

2 files changed, 2327 insertions, 2320 deletions

diff --git a/src/lib/TntUnicodeControls/TntClasses.pas b/src/lib/TntUnicodeControls/TntClasses.pas
index be043421..f0ebd14c 100644
--- a/src/lib/TntUnicodeControls/TntClasses.pas
+++ b/src/lib/TntUnicodeControls/TntClasses.pas
@@ -1,1799 +1,1806 @@
-
-{*****************************************************************************}
-{                                                                             }
-{    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 TntClasses;
-
-{$IFDEF FPC}
-  {$MODE Delphi}
-{$ENDIF}
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-{ TODO: Consider: TTntRegIniFile, TTntMemIniFile (consider if UTF8 fits into this solution). }
-
-{***********************************************}
-{  WideChar-streaming implemented by Maël Hörz  }
-{***********************************************}
-
-uses
-  Classes, SysUtils, Windows,
-  {$IFNDEF COMPILER_10_UP}
-  TntWideStrings,
-  {$ELSE}
-  WideStrings,
-  {$ENDIF}
-  ActiveX, Contnrs;
-
-// ......... introduced .........
-type
-  TTntStreamCharSet = (csAnsi, csUnicode, csUnicodeSwapped, csUtf8);
-
-function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;
-
-//---------------------------------------------------------------------------------------------
-//                                 Tnt - Classes
-//---------------------------------------------------------------------------------------------
-
-{TNT-WARN ExtractStrings}
-{TNT-WARN LineStart}
-{TNT-WARN TStringStream}   // TODO: Implement a TWideStringStream
-
-// A potential implementation of TWideStringStream can be found at:
-//   http://kdsxml.cvs.sourceforge.net/kdsxml/Global/KDSClasses.pas?revision=1.10&view=markup
-
-procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);
-
-type
-{TNT-WARN TFileStream}
-  TTntFileStream = class(THandleStream)
-  public
-    constructor Create(const FileName: WideString; Mode: Word);
-    destructor Destroy; override;
-  end;
-
-{TNT-WARN TMemoryStream}
-  TTntMemoryStream = class(TMemoryStream{TNT-ALLOW TMemoryStream})
-  public
-    procedure LoadFromFile(const FileName: WideString);
-    procedure SaveToFile(const FileName: WideString);
-  end;
-
-{TNT-WARN TResourceStream}
-  TTntResourceStream = class(TCustomMemoryStream)
-  private
-    HResInfo: HRSRC;
-    HGlobal: THandle;
-    procedure Initialize(Instance: THandle; Name, ResType: PWideChar);
-  public
-    constructor Create(Instance: THandle; const ResName: WideString; ResType: PWideChar);
-    constructor CreateFromID(Instance: THandle; ResID: Word; ResType: PWideChar);
-    destructor Destroy; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    procedure SaveToFile(const FileName: WideString);
-  end;
-
-  TTntStrings = class;
-
-{TNT-WARN TAnsiStrings}
-  TAnsiStrings{TNT-ALLOW TAnsiStrings} = class(TStrings{TNT-ALLOW TStrings})
-  public
-    procedure LoadFromFile(const FileName: WideString); reintroduce;
-    procedure SaveToFile(const FileName: WideString); reintroduce;
-    procedure LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);
-    procedure SaveToFileEx(const FileName: WideString; CodePage: Cardinal);
-    procedure LoadFromStreamEx(Stream: TStream; CodePage: Cardinal); virtual; abstract;
-    procedure SaveToStreamEx(Stream: TStream; CodePage: Cardinal); virtual; abstract;
-  end;
-
-  TAnsiStringsForWideStringsAdapter = class(TAnsiStrings{TNT-ALLOW TAnsiStrings})
-  private
-    FWideStrings: TTntStrings;
-    FAdapterCodePage: Cardinal;
-  protected
-    function Get(Index: Integer): AnsiString; override;
-    procedure Put(Index: Integer; const S: AnsiString); override;
-    function GetCount: Integer; override;
-    function GetObject(Index: Integer): TObject; override;
-    procedure PutObject(Index: Integer; AObject: TObject); override;
-    procedure SetUpdateState(Updating: Boolean); override;
-    function AdapterCodePage: Cardinal; dynamic;
-  public
-    constructor Create(AWideStrings: TTntStrings; _AdapterCodePage: Cardinal = 0);
-    procedure Clear; override;
-    procedure Delete(Index: Integer); override;
-    procedure Insert(Index: Integer; const S: AnsiString); override;
-    procedure LoadFromStreamEx(Stream: TStream; CodePage: Cardinal); override;
-    procedure SaveToStreamEx(Stream: TStream; CodePage: Cardinal); override;
-  end;
-
-{TNT-WARN TStrings}
-  TTntStrings = class(TWideStrings)
-  private
-    FLastFileCharSet: TTntStreamCharSet;
-    FAnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings};
-    procedure SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});
-    procedure ReadData(Reader: TReader);
-    procedure ReadDataUTF7(Reader: TReader);
-    procedure ReadDataUTF8(Reader: TReader);
-    procedure WriteDataUTF7(Writer: TWriter);
-  protected
-    procedure DefineProperties(Filer: TFiler); override;
-  public
-    constructor Create;
-    destructor Destroy; override;
-
-    procedure LoadFromFile(const FileName: WideString); override;
-    procedure LoadFromStream(Stream: TStream); override;
-    procedure LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean); virtual;
-
-    procedure SaveToFile(const FileName: WideString); override;
-    procedure SaveToStream(Stream: TStream); override;
-    procedure SaveToStream_BOM(Stream: TStream; WithBOM: Boolean); virtual;
-
-    property LastFileCharSet: TTntStreamCharSet read FLastFileCharSet;
-  published
-    property AnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings} read FAnsiStrings write SetAnsiStrings stored False;
-  end;
-
-{ TTntStringList class }
-
-  TTntStringList = class;
-  TWideStringListSortCompare = function(List: TTntStringList; Index1, Index2: Integer): Integer;
-
-{TNT-WARN TStringList}
-  TTntStringList = class(TTntStrings)
-  private
-    FUpdating: Boolean;
-    FList: PWideStringItemList;
-    FCount: Integer;
-    FCapacity: Integer;
-    FSorted: Boolean;
-    FDuplicates: TDuplicates;
-    FCaseSensitive: Boolean;
-    FOnChange: TNotifyEvent;
-    FOnChanging: TNotifyEvent;
-    procedure ExchangeItems(Index1, Index2: Integer);
-    procedure Grow;
-    procedure QuickSort(L, R: Integer; SCompare: TWideStringListSortCompare);
-    procedure SetSorted(Value: Boolean);
-    procedure SetCaseSensitive(const Value: Boolean);
-  protected
-    procedure Changed; virtual;
-    procedure Changing; virtual;
-    function Get(Index: Integer): WideString; override;
-    function GetCapacity: Integer; override;
-    function GetCount: Integer; override;
-    function GetObject(Index: Integer): TObject; override;
-    procedure Put(Index: Integer; const S: WideString); override;
-    procedure PutObject(Index: Integer; AObject: TObject); override;
-    procedure SetCapacity(NewCapacity: Integer); override;
-    procedure SetUpdateState(Updating: Boolean); override;
-    function CompareStrings(const S1, S2: WideString): Integer; override;
-    procedure InsertItem(Index: Integer; const S: WideString; AObject: TObject); virtual;
-  public
-    destructor Destroy; override;
-    function Add(const S: WideString): Integer; override;
-    function AddObject(const S: WideString; AObject: TObject): Integer; override;
-    procedure Clear; override;
-    procedure Delete(Index: Integer); override;
-    procedure Exchange(Index1, Index2: Integer); override;
-    function Find(const S: WideString; var Index: Integer): Boolean; virtual;
-    function IndexOf(const S: WideString): Integer; override;
-    function IndexOfName(const Name: WideString): Integer; override;
-    procedure Insert(Index: Integer; const S: WideString); override;
-    procedure InsertObject(Index: Integer; const S: WideString;
-      AObject: TObject); override;
-    procedure Sort; virtual;
-    procedure CustomSort(Compare: TWideStringListSortCompare); virtual;
-    property Duplicates: TDuplicates read FDuplicates write FDuplicates;
-    property Sorted: Boolean read FSorted write SetSorted;
-    property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
-    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
-  end;
-
-// ......... introduced .........
-type
-  TListTargetCompare = function (Item, Target: Pointer): Integer;
-
-function FindSortedListByTarget(List: TList; TargetCompare: TListTargetCompare;
-  Target: Pointer; var Index: Integer): Boolean;
-
-function ClassIsRegistered(const clsid: TCLSID): Boolean;
-
-var
-  RuntimeUTFStreaming: Boolean;
-
-type
-  TBufferedAnsiString = class(TObject)
-  private
-    FStringBuffer: AnsiString;
-    LastWriteIndex: Integer;
-  public
-    procedure Clear;
-    procedure AddChar(const wc: AnsiChar);
-    procedure AddString(const s: AnsiString);
-    procedure AddBuffer(Buff: PAnsiChar; Chars: Integer);
-    function Value: AnsiString;
-    function BuffPtr: PAnsiChar;
-  end;
-
-  TBufferedWideString = class(TObject)
-  private
-    FStringBuffer: WideString;
-    LastWriteIndex: Integer;
-  public
-    procedure Clear;
-    procedure AddChar(const wc: WideChar);
-    procedure AddString(const s: WideString);
-    procedure AddBuffer(Buff: PWideChar; Chars: Integer);
-    function Value: WideString;
-    function BuffPtr: PWideChar;
-  end;
-
-  TBufferedStreamReader = class(TStream)
-  private
-    FStream: TStream;
-    FStreamSize: Integer;
-    FBuffer: array of Byte;
-    FBufferSize: Integer;
-    FBufferStartPosition: Integer;
-    FVirtualPosition: Integer;
-    procedure UpdateBufferFromPosition(StartPos: Integer);
-  public
-    constructor Create(Stream: TStream; BufferSize: Integer = 1024);
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-  end;
-
-// "synced" wide string
-type TSetAnsiStrEvent = procedure(const Value: AnsiString) of object;
-function GetSyncedWideString(var WideStr: WideString; const AnsiStr: AnsiString): WideString;
-procedure SetSyncedWideString(const Value: WideString; var WideStr: WideString;
-  const AnsiStr: AnsiString; SetAnsiStr: TSetAnsiStrEvent);
-
-type
-  TWideComponentHelper = class(TComponent)
-  private
-    FComponent: TComponent;
-  protected
-    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    constructor CreateHelper(AOwner: TComponent; ComponentHelperList: TComponentList);
-  end;
-
-function FindWideComponentHelper(ComponentHelperList: TComponentList; Component: TComponent): TWideComponentHelper;
-
-implementation
-
-uses
-  RTLConsts, ComObj, Math,
-  Registry, TypInfo, TntSystem, TntSysUtils;
-
-{ TntPersistent }
-
-//===========================================================================
-//   The Delphi 5 Classes.pas never supported the streaming of WideStrings.
-//   The Delphi 6 Classes.pas supports WideString streaming.  But it's too bad that
-//     the Delphi 6 IDE doesn't use the updated Classes.pas.  Switching between Form/Text
-//       mode corrupts extended characters in WideStrings even under Delphi 6.
-//   Delphi 7 seems to finally get right.  But let's keep the UTF7 support at design time
-//     to enable sharing source code with previous versions of Delphi.
-//
-//   The purpose of this solution is to store WideString properties which contain
-//     non-ASCII chars in the form of UTF7 under the old property name + '_UTF7'.
-//
-//   Special thanks go to Francisco Leong for helping to develop this solution.
-//
-
-{ TTntWideStringPropertyFiler }
-type
-  TTntWideStringPropertyFiler = class
-  private
-    FInstance: TPersistent;
-    FPropInfo: PPropInfo;
-    procedure ReadDataUTF8(Reader: TReader);
-    procedure ReadDataUTF7(Reader: TReader);
-    procedure WriteDataUTF7(Writer: TWriter);
-  public
-    procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
-  end;
-
-function ReaderNeedsUtfHelp(Reader: TReader): Boolean;
-begin
-  if Reader.Owner = nil then
-    Result := False { designtime - visual form inheritance ancestor }
-  else if csDesigning in Reader.Owner.ComponentState then
-    {$IFDEF COMPILER_7_UP}
-    Result := False { Delphi 7+: designtime - doesn't need UTF help. }
-    {$ELSE}
-    Result := True { Delphi 6: designtime - always needs UTF help. }
-    {$ENDIF}
-  else
-    Result := RuntimeUTFStreaming; { runtime }
-end;
-
-procedure TTntWideStringPropertyFiler.ReadDataUTF8(Reader: TReader);
-begin
-  if ReaderNeedsUtfHelp(Reader) then
-    SetWideStrProp(FInstance, FPropInfo, UTF8ToWideString(Reader.ReadString))
-  else
-    Reader.ReadString; { do nothing with Result }
-end;
-
-procedure TTntWideStringPropertyFiler.ReadDataUTF7(Reader: TReader);
-begin
-  if ReaderNeedsUtfHelp(Reader) then
-    SetWideStrProp(FInstance, FPropInfo, UTF7ToWideString(Reader.ReadString))
-  else
-    Reader.ReadString; { do nothing with Result }
-end;
-
-procedure TTntWideStringPropertyFiler.WriteDataUTF7(Writer: TWriter);
-begin
-  Writer.WriteString(WideStringToUTF7(GetWideStrProp(FInstance, FPropInfo)));
-end;
-
-procedure TTntWideStringPropertyFiler.DefineProperties(Filer: TFiler; Instance: TPersistent;
-  PropName: AnsiString);
-
-  {$IFNDEF COMPILER_7_UP}
-  function HasData: Boolean;
-  var
-    CurrPropValue: WideString;
-  begin
-    // must be stored
-    Result := IsStoredProp(Instance, FPropInfo);
-    if Result
-    and (Filer.Ancestor <> nil)
-    and (GetPropInfo(Filer.Ancestor, PropName, [tkWString]) <> nil) then
-    begin
-      // must be different than ancestor
-      CurrPropValue := GetWideStrProp(Instance, FPropInfo);
-      Result := CurrPropValue <> GetWideStrProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
-    end;
-    if Result then begin
-      // must be non-blank and different than UTF8 (implies all ASCII <= 127)
-      CurrPropValue := GetWideStrProp(Instance, FPropInfo);
-      Result := (CurrPropValue <> '') and (WideStringToUTF8(CurrPropValue) <> CurrPropValue);
-    end;
-  end;
-  {$ENDIF}
-
-begin
-  FInstance := Instance;
-  FPropInfo := GetPropInfo(Instance, PropName, [tkWString]);
-  if FPropInfo <> nil then begin
-    // must be published (and of type WideString)
-    Filer.DefineProperty(PropName + 'W', ReadDataUTF8, nil, False);
-    {$IFDEF COMPILER_7_UP}
-    Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, False);
-    {$ELSE}
-    Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, HasData);
-    {$ENDIF}
-  end;
-  FInstance := nil;
-  FPropInfo := nil;
-end;
-
-{ TTntWideCharPropertyFiler }
-type
-  TTntWideCharPropertyFiler = class
-  private
-    FInstance: TPersistent;
-    FPropInfo: PPropInfo;
-    {$IFNDEF COMPILER_9_UP}
-    FWriter: TWriter;
-    procedure GetLookupInfo(var Ancestor: TPersistent;
-      var Root, LookupRoot, RootAncestor: TComponent);
-    {$ENDIF}
-    procedure ReadData_W(Reader: TReader);
-    procedure ReadDataUTF7(Reader: TReader);
-    procedure WriteData_W(Writer: TWriter);
-    function ReadChar(Reader: TReader): WideChar;
-  public
-    procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
-  end;
-
-{$IFNDEF COMPILER_9_UP}
-type
-  TGetLookupInfoEvent = procedure(var Ancestor: TPersistent;
-    var Root, LookupRoot, RootAncestor: TComponent) of object;
-
-function AncestorIsValid(Ancestor: TPersistent; Root, RootAncestor: TComponent): Boolean;
-begin
-  Result := (Ancestor <> nil) and (RootAncestor <> nil) and
-            Root.InheritsFrom(RootAncestor.ClassType);
-end;
-
-function IsDefaultOrdPropertyValue(Instance: TObject; PropInfo: PPropInfo;
-  OnGetLookupInfo: TGetLookupInfoEvent): Boolean;
-var
-  Ancestor: TPersistent;
-  LookupRoot: TComponent;
-  RootAncestor: TComponent;
-  Root: TComponent;
-  AncestorValid: Boolean;
-  Value: Longint;
-  Default: LongInt;
-begin
-  Ancestor := nil;
-  Root := nil;
-  LookupRoot := nil;
-  RootAncestor := nil;
-
-  if Assigned(OnGetLookupInfo) then
-    OnGetLookupInfo(Ancestor, Root, LookupRoot, RootAncestor);
-
-  AncestorValid := AncestorIsValid(Ancestor, Root, RootAncestor);
-
-  Result := True;
-  if (PropInfo^.GetProc <> nil) and (PropInfo^.SetProc <> nil) then
-  begin
-    Value := GetOrdProp(Instance, PropInfo);
-    if AncestorValid then
-      Result := Value = GetOrdProp(Ancestor, PropInfo)
-    else
-    begin
-      Default := PPropInfo(PropInfo)^.Default;
-      Result :=  (Default <> LongInt($80000000)) and (Value = Default);
-    end;
-  end;
-end;
-
-procedure TTntWideCharPropertyFiler.GetLookupInfo(var Ancestor: TPersistent;
-  var Root, LookupRoot, RootAncestor: TComponent);
-begin
-  Ancestor := FWriter.Ancestor;
-  Root := FWriter.Root;
-  LookupRoot := FWriter.LookupRoot;
-  RootAncestor := FWriter.RootAncestor;
-end;
-{$ENDIF}
-
-function TTntWideCharPropertyFiler.ReadChar(Reader: TReader): WideChar;
-var
-  Temp: WideString;
-begin
-  case Reader.NextValue of
-    vaWString:
-      Temp := Reader.ReadWideString;
-    vaString:
-      Temp := Reader.ReadString;
-    else
-      raise EReadError.Create(SInvalidPropertyValue);
-  end;
-
-  if Length(Temp) > 1 then
-    raise EReadError.Create(SInvalidPropertyValue);
-  Result := Temp[1];
-end;
-
-procedure TTntWideCharPropertyFiler.ReadData_W(Reader: TReader);
-begin
-  SetOrdProp(FInstance, FPropInfo, Ord(ReadChar(Reader)));
-end;
-
-procedure TTntWideCharPropertyFiler.ReadDataUTF7(Reader: TReader);
-var
-  S: WideString;
-begin
-  S := UTF7ToWideString(Reader.ReadString);
-  if S = '' then
-    SetOrdProp(FInstance, FPropInfo, 0)
-  else
-    SetOrdProp(FInstance, FPropInfo, Ord(S[1]))
-end;
-
-type TAccessWriter = class(TWriter);
-
-procedure TTntWideCharPropertyFiler.WriteData_W(Writer: TWriter);
-var
-  L: Integer;
-  Temp: WideString;
-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);
-end;
-
-procedure TTntWideCharPropertyFiler.DefineProperties(Filer: TFiler;
-  Instance: TPersistent; PropName: AnsiString);
-
-  {$IFNDEF COMPILER_9_UP}
-  function HasData: Boolean;
-  var
-    CurrPropValue: Integer;
-  begin
-    // must be stored
-    Result := IsStoredProp(Instance, FPropInfo);
-    if Result and (Filer.Ancestor <> nil) and
-      (GetPropInfo(Filer.Ancestor, PropName, [tkWChar]) <> nil) then
-    begin
-      // must be different than ancestor
-      CurrPropValue := GetOrdProp(Instance, FPropInfo);
-      Result := CurrPropValue <> GetOrdProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
-    end;
-    if Result and (Filer is TWriter) then
-    begin
-      FWriter := TWriter(Filer);
-      Result := not IsDefaultOrdPropertyValue(Instance, FPropInfo, GetLookupInfo);
-    end;
-  end;
-  {$ENDIF}
-
-begin
-  FInstance := Instance;
-  FPropInfo := GetPropInfo(Instance, PropName, [tkWChar]);
-  if FPropInfo <> nil then
-  begin
-    // must be published (and of type WideChar)
-    {$IFDEF COMPILER_9_UP}
-    Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, False);
-    {$ELSE}
-    Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, HasData);
-    {$ENDIF}
-    Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, nil, False);
-  end;
-  FInstance := nil;
-  FPropInfo := nil;
-end;
-
-procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);
-var
-  I, Count: Integer;
-  PropInfo: PPropInfo;
-  PropList: PPropList;
-  WideStringFiler: TTntWideStringPropertyFiler;
-  WideCharFiler: TTntWideCharPropertyFiler;
-begin
-  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
-  if Count > 0 then
-  begin
-    WideStringFiler := TTntWideStringPropertyFiler.Create;
-    try
-      WideCharFiler := TTntWideCharPropertyFiler.Create;
-      try
-        GetMem(PropList, Count * SizeOf(Pointer));
-        try
-          GetPropInfos(Instance.ClassInfo, PropList);
-          for I := 0 to Count - 1 do
-          begin
-            PropInfo := PropList^[I];
-            if (PropInfo = nil) then
-              break;
-            if (PropInfo.PropType^.Kind = tkWString) then
-              WideStringFiler.DefineProperties(Filer, Instance, PropInfo.Name)
-            else if (PropInfo.PropType^.Kind = tkWChar) then
-              WideCharFiler.DefineProperties(Filer, Instance, PropInfo.Name)
-          end;
-        finally
-          FreeMem(PropList, Count * SizeOf(Pointer));
-        end;
-      finally
-        WideCharFiler.Free;
-      end;
-    finally
-      WideStringFiler.Free;
-    end;
-  end;
-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 HAS_SFCREATEERROREX}
-  ErrorMessage: WideString;
-  {$ENDIF}
-begin
-  if Mode = fmCreate then
-  begin
-    CreateHandle := WideFileCreate(FileName);
-    if CreateHandle < 0 then begin
-      {$IFDEF HAS_SFCREATEERROREX}
-      ErrorMessage := WideSysErrorMessage(GetLastError);
-      raise EFCreateError.CreateFmt(SFCreateErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
-      {$ELSE}
-      raise EFCreateError.CreateFmt(SFCreateError, [WideExpandFileName(FileName)]);
-      {$ENDIF}
-    end;
-  end else
-  begin
-    CreateHandle := WideFileOpen(FileName, Mode);
-    if CreateHandle < 0 then begin
-      {$IFDEF HAS_SFCREATEERROREX}
-      ErrorMessage := WideSysErrorMessage(GetLastError);
-      raise EFOpenError.CreateFmt(SFOpenErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
-      {$ELSE}
-      raise EFOpenError.CreateFmt(SFOpenError, [WideExpandFileName(FileName)]);
-      {$ENDIF}
-    end;
-  end;
-  inherited Create(CreateHandle);
-end;
-
-destructor TTntFileStream.Destroy;
-begin
-  if Handle >= 0 then FileClose(Handle);
-end;
-
-{ TTntMemoryStream }
-
-procedure TTntMemoryStream.LoadFromFile(const FileName: WideString);
-var
-  Stream: TStream;
-begin
-  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
-  try
-    LoadFromStream(Stream);
-  finally
-    Stream.Free;
-  end;
-end;
-
-procedure TTntMemoryStream.SaveToFile(const FileName: WideString);
-var
-  Stream: TStream;
-begin
-  Stream := TTntFileStream.Create(FileName, fmCreate);
-  try
-    SaveToStream(Stream);
-  finally
-    Stream.Free;
-  end;
-end;
-
-{ TTntResourceStream }
-
-constructor TTntResourceStream.Create(Instance: THandle; const ResName: WideString;
-  ResType: PWideChar);
-begin
-  inherited Create;
-  Initialize(Instance, PWideChar(ResName), ResType);
-end;
-
-constructor TTntResourceStream.CreateFromID(Instance: THandle; ResID: Word;
-  ResType: PWideChar);
-begin
-  inherited Create;
-  Initialize(Instance, PWideChar(ResID), ResType);
-end;
-
-procedure TTntResourceStream.Initialize(Instance: THandle; Name, ResType: PWideChar);
-
-  procedure Error;
-  begin
-    raise EResNotFound.CreateFmt(SResNotFound, [Name]);
-  end;
-
-begin
-  HResInfo := FindResourceW(Instance, Name, ResType);
-  if HResInfo = 0 then Error;
-  HGlobal := LoadResource(Instance, HResInfo);
-  if HGlobal = 0 then Error;
-  SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));
-end;
-
-destructor TTntResourceStream.Destroy;
-begin
-  UnlockResource(HGlobal);
-  FreeResource(HGlobal); { Technically this is not necessary (MS KB #193678) }
-  inherited Destroy;
-end;
-
-function TTntResourceStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError));
-end;
-
-procedure TTntResourceStream.SaveToFile(const FileName: WideString);
-var
-  Stream: TStream;
-begin
-  Stream := TTntFileStream.Create(FileName, fmCreate);
-  try
-    SaveToStream(Stream);
-  finally
-    Stream.Free;
-  end;
-end;
-
-{ TAnsiStrings }
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFile(const FileName: WideString);
-var
-  Stream: TStream;
-begin
-  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
-  try
-    LoadFromStream(Stream);
-  finally
-    Stream.Free;
-  end;
-end;
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFile(const FileName: WideString);
-var
-  Stream: TStream;
-begin
-  Stream := TTntFileStream.Create(FileName, fmCreate);
-  try
-    SaveToStream(Stream);
-  finally
-    Stream.Free;
-  end;
-end;
-
-procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);
-var
-  Stream: TStream;
-begin
-  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
-  try
-    LoadFromStreamEx(Stream, CodePage);
-  finally
-    Stream.Free;
-  end;
-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
-    begin
-      Utf8BomPtr := PAnsiChar(UTF8_BOM);
-      Stream.WriteBuffer(Utf8BomPtr^, Length(UTF8_BOM));
-    end;
-    SaveToStreamEx(Stream, CodePage);
-  finally
-    Stream.Free;
-  end;
-end;
-
-{ TAnsiStringsForWideStringsAdapter }
-
-constructor TAnsiStringsForWideStringsAdapter.Create(AWideStrings: TTntStrings; _AdapterCodePage: Cardinal);
-begin
-  inherited Create;
-  FWideStrings := AWideStrings;
-  FAdapterCodePage := _AdapterCodePage;
-end;
-
-function TAnsiStringsForWideStringsAdapter.AdapterCodePage: Cardinal;
-begin
-  if FAdapterCodePage = 0 then
-    Result := TntSystem.DefaultSystemCodePage
-  else
-    Result := FAdapterCodePage;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Clear;
-begin
-  FWideStrings.Clear;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Delete(Index: Integer);
-begin
-  FWideStrings.Delete(Index);
-end;
-
-function TAnsiStringsForWideStringsAdapter.Get(Index: Integer): AnsiString;
-begin
-  Result := WideStringToStringEx(FWideStrings.Get(Index), AdapterCodePage);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Put(Index: Integer; const S: AnsiString);
-begin
-  FWideStrings.Put(Index, StringToWideStringEx(S, AdapterCodePage));
-end;
-
-function TAnsiStringsForWideStringsAdapter.GetCount: Integer;
-begin
-  Result := FWideStrings.GetCount;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.Insert(Index: Integer; const S: AnsiString);
-begin
-  FWideStrings.Insert(Index, StringToWideStringEx(S, AdapterCodePage));
-end;
-
-function TAnsiStringsForWideStringsAdapter.GetObject(Index: Integer): TObject;
-begin
-  Result := FWideStrings.GetObject(Index);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.PutObject(Index: Integer; AObject: TObject);
-begin
-  FWideStrings.PutObject(Index, AObject);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.SetUpdateState(Updating: Boolean);
-begin
-  FWideStrings.SetUpdateState(Updating);
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.LoadFromStreamEx(Stream: TStream; CodePage: Cardinal);
-var
-  Size: Integer;
-  S: AnsiString;
-begin
-  BeginUpdate;
-  try
-    Size := Stream.Size - Stream.Position;
-    SetString(S, nil, Size);
-    Stream.Read(Pointer(S)^, Size);
-    FWideStrings.SetTextStr(StringToWideStringEx(S, CodePage));
-  finally
-    EndUpdate;
-  end;
-end;
-
-procedure TAnsiStringsForWideStringsAdapter.SaveToStreamEx(Stream: TStream; CodePage: Cardinal);
-var
-  S: AnsiString;
-begin
-  S := WideStringToStringEx(FWideStrings.GetTextStr, CodePage);
-  Stream.WriteBuffer(Pointer(S)^, Length(S));
-end;
-
-{ TTntStrings }
-
-constructor TTntStrings.Create;
-begin
-  inherited;
-  FAnsiStrings := TAnsiStringsForWideStringsAdapter.Create(Self);
-  FLastFileCharSet := csUnicode;
-end;
-
-destructor TTntStrings.Destroy;
-begin
-  FreeAndNil(FAnsiStrings);
-  inherited;
-end;
-
-procedure TTntStrings.SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});
-begin
-  FAnsiStrings.Assign(Value);
-end;
-
-procedure TTntStrings.DefineProperties(Filer: TFiler);
-
-  {$IFNDEF COMPILER_7_UP}
-  function DoWrite: Boolean;
-  begin
-    if Filer.Ancestor <> nil then
-    begin
-      Result := True;
-      if Filer.Ancestor is TWideStrings then
-        Result := not Equals(TWideStrings(Filer.Ancestor))
-    end
-    else Result := Count > 0;
-  end;
-
-  function DoWriteAsUTF7: Boolean;
-  var
-    i: integer;
-  begin
-    Result := False;
-    for i := 0 to Count - 1 do begin
-      if (Strings[i] <> '') and (WideStringToUTF8(Strings[i]) <> Strings[i]) then begin
-        Result := True;
-        break; { found a string with non-ASCII chars (> 127) }
-      end;
-    end;
-  end;
-  {$ENDIF}
-
-begin
-  inherited DefineProperties(Filer); { Handles main 'Strings' property.' }
-  Filer.DefineProperty('WideStrings', ReadData, nil, False);
-  Filer.DefineProperty('WideStringsW', ReadDataUTF8, nil, False);
-  {$IFDEF COMPILER_7_UP}
-  Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, False);
-  {$ELSE}
-  Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, DoWrite and DoWriteAsUTF7);
-  {$ENDIF}
-end;
-
-procedure TTntStrings.LoadFromFile(const FileName: WideString);
-var
-  Stream: TStream;
-begin
-  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
-  try
-    FLastFileCharSet := AutoDetectCharacterSet(Stream);
-    Stream.Position := 0;
-    LoadFromStream(Stream);
-  finally
-    Stream.Free;
-  end;
-end;
-
-procedure TTntStrings.LoadFromStream(Stream: TStream);
-begin
-  LoadFromStream_BOM(Stream, True);
-end;
-
-procedure TTntStrings.LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean);
-var
-  DataLeft: Integer;
-  StreamCharSet: TTntStreamCharSet;
-  SW: WideString;
-  SA: AnsiString;
-begin
-  BeginUpdate;
-  try
-    if WithBOM then
-      StreamCharSet := AutoDetectCharacterSet(Stream)
-    else
-      StreamCharSet := csUnicode;
-    DataLeft := Stream.Size - Stream.Position;
-    if (StreamCharSet in [csUnicode, csUnicodeSwapped]) then
-    begin
-      // BOM indicates Unicode text stream
-      if DataLeft < SizeOf(WideChar) then
-        SW := ''
-      else begin
-        SetLength(SW, DataLeft div SizeOf(WideChar));
-        Stream.Read(PWideChar(SW)^, DataLeft);
-        if StreamCharSet = csUnicodeSwapped then
-          StrSwapByteOrder(PWideChar(SW));
-      end;
-      SetTextStr(SW);
-    end
-    else if StreamCharSet = csUtf8 then
-    begin
-      // BOM indicates UTF-8 text stream
-      SetLength(SA, DataLeft div SizeOf(AnsiChar));
-      Stream.Read(PAnsiChar(SA)^, DataLeft);
-      SetTextStr(UTF8ToWideString(SA));
-    end
-    else
-    begin
-      // without byte order mark it is assumed that we are loading ANSI text
-      SetLength(SA, DataLeft div SizeOf(AnsiChar));
-      Stream.Read(PAnsiChar(SA)^, DataLeft);
-      SetTextStr(SA);
-    end;
-  finally
-    EndUpdate;
-  end;
-end;
-
-procedure TTntStrings.ReadData(Reader: TReader);
-begin
-  if Reader.NextValue in [vaString, vaLString] then
-    SetTextStr(Reader.ReadString) {JCL compatiblity}
-  else if Reader.NextValue = vaWString then
-    SetTextStr(Reader.ReadWideString) {JCL compatiblity}
-  else begin
-    BeginUpdate;
-    try
-      Clear;
-      Reader.ReadListBegin;
-      while not Reader.EndOfList do
-        if Reader.NextValue in [vaString, vaLString] then
-          Add(Reader.ReadString) {TStrings compatiblity}
-        else
-          Add(Reader.ReadWideString);
-      Reader.ReadListEnd;
-    finally
-      EndUpdate;
-    end;
-  end;
-end;
-
-procedure TTntStrings.ReadDataUTF7(Reader: TReader);
-begin
-  Reader.ReadListBegin;
-  if ReaderNeedsUtfHelp(Reader) then
-  begin
-    BeginUpdate;
-    try
-      Clear;
-      while not Reader.EndOfList do
-        Add(UTF7ToWideString(Reader.ReadString))
-    finally
-      EndUpdate;
-    end;
-  end else begin
-    while not Reader.EndOfList do
-      Reader.ReadString; { do nothing with Result }
-  end;
-  Reader.ReadListEnd;
-end;
-
-procedure TTntStrings.ReadDataUTF8(Reader: TReader);
-begin
-  Reader.ReadListBegin;
-  if ReaderNeedsUtfHelp(Reader)
-  or (Count = 0){ Legacy support where 'WideStrings' was never written in lieu of WideStringsW }
-  then begin
-    BeginUpdate;
-    try
-      Clear;
-      while not Reader.EndOfList do
-        Add(UTF8ToWideString(Reader.ReadString))
-    finally
-      EndUpdate;
-    end;
-  end else begin
-    while not Reader.EndOfList do
-      Reader.ReadString; { do nothing with Result }
-  end;
-  Reader.ReadListEnd;
-end;
-
-procedure TTntStrings.SaveToFile(const FileName: WideString);
-var
-  Stream: TStream;
-begin
-  Stream := TTntFileStream.Create(FileName, fmCreate);
-  try
-    SaveToStream(Stream);
-  finally
-    Stream.Free;
-  end;
-end;
-
-procedure TTntStrings.SaveToStream(Stream: TStream);
-begin
-  SaveToStream_BOM(Stream, True);
-end;
-
-procedure TTntStrings.SaveToStream_BOM(Stream: TStream; WithBOM: Boolean);
-// Saves the currently loaded text into the given stream.
-// WithBOM determines whether to write a byte order mark or not.
-var
-  SW: WideString;
-  BOM: WideChar;
-begin
-  if WithBOM then begin
-    BOM := UNICODE_BOM;
-    Stream.WriteBuffer(BOM, SizeOf(WideChar));
-  end;
-  SW := GetTextStr;
-  Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar));
-end;
-
-procedure TTntStrings.WriteDataUTF7(Writer: TWriter);
-var
-  I: Integer;
-begin
-  Writer.WriteListBegin;
-  for I := 0 to Count-1 do
-    Writer.WriteString(WideStringToUTF7(Get(I)));
-  Writer.WriteListEnd;
-end;
-
-{ TTntStringList }
-
-destructor TTntStringList.Destroy;
-begin
-  FOnChange := nil;
-  FOnChanging := nil;
-  inherited Destroy;
-  if FCount <> 0 then Finalize(FList^[0], FCount);
-  FCount := 0;
-  SetCapacity(0);
-end;
-
-function TTntStringList.Add(const S: WideString): Integer;
-begin
-  Result := AddObject(S, nil);
-end;
-
-function TTntStringList.AddObject(const S: WideString; AObject: TObject): Integer;
-begin
-  if not Sorted then
-    Result := FCount
-  else
-    if Find(S, Result) then
-      case Duplicates of
-        dupIgnore: Exit;
-        dupError: Error(PResStringRec(@SDuplicateString), 0);
-      end;
-  InsertItem(Result, S, AObject);
-end;
-
-procedure TTntStringList.Changed;
-begin
-  if (not FUpdating) and Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-procedure TTntStringList.Changing;
-begin
-  if (not FUpdating) and Assigned(FOnChanging) then
-    FOnChanging(Self);
-end;
-
-procedure TTntStringList.Clear;
-begin
-  if FCount <> 0 then
-  begin
-    Changing;
-    Finalize(FList^[0], FCount);
-    FCount := 0;
-    SetCapacity(0);
-    Changed;
-  end;
-end;
-
-procedure TTntStringList.Delete(Index: Integer);
-begin
-  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
-  Changing;
-  Finalize(FList^[Index]);
-  Dec(FCount);
-  if Index < FCount then
-    System.Move(FList^[Index + 1], FList^[Index],
-      (FCount - Index) * SizeOf(TWideStringItem));
-  Changed;
-end;
-
-procedure TTntStringList.Exchange(Index1, Index2: Integer);
-begin
-  if (Index1 < 0) or (Index1 >= FCount) then Error(PResStringRec(@SListIndexError), Index1);
-  if (Index2 < 0) or (Index2 >= FCount) then Error(PResStringRec(@SListIndexError), Index2);
-  Changing;
-  ExchangeItems(Index1, Index2);
-  Changed;
-end;
-
-procedure TTntStringList.ExchangeItems(Index1, Index2: Integer);
-var
-  Temp: Integer;
-  Item1, Item2: PWideStringItem;
-begin
-  Item1 := @FList^[Index1];
-  Item2 := @FList^[Index2];
-  Temp := Integer(Item1^.FString);
-  Integer(Item1^.FString) := Integer(Item2^.FString);
-  Integer(Item2^.FString) := Temp;
-  Temp := Integer(Item1^.FObject);
-  Integer(Item1^.FObject) := Integer(Item2^.FObject);
-  Integer(Item2^.FObject) := Temp;
-end;
-
-function TTntStringList.Find(const S: WideString; var Index: Integer): Boolean;
-var
-  L, H, I, C: Integer;
-begin
-  Result := False;
-  L := 0;
-  H := FCount - 1;
-  while L <= H do
-  begin
-    I := (L + H) shr 1;
-    C := CompareStrings(FList^[I].FString, S);
-    if C < 0 then L := I + 1 else
-    begin
-      H := I - 1;
-      if C = 0 then
-      begin
-        Result := True;
-        if Duplicates <> dupAccept then L := I;
-      end;
-    end;
-  end;
-  Index := L;
-end;
-
-function TTntStringList.Get(Index: Integer): WideString;
-begin
-  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
-  Result := FList^[Index].FString;
-end;
-
-function TTntStringList.GetCapacity: Integer;
-begin
-  Result := FCapacity;
-end;
-
-function TTntStringList.GetCount: Integer;
-begin
-  Result := FCount;
-end;
-
-function TTntStringList.GetObject(Index: Integer): TObject;
-begin
-  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
-  Result := FList^[Index].FObject;
-end;
-
-procedure TTntStringList.Grow;
-var
-  Delta: Integer;
-begin
-  if FCapacity > 64 then Delta := FCapacity div 4 else
-    if FCapacity > 8 then Delta := 16 else
-      Delta := 4;
-  SetCapacity(FCapacity + Delta);
-end;
-
-function TTntStringList.IndexOf(const S: WideString): Integer;
-begin
-  if not Sorted then Result := inherited IndexOf(S) else
-    if not Find(S, Result) then Result := -1;
-end;
-
-function TTntStringList.IndexOfName(const Name: WideString): Integer;
-var
-  NameKey: WideString;
-begin
-  if not Sorted then
-    Result := inherited IndexOfName(Name)
-  else begin
-    // use sort to find index more quickly
-    NameKey := Name + NameValueSeparator;
-    Find(NameKey, Result);
-    if (Result < 0) or (Result > Count - 1) then
-      Result := -1
-    else if CompareStrings(NameKey, Copy(Strings[Result], 1, Length(NameKey))) <> 0 then
-      Result := -1
-  end;
-end;
-
-procedure TTntStringList.Insert(Index: Integer; const S: WideString);
-begin
-  InsertObject(Index, S, nil);
-end;
-
-procedure TTntStringList.InsertObject(Index: Integer; const S: WideString;
-  AObject: TObject);
-begin
-  if Sorted then Error(PResStringRec(@SSortedListError), 0);
-  if (Index < 0) or (Index > FCount) then Error(PResStringRec(@SListIndexError), Index);
-  InsertItem(Index, S, AObject);
-end;
-
-procedure TTntStringList.InsertItem(Index: Integer; const S: WideString; AObject: TObject);
-begin
-  Changing;
-  if FCount = FCapacity then Grow;
-  if Index < FCount then
-    System.Move(FList^[Index], FList^[Index + 1],
-      (FCount - Index) * SizeOf(TWideStringItem));
-  with FList^[Index] do
-  begin
-    Pointer(FString) := nil;
-    FObject := AObject;
-    FString := S;
-  end;
-  Inc(FCount);
-  Changed;
-end;
-
-procedure TTntStringList.Put(Index: Integer; const S: WideString);
-begin
-  if Sorted then Error(PResStringRec(@SSortedListError), 0);
-  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
-  Changing;
-  FList^[Index].FString := S;
-  Changed;
-end;
-
-procedure TTntStringList.PutObject(Index: Integer; AObject: TObject);
-begin
-  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);
-  Changing;
-  FList^[Index].FObject := AObject;
-  Changed;
-end;
-
-procedure TTntStringList.QuickSort(L, R: Integer; SCompare: TWideStringListSortCompare);
-var
-  I, J, P: Integer;
-begin
-  repeat
-    I := L;
-    J := R;
-    P := (L + R) shr 1;
-    repeat
-      while SCompare(Self, I, P) < 0 do Inc(I);
-      while SCompare(Self, J, P) > 0 do Dec(J);
-      if I <= J then
-      begin
-        ExchangeItems(I, J);
-        if P = I then
-          P := J
-        else if P = J then
-          P := I;
-        Inc(I);
-        Dec(J);
-      end;
-    until I > J;
-    if L < J then QuickSort(L, J, SCompare);
-    L := I;
-  until I >= R;
-end;
-
-procedure TTntStringList.SetCapacity(NewCapacity: Integer);
-begin
-  ReallocMem(FList, NewCapacity * SizeOf(TWideStringItem));
-  FCapacity := NewCapacity;
-end;
-
-procedure TTntStringList.SetSorted(Value: Boolean);
-begin
-  if FSorted <> Value then
-  begin
-    if Value then Sort;
-    FSorted := Value;
-  end;
-end;
-
-procedure TTntStringList.SetUpdateState(Updating: Boolean);
-begin
-  FUpdating := Updating;
-  if Updating then Changing else Changed;
-end;
-
-function WideStringListCompareStrings(List: TTntStringList; Index1, Index2: Integer): Integer;
-begin
-  Result := List.CompareStrings(List.FList^[Index1].FString,
-                                List.FList^[Index2].FString);
-end;
-
-procedure TTntStringList.Sort;
-begin
-  CustomSort(WideStringListCompareStrings);
-end;
-
-procedure TTntStringList.CustomSort(Compare: TWideStringListSortCompare);
-begin
-  if not Sorted and (FCount > 1) then
-  begin
-    Changing;
-    QuickSort(0, FCount - 1, Compare);
-    Changed;
-  end;
-end;
-
-function TTntStringList.CompareStrings(const S1, S2: WideString): Integer;
-begin
-  if CaseSensitive then
-    Result := WideCompareStr(S1, S2)
-  else
-    Result := WideCompareText(S1, S2);
-end;
-
-procedure TTntStringList.SetCaseSensitive(const Value: Boolean);
-begin
-  if Value <> FCaseSensitive then
-  begin
-    FCaseSensitive := Value;
-    if Sorted then Sort;
-  end;
-end;
-
-//------------------------- TntClasses introduced procs ----------------------------------
-
-function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;
-var
-  ByteOrderMark: WideChar;
-  BytesRead: Integer;
-  Utf8Test: array[0..2] of AnsiChar;
-begin
-  // Byte Order Mark
-  ByteOrderMark := #0;
-  if (Stream.Size - Stream.Position) >= SizeOf(ByteOrderMark) then begin
-    BytesRead := Stream.Read(ByteOrderMark, SizeOf(ByteOrderMark));
-    if (ByteOrderMark <> UNICODE_BOM) and (ByteOrderMark <> UNICODE_BOM_SWAPPED) then begin
-      ByteOrderMark := #0;
-      Stream.Seek(-BytesRead, soFromCurrent);
-      if (Stream.Size - Stream.Position) >= Length(Utf8Test) * SizeOf(AnsiChar) then begin
-        BytesRead := Stream.Read(Utf8Test[0], Length(Utf8Test) * SizeOf(AnsiChar));
-        if Utf8Test <> UTF8_BOM then
-          Stream.Seek(-BytesRead, soFromCurrent);
-      end;
-    end;
-  end;
-  // Test Byte Order Mark
-  if ByteOrderMark = UNICODE_BOM then
-    Result := csUnicode
-  else if ByteOrderMark = UNICODE_BOM_SWAPPED then
-    Result := csUnicodeSwapped
-  else if Utf8Test = UTF8_BOM then
-    Result := csUtf8
-  else
-    Result := csAnsi;
-end;
-
-function FindSortedListByTarget(List: TList; TargetCompare: TListTargetCompare;
-  Target: Pointer; var Index: Integer): Boolean;
-var
-  L, H, I, C: Integer;
-begin
-  Result := False;
-  L := 0;
-  H := List.Count - 1;
-  while L <= H do
-  begin
-    I := (L + H) shr 1;
-    C := TargetCompare(List[i], Target);
-    if C < 0 then L := I + 1 else
-    begin
-      H := I - 1;
-      if C = 0 then
-      begin
-        Result := True;
-        L := I;
-      end;
-    end;
-  end;
-  Index := L;
-end;
-
-function ClassIsRegistered(const clsid: TCLSID): Boolean;
-var
-  OleStr: POleStr;
-  Reg: TRegIniFile;
-  Key, Filename: WideString;
-begin
-  // First, check to see if there is a ProgID.  This will tell if the
-  // control is registered on the machine.  No ProgID, control won't run
-  Result := ProgIDFromCLSID(clsid, OleStr) = S_OK;
-  if not Result then Exit;  //Bail as soon as anything goes wrong.
-
-  // Next, make sure that the file is actually there by rooting it out
-  // of the registry
-  Key := WideFormat('\SOFTWARE\Classes\CLSID\%s', [GUIDToString(clsid)]);
-  Reg := TRegIniFile.Create;
-  try
-    Reg.RootKey := HKEY_LOCAL_MACHINE;
-    Result := Reg.OpenKeyReadOnly(Key);
-    if not Result then Exit; // Bail as soon as anything goes wrong.
-
-    FileName := Reg.ReadString('InProcServer32', '', EmptyStr);
-    if (Filename = EmptyStr) then // try another key for the file name
-    begin
-      FileName := Reg.ReadString('InProcServer', '', EmptyStr);
-    end;
-    Result := Filename <> EmptyStr;
-    if not Result then Exit;
-    Result := WideFileExists(Filename);
-  finally
-    Reg.Free;
-  end;
-end;
-
-{ TBufferedAnsiString }
-
-procedure TBufferedAnsiString.Clear;
-begin
-  LastWriteIndex := 0;
-  if Length(FStringBuffer) > 0 then
-    FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(AnsiChar), 0);
-end;
-
-procedure TBufferedAnsiString.AddChar(const wc: AnsiChar);
-const
-  MIN_GROW_SIZE = 32;
-  MAX_GROW_SIZE = 256;
-var
-  GrowSize: Integer;
-begin
-  Inc(LastWriteIndex);
-  if LastWriteIndex > Length(FStringBuffer) then begin
-    GrowSize := Max(MIN_GROW_SIZE, Length(FStringBuffer));
-    GrowSize := Min(GrowSize, MAX_GROW_SIZE);
-    SetLength(FStringBuffer, Length(FStringBuffer) + GrowSize);
-    FillChar(FStringBuffer[LastWriteIndex], GrowSize * SizeOf(AnsiChar), 0);
-  end;
-  FStringBuffer[LastWriteIndex] := wc;
-end;
-
-procedure TBufferedAnsiString.AddString(const s: AnsiString);
-var
-  LenS: Integer;
-  BlockSize: Integer;
-  AllocSize: Integer;
-begin
-  LenS := Length(s);
-  if LenS > 0 then begin
-    Inc(LastWriteIndex);
-    if LastWriteIndex + LenS - 1 > Length(FStringBuffer) then begin
-      // determine optimum new allocation size
-      BlockSize := Length(FStringBuffer) div 2;
-      if BlockSize < 8 then
-        BlockSize := 8;
-      AllocSize := ((LenS div BlockSize) + 1) * BlockSize;
-      // realloc buffer
-      SetLength(FStringBuffer, Length(FStringBuffer) + AllocSize);
-      FillChar(FStringBuffer[Length(FStringBuffer) - AllocSize + 1], AllocSize * SizeOf(AnsiChar), 0);
-    end;
-    CopyMemory(@FStringBuffer[LastWriteIndex], @s[1], LenS * SizeOf(AnsiChar));
-    Inc(LastWriteIndex, LenS - 1);
-  end;
-end;
-
-procedure TBufferedAnsiString.AddBuffer(Buff: PAnsiChar; Chars: Integer);
-var
-  i: integer;
-begin
-  for i := 1 to Chars do begin
-    if Buff^ = #0 then
-      break;
-    AddChar(Buff^);
-    Inc(Buff);
-  end;
-end;
-
-function TBufferedAnsiString.Value: AnsiString;
-begin
-  Result := PAnsiChar(FStringBuffer);
-end;
-
-function TBufferedAnsiString.BuffPtr: PAnsiChar;
-begin
-  Result := PAnsiChar(FStringBuffer);
-end;
-
-{ TBufferedWideString }
-
-procedure TBufferedWideString.Clear;
-begin
-  LastWriteIndex := 0;
-  if Length(FStringBuffer) > 0 then
-    FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(WideChar), 0);
-end;
-
-procedure TBufferedWideString.AddChar(const wc: WideChar);
-const
-  MIN_GROW_SIZE = 32;
-  MAX_GROW_SIZE = 256;
-var
-  GrowSize: Integer;
-begin
-  Inc(LastWriteIndex);
-  if LastWriteIndex > Length(FStringBuffer) then begin
-    GrowSize := Max(MIN_GROW_SIZE, Length(FStringBuffer));
-    GrowSize := Min(GrowSize, MAX_GROW_SIZE);
-    SetLength(FStringBuffer, Length(FStringBuffer) + GrowSize);
-    FillChar(FStringBuffer[LastWriteIndex], GrowSize * SizeOf(WideChar), 0);
-  end;
-  FStringBuffer[LastWriteIndex] := wc;
-end;
-
-procedure TBufferedWideString.AddString(const s: WideString);
-var
-  i: integer;
-begin
-  for i := 1 to Length(s) do
-    AddChar(s[i]);
-end;
-
-procedure TBufferedWideString.AddBuffer(Buff: PWideChar; Chars: Integer);
-var
-  i: integer;
-begin
-  for i := 1 to Chars do begin
-    if Buff^ = #0 then
-      break;
-    AddChar(Buff^);
-    Inc(Buff);
-  end;
-end;
-
-function TBufferedWideString.Value: WideString;
-begin
-  Result := PWideChar(FStringBuffer);
-end;
-
-function TBufferedWideString.BuffPtr: PWideChar;
-begin
-  Result := PWideChar(FStringBuffer);
-end;
-
-{ TBufferedStreamReader }
-
-constructor TBufferedStreamReader.Create(Stream: TStream; BufferSize: Integer = 1024);
-begin
-  // init stream
-  FStream := Stream;
-  FStreamSize := Stream.Size;
-  // init buffer
-  FBufferSize := BufferSize;
-  SetLength(FBuffer, BufferSize);
-  FBufferStartPosition := -FBufferSize; { out of any useful range }
-  // init virtual position
-  FVirtualPosition := 0;
-end;
-
-function TBufferedStreamReader.Seek(Offset: Integer; Origin: Word): Longint;
-begin
-  case Origin of
-    soFromBeginning: FVirtualPosition := Offset;
-    soFromCurrent:   Inc(FVirtualPosition, Offset);
-    soFromEnd:       FVirtualPosition := FStreamSize + Offset;
-  end;
-  Result := FVirtualPosition;
-end;
-
-procedure TBufferedStreamReader.UpdateBufferFromPosition(StartPos: Integer);
-begin
-  try
-    FStream.Position := StartPos;
-    FStream.Read(FBuffer[0], FBufferSize);
-    FBufferStartPosition := StartPos;
-  except
-    FBufferStartPosition := -FBufferSize; { out of any useful range }
-    raise;
-  end;
-end;
-
-function TBufferedStreamReader.Read(var Buffer; Count: Integer): Longint;
-var
-  BytesLeft: Integer;
-  FirstBufferRead: Integer;
-  StreamDirectRead: Integer;
-  Buf: PAnsiChar;
-begin
-  if (FVirtualPosition >= 0) and (Count >= 0) then
-  begin
-    Result := FStreamSize - FVirtualPosition;
-    if Result > 0 then
-    begin
-      if Result > Count then
-        Result := Count;
-
-      Buf := @Buffer;
-      BytesLeft := Result;
-
-      // try to read what is left in buffer
-      FirstBufferRead := FBufferStartPosition + FBufferSize - FVirtualPosition;
-      if (FirstBufferRead < 0) or (FirstBufferRead > FBufferSize) then
-        FirstBufferRead := 0;
-      FirstBufferRead := Min(FirstBufferRead, Result);
-      if FirstBufferRead > 0 then begin
-        Move(FBuffer[FVirtualPosition - FBufferStartPosition], Buf[0], FirstBufferRead);
-        Dec(BytesLeft, FirstBufferRead);
-      end;
-
-      if BytesLeft > 0 then begin
-        // The first read in buffer was not enough
-        StreamDirectRead := (BytesLeft div FBufferSize) * FBufferSize;
-        FStream.Position := FVirtualPosition + FirstBufferRead;
-        FStream.Read(Buf[FirstBufferRead], StreamDirectRead);
-        Dec(BytesLeft, StreamDirectRead);
-
-        if BytesLeft > 0 then begin
-          // update buffer, and read what is left
-          UpdateBufferFromPosition(FStream.Position);
-          Move(FBuffer[0], Buf[FirstBufferRead + StreamDirectRead], BytesLeft);
-        end;
-      end;
-
-      Inc(FVirtualPosition, Result);
-      Exit;
-    end;
-  end;
-  Result := 0;
-end;
-
-function TBufferedStreamReader.Write(const Buffer; Count: Integer): Longint;
-begin
-  raise ETntInternalError.Create('Internal Error: class can not write.');
-  Result := 0;
-end;
-
-//-------- synced wide string -----------------
-
-function GetSyncedWideString(var WideStr: WideString; const AnsiStr: AnsiString): WideString;
-begin
-  if AnsiString(WideStr) <> (AnsiStr) then begin
-    WideStr := AnsiStr; {AnsiStr changed.  Keep WideStr in sync.}
-  end;
-  Result := WideStr;
-end;
-
-procedure SetSyncedWideString(const Value: WideString; var WideStr: WideString;
-  const AnsiStr: AnsiString; SetAnsiStr: TSetAnsiStrEvent);
-begin
-  if Value <> GetSyncedWideString(WideStr, AnsiStr) then
-  begin
-    if (not WideSameStr(Value, AnsiString(Value))) {unicode chars lost in conversion}
-    and (AnsiStr = AnsiString(Value))  {AnsiStr is not going to change}
-    then begin
-      SetAnsiStr(''); {force the change}
-    end;
-    WideStr := Value;
-    SetAnsiStr(Value);
-  end;
-end;
-
-{ TWideComponentHelper }
-
-function CompareComponentHelperToTarget(Item, Target: Pointer): Integer;
-begin
-  if PtrUInt(TWideComponentHelper(Item).FComponent) < PtrUInt(Target) then
-    Result := -1
-  else if PtrUInt(TWideComponentHelper(Item).FComponent) > PtrUInt(Target) then
-    Result := 1
-  else
-    Result := 0;
-end;
-
-function FindWideComponentHelperIndex(ComponentHelperList: TComponentList; Component: TComponent; var Index: Integer): Boolean;
-begin
-  // find Component in sorted wide caption list (list is sorted by TWideComponentHelper.FComponent)
-  Result := FindSortedListByTarget(ComponentHelperList, CompareComponentHelperToTarget, Component, Index);
-end;
-
-constructor TWideComponentHelper.Create(AOwner: TComponent);
-begin
-  raise ETntInternalError.Create('TNT Internal Error: TWideComponentHelper.Create should never be encountered.');
-end;
-
-constructor TWideComponentHelper.CreateHelper(AOwner: TComponent; ComponentHelperList: TComponentList);
-var
-  Index: Integer;
-begin
-  // don't use direct ownership for memory management
-  inherited Create(nil);
-  FComponent := AOwner;
-  FComponent.FreeNotification(Self);
-
-  // insert into list according to sort
-  FindWideComponentHelperIndex(ComponentHelperList, FComponent, Index);
-  ComponentHelperList.Insert(Index, Self);
-end;
-
-procedure TWideComponentHelper.Notification(AComponent: TComponent; Operation: TOperation);
-begin
-  inherited;
-  if (AComponent = FComponent) and (Operation = opRemove) then begin
-    FComponent := nil;
-    Free;
-  end;
-end;
-
-function FindWideComponentHelper(ComponentHelperList: TComponentList; Component: TComponent): TWideComponentHelper;
-var
-  Index: integer;
-begin
-  if FindWideComponentHelperIndex(ComponentHelperList, Component, Index) then begin
-  	Result := TWideComponentHelper(ComponentHelperList[Index]);
-    Assert(Result.FComponent = Component, 'TNT Internal Error: FindWideComponentHelperIndex failed.');
-  end else
-    Result := nil;
-end;
-
-initialization
-  RuntimeUTFStreaming := False; { Delphi 6 and higher don't need UTF help at runtime. }
-
-end.
+

+{*****************************************************************************}

+{                                                                             }

+{    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 TntClasses;

+

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

+{$INCLUDE TntCompilers.inc}

+

+interface

+

+{ TODO: Consider: TTntRegIniFile, TTntMemIniFile (consider if UTF8 fits into this solution). }

+

+{***********************************************}

+{  WideChar-streaming implemented by Maël Hörz  }

+{***********************************************}

+

+uses

+  Classes, SysUtils, Windows,

+  {$IFNDEF COMPILER_10_UP}

+  TntWideStrings,

+  {$ELSE}

+  WideStrings,

+  {$ENDIF}

+  ActiveX, Contnrs;

+

+// ......... introduced .........

+type

+  TTntStreamCharSet = (csAnsi, csUnicode, csUnicodeSwapped, csUtf8);

+

+function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;

+

+//---------------------------------------------------------------------------------------------

+//                                 Tnt - Classes

+//---------------------------------------------------------------------------------------------

+

+{TNT-WARN ExtractStrings}

+{TNT-WARN LineStart}

+{TNT-WARN TStringStream}   // TODO: Implement a TWideStringStream

+

+// A potential implementation of TWideStringStream can be found at:

+//   http://kdsxml.cvs.sourceforge.net/kdsxml/Global/KDSClasses.pas?revision=1.10&view=markup

+

+procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);

+

+type

+{TNT-WARN TFileStream}

+  TTntFileStream = class(THandleStream)

+  public

+    constructor Create(const FileName: WideString; Mode: Word);

+    destructor Destroy; override;

+  end;

+

+{TNT-WARN TMemoryStream}

+  TTntMemoryStream = class(TMemoryStream{TNT-ALLOW TMemoryStream})

+  public

+    procedure LoadFromFile(const FileName: WideString);

+    procedure SaveToFile(const FileName: WideString);

+  end;

+

+{TNT-WARN TResourceStream}

+  TTntResourceStream = class(TCustomMemoryStream)

+  private

+    HResInfo: HRSRC;

+    HGlobal: THandle;

+    procedure Initialize(Instance: THandle; Name, ResType: PWideChar);

+  public

+    constructor Create(Instance: THandle; const ResName: WideString; ResType: PWideChar);

+    constructor CreateFromID(Instance: THandle; ResID: Word; ResType: PWideChar);

+    destructor Destroy; override;

+    function Write(const Buffer; Count: Longint): Longint; override;

+    procedure SaveToFile(const FileName: WideString);

+  end;

+

+  TTntStrings = class;

+

+{TNT-WARN TAnsiStrings}

+  TAnsiStrings{TNT-ALLOW TAnsiStrings} = class(TStrings{TNT-ALLOW TStrings})

+  public

+    procedure LoadFromFile(const FileName: WideString); reintroduce;

+    procedure SaveToFile(const FileName: WideString); reintroduce;

+    procedure LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);

+    procedure SaveToFileEx(const FileName: WideString; CodePage: Cardinal);

+    procedure LoadFromStreamEx(Stream: TStream; CodePage: Cardinal); virtual; abstract;

+    procedure SaveToStreamEx(Stream: TStream; CodePage: Cardinal); virtual; abstract;

+  end;

+

+  TAnsiStringsForWideStringsAdapter = class(TAnsiStrings{TNT-ALLOW TAnsiStrings})

+  private

+    FWideStrings: TTntStrings;

+    FAdapterCodePage: Cardinal;

+  protected

+    function Get(Index: Integer): AnsiString; override;

+    procedure Put(Index: Integer; const S: AnsiString); override;

+    function GetCount: Integer; override;

+    function GetObject(Index: Integer): TObject; override;

+    procedure PutObject(Index: Integer; AObject: TObject); override;

+    procedure SetUpdateState(Updating: Boolean); override;

+    function AdapterCodePage: Cardinal; dynamic;

+  public

+    constructor Create(AWideStrings: TTntStrings; _AdapterCodePage: Cardinal = 0);

+    procedure Clear; override;

+    procedure Delete(Index: Integer); override;

+    procedure Insert(Index: Integer; const S: AnsiString); override;

+    procedure LoadFromStreamEx(Stream: TStream; CodePage: Cardinal); override;

+    procedure SaveToStreamEx(Stream: TStream; CodePage: Cardinal); override;

+  end;

+

+{TNT-WARN TStrings}

+  TTntStrings = class(TWideStrings)

+  private

+    FLastFileCharSet: TTntStreamCharSet;

+    FAnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings};

+    procedure SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});

+    procedure ReadData(Reader: TReader);

+    procedure ReadDataUTF7(Reader: TReader);

+    procedure ReadDataUTF8(Reader: TReader);

+    procedure WriteDataUTF7(Writer: TWriter);

+  protected

+    procedure DefineProperties(Filer: TFiler); override;

+  public

+    constructor Create;

+    destructor Destroy; override;

+

+    procedure LoadFromFile(const FileName: WideString); override;

+    procedure LoadFromStream(Stream: TStream); override;

+    procedure LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean); virtual;

+

+    procedure SaveToFile(const FileName: WideString); override;

+    procedure SaveToStream(Stream: TStream); override;

+    procedure SaveToStream_BOM(Stream: TStream; WithBOM: Boolean); virtual;

+

+    property LastFileCharSet: TTntStreamCharSet read FLastFileCharSet;

+  published

+    property AnsiStrings: TAnsiStrings{TNT-ALLOW TAnsiStrings} read FAnsiStrings write SetAnsiStrings stored False;

+  end;

+

+{ TTntStringList class }

+

+  TTntStringList = class;

+  TWideStringListSortCompare = function(List: TTntStringList; Index1, Index2: Integer): Integer;

+

+{TNT-WARN TStringList}

+  TTntStringList = class(TTntStrings)

+  private

+    FUpdating: Boolean;

+    FList: PWideStringItemList;

+    FCount: Integer;

+    FCapacity: Integer;

+    FSorted: Boolean;

+    FDuplicates: TDuplicates;

+    FCaseSensitive: Boolean;

+    FOnChange: TNotifyEvent;

+    FOnChanging: TNotifyEvent;

+    procedure ExchangeItems(Index1, Index2: Integer);

+    procedure Grow;

+    procedure QuickSort(L, R: Integer; SCompare: TWideStringListSortCompare);

+    procedure SetSorted(Value: Boolean);

+    procedure SetCaseSensitive(const Value: Boolean);

+  protected

+    procedure Changed; virtual;

+    procedure Changing; virtual;

+    function Get(Index: Integer): WideString; override;

+    function GetCapacity: Integer; override;

+    function GetCount: Integer; override;

+    function GetObject(Index: Integer): TObject; override;

+    procedure Put(Index: Integer; const S: WideString); override;

+    procedure PutObject(Index: Integer; AObject: TObject); override;

+    procedure SetCapacity(NewCapacity: Integer); override;

+    procedure SetUpdateState(Updating: Boolean); override;

+    function CompareStrings(const S1, S2: WideString): Integer; override;

+    procedure InsertItem(Index: Integer; const S: WideString; AObject: TObject); virtual;

+  public

+    destructor Destroy; override;

+    function Add(const S: WideString): Integer; override;

+    function AddObject(const S: WideString; AObject: TObject): Integer; override;

+    procedure Clear; override;

+    procedure Delete(Index: Integer); override;

+    procedure Exchange(Index1, Index2: Integer); override;

+    function Find(const S: WideString; var Index: Integer): Boolean; virtual;

+    function IndexOf(const S: WideString): Integer; override;

+    function IndexOfName(const Name: WideString): Integer; override;

+    procedure Insert(Index: Integer; const S: WideString); override;

+    procedure InsertObject(Index: Integer; const S: WideString;

+      AObject: TObject); override;

+    procedure Sort; virtual;

+    procedure CustomSort(Compare: TWideStringListSortCompare); virtual;

+    property Duplicates: TDuplicates read FDuplicates write FDuplicates;

+    property Sorted: Boolean read FSorted write SetSorted;

+    property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;

+    property OnChange: TNotifyEvent read FOnChange write FOnChange;

+    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;

+  end;

+

+// ......... introduced .........

+type

+  TListTargetCompare = function (Item, Target: Pointer): Integer;

+

+function FindSortedListByTarget(List: TList; TargetCompare: TListTargetCompare;

+  Target: Pointer; var Index: Integer): Boolean;

+

+function ClassIsRegistered(const clsid: TCLSID): Boolean;

+

+var

+  RuntimeUTFStreaming: Boolean;

+

+type

+  TBufferedAnsiString = class(TObject)

+  private

+    FStringBuffer: AnsiString;

+    LastWriteIndex: Integer;

+  public

+    procedure Clear;

+    procedure AddChar(const wc: AnsiChar);

+    procedure AddString(const s: AnsiString);

+    procedure AddBuffer(Buff: PAnsiChar; Chars: Integer);

+    function Value: AnsiString;

+    function BuffPtr: PAnsiChar;

+  end;

+

+  TBufferedWideString = class(TObject)

+  private

+    FStringBuffer: WideString;

+    LastWriteIndex: Integer;

+  public

+    procedure Clear;

+    procedure AddChar(const wc: WideChar);

+    procedure AddString(const s: WideString);

+    procedure AddBuffer(Buff: PWideChar; Chars: Integer);

+    function Value: WideString;

+    function BuffPtr: PWideChar;

+  end;

+

+  TBufferedStreamReader = class(TStream)

+  private

+    FStream: TStream;

+    FStreamSize: Integer;

+    FBuffer: array of Byte;

+    FBufferSize: Integer;

+    FBufferStartPosition: Integer;

+    FVirtualPosition: Integer;

+    procedure UpdateBufferFromPosition(StartPos: Integer);

+  public

+    constructor Create(Stream: TStream; BufferSize: Integer = 1024);

+    function Read(var Buffer; Count: Longint): Longint; override;

+    function Write(const Buffer; Count: Longint): Longint; override;

+    function Seek(Offset: Longint; Origin: Word): Longint; override;

+  end;

+

+// "synced" wide string

+type TSetAnsiStrEvent = procedure(const Value: AnsiString) of object;

+function GetSyncedWideString(var WideStr: WideString; const AnsiStr: AnsiString): WideString;

+procedure SetSyncedWideString(const Value: WideString; var WideStr: WideString;

+  const AnsiStr: AnsiString; SetAnsiStr: TSetAnsiStrEvent);

+

+type

+  TWideComponentHelper = class(TComponent)

+  private

+    FComponent: TComponent;

+  protected

+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

+  public

+    constructor Create(AOwner: TComponent); override;

+    constructor CreateHelper(AOwner: TComponent; ComponentHelperList: TComponentList);

+  end;

+

+function FindWideComponentHelper(ComponentHelperList: TComponentList; Component: TComponent): TWideComponentHelper;

+

+implementation

+

+uses

+  RTLConsts, ComObj, Math,

+  Registry, TypInfo, TntSystem, TntSysUtils;

+

+{ TntPersistent }

+

+//===========================================================================

+//   The Delphi 5 Classes.pas never supported the streaming of WideStrings.

+//   The Delphi 6 Classes.pas supports WideString streaming.  But it's too bad that

+//     the Delphi 6 IDE doesn't use the updated Classes.pas.  Switching between Form/Text

+//       mode corrupts extended characters in WideStrings even under Delphi 6.

+//   Delphi 7 seems to finally get right.  But let's keep the UTF7 support at design time

+//     to enable sharing source code with previous versions of Delphi.

+//

+//   The purpose of this solution is to store WideString properties which contain

+//     non-ASCII chars in the form of UTF7 under the old property name + '_UTF7'.

+//

+//   Special thanks go to Francisco Leong for helping to develop this solution.

+//

+

+{ TTntWideStringPropertyFiler }

+type

+  TTntWideStringPropertyFiler = class

+  private

+    FInstance: TPersistent;

+    FPropInfo: PPropInfo;

+    procedure ReadDataUTF8(Reader: TReader);

+    procedure ReadDataUTF7(Reader: TReader);

+    procedure WriteDataUTF7(Writer: TWriter);

+  public

+    procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);

+  end;

+

+function ReaderNeedsUtfHelp(Reader: TReader): Boolean;

+begin

+  if Reader.Owner = nil then

+    Result := False { designtime - visual form inheritance ancestor }

+  else if csDesigning in Reader.Owner.ComponentState then

+    {$IFDEF COMPILER_7_UP}

+    Result := False { Delphi 7+: designtime - doesn't need UTF help. }

+    {$ELSE}

+    Result := True { Delphi 6: designtime - always needs UTF help. }

+    {$ENDIF}

+  else

+    Result := RuntimeUTFStreaming; { runtime }

+end;

+

+procedure TTntWideStringPropertyFiler.ReadDataUTF8(Reader: TReader);

+begin

+  if ReaderNeedsUtfHelp(Reader) then

+    SetWideStrProp(FInstance, FPropInfo, UTF8ToWideString(Reader.ReadString))

+  else

+    Reader.ReadString; { do nothing with Result }

+end;

+

+procedure TTntWideStringPropertyFiler.ReadDataUTF7(Reader: TReader);

+begin

+  if ReaderNeedsUtfHelp(Reader) then

+    SetWideStrProp(FInstance, FPropInfo, UTF7ToWideString(Reader.ReadString))

+  else

+    Reader.ReadString; { do nothing with Result }

+end;

+

+procedure TTntWideStringPropertyFiler.WriteDataUTF7(Writer: TWriter);

+begin

+  Writer.WriteString(WideStringToUTF7(GetWideStrProp(FInstance, FPropInfo)));

+end;

+

+procedure TTntWideStringPropertyFiler.DefineProperties(Filer: TFiler; Instance: TPersistent;

+  PropName: AnsiString);

+

+  {$IFNDEF COMPILER_7_UP}

+  function HasData: Boolean;

+  var

+    CurrPropValue: WideString;

+  begin

+    // must be stored

+    Result := IsStoredProp(Instance, FPropInfo);

+    if Result

+    and (Filer.Ancestor <> nil)

+    and (GetPropInfo(Filer.Ancestor, PropName, [tkWString]) <> nil) then

+    begin

+      // must be different than ancestor

+      CurrPropValue := GetWideStrProp(Instance, FPropInfo);

+      Result := CurrPropValue <> GetWideStrProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));

+    end;

+    if Result then begin

+      // must be non-blank and different than UTF8 (implies all ASCII <= 127)

+      CurrPropValue := GetWideStrProp(Instance, FPropInfo);

+      Result := (CurrPropValue <> '') and (WideStringToUTF8(CurrPropValue) <> CurrPropValue);

+    end;

+  end;

+  {$ENDIF}

+

+begin

+  FInstance := Instance;

+  FPropInfo := GetPropInfo(Instance, PropName, [tkWString]);

+  if FPropInfo <> nil then begin

+    // must be published (and of type WideString)

+    Filer.DefineProperty(PropName + 'W', ReadDataUTF8, nil, False);

+    {$IFDEF COMPILER_7_UP}

+    Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, False);

+    {$ELSE}

+    Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, HasData);

+    {$ENDIF}

+  end;

+  FInstance := nil;

+  FPropInfo := nil;

+end;

+

+{ TTntWideCharPropertyFiler }

+type

+  TTntWideCharPropertyFiler = class

+  private

+    FInstance: TPersistent;

+    FPropInfo: PPropInfo;

+    {$IFNDEF COMPILER_9_UP}

+    FWriter: TWriter;

+    procedure GetLookupInfo(var Ancestor: TPersistent;

+      var Root, LookupRoot, RootAncestor: TComponent);

+    {$ENDIF}

+    procedure ReadData_W(Reader: TReader);

+    procedure ReadDataUTF7(Reader: TReader);

+    procedure WriteData_W(Writer: TWriter);

+    function ReadChar(Reader: TReader): WideChar;

+  public

+    procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);

+  end;

+

+{$IFNDEF COMPILER_9_UP}

+type

+  TGetLookupInfoEvent = procedure(var Ancestor: TPersistent;

+    var Root, LookupRoot, RootAncestor: TComponent) of object;

+

+function AncestorIsValid(Ancestor: TPersistent; Root, RootAncestor: TComponent): Boolean;

+begin

+  Result := (Ancestor <> nil) and (RootAncestor <> nil) and

+            Root.InheritsFrom(RootAncestor.ClassType);

+end;

+

+function IsDefaultOrdPropertyValue(Instance: TObject; PropInfo: PPropInfo;

+  OnGetLookupInfo: TGetLookupInfoEvent): Boolean;

+var

+  Ancestor: TPersistent;

+  LookupRoot: TComponent;

+  RootAncestor: TComponent;

+  Root: TComponent;

+  AncestorValid: Boolean;

+  Value: Longint;

+  Default: LongInt;

+begin

+  Ancestor := nil;

+  Root := nil;

+  LookupRoot := nil;

+  RootAncestor := nil;

+

+  if Assigned(OnGetLookupInfo) then

+    OnGetLookupInfo(Ancestor, Root, LookupRoot, RootAncestor);

+

+  AncestorValid := AncestorIsValid(Ancestor, Root, RootAncestor);

+

+  Result := True;

+  if (PropInfo^.GetProc <> nil) and (PropInfo^.SetProc <> nil) then

+  begin

+    Value := GetOrdProp(Instance, PropInfo);

+    if AncestorValid then

+      Result := Value = GetOrdProp(Ancestor, PropInfo)

+    else

+    begin

+      Default := PPropInfo(PropInfo)^.Default;

+      Result :=  (Default <> LongInt($80000000)) and (Value = Default);

+    end;

+  end;

+end;

+

+procedure TTntWideCharPropertyFiler.GetLookupInfo(var Ancestor: TPersistent;

+  var Root, LookupRoot, RootAncestor: TComponent);

+begin

+  Ancestor := FWriter.Ancestor;

+  Root := FWriter.Root;

+  LookupRoot := FWriter.LookupRoot;

+  RootAncestor := FWriter.RootAncestor;

+end;

+{$ENDIF}

+

+function TTntWideCharPropertyFiler.ReadChar(Reader: TReader): WideChar;

+var

+  Temp: WideString;

+begin

+  case Reader.NextValue of

+    vaWString:

+      Temp := Reader.ReadWideString;

+    vaString:

+      Temp := Reader.ReadString;

+    else

+      raise EReadError.Create(SInvalidPropertyValue);

+  end;

+

+  if Length(Temp) > 1 then

+    raise EReadError.Create(SInvalidPropertyValue);

+  Result := Temp[1];

+end;

+

+procedure TTntWideCharPropertyFiler.ReadData_W(Reader: TReader);

+begin

+  SetOrdProp(FInstance, FPropInfo, Ord(ReadChar(Reader)));

+end;

+

+procedure TTntWideCharPropertyFiler.ReadDataUTF7(Reader: TReader);

+var

+  S: WideString;

+begin

+  S := UTF7ToWideString(Reader.ReadString);

+  if S = '' then

+    SetOrdProp(FInstance, FPropInfo, 0)

+  else

+    SetOrdProp(FInstance, FPropInfo, Ord(S[1]))

+end;

+

+type TAccessWriter = class(TWriter);

+

+procedure TTntWideCharPropertyFiler.WriteData_W(Writer: TWriter);

+var

+  L: Integer;

+  Temp: WideString;

+{$IFDEF FPC}

+// Workaround: the Buffer parameter of TWriter.Write() must be of a fixed size

+// type for FPC >= 2.4.0. The values vaWString, Ord(vaWString) or Integer(vaWString)

+// are not allowed anymore.

+const

+  vaWStringInt: integer = Ord(vaWString);

+{$ENDIF}

+begin

+  Temp := WideChar(GetOrdProp(FInstance, FPropInfo));

+

+  {$IFNDEF FPC}

+  TAccessWriter(Writer).WriteValue(vaWString);

+  {$ELSE}

+  TAccessWriter(Writer).Write(vaWStringInt, SizeOf(vaWString));

+  {$ENDIF}

+  L := Length(Temp);

+  Writer.Write(L, SizeOf(Integer));

+  Writer.Write(Pointer(@Temp[1])^, L * 2);

+end;

+

+procedure TTntWideCharPropertyFiler.DefineProperties(Filer: TFiler;

+  Instance: TPersistent; PropName: AnsiString);

+

+  {$IFNDEF COMPILER_9_UP}

+  function HasData: Boolean;

+  var

+    CurrPropValue: Integer;

+  begin

+    // must be stored

+    Result := IsStoredProp(Instance, FPropInfo);

+    if Result and (Filer.Ancestor <> nil) and

+      (GetPropInfo(Filer.Ancestor, PropName, [tkWChar]) <> nil) then

+    begin

+      // must be different than ancestor

+      CurrPropValue := GetOrdProp(Instance, FPropInfo);

+      Result := CurrPropValue <> GetOrdProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));

+    end;

+    if Result and (Filer is TWriter) then

+    begin

+      FWriter := TWriter(Filer);

+      Result := not IsDefaultOrdPropertyValue(Instance, FPropInfo, GetLookupInfo);

+    end;

+  end;

+  {$ENDIF}

+

+begin

+  FInstance := Instance;

+  FPropInfo := GetPropInfo(Instance, PropName, [tkWChar]);

+  if FPropInfo <> nil then

+  begin

+    // must be published (and of type WideChar)

+    {$IFDEF COMPILER_9_UP}

+    Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, False);

+    {$ELSE}

+    Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, HasData);

+    {$ENDIF}

+    Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, nil, False);

+  end;

+  FInstance := nil;

+  FPropInfo := nil;

+end;

+

+procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);

+var

+  I, Count: Integer;

+  PropInfo: PPropInfo;

+  PropList: PPropList;

+  WideStringFiler: TTntWideStringPropertyFiler;

+  WideCharFiler: TTntWideCharPropertyFiler;

+begin

+  Count := GetTypeData(Instance.ClassInfo)^.PropCount;

+  if Count > 0 then

+  begin

+    WideStringFiler := TTntWideStringPropertyFiler.Create;

+    try

+      WideCharFiler := TTntWideCharPropertyFiler.Create;

+      try

+        GetMem(PropList, Count * SizeOf(Pointer));

+        try

+          GetPropInfos(Instance.ClassInfo, PropList);

+          for I := 0 to Count - 1 do

+          begin

+            PropInfo := PropList^[I];

+            if (PropInfo = nil) then

+              break;

+            if (PropInfo.PropType^.Kind = tkWString) then

+              WideStringFiler.DefineProperties(Filer, Instance, PropInfo.Name)

+            else if (PropInfo.PropType^.Kind = tkWChar) then

+              WideCharFiler.DefineProperties(Filer, Instance, PropInfo.Name)

+          end;

+        finally

+          FreeMem(PropList, Count * SizeOf(Pointer));

+        end;

+      finally

+        WideCharFiler.Free;

+      end;

+    finally

+      WideStringFiler.Free;

+    end;

+  end;

+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 HAS_SFCREATEERROREX}

+  ErrorMessage: WideString;

+  {$ENDIF}

+begin

+  if Mode = fmCreate then

+  begin

+    CreateHandle := WideFileCreate(FileName);

+    if CreateHandle < 0 then begin

+      {$IFDEF HAS_SFCREATEERROREX}

+      ErrorMessage := WideSysErrorMessage(GetLastError);

+      raise EFCreateError.CreateFmt(SFCreateErrorEx, [WideExpandFileName(FileName), ErrorMessage]);

+      {$ELSE}

+      raise EFCreateError.CreateFmt(SFCreateError, [WideExpandFileName(FileName)]);

+      {$ENDIF}

+    end;

+  end else

+  begin

+    CreateHandle := WideFileOpen(FileName, Mode);

+    if CreateHandle < 0 then begin

+      {$IFDEF HAS_SFCREATEERROREX}

+      ErrorMessage := WideSysErrorMessage(GetLastError);

+      raise EFOpenError.CreateFmt(SFOpenErrorEx, [WideExpandFileName(FileName), ErrorMessage]);

+      {$ELSE}

+      raise EFOpenError.CreateFmt(SFOpenError, [WideExpandFileName(FileName)]);

+      {$ENDIF}

+    end;

+  end;

+  inherited Create(CreateHandle);

+end;

+

+destructor TTntFileStream.Destroy;

+begin

+  if Handle >= 0 then FileClose(Handle);

+end;

+

+{ TTntMemoryStream }

+

+procedure TTntMemoryStream.LoadFromFile(const FileName: WideString);

+var

+  Stream: TStream;

+begin

+  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

+  try

+    LoadFromStream(Stream);

+  finally

+    Stream.Free;

+  end;

+end;

+

+procedure TTntMemoryStream.SaveToFile(const FileName: WideString);

+var

+  Stream: TStream;

+begin

+  Stream := TTntFileStream.Create(FileName, fmCreate);

+  try

+    SaveToStream(Stream);

+  finally

+    Stream.Free;

+  end;

+end;

+

+{ TTntResourceStream }

+

+constructor TTntResourceStream.Create(Instance: THandle; const ResName: WideString;

+  ResType: PWideChar);

+begin

+  inherited Create;

+  Initialize(Instance, PWideChar(ResName), ResType);

+end;

+

+constructor TTntResourceStream.CreateFromID(Instance: THandle; ResID: Word;

+  ResType: PWideChar);

+begin

+  inherited Create;

+  Initialize(Instance, PWideChar(ResID), ResType);

+end;

+

+procedure TTntResourceStream.Initialize(Instance: THandle; Name, ResType: PWideChar);

+

+  procedure Error;

+  begin

+    raise EResNotFound.CreateFmt(SResNotFound, [Name]);

+  end;

+

+begin

+  HResInfo := FindResourceW(Instance, Name, ResType);

+  if HResInfo = 0 then Error;

+  HGlobal := LoadResource(Instance, HResInfo);

+  if HGlobal = 0 then Error;

+  SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));

+end;

+

+destructor TTntResourceStream.Destroy;

+begin

+  UnlockResource(HGlobal);

+  FreeResource(HGlobal); { Technically this is not necessary (MS KB #193678) }

+  inherited Destroy;

+end;

+

+function TTntResourceStream.Write(const Buffer; Count: Longint): Longint;

+begin

+  raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError));

+end;

+

+procedure TTntResourceStream.SaveToFile(const FileName: WideString);

+var

+  Stream: TStream;

+begin

+  Stream := TTntFileStream.Create(FileName, fmCreate);

+  try

+    SaveToStream(Stream);

+  finally

+    Stream.Free;

+  end;

+end;

+

+{ TAnsiStrings }

+

+procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFile(const FileName: WideString);

+var

+  Stream: TStream;

+begin

+  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

+  try

+    LoadFromStream(Stream);

+  finally

+    Stream.Free;

+  end;

+end;

+

+procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFile(const FileName: WideString);

+var

+  Stream: TStream;

+begin

+  Stream := TTntFileStream.Create(FileName, fmCreate);

+  try

+    SaveToStream(Stream);

+  finally

+    Stream.Free;

+  end;

+end;

+

+procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);

+var

+  Stream: TStream;

+begin

+  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

+  try

+    LoadFromStreamEx(Stream, CodePage);

+  finally

+    Stream.Free;

+  end;

+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

+    begin

+      Utf8BomPtr := PAnsiChar(UTF8_BOM);

+      Stream.WriteBuffer(Utf8BomPtr^, Length(UTF8_BOM));

+    end;

+    SaveToStreamEx(Stream, CodePage);

+  finally

+    Stream.Free;

+  end;

+end;

+

+{ TAnsiStringsForWideStringsAdapter }

+

+constructor TAnsiStringsForWideStringsAdapter.Create(AWideStrings: TTntStrings; _AdapterCodePage: Cardinal);

+begin

+  inherited Create;

+  FWideStrings := AWideStrings;

+  FAdapterCodePage := _AdapterCodePage;

+end;

+

+function TAnsiStringsForWideStringsAdapter.AdapterCodePage: Cardinal;

+begin

+  if FAdapterCodePage = 0 then

+    Result := TntSystem.DefaultSystemCodePage

+  else

+    Result := FAdapterCodePage;

+end;

+

+procedure TAnsiStringsForWideStringsAdapter.Clear;

+begin

+  FWideStrings.Clear;

+end;

+

+procedure TAnsiStringsForWideStringsAdapter.Delete(Index: Integer);

+begin

+  FWideStrings.Delete(Index);

+end;

+

+function TAnsiStringsForWideStringsAdapter.Get(Index: Integer): AnsiString;

+begin

+  Result := WideStringToStringEx(FWideStrings.Get(Index), AdapterCodePage);

+end;

+

+procedure TAnsiStringsForWideStringsAdapter.Put(Index: Integer; const S: AnsiString);

+begin

+  FWideStrings.Put(Index, StringToWideStringEx(S, AdapterCodePage));

+end;

+

+function TAnsiStringsForWideStringsAdapter.GetCount: Integer;

+begin

+  Result := FWideStrings.GetCount;

+end;

+

+procedure TAnsiStringsForWideStringsAdapter.Insert(Index: Integer; const S: AnsiString);

+begin

+  FWideStrings.Insert(Index, StringToWideStringEx(S, AdapterCodePage));

+end;

+

+function TAnsiStringsForWideStringsAdapter.GetObject(Index: Integer): TObject;

+begin

+  Result := FWideStrings.GetObject(Index);

+end;

+

+procedure TAnsiStringsForWideStringsAdapter.PutObject(Index: Integer; AObject: TObject);

+begin

+  FWideStrings.PutObject(Index, AObject);

+end;

+

+procedure TAnsiStringsForWideStringsAdapter.SetUpdateState(Updating: Boolean);

+begin

+  FWideStrings.SetUpdateState(Updating);

+end;

+

+procedure TAnsiStringsForWideStringsAdapter.LoadFromStreamEx(Stream: TStream; CodePage: Cardinal);

+var

+  Size: Integer;

+  S: AnsiString;

+begin

+  BeginUpdate;

+  try

+    Size := Stream.Size - Stream.Position;

+    SetString(S, nil, Size);

+    Stream.Read(Pointer(S)^, Size);

+    FWideStrings.SetTextStr(StringToWideStringEx(S, CodePage));

+  finally

+    EndUpdate;

+  end;

+end;

+

+procedure TAnsiStringsForWideStringsAdapter.SaveToStreamEx(Stream: TStream; CodePage: Cardinal);

+var

+  S: AnsiString;

+begin

+  S := WideStringToStringEx(FWideStrings.GetTextStr, CodePage);

+  Stream.WriteBuffer(Pointer(S)^, Length(S));

+end;

+

+{ TTntStrings }

+

+constructor TTntStrings.Create;

+begin

+  inherited;

+  FAnsiStrings := TAnsiStringsForWideStringsAdapter.Create(Self);

+  FLastFileCharSet := csUnicode;

+end;

+

+destructor TTntStrings.Destroy;

+begin

+  FreeAndNil(FAnsiStrings);

+  inherited;

+end;

+

+procedure TTntStrings.SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});

+begin

+  FAnsiStrings.Assign(Value);

+end;

+

+procedure TTntStrings.DefineProperties(Filer: TFiler);

+

+  {$IFNDEF COMPILER_7_UP}

+  function DoWrite: Boolean;

+  begin

+    if Filer.Ancestor <> nil then

+    begin

+      Result := True;

+      if Filer.Ancestor is TWideStrings then

+        Result := not Equals(TWideStrings(Filer.Ancestor))

+    end

+    else Result := Count > 0;

+  end;

+

+  function DoWriteAsUTF7: Boolean;

+  var

+    i: integer;

+  begin

+    Result := False;

+    for i := 0 to Count - 1 do begin

+      if (Strings[i] <> '') and (WideStringToUTF8(Strings[i]) <> Strings[i]) then begin

+        Result := True;

+        break; { found a string with non-ASCII chars (> 127) }

+      end;

+    end;

+  end;

+  {$ENDIF}

+

+begin

+  inherited DefineProperties(Filer); { Handles main 'Strings' property.' }

+  Filer.DefineProperty('WideStrings', ReadData, nil, False);

+  Filer.DefineProperty('WideStringsW', ReadDataUTF8, nil, False);

+  {$IFDEF COMPILER_7_UP}

+  Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, False);

+  {$ELSE}

+  Filer.DefineProperty('WideStrings_UTF7', ReadDataUTF7, WriteDataUTF7, DoWrite and DoWriteAsUTF7);

+  {$ENDIF}

+end;

+

+procedure TTntStrings.LoadFromFile(const FileName: WideString);

+var

+  Stream: TStream;

+begin

+  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

+  try

+    FLastFileCharSet := AutoDetectCharacterSet(Stream);

+    Stream.Position := 0;

+    LoadFromStream(Stream);

+  finally

+    Stream.Free;

+  end;

+end;

+

+procedure TTntStrings.LoadFromStream(Stream: TStream);

+begin

+  LoadFromStream_BOM(Stream, True);

+end;

+

+procedure TTntStrings.LoadFromStream_BOM(Stream: TStream; WithBOM: Boolean);

+var

+  DataLeft: Integer;

+  StreamCharSet: TTntStreamCharSet;

+  SW: WideString;

+  SA: AnsiString;

+begin

+  BeginUpdate;

+  try

+    if WithBOM then

+      StreamCharSet := AutoDetectCharacterSet(Stream)

+    else

+      StreamCharSet := csUnicode;

+    DataLeft := Stream.Size - Stream.Position;

+    if (StreamCharSet in [csUnicode, csUnicodeSwapped]) then

+    begin

+      // BOM indicates Unicode text stream

+      if DataLeft < SizeOf(WideChar) then

+        SW := ''

+      else begin

+        SetLength(SW, DataLeft div SizeOf(WideChar));

+        Stream.Read(PWideChar(SW)^, DataLeft);

+        if StreamCharSet = csUnicodeSwapped then

+          StrSwapByteOrder(PWideChar(SW));

+      end;

+      SetTextStr(SW);

+    end

+    else if StreamCharSet = csUtf8 then

+    begin

+      // BOM indicates UTF-8 text stream

+      SetLength(SA, DataLeft div SizeOf(AnsiChar));

+      Stream.Read(PAnsiChar(SA)^, DataLeft);

+      SetTextStr(UTF8ToWideString(SA));

+    end

+    else

+    begin

+      // without byte order mark it is assumed that we are loading ANSI text

+      SetLength(SA, DataLeft div SizeOf(AnsiChar));

+      Stream.Read(PAnsiChar(SA)^, DataLeft);

+      SetTextStr(SA);

+    end;

+  finally

+    EndUpdate;

+  end;

+end;

+

+procedure TTntStrings.ReadData(Reader: TReader);

+begin

+  if Reader.NextValue in [vaString, vaLString] then

+    SetTextStr(Reader.ReadString) {JCL compatiblity}

+  else if Reader.NextValue = vaWString then

+    SetTextStr(Reader.ReadWideString) {JCL compatiblity}

+  else begin

+    BeginUpdate;

+    try

+      Clear;

+      Reader.ReadListBegin;

+      while not Reader.EndOfList do

+        if Reader.NextValue in [vaString, vaLString] then

+          Add(Reader.ReadString) {TStrings compatiblity}

+        else

+          Add(Reader.ReadWideString);

+      Reader.ReadListEnd;

+    finally

+      EndUpdate;

+    end;

+  end;

+end;

+

+procedure TTntStrings.ReadDataUTF7(Reader: TReader);

+begin

+  Reader.ReadListBegin;

+  if ReaderNeedsUtfHelp(Reader) then

+  begin

+    BeginUpdate;

+    try

+      Clear;

+      while not Reader.EndOfList do

+        Add(UTF7ToWideString(Reader.ReadString))

+    finally

+      EndUpdate;

+    end;

+  end else begin

+    while not Reader.EndOfList do

+      Reader.ReadString; { do nothing with Result }

+  end;

+  Reader.ReadListEnd;

+end;

+

+procedure TTntStrings.ReadDataUTF8(Reader: TReader);

+begin

+  Reader.ReadListBegin;

+  if ReaderNeedsUtfHelp(Reader)

+  or (Count = 0){ Legacy support where 'WideStrings' was never written in lieu of WideStringsW }

+  then begin

+    BeginUpdate;

+    try

+      Clear;

+      while not Reader.EndOfList do

+        Add(UTF8ToWideString(Reader.ReadString))

+    finally

+      EndUpdate;

+    end;

+  end else begin

+    while not Reader.EndOfList do

+      Reader.ReadString; { do nothing with Result }

+  end;

+  Reader.ReadListEnd;

+end;

+

+procedure TTntStrings.SaveToFile(const FileName: WideString);

+var

+  Stream: TStream;

+begin

+  Stream := TTntFileStream.Create(FileName, fmCreate);

+  try

+    SaveToStream(Stream);

+  finally

+    Stream.Free;

+  end;

+end;

+

+procedure TTntStrings.SaveToStream(Stream: TStream);

+begin

+  SaveToStream_BOM(Stream, True);

+end;

+

+procedure TTntStrings.SaveToStream_BOM(Stream: TStream; WithBOM: Boolean);

+// Saves the currently loaded text into the given stream.

+// WithBOM determines whether to write a byte order mark or not.

+var

+  SW: WideString;

+  BOM: WideChar;

+begin

+  if WithBOM then begin

+    BOM := UNICODE_BOM;

+    Stream.WriteBuffer(BOM, SizeOf(WideChar));

+  end;

+  SW := GetTextStr;

+  Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar));

+end;

+

+procedure TTntStrings.WriteDataUTF7(Writer: TWriter);

+var

+  I: Integer;

+begin

+  Writer.WriteListBegin;

+  for I := 0 to Count-1 do

+    Writer.WriteString(WideStringToUTF7(Get(I)));

+  Writer.WriteListEnd;

+end;

+

+{ TTntStringList }

+

+destructor TTntStringList.Destroy;

+begin

+  FOnChange := nil;

+  FOnChanging := nil;

+  inherited Destroy;

+  if FCount <> 0 then Finalize(FList^[0], FCount);

+  FCount := 0;

+  SetCapacity(0);

+end;

+

+function TTntStringList.Add(const S: WideString): Integer;

+begin

+  Result := AddObject(S, nil);

+end;

+

+function TTntStringList.AddObject(const S: WideString; AObject: TObject): Integer;

+begin

+  if not Sorted then

+    Result := FCount

+  else

+    if Find(S, Result) then

+      case Duplicates of

+        dupIgnore: Exit;

+        dupError: Error(PResStringRec(@SDuplicateString), 0);

+      end;

+  InsertItem(Result, S, AObject);

+end;

+

+procedure TTntStringList.Changed;

+begin

+  if (not FUpdating) and Assigned(FOnChange) then

+    FOnChange(Self);

+end;

+

+procedure TTntStringList.Changing;

+begin

+  if (not FUpdating) and Assigned(FOnChanging) then

+    FOnChanging(Self);

+end;

+

+procedure TTntStringList.Clear;

+begin

+  if FCount <> 0 then

+  begin

+    Changing;

+    Finalize(FList^[0], FCount);

+    FCount := 0;

+    SetCapacity(0);

+    Changed;

+  end;

+end;

+

+procedure TTntStringList.Delete(Index: Integer);

+begin

+  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);

+  Changing;

+  Finalize(FList^[Index]);

+  Dec(FCount);

+  if Index < FCount then

+    System.Move(FList^[Index + 1], FList^[Index],

+      (FCount - Index) * SizeOf(TWideStringItem));

+  Changed;

+end;

+

+procedure TTntStringList.Exchange(Index1, Index2: Integer);

+begin

+  if (Index1 < 0) or (Index1 >= FCount) then Error(PResStringRec(@SListIndexError), Index1);

+  if (Index2 < 0) or (Index2 >= FCount) then Error(PResStringRec(@SListIndexError), Index2);

+  Changing;

+  ExchangeItems(Index1, Index2);

+  Changed;

+end;

+

+procedure TTntStringList.ExchangeItems(Index1, Index2: Integer);

+var

+  Temp: Integer;

+  Item1, Item2: PWideStringItem;

+begin

+  Item1 := @FList^[Index1];

+  Item2 := @FList^[Index2];

+  Temp := Integer(Item1^.FString);

+  Integer(Item1^.FString) := Integer(Item2^.FString);

+  Integer(Item2^.FString) := Temp;

+  Temp := Integer(Item1^.FObject);

+  Integer(Item1^.FObject) := Integer(Item2^.FObject);

+  Integer(Item2^.FObject) := Temp;

+end;

+

+function TTntStringList.Find(const S: WideString; var Index: Integer): Boolean;

+var

+  L, H, I, C: Integer;

+begin

+  Result := False;

+  L := 0;

+  H := FCount - 1;

+  while L <= H do

+  begin

+    I := (L + H) shr 1;

+    C := CompareStrings(FList^[I].FString, S);

+    if C < 0 then L := I + 1 else

+    begin

+      H := I - 1;

+      if C = 0 then

+      begin

+        Result := True;

+        if Duplicates <> dupAccept then L := I;

+      end;

+    end;

+  end;

+  Index := L;

+end;

+

+function TTntStringList.Get(Index: Integer): WideString;

+begin

+  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);

+  Result := FList^[Index].FString;

+end;

+

+function TTntStringList.GetCapacity: Integer;

+begin

+  Result := FCapacity;

+end;

+

+function TTntStringList.GetCount: Integer;

+begin

+  Result := FCount;

+end;

+

+function TTntStringList.GetObject(Index: Integer): TObject;

+begin

+  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);

+  Result := FList^[Index].FObject;

+end;

+

+procedure TTntStringList.Grow;

+var

+  Delta: Integer;

+begin

+  if FCapacity > 64 then Delta := FCapacity div 4 else

+    if FCapacity > 8 then Delta := 16 else

+      Delta := 4;

+  SetCapacity(FCapacity + Delta);

+end;

+

+function TTntStringList.IndexOf(const S: WideString): Integer;

+begin

+  if not Sorted then Result := inherited IndexOf(S) else

+    if not Find(S, Result) then Result := -1;

+end;

+

+function TTntStringList.IndexOfName(const Name: WideString): Integer;

+var

+  NameKey: WideString;

+begin

+  if not Sorted then

+    Result := inherited IndexOfName(Name)

+  else begin

+    // use sort to find index more quickly

+    NameKey := Name + NameValueSeparator;

+    Find(NameKey, Result);

+    if (Result < 0) or (Result > Count - 1) then

+      Result := -1

+    else if CompareStrings(NameKey, Copy(Strings[Result], 1, Length(NameKey))) <> 0 then

+      Result := -1

+  end;

+end;

+

+procedure TTntStringList.Insert(Index: Integer; const S: WideString);

+begin

+  InsertObject(Index, S, nil);

+end;

+

+procedure TTntStringList.InsertObject(Index: Integer; const S: WideString;

+  AObject: TObject);

+begin

+  if Sorted then Error(PResStringRec(@SSortedListError), 0);

+  if (Index < 0) or (Index > FCount) then Error(PResStringRec(@SListIndexError), Index);

+  InsertItem(Index, S, AObject);

+end;

+

+procedure TTntStringList.InsertItem(Index: Integer; const S: WideString; AObject: TObject);

+begin

+  Changing;

+  if FCount = FCapacity then Grow;

+  if Index < FCount then

+    System.Move(FList^[Index], FList^[Index + 1],

+      (FCount - Index) * SizeOf(TWideStringItem));

+  with FList^[Index] do

+  begin

+    Pointer(FString) := nil;

+    FObject := AObject;

+    FString := S;

+  end;

+  Inc(FCount);

+  Changed;

+end;

+

+procedure TTntStringList.Put(Index: Integer; const S: WideString);

+begin

+  if Sorted then Error(PResStringRec(@SSortedListError), 0);

+  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);

+  Changing;

+  FList^[Index].FString := S;

+  Changed;

+end;

+

+procedure TTntStringList.PutObject(Index: Integer; AObject: TObject);

+begin

+  if (Index < 0) or (Index >= FCount) then Error(PResStringRec(@SListIndexError), Index);

+  Changing;

+  FList^[Index].FObject := AObject;

+  Changed;

+end;

+

+procedure TTntStringList.QuickSort(L, R: Integer; SCompare: TWideStringListSortCompare);

+var

+  I, J, P: Integer;

+begin

+  repeat

+    I := L;

+    J := R;

+    P := (L + R) shr 1;

+    repeat

+      while SCompare(Self, I, P) < 0 do Inc(I);

+      while SCompare(Self, J, P) > 0 do Dec(J);

+      if I <= J then

+      begin

+        ExchangeItems(I, J);

+        if P = I then

+          P := J

+        else if P = J then

+          P := I;

+        Inc(I);

+        Dec(J);

+      end;

+    until I > J;

+    if L < J then QuickSort(L, J, SCompare);

+    L := I;

+  until I >= R;

+end;

+

+procedure TTntStringList.SetCapacity(NewCapacity: Integer);

+begin

+  ReallocMem(FList, NewCapacity * SizeOf(TWideStringItem));

+  FCapacity := NewCapacity;

+end;

+

+procedure TTntStringList.SetSorted(Value: Boolean);

+begin

+  if FSorted <> Value then

+  begin

+    if Value then Sort;

+    FSorted := Value;

+  end;

+end;

+

+procedure TTntStringList.SetUpdateState(Updating: Boolean);

+begin

+  FUpdating := Updating;

+  if Updating then Changing else Changed;

+end;

+

+function WideStringListCompareStrings(List: TTntStringList; Index1, Index2: Integer): Integer;

+begin

+  Result := List.CompareStrings(List.FList^[Index1].FString,

+                                List.FList^[Index2].FString);

+end;

+

+procedure TTntStringList.Sort;

+begin

+  CustomSort(WideStringListCompareStrings);

+end;

+

+procedure TTntStringList.CustomSort(Compare: TWideStringListSortCompare);

+begin

+  if not Sorted and (FCount > 1) then

+  begin

+    Changing;

+    QuickSort(0, FCount - 1, Compare);

+    Changed;

+  end;

+end;

+

+function TTntStringList.CompareStrings(const S1, S2: WideString): Integer;

+begin

+  if CaseSensitive then

+    Result := WideCompareStr(S1, S2)

+  else

+    Result := WideCompareText(S1, S2);

+end;

+

+procedure TTntStringList.SetCaseSensitive(const Value: Boolean);

+begin

+  if Value <> FCaseSensitive then

+  begin

+    FCaseSensitive := Value;

+    if Sorted then Sort;

+  end;

+end;

+

+//------------------------- TntClasses introduced procs ----------------------------------

+

+function AutoDetectCharacterSet(Stream: TStream): TTntStreamCharSet;

+var

+  ByteOrderMark: WideChar;

+  BytesRead: Integer;

+  Utf8Test: array[0..2] of AnsiChar;

+begin

+  // Byte Order Mark

+  ByteOrderMark := #0;

+  if (Stream.Size - Stream.Position) >= SizeOf(ByteOrderMark) then begin

+    BytesRead := Stream.Read(ByteOrderMark, SizeOf(ByteOrderMark));

+    if (ByteOrderMark <> UNICODE_BOM) and (ByteOrderMark <> UNICODE_BOM_SWAPPED) then begin

+      ByteOrderMark := #0;

+      Stream.Seek(-BytesRead, soFromCurrent);

+      if (Stream.Size - Stream.Position) >= Length(Utf8Test) * SizeOf(AnsiChar) then begin

+        BytesRead := Stream.Read(Utf8Test[0], Length(Utf8Test) * SizeOf(AnsiChar));

+        if Utf8Test <> UTF8_BOM then

+          Stream.Seek(-BytesRead, soFromCurrent);

+      end;

+    end;

+  end;

+  // Test Byte Order Mark

+  if ByteOrderMark = UNICODE_BOM then

+    Result := csUnicode

+  else if ByteOrderMark = UNICODE_BOM_SWAPPED then

+    Result := csUnicodeSwapped

+  else if Utf8Test = UTF8_BOM then

+    Result := csUtf8

+  else

+    Result := csAnsi;

+end;

+

+function FindSortedListByTarget(List: TList; TargetCompare: TListTargetCompare;

+  Target: Pointer; var Index: Integer): Boolean;

+var

+  L, H, I, C: Integer;

+begin

+  Result := False;

+  L := 0;

+  H := List.Count - 1;

+  while L <= H do

+  begin

+    I := (L + H) shr 1;

+    C := TargetCompare(List[i], Target);

+    if C < 0 then L := I + 1 else

+    begin

+      H := I - 1;

+      if C = 0 then

+      begin

+        Result := True;

+        L := I;

+      end;

+    end;

+  end;

+  Index := L;

+end;

+

+function ClassIsRegistered(const clsid: TCLSID): Boolean;

+var

+  OleStr: POleStr;

+  Reg: TRegIniFile;

+  Key, Filename: WideString;

+begin

+  // First, check to see if there is a ProgID.  This will tell if the

+  // control is registered on the machine.  No ProgID, control won't run

+  Result := ProgIDFromCLSID(clsid, OleStr) = S_OK;

+  if not Result then Exit;  //Bail as soon as anything goes wrong.

+

+  // Next, make sure that the file is actually there by rooting it out

+  // of the registry

+  Key := WideFormat('\SOFTWARE\Classes\CLSID\%s', [GUIDToString(clsid)]);

+  Reg := TRegIniFile.Create;

+  try

+    Reg.RootKey := HKEY_LOCAL_MACHINE;

+    Result := Reg.OpenKeyReadOnly(Key);

+    if not Result then Exit; // Bail as soon as anything goes wrong.

+

+    FileName := Reg.ReadString('InProcServer32', '', EmptyStr);

+    if (Filename = EmptyStr) then // try another key for the file name

+    begin

+      FileName := Reg.ReadString('InProcServer', '', EmptyStr);

+    end;

+    Result := Filename <> EmptyStr;

+    if not Result then Exit;

+    Result := WideFileExists(Filename);

+  finally

+    Reg.Free;

+  end;

+end;

+

+{ TBufferedAnsiString }

+

+procedure TBufferedAnsiString.Clear;

+begin

+  LastWriteIndex := 0;

+  if Length(FStringBuffer) > 0 then

+    FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(AnsiChar), 0);

+end;

+

+procedure TBufferedAnsiString.AddChar(const wc: AnsiChar);

+const

+  MIN_GROW_SIZE = 32;

+  MAX_GROW_SIZE = 256;

+var

+  GrowSize: Integer;

+begin

+  Inc(LastWriteIndex);

+  if LastWriteIndex > Length(FStringBuffer) then begin

+    GrowSize := Max(MIN_GROW_SIZE, Length(FStringBuffer));

+    GrowSize := Min(GrowSize, MAX_GROW_SIZE);

+    SetLength(FStringBuffer, Length(FStringBuffer) + GrowSize);

+    FillChar(FStringBuffer[LastWriteIndex], GrowSize * SizeOf(AnsiChar), 0);

+  end;

+  FStringBuffer[LastWriteIndex] := wc;

+end;

+

+procedure TBufferedAnsiString.AddString(const s: AnsiString);

+var

+  LenS: Integer;

+  BlockSize: Integer;

+  AllocSize: Integer;

+begin

+  LenS := Length(s);

+  if LenS > 0 then begin

+    Inc(LastWriteIndex);

+    if LastWriteIndex + LenS - 1 > Length(FStringBuffer) then begin

+      // determine optimum new allocation size

+      BlockSize := Length(FStringBuffer) div 2;

+      if BlockSize < 8 then

+        BlockSize := 8;

+      AllocSize := ((LenS div BlockSize) + 1) * BlockSize;

+      // realloc buffer

+      SetLength(FStringBuffer, Length(FStringBuffer) + AllocSize);

+      FillChar(FStringBuffer[Length(FStringBuffer) - AllocSize + 1], AllocSize * SizeOf(AnsiChar), 0);

+    end;

+    CopyMemory(@FStringBuffer[LastWriteIndex], @s[1], LenS * SizeOf(AnsiChar));

+    Inc(LastWriteIndex, LenS - 1);

+  end;

+end;

+

+procedure TBufferedAnsiString.AddBuffer(Buff: PAnsiChar; Chars: Integer);

+var

+  i: integer;

+begin

+  for i := 1 to Chars do begin

+    if Buff^ = #0 then

+      break;

+    AddChar(Buff^);

+    Inc(Buff);

+  end;

+end;

+

+function TBufferedAnsiString.Value: AnsiString;

+begin

+  Result := PAnsiChar(FStringBuffer);

+end;

+

+function TBufferedAnsiString.BuffPtr: PAnsiChar;

+begin

+  Result := PAnsiChar(FStringBuffer);

+end;

+

+{ TBufferedWideString }

+

+procedure TBufferedWideString.Clear;

+begin

+  LastWriteIndex := 0;

+  if Length(FStringBuffer) > 0 then

+    FillChar(FStringBuffer[1], Length(FStringBuffer) * SizeOf(WideChar), 0);

+end;

+

+procedure TBufferedWideString.AddChar(const wc: WideChar);

+const

+  MIN_GROW_SIZE = 32;

+  MAX_GROW_SIZE = 256;

+var

+  GrowSize: Integer;

+begin

+  Inc(LastWriteIndex);

+  if LastWriteIndex > Length(FStringBuffer) then begin

+    GrowSize := Max(MIN_GROW_SIZE, Length(FStringBuffer));

+    GrowSize := Min(GrowSize, MAX_GROW_SIZE);

+    SetLength(FStringBuffer, Length(FStringBuffer) + GrowSize);

+    FillChar(FStringBuffer[LastWriteIndex], GrowSize * SizeOf(WideChar), 0);

+  end;

+  FStringBuffer[LastWriteIndex] := wc;

+end;

+

+procedure TBufferedWideString.AddString(const s: WideString);

+var

+  i: integer;

+begin

+  for i := 1 to Length(s) do

+    AddChar(s[i]);

+end;

+

+procedure TBufferedWideString.AddBuffer(Buff: PWideChar; Chars: Integer);

+var

+  i: integer;

+begin

+  for i := 1 to Chars do begin

+    if Buff^ = #0 then

+      break;

+    AddChar(Buff^);

+    Inc(Buff);

+  end;

+end;

+

+function TBufferedWideString.Value: WideString;

+begin

+  Result := PWideChar(FStringBuffer);

+end;

+

+function TBufferedWideString.BuffPtr: PWideChar;

+begin

+  Result := PWideChar(FStringBuffer);

+end;

+

+{ TBufferedStreamReader }

+

+constructor TBufferedStreamReader.Create(Stream: TStream; BufferSize: Integer = 1024);

+begin

+  // init stream

+  FStream := Stream;

+  FStreamSize := Stream.Size;

+  // init buffer

+  FBufferSize := BufferSize;

+  SetLength(FBuffer, BufferSize);

+  FBufferStartPosition := -FBufferSize; { out of any useful range }

+  // init virtual position

+  FVirtualPosition := 0;

+end;

+

+function TBufferedStreamReader.Seek(Offset: Integer; Origin: Word): Longint;

+begin

+  case Origin of

+    soFromBeginning: FVirtualPosition := Offset;

+    soFromCurrent:   Inc(FVirtualPosition, Offset);

+    soFromEnd:       FVirtualPosition := FStreamSize + Offset;

+  end;

+  Result := FVirtualPosition;

+end;

+

+procedure TBufferedStreamReader.UpdateBufferFromPosition(StartPos: Integer);

+begin

+  try

+    FStream.Position := StartPos;

+    FStream.Read(FBuffer[0], FBufferSize);

+    FBufferStartPosition := StartPos;

+  except

+    FBufferStartPosition := -FBufferSize; { out of any useful range }

+    raise;

+  end;

+end;

+

+function TBufferedStreamReader.Read(var Buffer; Count: Integer): Longint;

+var

+  BytesLeft: Integer;

+  FirstBufferRead: Integer;

+  StreamDirectRead: Integer;

+  Buf: PAnsiChar;

+begin

+  if (FVirtualPosition >= 0) and (Count >= 0) then

+  begin

+    Result := FStreamSize - FVirtualPosition;

+    if Result > 0 then

+    begin

+      if Result > Count then

+        Result := Count;

+

+      Buf := @Buffer;

+      BytesLeft := Result;

+

+      // try to read what is left in buffer

+      FirstBufferRead := FBufferStartPosition + FBufferSize - FVirtualPosition;

+      if (FirstBufferRead < 0) or (FirstBufferRead > FBufferSize) then

+        FirstBufferRead := 0;

+      FirstBufferRead := Min(FirstBufferRead, Result);

+      if FirstBufferRead > 0 then begin

+        Move(FBuffer[FVirtualPosition - FBufferStartPosition], Buf[0], FirstBufferRead);

+        Dec(BytesLeft, FirstBufferRead);

+      end;

+

+      if BytesLeft > 0 then begin

+        // The first read in buffer was not enough

+        StreamDirectRead := (BytesLeft div FBufferSize) * FBufferSize;

+        FStream.Position := FVirtualPosition + FirstBufferRead;

+        FStream.Read(Buf[FirstBufferRead], StreamDirectRead);

+        Dec(BytesLeft, StreamDirectRead);

+

+        if BytesLeft > 0 then begin

+          // update buffer, and read what is left

+          UpdateBufferFromPosition(FStream.Position);

+          Move(FBuffer[0], Buf[FirstBufferRead + StreamDirectRead], BytesLeft);

+        end;

+      end;

+

+      Inc(FVirtualPosition, Result);

+      Exit;

+    end;

+  end;

+  Result := 0;

+end;

+

+function TBufferedStreamReader.Write(const Buffer; Count: Integer): Longint;

+begin

+  raise ETntInternalError.Create('Internal Error: class can not write.');

+  Result := 0;

+end;

+

+//-------- synced wide string -----------------

+

+function GetSyncedWideString(var WideStr: WideString; const AnsiStr: AnsiString): WideString;

+begin

+  if AnsiString(WideStr) <> (AnsiStr) then begin

+    WideStr := AnsiStr; {AnsiStr changed.  Keep WideStr in sync.}

+  end;

+  Result := WideStr;

+end;

+

+procedure SetSyncedWideString(const Value: WideString; var WideStr: WideString;

+  const AnsiStr: AnsiString; SetAnsiStr: TSetAnsiStrEvent);

+begin

+  if Value <> GetSyncedWideString(WideStr, AnsiStr) then

+  begin

+    if (not WideSameStr(Value, AnsiString(Value))) {unicode chars lost in conversion}

+    and (AnsiStr = AnsiString(Value))  {AnsiStr is not going to change}

+    then begin

+      SetAnsiStr(''); {force the change}

+    end;

+    WideStr := Value;

+    SetAnsiStr(Value);

+  end;

+end;

+

+{ TWideComponentHelper }

+

+function CompareComponentHelperToTarget(Item, Target: Pointer): Integer;

+begin

+  if PtrUInt(TWideComponentHelper(Item).FComponent) < PtrUInt(Target) then

+    Result := -1

+  else if PtrUInt(TWideComponentHelper(Item).FComponent) > PtrUInt(Target) then

+    Result := 1

+  else

+    Result := 0;

+end;

+

+function FindWideComponentHelperIndex(ComponentHelperList: TComponentList; Component: TComponent; var Index: Integer): Boolean;

+begin

+  // find Component in sorted wide caption list (list is sorted by TWideComponentHelper.FComponent)

+  Result := FindSortedListByTarget(ComponentHelperList, CompareComponentHelperToTarget, Component, Index);

+end;

+

+constructor TWideComponentHelper.Create(AOwner: TComponent);

+begin

+  raise ETntInternalError.Create('TNT Internal Error: TWideComponentHelper.Create should never be encountered.');

+end;

+

+constructor TWideComponentHelper.CreateHelper(AOwner: TComponent; ComponentHelperList: TComponentList);

+var

+  Index: Integer;

+begin

+  // don't use direct ownership for memory management

+  inherited Create(nil);

+  FComponent := AOwner;

+  FComponent.FreeNotification(Self);

+

+  // insert into list according to sort

+  FindWideComponentHelperIndex(ComponentHelperList, FComponent, Index);

+  ComponentHelperList.Insert(Index, Self);

+end;

+

+procedure TWideComponentHelper.Notification(AComponent: TComponent; Operation: TOperation);

+begin

+  inherited;

+  if (AComponent = FComponent) and (Operation = opRemove) then begin

+    FComponent := nil;

+    Free;

+  end;

+end;

+

+function FindWideComponentHelper(ComponentHelperList: TComponentList; Component: TComponent): TWideComponentHelper;

+var

+  Index: integer;

+begin

+  if FindWideComponentHelperIndex(ComponentHelperList, Component, Index) then begin

+  	Result := TWideComponentHelper(ComponentHelperList[Index]);

+    Assert(Result.FComponent = Component, 'TNT Internal Error: FindWideComponentHelperIndex failed.');

+  end else

+    Result := nil;

+end;

+

+initialization

+  RuntimeUTFStreaming := False; { Delphi 6 and higher don't need UTF help at runtime. }

+

+end.

diff --git a/src/lib/TntUnicodeControls/TntFormatStrUtils.pas b/src/lib/TntUnicodeControls/TntFormatStrUtils.pas
index c6b65082..80aefd4a 100644
--- a/src/lib/TntUnicodeControls/TntFormatStrUtils.pas
+++ b/src/lib/TntUnicodeControls/TntFormatStrUtils.pas
@@ -1,521 +1,521 @@
-
-{*****************************************************************************}
-{                                                                             }
-{    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 TntFormatStrUtils;
-
-{$IFDEF FPC}
-  {$MODE Delphi}
-{$ENDIF}
-
-{$INCLUDE TntCompilers.inc}
-
-interface
-
-// this unit provides functions to work with format strings
-
-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;
-
-type
-  EFormatSpecError = class(ETntGeneralError);
-
-implementation
-
-uses
-  SysUtils, Math, TntClasses;
-
-resourcestring
-  SInvalidFormatSpecifier = 'Invalid Format Specifier: %s';
-  SMismatchedArgumentTypes = 'Argument types for index %d do not match. (%s <> %s)';
-  SMismatchedArgumentCounts = 'Number of format specifiers do not match.';
-
-type
-  TFormatSpecifierType = (fstInteger, fstFloating, fstPointer, fstString);
-
-function GetFormatSpecifierType(const FormatSpecifier: WideString): TFormatSpecifierType;
-var
-  LastChar: WideChar;
-begin
-  LastChar := TntWideLastChar(FormatSpecifier);
-  case LastChar of
-    'd', 'D', 'u', 'U', 'x', 'X':
-      result := fstInteger;
-    'e', 'E', 'f', 'F', 'g', 'G', 'n', 'N', 'm', 'M':
-      result := fstFloating;
-    'p', 'P':
-      result := fstPointer;
-    's', 'S':
-      result := fstString
-    else
-      raise ETntInternalError.CreateFmt('Internal Error: Unexpected format type (%s)', [LastChar]);
-  end;
-end;
-
-type
-  TFormatStrParser = class(TObject)
-  private
-    ParsedString: TBufferedWideString;
-    PFormatString: PWideChar;
-    LastIndex: Integer;
-    ExplicitCount: Integer;
-    ImplicitCount: Integer;
-    procedure RaiseInvalidFormatSpecifier;
-    function ParseChar(c: WideChar): Boolean;
-    procedure ForceParseChar(c: WideChar);
-    function ParseDigit: Boolean;
-    function ParseInteger: Boolean;
-    procedure ForceParseType;
-    function PeekDigit: Boolean;
-    function PeekIndexSpecifier(out Index: Integer): Boolean;
-  public
-    constructor Create(const _FormatString: WideString);
-    destructor Destroy; override;
-    function ParseFormatSpecifier: Boolean;
-  end;
-
-constructor TFormatStrParser.Create(const _FormatString: WideString);
-begin
-  inherited Create;
-  PFormatString := PWideChar(_FormatString);
-  ExplicitCount := 0;
-  ImplicitCount := 0;
-  LastIndex := -1;
-  ParsedString := TBufferedWideString.Create;
-end;
-
-destructor TFormatStrParser.Destroy;
-begin
-  FreeAndNil(ParsedString);
-  inherited;
-end;
-
-procedure TFormatStrParser.RaiseInvalidFormatSpecifier;
-begin
-  raise EFormatSpecError.CreateFmt(SInvalidFormatSpecifier, [ParsedString.Value + PFormatString]);
-end;
-
-function TFormatStrParser.ParseChar(c: WideChar): Boolean;
-begin
-  result := False;
-  if PFormatString^ = c then begin
-    result := True;
-    ParsedString.AddChar(c);
-    Inc(PFormatString);
-  end;
-end;
-
-procedure TFormatStrParser.ForceParseChar(c: WideChar);
-begin
-  if not ParseChar(c) then
-    RaiseInvalidFormatSpecifier;
-end;
-
-function TFormatStrParser.PeekDigit: Boolean;
-begin
-  result := False;
-  if  (PFormatString^ <> #0)
-  and (PFormatString^ >= '0')
-  and (PFormatString^ <= '9') then
-    result := True;
-end;
-
-function TFormatStrParser.ParseDigit: Boolean;
-begin
-  result := False;
-  if PeekDigit then begin
-    result := True;
-    ForceParseChar(PFormatString^);
-  end;
-end;
-
-function TFormatStrParser.ParseInteger: Boolean;
-const
-  MAX_INT_DIGITS = 6;
-var
-  digitcount: integer;
-begin
-  digitcount := 0;
-  While ParseDigit do begin
-    inc(digitcount);
-  end;
-  result := (digitcount > 0);
-  if digitcount > MAX_INT_DIGITS then
-    RaiseInvalidFormatSpecifier;
-end;
-
-procedure TFormatStrParser.ForceParseType;
-begin
-  if PFormatString^ = #0 then
-    RaiseInvalidFormatSpecifier;
-
-  case PFormatString^ of
-    'd', 'u', 'x', 'e', 'f', 'g', 'n', 'm', 'p', 's',
-    'D', 'U', 'X', 'E', 'F', 'G', 'N', 'M', 'P', 'S':
-  begin
-    // do nothing
-  end
-  else
-    RaiseInvalidFormatSpecifier;
-  end;
-  ForceParseChar(PFormatString^);
-end;
-
-function TFormatStrParser.PeekIndexSpecifier(out Index: Integer): Boolean;
-var
-  SaveParsedString: WideString;
-  SaveFormatString: PWideChar;
-begin
-  SaveParsedString := ParsedString.Value;
-  SaveFormatString := PFormatString;
-  try
-    ParsedString.Clear;
-    Result := False;
-    Index := -1;
-    if ParseInteger then begin
-      Index := StrToInt(ParsedString.Value);
-      if ParseChar(':') then
-        Result := True;
-    end;
-  finally
-    ParsedString.Clear;
-    ParsedString.AddString(SaveParsedString);
-    PFormatString := SaveFormatString;
-  end;
-end;
-
-function TFormatStrParser.ParseFormatSpecifier: Boolean;
-var
-  ExplicitIndex: Integer;
-begin
-  Result := False;
-  // Parse entire format specifier
-  ForceParseChar('%');
-  if (PFormatString^ <> #0)
-  and (not ParseChar(' '))
-  and (not ParseChar('%')) then begin
-    if PeekIndexSpecifier(ExplicitIndex) then begin
-      Inc(ExplicitCount);
-      LastIndex := Max(LastIndex, ExplicitIndex);
-    end else begin
-      Inc(ImplicitCount);
-      Inc(LastIndex);
-      ParsedString.AddString(IntToStr(LastIndex));
-      ParsedString.AddChar(':');
-    end;
-    if ParseChar('*') then
-    begin
-      Inc(ImplicitCount);
-      Inc(LastIndex);
-      ParseChar(':');
-    end else if ParseInteger then
-      ParseChar(':');
-    ParseChar('-');
-    if ParseChar('*') then begin
-      Inc(ImplicitCount);
-      Inc(LastIndex);
-    end else
-      ParseInteger;
-    if ParseChar('.') then begin
-      if not ParseChar('*') then
-        ParseInteger;
-    end;
-    ForceParseType;
-    Result := True;
-  end;
-end;
-
-//-----------------------------------
-
-function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
-var
-  PosSpec: Integer;
-begin
-  with TFormatStrParser.Create(_FormatString) do
-  try
-    // loop until no more '%'
-    PosSpec := Pos('%', PFormatString);
-    While PosSpec <> 0 do begin
-      try
-        // delete everything up until '%'
-        ParsedString.AddBuffer(PFormatString, PosSpec - 1);
-        Inc(PFormatString, PosSpec - 1);
-        // parse format specifier
-        ParseFormatSpecifier;
-      finally
-        PosSpec := Pos('%', PFormatString);
-      end;
-    end;
-    if ((ExplicitCount = 0) and (ImplicitCount = 1)) {simple expression}
-    or ((ExplicitCount > 0) and (ImplicitCount = 0)) {nothing converted} then
-      result := _FormatString {original}
-    else
-      result := ParsedString.Value + PFormatString;
-  finally
-    Free;
-  end;
-end;
-
-{$IFNDEF FPC}
-{$IFNDEF COMPILER_9_UP}
-function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
-  const Args: array of const
-    {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
-{ This function replaces floating point format specifiers with their actual formatted values.
-  It also adds index specifiers so that the other format specifiers don't lose their place.
-  The reason for this is that WideFormat doesn't correctly format floating point specifiers.
-  See QC#4254. }
-var
-  Parser: TFormatStrParser;
-  PosSpec: Integer;
-  Output: TBufferedWideString;
-begin
-  Output := TBufferedWideString.Create;
-  try
-    Parser := TFormatStrParser.Create(_FormatString);
-    with Parser do
-    try
-      // loop until no more '%'
-      PosSpec := Pos('%', PFormatString);
-      While PosSpec <> 0 do begin
-        try
-          // delete everything up until '%'
-          Output.AddBuffer(PFormatString, PosSpec - 1);
-          Inc(PFormatString, PosSpec - 1);
-          // parse format specifier
-          ParsedString.Clear;
-          if (not ParseFormatSpecifier)
-          or (GetFormatSpecifierType(ParsedString.Value) <> fstFloating) then
-            Output.AddBuffer(ParsedString.BuffPtr, MaxInt)
-          {$IFDEF COMPILER_7_UP}
-          else if Assigned(FormatSettings) then
-            Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args, FormatSettings^))
-          {$ENDIF}
-          else
-            Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args));
-        finally
-          PosSpec := Pos('%', PFormatString);
-        end;
-      end;
-      Output.AddString(PFormatString);
-    finally
-      Free;
-    end;
-    Result := Output.Value;
-  finally
-    Output.Free;
-  end;
-end;
-{$ENDIF}
-{$ENDIF}
-
-procedure GetFormatArgs(const _FormatString: WideString; FormatArgs: TTntStrings);
-var
-  PosSpec: Integer;
-begin
-  with TFormatStrParser.Create(_FormatString) do
-  try
-    FormatArgs.Clear;
-    // loop until no more '%'
-    PosSpec := Pos('%', PFormatString);
-    While PosSpec <> 0 do begin
-      try
-        // delete everything up until '%'
-        Inc(PFormatString, PosSpec - 1);
-        // add format specifier to list
-        ParsedString.Clear;
-        if ParseFormatSpecifier then
-          FormatArgs.Add(ParsedString.Value);
-      finally
-        PosSpec := Pos('%', PFormatString);
-      end;
-    end;
-  finally
-    Free;
-  end;
-end;
-
-function GetExplicitIndex(const FormatSpecifier: WideString): Integer;
-var
-  IndexStr: WideString;
-  PosColon: Integer;
-begin
-  result := -1;
-  PosColon := Pos(':', FormatSpecifier);
-  if PosColon <> 0 then begin
-    IndexStr := Copy(FormatSpecifier, 2, PosColon - 2);
-    result := StrToInt(IndexStr);
-  end;
-end;
-
-function GetMaxIndex(FormatArgs: TTntStrings): Integer;
-var
-  i: integer;
-  RunningIndex: Integer;
-  ExplicitIndex: Integer;
-begin
-  result := -1;
-  RunningIndex := -1;
-  for i := 0 to FormatArgs.Count - 1 do begin
-    ExplicitIndex := GetExplicitIndex(FormatArgs[i]);
-    if ExplicitIndex <> -1 then
-      RunningIndex := ExplicitIndex
-    else
-      inc(RunningIndex);
-    result := Max(result, RunningIndex);
-  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;
-  f: WideString;
-  SpecType: TFormatSpecifierType;
-  ExplicitIndex: Integer;
-  MaxIndex: Integer;
-  RunningIndex: Integer;
-begin
-  // set count of TypeList to accomodate maximum index
-  MaxIndex := GetMaxIndex(FormatArgs);
-  TypeList.Clear;
-  for i := 0 to MaxIndex do
-    TypeList.Add('');
-
-  // for each arg...
-  RunningIndex := -1;
-  for i := 0 to FormatArgs.Count - 1 do begin
-    f := FormatArgs[i];
-    ExplicitIndex := GetExplicitIndex(f);
-    SpecType := GetFormatSpecifierType(f);
-
-    // determine running arg index
-    if ExplicitIndex <> -1 then
-      RunningIndex := ExplicitIndex
-    else
-      inc(RunningIndex);
-
-    if TypeList[RunningIndex] <> '' then begin
-      // already exists in list, check for compatibility
-      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] := FormatSpecToObject(SpecType);
-    end;
-  end;
-end;
-
-procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
-var
-  ArgList1: TTntStringList;
-  ArgList2: TTntStringList;
-  TypeList1: TTntStringList;
-  TypeList2: TTntStringList;
-  i: integer;
-begin
-  ArgList1 := nil;
-  ArgList2 := nil;
-  TypeList1 := nil;
-  TypeList2 := nil;
-  try
-    ArgList1 := TTntStringList.Create;
-    ArgList2 := TTntStringList.Create;
-    TypeList1 := TTntStringList.Create;
-    TypeList2 := TTntStringList.Create;
-
-    GetFormatArgs(FormatStr1, ArgList1);
-    UpdateTypeList(ArgList1, TypeList1);
-
-    GetFormatArgs(FormatStr2, ArgList2);
-    UpdateTypeList(ArgList2, TypeList2);
-
-    if TypeList1.Count <> TypeList2.Count then
-      raise EFormatSpecError.Create(SMismatchedArgumentCounts + CRLF + CRLF + '> ' + FormatStr1 + CRLF + '> ' + FormatStr2);
-
-    for i := 0 to TypeList1.Count - 1 do begin
-      if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
-        raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
-          [i, TypeList1[i], TypeList2[i]]);
-      end;
-    end;
-
-  finally
-    ArgList1.Free;
-    ArgList2.Free;
-    TypeList1.Free;
-    TypeList2.Free;
-  end;
-end;
-
-function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
-var
-  ArgList1: TTntStringList;
-  ArgList2: TTntStringList;
-  TypeList1: TTntStringList;
-  TypeList2: TTntStringList;
-  i: integer;
-begin
-  ArgList1 := nil;
-  ArgList2 := nil;
-  TypeList1 := nil;
-  TypeList2 := nil;
-  try
-    ArgList1 := TTntStringList.Create;
-    ArgList2 := TTntStringList.Create;
-    TypeList1 := TTntStringList.Create;
-    TypeList2 := TTntStringList.Create;
-
-    GetFormatArgs(FormatStr1, ArgList1);
-    UpdateTypeList(ArgList1, TypeList1);
-
-    GetFormatArgs(FormatStr2, ArgList2);
-    UpdateTypeList(ArgList2, TypeList2);
-
-    Result := (TypeList1.Count = TypeList2.Count);
-    if Result then begin
-      for i := 0 to TypeList1.Count - 1 do begin
-        if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
-          Result := False;
-          break;
-        end;
-      end;
-    end;
-  finally
-    ArgList1.Free;
-    ArgList2.Free;
-    TypeList1.Free;
-    TypeList2.Free;
-  end;
-end;
-
-end.
+

+{*****************************************************************************}

+{                                                                             }

+{    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 TntFormatStrUtils;

+

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

+{$INCLUDE TntCompilers.inc}

+

+interface

+

+// this unit provides functions to work with format strings

+

+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;

+

+type

+  EFormatSpecError = class(ETntGeneralError);

+

+implementation

+

+uses

+  SysUtils, Math, TntClasses;

+

+resourcestring

+  SInvalidFormatSpecifier = 'Invalid Format Specifier: %s';

+  SMismatchedArgumentTypes = 'Argument types for index %d do not match. (%s <> %s)';

+  SMismatchedArgumentCounts = 'Number of format specifiers do not match.';

+

+type

+  TFormatSpecifierType = (fstInteger, fstFloating, fstPointer, fstString);

+

+function GetFormatSpecifierType(const FormatSpecifier: WideString): TFormatSpecifierType;

+var

+  LastChar: WideChar;

+begin

+  LastChar := TntWideLastChar(FormatSpecifier);

+  case LastChar of

+    'd', 'D', 'u', 'U', 'x', 'X':

+      result := fstInteger;

+    'e', 'E', 'f', 'F', 'g', 'G', 'n', 'N', 'm', 'M':

+      result := fstFloating;

+    'p', 'P':

+      result := fstPointer;

+    's', 'S':

+      result := fstString

+    else

+      raise ETntInternalError.CreateFmt('Internal Error: Unexpected format type (%s)', [LastChar]);

+  end;

+end;

+

+type

+  TFormatStrParser = class(TObject)

+  private

+    ParsedString: TBufferedWideString;

+    PFormatString: PWideChar;

+    LastIndex: Integer;

+    ExplicitCount: Integer;

+    ImplicitCount: Integer;

+    procedure RaiseInvalidFormatSpecifier;

+    function ParseChar(c: WideChar): Boolean;

+    procedure ForceParseChar(c: WideChar);

+    function ParseDigit: Boolean;

+    function ParseInteger: Boolean;

+    procedure ForceParseType;

+    function PeekDigit: Boolean;

+    function PeekIndexSpecifier(out Index: Integer): Boolean;

+  public

+    constructor Create(const _FormatString: WideString);

+    destructor Destroy; override;

+    function ParseFormatSpecifier: Boolean;

+  end;

+

+constructor TFormatStrParser.Create(const _FormatString: WideString);

+begin

+  inherited Create;

+  PFormatString := PWideChar(_FormatString);

+  ExplicitCount := 0;

+  ImplicitCount := 0;

+  LastIndex := -1;

+  ParsedString := TBufferedWideString.Create;

+end;

+

+destructor TFormatStrParser.Destroy;

+begin

+  FreeAndNil(ParsedString);

+  inherited;

+end;

+

+procedure TFormatStrParser.RaiseInvalidFormatSpecifier;

+begin

+  raise EFormatSpecError.CreateFmt(SInvalidFormatSpecifier, [ParsedString.Value + PFormatString]);

+end;

+

+function TFormatStrParser.ParseChar(c: WideChar): Boolean;

+begin

+  result := False;

+  if PFormatString^ = c then begin

+    result := True;

+    ParsedString.AddChar(c);

+    Inc(PFormatString);

+  end;

+end;

+

+procedure TFormatStrParser.ForceParseChar(c: WideChar);

+begin

+  if not ParseChar(c) then

+    RaiseInvalidFormatSpecifier;

+end;

+

+function TFormatStrParser.PeekDigit: Boolean;

+begin

+  result := False;

+  if  (PFormatString^ <> #0)

+  and (PFormatString^ >= '0')

+  and (PFormatString^ <= '9') then

+    result := True;

+end;

+

+function TFormatStrParser.ParseDigit: Boolean;

+begin

+  result := False;

+  if PeekDigit then begin

+    result := True;

+    ForceParseChar(PFormatString^);

+  end;

+end;

+

+function TFormatStrParser.ParseInteger: Boolean;

+const

+  MAX_INT_DIGITS = 6;

+var

+  digitcount: integer;

+begin

+  digitcount := 0;

+  While ParseDigit do begin

+    inc(digitcount);

+  end;

+  result := (digitcount > 0);

+  if digitcount > MAX_INT_DIGITS then

+    RaiseInvalidFormatSpecifier;

+end;

+

+procedure TFormatStrParser.ForceParseType;

+begin

+  if PFormatString^ = #0 then

+    RaiseInvalidFormatSpecifier;

+

+  case PFormatString^ of

+    'd', 'u', 'x', 'e', 'f', 'g', 'n', 'm', 'p', 's',

+    'D', 'U', 'X', 'E', 'F', 'G', 'N', 'M', 'P', 'S':

+  begin

+    // do nothing

+  end

+  else

+    RaiseInvalidFormatSpecifier;

+  end;

+  ForceParseChar(PFormatString^);

+end;

+

+function TFormatStrParser.PeekIndexSpecifier(out Index: Integer): Boolean;

+var

+  SaveParsedString: WideString;

+  SaveFormatString: PWideChar;

+begin

+  SaveParsedString := ParsedString.Value;

+  SaveFormatString := PFormatString;

+  try

+    ParsedString.Clear;

+    Result := False;

+    Index := -1;

+    if ParseInteger then begin

+      Index := StrToInt(ParsedString.Value);

+      if ParseChar(':') then

+        Result := True;

+    end;

+  finally

+    ParsedString.Clear;

+    ParsedString.AddString(SaveParsedString);

+    PFormatString := SaveFormatString;

+  end;

+end;

+

+function TFormatStrParser.ParseFormatSpecifier: Boolean;

+var

+  ExplicitIndex: Integer;

+begin

+  Result := False;

+  // Parse entire format specifier

+  ForceParseChar('%');

+  if (PFormatString^ <> #0)

+  and (not ParseChar(' '))

+  and (not ParseChar('%')) then begin

+    if PeekIndexSpecifier(ExplicitIndex) then begin

+      Inc(ExplicitCount);

+      LastIndex := Max(LastIndex, ExplicitIndex);

+    end else begin

+      Inc(ImplicitCount);

+      Inc(LastIndex);

+      ParsedString.AddString(IntToStr(LastIndex));

+      ParsedString.AddChar(':');

+    end;

+    if ParseChar('*') then

+    begin

+      Inc(ImplicitCount);

+      Inc(LastIndex);

+      ParseChar(':');

+    end else if ParseInteger then

+      ParseChar(':');

+    ParseChar('-');

+    if ParseChar('*') then begin

+      Inc(ImplicitCount);

+      Inc(LastIndex);

+    end else

+      ParseInteger;

+    if ParseChar('.') then begin

+      if not ParseChar('*') then

+        ParseInteger;

+    end;

+    ForceParseType;

+    Result := True;

+  end;

+end;

+

+//-----------------------------------

+

+function GetCanonicalFormatStr(const _FormatString: WideString): WideString;

+var

+  PosSpec: Integer;

+begin

+  with TFormatStrParser.Create(_FormatString) do

+  try

+    // loop until no more '%'

+    PosSpec := Pos(WideString('%'), PFormatString);

+    While PosSpec <> 0 do begin

+      try

+        // delete everything up until '%'

+        ParsedString.AddBuffer(PFormatString, PosSpec - 1);

+        Inc(PFormatString, PosSpec - 1);

+        // parse format specifier

+        ParseFormatSpecifier;

+      finally

+        PosSpec := Pos(WideString('%'), PFormatString);

+      end;

+    end;

+    if ((ExplicitCount = 0) and (ImplicitCount = 1)) {simple expression}

+    or ((ExplicitCount > 0) and (ImplicitCount = 0)) {nothing converted} then

+      result := _FormatString {original}

+    else

+      result := ParsedString.Value + PFormatString;

+  finally

+    Free;

+  end;

+end;

+

+{$IFNDEF FPC}

+{$IFNDEF COMPILER_9_UP}

+function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;

+  const Args: array of const

+    {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;

+{ This function replaces floating point format specifiers with their actual formatted values.

+  It also adds index specifiers so that the other format specifiers don't lose their place.

+  The reason for this is that WideFormat doesn't correctly format floating point specifiers.

+  See QC#4254. }

+var

+  Parser: TFormatStrParser;

+  PosSpec: Integer;

+  Output: TBufferedWideString;

+begin

+  Output := TBufferedWideString.Create;

+  try

+    Parser := TFormatStrParser.Create(_FormatString);

+    with Parser do

+    try

+      // loop until no more '%'

+      PosSpec := Pos('%', PFormatString);

+      While PosSpec <> 0 do begin

+        try

+          // delete everything up until '%'

+          Output.AddBuffer(PFormatString, PosSpec - 1);

+          Inc(PFormatString, PosSpec - 1);

+          // parse format specifier

+          ParsedString.Clear;

+          if (not ParseFormatSpecifier)

+          or (GetFormatSpecifierType(ParsedString.Value) <> fstFloating) then

+            Output.AddBuffer(ParsedString.BuffPtr, MaxInt)

+          {$IFDEF COMPILER_7_UP}

+          else if Assigned(FormatSettings) then

+            Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args, FormatSettings^))

+          {$ENDIF}

+          else

+            Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args));

+        finally

+          PosSpec := Pos('%', PFormatString);

+        end;

+      end;

+      Output.AddString(PFormatString);

+    finally

+      Free;

+    end;

+    Result := Output.Value;

+  finally

+    Output.Free;

+  end;

+end;

+{$ENDIF}

+{$ENDIF}

+

+procedure GetFormatArgs(const _FormatString: WideString; FormatArgs: TTntStrings);

+var

+  PosSpec: Integer;

+begin

+  with TFormatStrParser.Create(_FormatString) do

+  try

+    FormatArgs.Clear;

+    // loop until no more '%'

+    PosSpec := Pos(WideString('%'), PFormatString);

+    While PosSpec <> 0 do begin

+      try

+        // delete everything up until '%'

+        Inc(PFormatString, PosSpec - 1);

+        // add format specifier to list

+        ParsedString.Clear;

+        if ParseFormatSpecifier then

+          FormatArgs.Add(ParsedString.Value);

+      finally

+        PosSpec := Pos(WideString('%'), PFormatString);

+      end;

+    end;

+  finally

+    Free;

+  end;

+end;

+

+function GetExplicitIndex(const FormatSpecifier: WideString): Integer;

+var

+  IndexStr: WideString;

+  PosColon: Integer;

+begin

+  result := -1;

+  PosColon := Pos(':', FormatSpecifier);

+  if PosColon <> 0 then begin

+    IndexStr := Copy(FormatSpecifier, 2, PosColon - 2);

+    result := StrToInt(IndexStr);

+  end;

+end;

+

+function GetMaxIndex(FormatArgs: TTntStrings): Integer;

+var

+  i: integer;

+  RunningIndex: Integer;

+  ExplicitIndex: Integer;

+begin

+  result := -1;

+  RunningIndex := -1;

+  for i := 0 to FormatArgs.Count - 1 do begin

+    ExplicitIndex := GetExplicitIndex(FormatArgs[i]);

+    if ExplicitIndex <> -1 then

+      RunningIndex := ExplicitIndex

+    else

+      inc(RunningIndex);

+    result := Max(result, RunningIndex);

+  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;

+  f: WideString;

+  SpecType: TFormatSpecifierType;

+  ExplicitIndex: Integer;

+  MaxIndex: Integer;

+  RunningIndex: Integer;

+begin

+  // set count of TypeList to accomodate maximum index

+  MaxIndex := GetMaxIndex(FormatArgs);

+  TypeList.Clear;

+  for i := 0 to MaxIndex do

+    TypeList.Add('');

+

+  // for each arg...

+  RunningIndex := -1;

+  for i := 0 to FormatArgs.Count - 1 do begin

+    f := FormatArgs[i];

+    ExplicitIndex := GetExplicitIndex(f);

+    SpecType := GetFormatSpecifierType(f);

+

+    // determine running arg index

+    if ExplicitIndex <> -1 then

+      RunningIndex := ExplicitIndex

+    else

+      inc(RunningIndex);

+

+    if TypeList[RunningIndex] <> '' then begin

+      // already exists in list, check for compatibility

+      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] := FormatSpecToObject(SpecType);

+    end;

+  end;

+end;

+

+procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);

+var

+  ArgList1: TTntStringList;

+  ArgList2: TTntStringList;

+  TypeList1: TTntStringList;

+  TypeList2: TTntStringList;

+  i: integer;

+begin

+  ArgList1 := nil;

+  ArgList2 := nil;

+  TypeList1 := nil;

+  TypeList2 := nil;

+  try

+    ArgList1 := TTntStringList.Create;

+    ArgList2 := TTntStringList.Create;

+    TypeList1 := TTntStringList.Create;

+    TypeList2 := TTntStringList.Create;

+

+    GetFormatArgs(FormatStr1, ArgList1);

+    UpdateTypeList(ArgList1, TypeList1);

+

+    GetFormatArgs(FormatStr2, ArgList2);

+    UpdateTypeList(ArgList2, TypeList2);

+

+    if TypeList1.Count <> TypeList2.Count then

+      raise EFormatSpecError.Create(SMismatchedArgumentCounts + CRLF + CRLF + '> ' + FormatStr1 + CRLF + '> ' + FormatStr2);

+

+    for i := 0 to TypeList1.Count - 1 do begin

+      if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin

+        raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,

+          [i, TypeList1[i], TypeList2[i]]);

+      end;

+    end;

+

+  finally

+    ArgList1.Free;

+    ArgList2.Free;

+    TypeList1.Free;

+    TypeList2.Free;

+  end;

+end;

+

+function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;

+var

+  ArgList1: TTntStringList;

+  ArgList2: TTntStringList;

+  TypeList1: TTntStringList;

+  TypeList2: TTntStringList;

+  i: integer;

+begin

+  ArgList1 := nil;

+  ArgList2 := nil;

+  TypeList1 := nil;

+  TypeList2 := nil;

+  try

+    ArgList1 := TTntStringList.Create;

+    ArgList2 := TTntStringList.Create;

+    TypeList1 := TTntStringList.Create;

+    TypeList2 := TTntStringList.Create;

+

+    GetFormatArgs(FormatStr1, ArgList1);

+    UpdateTypeList(ArgList1, TypeList1);

+

+    GetFormatArgs(FormatStr2, ArgList2);

+    UpdateTypeList(ArgList2, TypeList2);

+

+    Result := (TypeList1.Count = TypeList2.Count);

+    if Result then begin

+      for i := 0 to TypeList1.Count - 1 do begin

+        if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin

+          Result := False;

+          break;

+        end;

+      end;

+    end;

+  finally

+    ArgList1.Free;

+    ArgList2.Free;

+    TypeList1.Free;

+    TypeList2.Free;

+  end;

+end;

+

+end.