unit U_SCSLists;

interface

Uses Windows, Classes, SysUtils, ComCtrls, Controls, Contnrs, idGlobal, DateUtils, RTLConsts, U_Common_Classes;

resourcestring
  SInvalidFieldOffset = 'Field offset (%d) differ from first';

type
    TPtrList = array of Pointer;
    PPtrList = ^TPtrList;

    TRapList = class(TMyObject)
      private
        FList: PPointerList;
        FCount: Integer;
        FCapacity: Integer;
        FSortFieldOffset: Integer;
      protected
        function Get(Index: Integer): Pointer;
        procedure Grow; virtual;
        procedure Put(Index: Integer; Item: Pointer);
        //procedure Notify(Ptr: Pointer; Action: TListNotification); virtual;
        procedure SetCapacity(NewCapacity: Integer);
        procedure SetCount(NewCount: Integer);
      public
        constructor Create;
        destructor Destroy; override;
        procedure Add(Item: Pointer);
        procedure AddList(AList: TRapList);
        procedure Clear; virtual;
        procedure ClearOwnObjects;
        procedure Delete(Index: Integer);
        procedure DeleteRange(Index, Len: Integer);
        class procedure Error(const Msg: string; Data: Integer); overload; virtual;
        class procedure Error(Msg: PResStringRec; Data: Integer); overload;
        procedure Exchange(Index1, Index2: Integer);
        //function Expand: TRapList;
        function Extract(Item: Pointer): Pointer;
        function First: Pointer;
        function IndexOf(Item: Pointer): Integer;
        procedure Insert(Index: Integer; Item: Pointer);
        function Last: Pointer;
        procedure Move(CurIndex, NewIndex: Integer);
        function Remove(Item: Pointer): Integer;
        procedure Pack;
        procedure Sort(Compare: TListSortCompare);
        procedure Assign(ListA: TRapList; AOperator: TListAssignOp = laCopy; ListB: TRapList = nil);
        property Capacity: Integer read FCapacity write SetCapacity;
        property Count: Integer read FCount write SetCount;
        property Items[Index: Integer]: Pointer read Get write Put; default;
        property List: PPointerList read FList;
        //property List: TPtrList read FList;
      end;

    TRapObjectList = class(TMyObject)
      private
        FItems: TRapList;
        FSortFieldOffset: Integer;
        FOwnsObjects: Boolean;
        FAllowDuplicates: Boolean;

        function FindObject(AValue: Pointer; AObject: TObject; AFieldAdress: Pointer;
              var Index: Integer): Boolean;
        function Get(Index: Integer): Pointer;
        function GetCount: Integer;
      public
        constructor Create(AOwnsObjects: Boolean=false; AAllowDuplicates: Boolean=true); overload;
        destructor Destroy; override;
        procedure Clear;
        function GetObject(AFieldValue: Integer): TObject;
        function Insert(AObject: TObject; AFieldAdress: Pointer): Integer;
        function Remove(AFieldValue: Integer): Integer;
        property Count: Integer read GetCount;
        property Items[Index: Integer]: Pointer read Get; default;
        property List: TRapList read FItems;
    end;

    TRapRecordList = class(TRapObjectList)
      private
        FOwnsObjects: Boolean;
      public
        constructor Create(AOwnsObjects: Boolean); overload;
        destructor Destroy; override;
    end;

    TIntList = class(TMyObject)
      protected
        FItems: TList;
        function GetCount: Integer;
        function GetItem(Index: Integer): Integer;
        procedure SetItem(Index: Integer; AInt: Integer);
      public
        constructor Create; overload;
        destructor  Destroy; override;

        function Add(AInt: Integer): Integer;
        procedure Assign(ListA: TIntList; AOperator: TListAssignOp = laCopy; ListB: TIntList = nil);
        procedure Clear;
        procedure Delete(AIndex: Integer);
        procedure Fill(AVal: Integer; AToIndex: Integer=-1);
        procedure Move(CurrIndex, NewIndex: Integer);
        function Remove(AInt: Integer): Integer;
        procedure RemoveDublicates;
        function RemoveItems(AItems: TIntList): Integer;
        function IndexOf(AInt: Integer): Integer;
        procedure Insert(Index: Integer; AInt: Integer);
        property Count: Integer read GetCount;
        property Items[index: integer]: Integer read GetItem write SetItem; default;
        property List: TList read FItems;
    end;

    TIDStringList = class(TMyObject)
      protected
        FIDs: TIntList;
        FStrings: TStringList;

        function GetCount: Integer;
      public
        property Count: Integer read GetCount;
        property IDs: TIntList read FIDs write FIDs;
        property Strings: TStringList read FStrings write FStrings;

        constructor Create; overload;
        // Tolik 16/01/2019 --
        //destructor Destroy; overload;
        destructor Destroy; override;
        //

        function Add(AID: Integer; AString: String): Integer; overload;
        function Add(AID: Integer; AString: String; AObject: TObject): Integer; overload;
        procedure Assign(ListA: TIDStringList; AOperator: TListAssignOp = laCopy; ListB: TIDStringList = nil);
        procedure Clear;
        procedure Delete(AIndex: Integer);
        function GetIDByIndex(AIndex: Integer): Integer;
        function GetIDByString(AString: String): Integer;
        function GetStringByID(AID: Integer): String;
        function GetStringByIndex(AIndex: Integer): String;
        function IndexOfByID(AID: Integer): Integer;
        function IndexOfByString(AString: String): Integer;
        function RemoveByID(AID: Integer): Integer;
        function RemoveByString(AString: String): Integer;
    end;

    TBasicArrayList = class(TMyObject)
      protected
        FCount: Integer;
        FItemsCount: Integer;
        procedure Assign(ASrc: TBasicArrayList);
      public
        property Count: Integer read FCount;

        constructor Create;
        destructor Destroy; override;
        procedure Clear; virtual;
    end;


    TConnectedComponsInfo = record
      ID: Integer;
      ComponWholeID: Integer;
      IDConnectObject: Integer;
      IDConnectCompon: Integer;
      IDSideCompon: Integer;
      TypeConnect: Integer;
    end;
    PConnectedComponsInfo = ^TConnectedComponsInfo;

    TConnectedComponsList = class(TBasicArrayList)
      protected
        FItems: array of TConnectedComponsInfo;
        function GetItem(Index: Integer): TConnectedComponsInfo;
        procedure SetItem(Index: Integer; AConnectedComponsInfo: TConnectedComponsInfo);
      public
        constructor Create; overload;
        destructor  Destroy; override;

        function Add(AConnectedComponsInfo: TConnectedComponsInfo): Integer;
        procedure Assign(AConnectedComponsList: TConnectedComponsList);
        procedure Clear; override;
        procedure Delete(Index: Integer);
        function GetConnectedComponsInfoByWholeID(AWholeID: Integer): TList;
        function GetConnectedComponsInfoByWholeIDAndType(AWholeID, AType: Integer): TConnectedComponsInfo;
        procedure GetConnectedComponsInfosByWholeID(AWholeID: Integer; var aResFrom, aResTo: TConnectedComponsInfo);
        procedure InsertRecord(AComponWholeID, AIDConnectedObject,
                      AIDConnectedCompon, AIDSideCompon, ATypeConnect: Integer);
        procedure RemoveByWholeID(AWholeID: Integer);
        //function IndexOf(AConnectedComponsInfo: PConnectedComponsInfo): Integer;
        //procedure Insert(Index: Integer; AConnectedComponsInfo: PConnectedComponsInfo);
        property Items[index: integer]: TConnectedComponsInfo read GetItem write SetItem; default;
    end;

    TJoinComponsInfo = record
      IDCompon1: Integer;
      IDCompon2: Integer;
      DBKind1: Integer;
      DBKind2: Integer;
    end;

    TJoinComponsInfoList = class(TBasicArrayList)
      protected
        FItems: array of TJoinComponsInfo;
        function GetItem(Index: Integer): TJoinComponsInfo;
        procedure SetItem(Index: Integer; AJoinComponsInfo: TJoinComponsInfo);
      public
        constructor Create; overload;
        destructor  Destroy; override;

        function Add: Integer;
        function AddRecord(AIDCompon1, AIDCompon2, ADBKind1, ADBKind2: Integer): Integer;
        procedure Clear;
        function FindJoinComponsInfo(AIDCompon1, AIDCompon2, ADBKind1, ADBKind2: Integer): Boolean;
        property Items[index: integer]: TJoinComponsInfo read GetItem write SetItem; default;
    end;

    TLog = class(TMyObject)
      private
        FDirectory: String;
        FFilePrefix: String;
        FFileExtension: String;

        FCurrData: TDate;
        FCurrFileIndex: Integer;
        FCurrLog: TStringList;
        FCurrLogSize: Integer;

        FExistsFiles: TStringList;
        FImmediateSave: Boolean;
        function CheckDirectoryExists: Boolean;
        procedure DefineExistsFiles;
        procedure SaveStringToFile(AText, AFileName: String);
      public
        procedure AddStringToLog(AText: String);
        constructor Create(ADirectory, AFilePrefix, AFileExtension: String; AImmediateSave: Boolean);
        destructor Destroy; override;
    end;

    TStreamList = class(TMyObject)
      private
        FOwnObjects: Boolean;
        FStreams: TObjectList;
        FStreamsCodes: TIntList;
        FFileCode: Integer;
       //FFileCodeStr: string;
        FFileCodeStr: AnsiString;
        FISStrCode: Boolean;

        FEOF: Boolean;
        FFileStream: TFileStream;
        FReadedStreamCode: Integer;

        procedure AfterCreate(AOwnObjects: Boolean);
        procedure CheckIsEnd;
      public
        property OwnObjects: Boolean read FOwnObjects write FOwnObjects;
        property ReadedStreamCode: Integer read FReadedStreamCode;
        property Streams: TObjectList read FStreams {write FStreams};
        property StreamsCodes: TIntList read FStreamsCodes {write FStreamsCodes};
        property EOF: Boolean read FEOF;
        property FileCode: Integer read FFileCode write FFileCode;
        //property FileCodeStr: string read FFileCodeStr write FFileCodeStr;
        property FileCodeStr: AnsiString read FFileCodeStr write FFileCodeStr;

        procedure Add(AStream: TStream; AStreamCode: Integer);
        procedure Clear;
        constructor Create(AFileCode: Integer; AOwnObjects: Boolean); overload;
        constructor Create(AFileCode: string; AOwnObjects: Boolean); overload;
        destructor Destroy; override;
        function GetStreamByCode(ACode: Integer): TStream;
        function LoadFromFile(AFileName: String): Boolean;
        procedure ReadFileEnd;
        function ReadFileHeader(AFileName: String; AFileCodeSizeToCheck: Integer): Boolean;
        function ReadStreamFromFile(AStream: TStream; AAddToList: Boolean): Boolean;
        procedure RotateList;
        procedure SaveToFile(AFileName: String);
    end;

    TStringObject = class(TObject)
      FString: String;
    end;

    TStringsHash = class
      protected
        FStrings: TStringList;
      public
        property Strings: TStringList read FStrings write FStrings;

        constructor Create;
        destructor Destroy; override;
        function GetVal(const aKey: String; var aVal: String): Boolean;
        function SetVal(const aKey, aVal: String): Integer;
    end;

    procedure QuickSortPointerList(SortList: PPointerList; L, R: Integer; SCompare: TListSortCompare);
    procedure DeleteArrayItem(var X; const Index, ItemSize: Integer) ;
    function FindInSortedIntList(AValue: Integer; AList: TIntList; var Index: Integer): Boolean;
    function FindInSortedList(AValue: Pointer; AList: TList; var Index: Integer): Boolean;
    function FindInSortedRapList(AValue: Pointer; AList: TRapList; var Index: Integer): Boolean;
    function FindObjectInSortedRapList(AObject: TObject; AFieldAdress: Pointer;
              AList: TRapList; var Index: Integer): Boolean;
    function InsertObjectToSortetRapList(AObject: TObject; AFieldAdress: Pointer; AList: TRapList): Integer;
    function InsertValueToSortetList(AValue: Pointer; AList: TList): Integer;
    function InsertValueToSortetRapList(AValue: Pointer; AList: TRapList): Integer;
    function InsertValueToSortetIntList(AValue: Integer; AList: TIntList): Integer;
    function IntListToList(AIntList: TIntList): TList;
    function IntListToSorted(AIntList: TIntList): TIntList;
    function GetValueIndexFromSortedRapList(AValue: Pointer; AList: TRapList): Integer;
    function GetValueIndexFromSortedIntList(AValue: Integer; AList: TIntList): Integer;
    procedure LoadIntListFromStream(AStream: TStream; AIntList: TIntList);
    procedure SaveIntListToStream(AStream: TStream; AIntList: TIntList);

    function AddStrObjToStrings(AStrings: TStrings; const AKeyStr, AStrObj: String): Integer;
    function GetObjFromStringsByStr(AStrings: TStrings; const AStr: String): TObject;
    function GetStrFromStringsByKey(AStrings: TStrings; const AKey: String): String;
    function GetStrFromStringsByIdx(AStrings: TStrings; AIdx: Integer): String;
    procedure FreeStringsObjects(AStrings: TStrings; AClear: Boolean);
    procedure SetStrToStringsByIdx(AStrings: TStrings; AIdx: Integer; const aVal: String);
    procedure SortListByItemField(AList: TList; AItem, AFieldAdress: Pointer);
    //procedure SortListByObjItemField(AList: TList; AItem: TObject; AFieldAdress: Pointer);

    procedure RotateTObjectList(AList: TObjectList);
    procedure RotateTList(AList: TList);

implementation
Uses U_BaseCommon;


{ TRapList }

constructor TRapList.Create;
begin
  inherited;
  //FAddBy := 10;
  FSortFieldOffset := -1;
end;

destructor TRapList.Destroy;
begin
  Clear;
  inherited;
end;

procedure TRapList.Add(Item: Pointer);
//var
  //Delta: Integer;
begin
  {Result := FCount;
  if Result = FCapacity then
    Grow;
  FList^[Result] := Item;
  Inc(FCount);
  if Item <> nil then
    Notify(Item, lnAdded);}

  //if FCount = FCapacity then
  //  Grow;
  //FList^[FCount] := Item;
  //Inc(FCount);

  if FCapacity <= FCount then
  begin
    //Capacity := FCount + FAddBy;
    {if FCapacity > 64 then
      Delta := FCapacity div 4
    else
      if FCapacity > 8 then
        Delta := 16
      else
        Delta := 4;
    Capacity := FCount + Delta;}
    Grow;
  end;
  FList^[FCount] := Item;
  FCount := FCount + 1; //Inc(FCount);
end;

procedure TRapList.AddList(AList: TRapList);
var
  NewCount: Integer;
  Delta: Integer;
  i: Integer;
begin
  NewCount := FCount + AList.FCount;
  if FCapacity <= NewCount then
  begin
    if FCapacity > 64 then
      Delta := FCapacity div 4
    else
      if FCapacity > 8 then
        Delta := 16
      else
        Delta := 4;
    Capacity := NewCount + Delta;
  end;
  for i := 0 to AList.FCount - 1 do
    FList^[FCount + i] := AList.FList^[i];
  FCount := NewCount;
end;

procedure TRapList.Clear;
var i, j: Integer;
begin
  //Tolik
  if FCount > 0 then
  begin
    while FCount > 0 do
     Delete(0);
  end;
  //
  SetCount(0);
  SetCapacity(0);
end;

procedure TRapList.ClearOwnObjects;
var
  i: Integer;
begin
  for i := 0 to FCount - 1 do
  begin
    if FList^[i] <> nil then
      TObject(FList^[i]).Free;
  end;
  Clear;
end;

procedure TRapList.Delete(Index: Integer);
//var
  //Temp: Pointer;
begin
  {if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  Temp := Items[Index];
  Dec(FCount);
  if Index < FCount then
    System.Move(FList^[Index + 1], FList^[Index],
      (FCount - Index) * SizeOf(Pointer));
  if Temp <> nil then
    Notify(Temp, lnDeleted);}

  //DeleteRange(Index, 1);

  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  FCount := FCount - 1;
  //if Index < FCount - 1 then
  //Tolik
  //if Index < FCount then
  if Index <= FCount then // (а то хер оно удалит нулевой элемент при количестве 1)
  //
  begin
    //FCount := FCount - 1;
    System.Move(FList^[Index + 1], FList^[Index], (FCount - Index) * SizeOf(Pointer));
  end;
end;

procedure TRapList.DeleteRange(Index, Len: Integer);
begin
  if Len <= 0 then
    Exit;
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  if Index + Len > FCount then
    Len := FCount - Index;

  //Если удаляется хвост, то память не уменьшаем
  if (Index + Len) < FCount then
    System.Move(FList^[ Index + Len ], FList^[ Index ], Sizeof( Pointer ) * (FCount - Index - Len) );
  FCount := FCount - Len; //Dec( fCount, Len );
end;

class procedure TRapList.Error(const Msg: string; Data: Integer);

  function ReturnAddr: Pointer;
  asm
          MOV     EAX,[EBP+4]
  end;

begin
  raise EListError.CreateFmt(Msg, [Data]) at ReturnAddr;
end;

class procedure TRapList.Error(Msg: PResStringRec; Data: Integer);
begin
  TRapList.Error(LoadResString(Msg), Data);
end;

procedure TRapList.Exchange(Index1, Index2: Integer);
var
  Item: Pointer;
begin
  if (Index1 < 0) or (Index1 >= FCount) then
    Error(@SListIndexError, Index1);
  if (Index2 < 0) or (Index2 >= FCount) then
    Error(@SListIndexError, Index2);
  Item := FList^[Index1];
  FList^[Index1] := FList^[Index2];
  FList^[Index2] := Item;
end;

{
function TRapList.Expand: TRapList;
begin
  if FCount = FCapacity then
    Grow;
  Result := Self;
end;}

function TRapList.First: Pointer;
begin
  Result := Get(0);
end;

function TRapList.Get(Index: Integer): Pointer;
begin
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  Result := FList^[Index];
end;

procedure TRapList.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 TRapList.IndexOf(Item: Pointer): Integer;
var
  i: Integer;
  MiddleIndex: Integer;
  LastIndex: Integer;
begin
  //Result := 0;
  //while (Result < FCount) and (FList^[Result] <> Item) do
  //  Inc(Result);
  //if Result = FCount then
  //  Result := -1;


  
  Result := -1;
  for i := 0 to FCount - 1 do
    if FList^[i] = Item then
    begin
      Result := i;
      Break; //// BREAK ////
    end;

        {
  Result := -1;
  MiddleIndex := FCount div 2;
  if (FCount mod 2) <> 0 then
    MiddleIndex := MiddleIndex + 1;
  LastIndex := FCount - 1;
  for i := 0 to MiddleIndex - 1 do
    if FList^[i] = Item then
    begin
      Result := i;
      Break; //// BREAK ////
    end
    else
    if FList^[LastIndex - i] = Item then
    begin
      Result := i;
      Break; //// BREAK ////
    end;   }
end;

procedure TRapList.Insert(Index: Integer; Item: Pointer);
begin
  {if (Index < 0) or (Index > FCount) then
    Error(@SListIndexError, Index);
  if FCount = FCapacity then
    Grow;
  if Index < FCount then
    System.Move(FList^[Index], FList^[Index + 1],
      (FCount - Index) * SizeOf(Pointer));
  FList^[Index] := Item;
  Inc(FCount);
  if Item <> nil then
    Notify(Item, lnAdded);}

  if (Index < 0) or (Index > FCount) then
    Error(@SListIndexError, Index);
  if FCount = FCapacity then
    Grow;
  if Index < FCount then
    System.Move(FList^[Index], FList^[Index + 1], (FCount - Index) * SizeOf(Pointer));
  FList^[Index] := Item;
  FCount := FCount + 1; 
end;

function TRapList.Last: Pointer;
begin
  Result := Get(FCount - 1);
end;

procedure TRapList.Move(CurIndex, NewIndex: Integer);
var
  Item: Pointer;
begin
  if CurIndex <> NewIndex then
  begin
    if (NewIndex < 0) or (NewIndex >= FCount) then
      Error(@SListIndexError, NewIndex);
    Item := Get(CurIndex);
    FList^[CurIndex] := nil;
    Delete(CurIndex);
    Insert(NewIndex, nil);
    FList^[NewIndex] := Item;
  end;
end;

procedure TRapList.Put(Index: Integer; Item: Pointer);
//var
  //Temp: Pointer;
begin
  {if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);
  if Item <> FList^[Index] then
  begin
    Temp := FList^[Index];
    FList^[Index] := Item;
    if Temp <> nil then
      Notify(Temp, lnDeleted);
    if Item <> nil then
      Notify(Item, lnAdded);
  end;}
  if (Index < 0) or (Index >= FCount) then
    Error(@SListIndexError, Index);

  FList^[Index] := Item;
end;

function TRapList.Remove(Item: Pointer): Integer;
begin
  Result := IndexOf(Item);
  if Result >= 0 then
    Delete(Result);
end;

procedure TRapList.Pack;
var
  I: Integer;
begin
  for I := FCount - 1 downto 0 do
    if Items[I] = nil then
      Delete(I);
end;

procedure TRapList.SetCapacity(NewCapacity: Integer);
begin
  {if (NewCapacity < FCount) or (NewCapacity > MaxListSize) then
    Error(@SListCapacityError, NewCapacity);
  if NewCapacity <> FCapacity then
  begin
    ReallocMem(FList, NewCapacity * SizeOf(Pointer));
    FCapacity := NewCapacity;
  end;}

  if NewCapacity < FCount then
    NewCapacity := FCount;
  if NewCapacity <> FCapacity then
  begin
    ReallocMem(FList, NewCapacity * SizeOf(Pointer));
    FCapacity := NewCapacity;
  end;
end;

procedure TRapList.SetCount(NewCount: Integer);
//var
  //I: Integer;
begin
  {
  if (NewCount < 0) or (NewCount > MaxListSize) then
    Error(@SListCountError, NewCount);
  if NewCount > FCapacity then
    SetCapacity(NewCount);
  if NewCount > FCount then
    FillChar(FList^[FCount], (NewCount - FCount) * SizeOf(Pointer), 0)
  else
    for I := FCount - 1 downto NewCount do
      Delete(I);
  FCount := NewCount;}

  if NewCount >= FCount then
    Exit;
  FCount := NewCount;
end;

procedure QuickSortPointerList(SortList: PPointerList; L, R: Integer;
  SCompare: TListSortCompare);
var
  I, J: Integer;
  P, T: Pointer;
begin
  repeat
    I := L;
    J := R;
    P := SortList^[(L + R) shr 1];
    repeat
      while SCompare(SortList^[I], P) < 0 do
        Inc(I);
      while SCompare(SortList^[J], P) > 0 do
        Dec(J);
      if I <= J then
      begin
        T := SortList^[I];
        SortList^[I] := SortList^[J];
        SortList^[J] := T;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSortPointerList(SortList, L, J, SCompare);
    L := I;
  until I >= R;
end;


procedure TRapList.Sort(Compare: TListSortCompare);
begin
  if (FList <> nil) and (Count > 0) then
    QuickSortPointerList(FList, 0, Count - 1, Compare);
end;

function TRapList.Extract(Item: Pointer): Pointer;
var
  I: Integer;
begin
  {Result := nil;
  I := IndexOf(Item);
  if I >= 0 then
  begin
    Result := Item;
    FList^[I] := nil;
    Delete(I);
    Notify(Result, lnExtracted);
  end; }
  Result := nil;
  I := IndexOf(Item);
  if I >= 0 then
  begin
    Result := Item;
    FList^[I] := nil;
    Delete(I);
  end;
end;

//procedure TRapList.Notify(Ptr: Pointer; Action: TListNotification);
//begin
//end;

procedure TRapList.Assign(ListA: TRapList; AOperator: TListAssignOp; ListB: TRapList);
var
  I: Integer;
  LTemp, LSource: TRapList;
begin
  // ListB given?
  if ListB <> nil then
  begin
    LSource := ListB;
    Assign(ListA);
  end
  else
    LSource := ListA;

  // on with the show
  case AOperator of

    // 12345, 346 = 346 : only those in the new list
    laCopy:
      begin
        Clear;
        Capacity := LSource.Capacity;
        for I := 0 to LSource.Count - 1 do
          Add(LSource[I]);
      end;

    // 12345, 346 = 34 : intersection of the two lists
    laAnd:
      for I := Count - 1 downto 0 do
        if LSource.IndexOf(Items[I]) = -1 then
          Delete(I);

    // 12345, 346 = 123456 : union of the two lists
    laOr:
      for I := 0 to LSource.Count - 1 do
        if IndexOf(LSource[I]) = -1 then
          Add(LSource[I]);

    // 12345, 346 = 1256 : only those not in both lists
    laXor:
      begin
        LTemp := TRapList.Create;  // Temp holder of 4 byte values
        try
          LTemp.Capacity := LSource.Count;
          for I := 0 to LSource.Count - 1 do
            if IndexOf(LSource[I]) = -1 then
              LTemp.Add(LSource[I]);
          for I := Count - 1 downto 0 do
            if LSource.IndexOf(Items[I]) <> -1 then
              Delete(I);
          I := Count + LTemp.Count;
          if Capacity < I then
            Capacity := I;
          for I := 0 to LTemp.Count - 1 do
            Add(LTemp[I]);
        finally
          LTemp.Free;
        end;
      end;

    // 12345, 346 = 125 : only those unique to source
    laSrcUnique:
      for I := Count - 1 downto 0 do
        if LSource.IndexOf(Items[I]) <> -1 then
          Delete(I);

    // 12345, 346 = 6 : only those unique to dest
    laDestUnique:
      begin
        LTemp := TRapList.Create;
        try
          LTemp.Capacity := LSource.Count;
          for I := LSource.Count - 1 downto 0 do
            if IndexOf(LSource[I]) = -1 then
              LTemp.Add(LSource[I]);
          Assign(LTemp);
        finally
          LTemp.Free;
        end;
      end;
  end;
end;

{ TRapObjectList }

constructor TRapObjectList.Create(AOwnsObjects: Boolean=false; AAllowDuplicates: Boolean=true);
begin
  inherited create;// Tolik 12/12/2019 --
  FItems := TRapList.Create;
  //FSortFieldOffset := -1;
  FOwnsObjects := AOwnsObjects;
  FAllowDuplicates := AAllowDuplicates;
  Clear;
end;

destructor TRapObjectList.Destroy;
begin
  FreeAndNil(FItems);
  inherited;
end;

procedure TRapObjectList.Clear;
var
  i: Integer;
begin
  if FOwnsObjects then
    for i := FItems.Count - 1 downto 0 do
      TObject(FItems[i]).Free;
  FItems.Clear;
  FSortFieldOffset := -1;
end;

function TRapObjectList.FindObject(AValue: Pointer; AObject: TObject; AFieldAdress: Pointer;
  var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
  FieldOffset: Integer;
  ValueParam: Integer;
  ValueI: Integer;
begin
  Result := False;

  ValueParam := 0;
  if AValue = nil then
  begin
    // Ищем смещение поля
    FieldOffset := Integer(Integer(AFieldAdress) - Integer(AObject));
    if FSortFieldOffset = -1 then
      FSortFieldOffset := FieldOffset
    else
    if FSortFieldOffset <> FieldOffset then
      FItems.Error(@SInvalidFieldOffset, FieldOffset);

    ValueParam := Integer(Pointer(AFieldAdress)^);
  end
  else
  begin
    FieldOffset := FSortFieldOffset;
    ValueParam := Integer(AValue^);
  end;

  L := 0;
  H := FItems.FCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;

    ValueI := Integer(Pointer(Integer(FItems.FList^[I]) + FieldOffset)^);
    //C := CompareStrings(FList^[I].FString, S);
    if ValueI < ValueParam then //if C < 0 then
      L := I + 1
    else
    begin
      H := I - 1;
      //if C = 0 then
      if ValueI = ValueParam then
      begin
        Result := True;
        L := I;
        Break; //// BREAK ////
      end;
    end;
  end;
  Index := L;
end;

function TRapObjectList.Get(Index: Integer): Pointer;
begin
  Result := FItems.Get(Index);
end;

function TRapObjectList.GetCount: Integer;
begin
  Result := FItems.FCount;
end;

function TRapObjectList.GetObject(AFieldValue: Integer): TObject;
var
  ObjectIndex: Integer;

begin
  Result := nil;

  if FSortFieldOffset <> -1 then
  begin
    if FindObject(@AFieldValue, nil, nil, ObjectIndex) then
      if ObjectIndex <> -1 then
        Result := TObject(FItems[ObjectIndex]);
  end;
end;


function TRapObjectList.Insert(AObject: TObject; AFieldAdress: Pointer): Integer;
var
  IndexToInsert: Integer;
  Finded: Boolean;
begin
  Result := -1;
  IndexToInsert := 0;

  Finded := FindObject(nil, AObject, AFieldAdress, IndexToInsert);

  if Not Finded or FAllowDuplicates then
  begin
    FItems.Insert(IndexToInsert, TObject(AObject));
    Result := IndexToInsert;
  end;
end;

function TRapObjectList.Remove(AFieldValue: Integer): Integer;
var
  ObjectIndex: Integer;
begin
  Result := -1;
  if FSortFieldOffset <> -1 then
  begin
    if FindObject(@AFieldValue, nil, nil, ObjectIndex) then
      if ObjectIndex <> -1 then
      begin
        Result := ObjectIndex;
        FItems.Delete(ObjectIndex);
      end;
  end;
end;

{ TRapRecordList }

constructor TRapRecordList.Create(AOwnsObjects: Boolean);
begin
  inherited Create;

end;

destructor TRapRecordList.Destroy;
var
  i: Integer;
  ptrToFree: Pointer;
begin
  if FOwnsObjects then
  begin
    for i := 0 to FItems.Count - 1 do
    begin
      ptrToFree := FItems.List^[i];
      if ptrToFree <> nil then
        FreeMem(ptrToFree);
    end;
    FItems.Clear;
  end;

  inherited;
end;


{ TIntList }

function TIntList.Add(AInt: Integer): Integer;
begin
  Result := FItems.Add(Pointer(AInt)); //inherited Add(Pointer(AInt));
end;

procedure TIntList.Assign(ListA: TIntList; AOperator: TListAssignOp = laCopy; ListB: TIntList = nil);
var
  LAItems: TList;
  LBItems: TList;
begin
  LAItems := nil;
  LBItems := nil;

  if Assigned(ListA) then
    LAItems := ListA.FItems;
  if Assigned(ListB) then
    LBItems := ListB.FItems;

  FItems.Assign(LAItems, AOperator, LBItems);
end;

procedure TIntList.Clear;
begin
  FItems.Clear;
end;

procedure TIntList.Delete(AIndex: Integer);
begin
  FItems.Delete(AIndex);
end;

procedure TIntList.Fill(AVal: Integer; AToIndex: Integer=-1);
var
  i: Integer;
  AddCount: Integer;
begin
  for i := 0 to FItems.Count - 1 do
    FItems[i] := Pointer(AVal);
  AddCount := AToIndex - (FItems.Count - 1);
  if AddCount > 0 then
    for i := 1 to AddCount do
      FItems.Add(Pointer(AVal));
end;

procedure TIntList.Move(CurrIndex, NewIndex: Integer);
begin
  FItems.Move(CurrIndex, NewIndex);
end;

constructor TIntList.Create;
begin
  inherited Create;
  FItems := Tlist.Create;
end;

destructor TIntList.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TIntList.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TIntList.GetItem(Index: Integer): Integer;
begin
  Result := Integer(FItems[Index]); //Integer(inherited Items[Index]);
end;

function TIntList.IndexOf(AInt: Integer): Integer;
var
  i: Integer;
begin
  Result := -1;
  //Result := FItems.IndexOf(Pointer(AInt)); //inherited IndexOf(Pointer(AInt));
  for i := 0 to FItems.Count - 1 do
    if Integer(FItems.List^[i]) = AInt then
    begin
      Result := i;
      Break; //// BREAK ////
    end;
end;

procedure TIntList.Insert(Index, AInt: Integer);
begin
  FItems.Insert(Index, Pointer(AInt)); //inherited Insert(Index, Pointer(AInt));
end;

function TIntList.Remove(AInt: Integer): Integer;
begin
  Result := FItems.Remove(Pointer(AInt)); //inherited Remove(Pointer(AInt));
end;

procedure TIntList.RemoveDublicates;
var
  i, j: Integer;
  ValueI, ValueJ: Integer;
begin
  i := 0;
  while i <= FItems.Count - 1 do
  begin
    ValueI := Integer(FItems[i]);

    j := i+1;
    while j <= FItems.Count - 1 do
    begin
      ValueJ := Integer(FItems[j]);
      if ValueJ = ValueI then
        FItems.Delete(j)
      else
        Inc(j);
    end;
    Inc(i);
  end;
end;

function TIntList.RemoveItems(AItems: TIntList): Integer;
var
  i: Integer;
begin
  for i := 0 to AItems.Count - 1 do
    Remove(AItems[i]);
end;

procedure TIntList.SetItem(Index, AInt: Integer);
begin
  FItems.Items[Index] := Pointer(AInt); //inherited Items[Index] := Pointer(AInt);
end;

{ TIDStringList }

constructor TIDStringList.Create;
begin
  inherited;
  FIDs := TIntList.Create;
  FStrings := TStringList.Create;
end;

destructor TIDStringList.Destroy;
begin
  FreeAndNil(FIDs);
  FreeAndNil(FStrings);
  inherited;
end;

function TIDStringList.Add(AID: Integer; AString: String): Integer;
begin
  Result := FIDs.Add(AID);
  FStrings.Add(AString);
end;

function TIDStringList.Add(AID: Integer; AString: String; AObject: TObject): Integer;
begin
  Result := FIDs.Add(AID);
  FStrings.AddObject(AString, AObject);
end;

procedure TIDStringList.Assign(ListA: TIDStringList; AOperator:
  TListAssignOp = laCopy; ListB: TIDStringList = nil);
begin
  if ListB <> nil then
    FIDs.Assign(ListA.FIDs, AOperator, ListB.FIDs)
  else
    FIDs.Assign(ListA.FIDs, AOperator, nil);
  FStrings.Assign(ListA.FStrings);
end;

procedure TIDStringList.Clear;
begin
  FIDs.Clear;
  FStrings.Clear;
end;

procedure TIDStringList.Delete(AIndex: Integer);
begin
  FIDs.Delete(AIndex);
  FStrings.Delete(AIndex);
end;

function TIDStringList.GetCount: Integer;
begin
  Result := FIDs.Count;
end;

function TIDStringList.GetIDByIndex(AIndex: Integer): Integer;
begin
  Result := FIDs[AIndex];
end;

function TIDStringList.GetIDByString(AString: String): Integer;
var
  Index: Integer;
begin
  Result := -1;
  Index := FStrings.IndexOf(AString);
  if Index <> -1 then
    Result := FIDs.Items[Index];
end;

function TIDStringList.GetStringByID(AID: Integer): String;
var
  Index: Integer;
begin
  Result := '';
  Index := FIDs.IndexOf(AID);
  if Index <> -1 then
    Result := FStrings[Index];
end;

function TIDStringList.GetStringByIndex(AIndex: Integer): String;
begin
  Result := FStrings[AIndex];
end;

function TIDStringList.IndexOfByID(AID: Integer): Integer;
begin
  Result := FIDs.IndexOf(AID);
end;

function TIDStringList.IndexOfByString(AString: String): Integer;
begin
  Result := FStrings.IndexOf(AString);
end;

function TIDStringList.RemoveByID(AID: Integer): Integer;
var
  RemIndex: Integer;
begin
  RemIndex := FIDs.Remove(AID);
  if RemIndex <> -1 then
    FStrings.Delete(RemIndex);
  Result := RemIndex;
end;

function TIDStringList.RemoveByString(AString: String): Integer;
var
  RemIndex: Integer;
begin
  RemIndex := FStrings.IndexOf(AString);
  if RemIndex <> -1 then
  begin
    FIDs.Delete(RemIndex);
    FStrings.Delete(RemIndex);
  end;
  Result := RemIndex;
end;


{ TBasicArrayList }

procedure TBasicArrayList.Assign(ASrc: TBasicArrayList);
begin
  FCount := ASrc.FCount;
  FItemsCount := ASrc.FItemsCount;
end;

procedure TBasicArrayList.Clear;
begin
  FCount := 0;
  FItemsCount := 0;
end;

constructor TBasicArrayList.Create;
begin
  inherited Create;
  FCount := 0;
  FItemsCount := 0;
end;

destructor TBasicArrayList.Destroy;
begin
  Clear;
  inherited;
end;


{ TConnectedComponsList }

function TConnectedComponsList.Add(AConnectedComponsInfo: TConnectedComponsInfo): Integer;
begin
  //Result := inherited Add(AConnectedComponsInfo);
  Inc(FCount);
  if FCount > FItemsCount then
  begin
    FItemsCount := FItemsCount + 200;
    SetLength(FItems, FItemsCount);
  end;
  FItems[FCount - 1] := AConnectedComponsInfo;
  Result := FCount - 1;
end;

procedure TConnectedComponsList.Assign(AConnectedComponsList: TConnectedComponsList);
begin
  inherited Assign(AConnectedComponsList);
  SetLength(FItems, Length(AConnectedComponsList.FItems));
  FItems := AConnectedComponsList.FItems;

  //CopyMemory(@FItems, @AConnectedComponsList.FItems, Length(AConnectedComponsList.FItems));
end;

procedure TConnectedComponsList.Clear;
begin
  //Tolik
  SetLength(FItems,0);
  //
  inherited;
end;

procedure TConnectedComponsList.Delete(Index: Integer);
var
  Len: Integer;
begin
  if Index >= FCount then
    raise Exception.Create('Index out of bounds '+IntToStr(FCount - Index));

  Len := High(FItems);
  if index < Len then
  begin
    if index < FCount - 1 then
      Move(FItems[Index+1], FItems[Index], (Len - Index)*SizeOf(FItems[Index]));
  end;
  Dec(FCount);
  if FItemsCount - FCount = 200 then
  begin
    FItemsCount := FItemsCount - 200;
    SetLength(FItems, FItemsCount);
  end;
end;

function TConnectedComponsList.GetConnectedComponsInfoByWholeID(AWholeID: Integer): TList;
var
  i: Integer;
  ConnectedComponsInfo: TConnectedComponsInfo;
  ptrConnectedComponsInfo: PConnectedComponsInfo;
begin
  Result := TList.Create;
  for i := 0 to Count - 1 do
  begin
    ConnectedComponsInfo := FItems[i];
    if ConnectedComponsInfo.ComponWholeID = AWholeID then
    begin
      GetMem(ptrConnectedComponsInfo, SizeOf(TConnectedComponsInfo));
      ptrConnectedComponsInfo^ := ConnectedComponsInfo;
      Result.Add(ptrConnectedComponsInfo);
    end;
  end;
end;

function TConnectedComponsList.GetConnectedComponsInfoByWholeIDAndType(AWholeID, AType: Integer): TConnectedComponsInfo;
var
  i: Integer;
  ConnectedComponsInfo: TConnectedComponsInfo;
begin
  ZeroMemory(@Result, SizeOf(TConnectedComponsInfo));
  for i := 0 to FCount - 1 do
  begin
    ConnectedComponsInfo := FItems[i];
    if (ConnectedComponsInfo.ComponWholeID = AWholeID) and
       (ConnectedComponsInfo.TypeConnect = AType) then
    begin
      Result := ConnectedComponsInfo;
      Break; ///// BREAK /////
    end;
  end;
end;

procedure TConnectedComponsList.GetConnectedComponsInfosByWholeID(AWholeID: Integer; var aResFrom, aResTo: TConnectedComponsInfo);
var
  i: Integer;
  ptrConnectedComponsInfo: PConnectedComponsInfo;
  RecCnt: SmallInt;
begin
  ZeroMemory(@aResFrom, SizeOf(TConnectedComponsInfo));
  ZeroMemory(@aResTo, SizeOf(TConnectedComponsInfo));
  RecCnt := 0;
  for i := 0 to FCount - 1 do
  begin
    ptrConnectedComponsInfo := @FItems[i];
    if ptrConnectedComponsInfo.ComponWholeID = AWholeID then
    begin
      if ptrConnectedComponsInfo.TypeConnect = tcoFrom then
      begin
        aResFrom := ptrConnectedComponsInfo^;
        Inc(RecCnt);
      end
      else if ptrConnectedComponsInfo.TypeConnect = tcoTo then
      begin
        aResTo := ptrConnectedComponsInfo^;
        Inc(RecCnt);
      end;
      if RecCnt = 2 then
        Break; ///// BREAK /////
    end;
  end;
end;

constructor TConnectedComponsList.Create;
begin
  //Tolik
  Clear;
  //
  inherited Create;
end;

destructor TConnectedComponsList.Destroy;
begin
  Clear;
  inherited;
end;

function TConnectedComponsList.GetItem(Index: Integer): TConnectedComponsInfo;
begin
  Result := FItems[Index]; //PConnectedComponsInfo(inherited Items[Index]);
end;

procedure TConnectedComponsList.RemoveByWholeID(AWholeID: Integer);
var
  ConnectedComponsInfo: TConnectedComponsInfo;
  i: Integer;
begin
  i := 0;
  while i <= FCount - 1 do
  begin
    ConnectedComponsInfo := Items[i];
    if ConnectedComponsInfo.ComponWholeID = AWholeID then
    begin
      Delete(i);
      //Remove(ptrConnectedComponsInfo);
      //FreeMem(ptrConnectedComponsInfo);
    end
    else
      Inc(i);
  end;

  {ptrConnectedComponsInfo := GetConnectedComponsInfoByWholeIDAndType(AWholeID, tcoFrom);
  if ptrConnectedComponsInfo <> nil then
  begin
    Remove(ptrConnectedComponsInfo);
    FreeMem(ptrConnectedComponsInfo);
  end;
  ptrConnectedComponsInfo := GetConnectedComponsInfoByWholeIDAndType(AWholeID, tcoTo);
  if ptrConnectedComponsInfo <> nil then
  begin
    Remove(ptrConnectedComponsInfo);
    FreeMem(ptrConnectedComponsInfo);
  end;}
end;


procedure TConnectedComponsList.InsertRecord(AComponWholeID, AIDConnectedObject,
  AIDConnectedCompon, AIDSideCompon, ATypeConnect: Integer);
var
  ConnectedComponsInfo: TConnectedComponsInfo;
begin
  ZeroMemory(@ConnectedComponsInfo, SizeOf(TConnectedComponsInfo));
  ConnectedComponsInfo.ID := 0;
  ConnectedComponsInfo.ComponWholeID := AComponWholeID;
  ConnectedComponsInfo.IDConnectObject := AIDConnectedObject;
  ConnectedComponsInfo.IDConnectCompon := AIDConnectedCompon;
  ConnectedComponsInfo.IDSideCompon := AIDSideCompon;
  ConnectedComponsInfo.TypeConnect := ATypeConnect;
  Add(ConnectedComponsInfo);
end;

procedure TConnectedComponsList.SetItem(Index: Integer;
  AConnectedComponsInfo: TConnectedComponsInfo);
begin
  FItems[Index] := AConnectedComponsInfo; //inherited Items[Index] := AConnectedComponsInfo;
end;


{ TJoinComponsInfoList }

function TJoinComponsInfoList.Add: Integer;
begin
  FCount := FCount + 1;
  if FCount > FItemsCount then
  begin
    FItemsCount := FItemsCount + 200;
    SetLength(FItems, FItemsCount);
  end;
  //FItems[FCount - 1] := AJoinComponsInfo;
  Result := FCount - 1;
end;

function TJoinComponsInfoList.AddRecord(AIDCompon1, AIDCompon2,
  ADBKind1, ADBKind2: Integer): Integer;
//var
  //JoinComponsInfo: TJoinComponsInfo;
begin
  {//11.03.2009
  Result := -1;
  ZeroMemory(@JoinComponsInfo, SizeOf(TJoinComponsInfo));
  JoinComponsInfo.IDCompon1 := AIDCompon1;
  JoinComponsInfo.IDCompon2 := AIDCompon2;
  JoinComponsInfo.DBKind1 := ADBKind1;
  JoinComponsInfo.DBKind2 := ADBKind2;
  Result := Add(JoinComponsInfo);
  }

  Result := Add;
  FItems[Result].IDCompon1 := AIDCompon1;
  FItems[Result].IDCompon2 := AIDCompon2;
  FItems[Result].DBKind1 := ADBKind1;
  FItems[Result].DBKind2 := ADBKind2;
end;

procedure TJoinComponsInfoList.Clear;
begin
  SetLength(FItems, 0);
  inherited;
end;

constructor TJoinComponsInfoList.Create;
begin
  //Tolik
  Clear;
  //
  inherited Create;
end;

destructor TJoinComponsInfoList.Destroy;
begin
  // Tolik
  Clear;
  //
  inherited;
end;

function TJoinComponsInfoList.GetItem(Index: Integer): TJoinComponsInfo;
begin
  Result := FItems[Index]; //PJoinComponsInfo(inherited Items[Index]);
end;

function TJoinComponsInfoList.FindJoinComponsInfo(AIDCompon1,
  AIDCompon2, ADBKind1, ADBKind2: Integer): Boolean;
var
  i: Integer;
  JoinComponsInfo: TJoinComponsInfo;
begin
  Result := false;
  for i := 0 to FCount - 1 do
  begin
    JoinComponsInfo := FItems[i];
    if ((JoinComponsInfo.IDCompon1 = AIDCompon1) and (JoinComponsInfo.IDCompon2 = AIDCompon2) and
        (JoinComponsInfo.DBKind1 = ADBKind1) and (JoinComponsInfo.DBKind2 = ADBKind2)) or
       ((JoinComponsInfo.IDCompon1 = AIDCompon2) and (JoinComponsInfo.IDCompon2 = AIDCompon1) and
        (JoinComponsInfo.DBKind1 = ADBKind2) and (JoinComponsInfo.DBKind2 = ADBKind1)) then
    begin
      Result := true;
      Break; ///// BREAK /////
    end;
  end;
end;

procedure TJoinComponsInfoList.SetItem(Index: Integer;
  AJoinComponsInfo: TJoinComponsInfo);
begin
  Items[Index] := AJoinComponsInfo;
end;

{ TLog }

function TLog.CheckDirectoryExists: Boolean;
begin
  Result := false;
  if Not DirectoryExists(FDirectory) then
    CreateDir(FDirectory);
  if DirectoryExists(FDirectory) then
    Result := true;
end;

procedure TLog.DefineExistsFiles;
var
  SearchRec: TSearchRec;

  DirName: String;
  FileAttrs: Integer;
begin
  DirName := FDirectory;
  if DirName[Length(DirName)] <> '\' then
    DirName := DirName + '\';

  FileAttrs := faAnyFile + faHidden;
  if FindFirst(DirName + '*.*', FileAttrs, SearchRec) <> 0 then
  begin
    repeat
      if (SearchRec.Attr and FileAttrs) = SearchRec.Attr then
        if Pos(FFilePrefix, SearchRec.Name) = 1 then
          FExistsFiles.Add(SearchRec.Name);
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;
end;

procedure TLog.SaveStringToFile(AText, AFileName: String);
var
  FHandle: TextFile;
begin
  if FileExists(AFileName) then
    Append(FHandle)
  else
    Rewrite(FHandle);
  try
    WriteLn(FHandle, AText);
  finally
    CloseFile(FHandle);
  end;
end;

procedure TLog.AddStringToLog(AText: String);
var
  TextLength: Integer;
  FileName: String;
  NewData: TDate;
begin
  TextLength := Length(AText);

  NewData := Date;
  if (FCurrData <> NewData) then
  begin
    FileName := FFilePrefix + '_'+
                IntToStrF(YearOf(NewData), 4)+
                IntToStrF(MonthOf(NewData), 2)+
                IntToStrF(DayOf(NewData), 2)+'.'+FFileExtension;
    FCurrLogSize := 0;
    FCurrFileIndex := 0;
  end;
  if FileName = '' then
    if ((FCurrLogSize + TextLength) > 2048) then
    begin

    end;

  if FImmediateSave then
  begin

  end
  else
  begin

  end;
end;

constructor TLog.Create(ADirectory, AFilePrefix, AFileExtension: String; AImmediateSave: Boolean);
begin
  inherited Create;

  FDirectory := ADirectory + '\';
  FFilePrefix := AFilePrefix;
  FFileExtension := AFileExtension;
  FImmediateSave := AImmediateSave;

  FCurrData := Date;
  FCurrFileIndex := 0;
  FCurrLog := nil;
  FCurrLogSize := 0;
  if Not AImmediateSave then
    FCurrLog := TStringList.Create;
  FExistsFiles := TStringList.Create;

  if CheckDirectoryExists then
    DefineExistsFiles;
end;

destructor TLog.Destroy;
begin
  if Assigned(FCurrLog) then
    FreeAndNil(FCurrLog);
  if Assigned(FExistsFiles) then
    FreeAndNil(FExistsFiles);

  inherited;
end;

function AddStrObjToStrings(AStrings: TStrings; const AKeyStr, AStrObj: String): Integer;
var
  StringObject: TStringObject;
begin
  Result := -1;

  StringObject := TStringObject.Create;
  StringObject.FString := AStrObj;
  Result := AStrings.AddObject(AKeyStr, StringObject);
end;

procedure DeleteArrayItem(var X; const Index, ItemSize: Integer);
begin
  {if Index > High(X) then
    Exit;
  if Index < Low(X) then
    Exit;
  if Index = High(X) then
  begin
   SetLength(X, Length(X) - 1) ;
   Exit;
  end;
  Finalize(X[Index]) ;
  System.Move(X[Index +1], X[Index],(Length(X) - Index -1) * ItemSize + 1);
  SetLength(X, Length(X) - 1);}
end;

function FindInSortedIntList(AValue: Integer; AList: TIntList; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := AList.Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    //C := CompareStrings(FList^[I].FString, S);
    if Integer(AList.List.List^[I]) < AValue then //if C < 0 then
      L := I + 1
    else
    begin
      H := I - 1;
      //if C = 0 then
      if Integer(AList.List.List^[I]) = AValue then
      begin
        Result := True;
        L := I;
        Break; //// BREAK ////
      end;
    end;
  end;
  Index := L;
end;

function FindInSortedList(AValue: Pointer; AList: TList; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := AList.Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    //C := CompareStrings(FList^[I].FString, S);
    if Integer(AList.List^[I]) < Integer(AValue) then //if C < 0 then
      L := I + 1
    else
    begin
      H := I - 1;
      //if C = 0 then
      if Integer(AList.List^[I]) = Integer(AValue) then
      begin
        Result := True;
        L := I;
        Break; //// BREAK ////
      end;
    end;
  end;
  Index := L;
end;

function FindInSortedRapList(AValue: Pointer; AList: TRapList; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := AList.FCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    //C := CompareStrings(FList^[I].FString, S);
    if LongInt(AList.FList^[I]) < LongInt(AValue) then //if C < 0 then
      L := I + 1
    else
    begin
      H := I - 1;
      //if C = 0 then
      if LongInt(AList.FList^[I]) = LongInt(AValue) then
      begin
        Result := True;
        L := I;
        Break; //// BREAK ////
      end;
    end;
  end;
  Index := L;
end;

function FindObjectInSortedRapList(AObject: TObject; AFieldAdress: Pointer;
  AList: TRapList; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
  FieldOffset: Integer;
  ValueParam: Integer;
  ValueI: Integer;
begin
  Result := False;

  // Ищем смещение поля
  FieldOffset := Integer(Integer(AFieldAdress) - Integer(AObject));
  if AList.FSortFieldOffset = -1 then
    AList.FSortFieldOffset := FieldOffset;

  ValueParam := Integer(Pointer(AFieldAdress)^);

  L := 0;
  H := AList.FCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;

    ValueI := Integer(Pointer(Integer(AList.FList^[I]) + FieldOffset)^);
    //C := CompareStrings(FList^[I].FString, S);
    if ValueI < ValueParam then //if C < 0 then
      L := I + 1
    else
    begin
      H := I - 1;
      //if C = 0 then
      if ValueI = ValueParam then
      begin
        Result := True;
        Break; //// BREAK ////
      end;
    end;
  end;
  Index := L;
end;

function InsertObjectToSortetRapList(AObject: TObject; AFieldAdress: Pointer; AList: TRapList): Integer;
var
  IndexToInsert: Integer;
begin
  Result := -1;
  IndexToInsert := 0;

  //FindInSortedRapList(AValue, AList, IndexToInsert);
  FindObjectInSortedRapList(AObject, AFieldAdress, AList, IndexToInsert);

  AList.Insert(IndexToInsert, TObject(AObject));
  Result := IndexToInsert;
end;

function InsertValueToSortetList(AValue: Pointer; AList: TList): Integer;
var
  IndexToInsert: Integer;
begin
  FindInSortedList(AValue, AList, IndexToInsert);

  AList.Insert(IndexToInsert, Pointer(AValue));
  Result := IndexToInsert;
end;

function InsertValueToSortetRapList(AValue: Pointer; AList: TRapList): Integer;
var
  FirstIndex: Integer;
  LastIndex: Integer;
  MidleIndex: Integer;

  IndexToInsert: Integer;
begin
  Result := -1;
  IndexToInsert := 0;

  {if Alist.Count > 0 then
  begin
    FirstIndex := 0;
    LastIndex := AList.Count - 1;
    while FirstIndex <= LastIndex do
    begin
      if LongInt(Alist.List^[LastIndex]) = LongInt(AValue) then
      begin
        IndexToInsert := LastIndex;
        Break; //// BREAK ////
      end
      else
      begin
        // Найти средний индекс
        MidleIndex := LastIndex;
        if LastIndex > FirstIndex then
          MidleIndex := FirstIndex + Trunc((LastIndex-FirstIndex)/2);
        // На всякий случай проверить, не вышел ли средний индекс за диапазон
        if (MidleIndex < FirstIndex) or (MidleIndex > LastIndex) then
        begin
          Break; //// BREAK ////
        end
        else
        if (LongInt(AList.List^[MidleIndex]) < LongInt(AVAlue)) and (LongInt(AVAlue) < LongInt(AList.List^[LastIndex])) then
        begin
          if FirstIndex = MidleIndex then
            FirstIndex := MidleIndex + 1
          else
            FirstIndex := MidleIndex;
          IndexToInsert := MidleIndex + 1;
        end
        else
        begin
          LastIndex := MidleIndex;
          if LongInt(AList.List^[LastIndex]) < LongInt(AValue) then
            IndexToInsert := LastIndex + 1
          else
            IndexToInsert := LastIndex;
        end;

        if FirstIndex = LastIndex then
          Break; //// BREAK ////
      end;
    end;
  end;  }

  FindInSortedRapList(AValue, AList, IndexToInsert);

  AList.Insert(IndexToInsert, AValue);
  Result := IndexToInsert;
end;

function InsertValueToSortetIntList(AValue: Integer; AList: TIntList): Integer;
var
  //FirstIndex: Integer;
  //LastIndex: Integer;
  //MidleIndex: Integer;

  IndexToInsert: Integer;
begin
  Result := -1;
  IndexToInsert := 0;

  {if Alist.Count > 0 then
  begin
    FirstIndex := 0;
    LastIndex := AList.Count - 1;
    while FirstIndex <= LastIndex do
    begin
      if Alist[LastIndex] = AValue then
      begin
        IndexToInsert := LastIndex;
        Break; //// BREAK ////
      end
      else
      begin
        // Найти средний индекс
        if LastIndex > FirstIndex then
        begin
          MidleIndex := FirstIndex + Trunc((LastIndex-FirstIndex)/2);
          // На всякий случай проверить, не вышел ли средний индекс за диапазон
          if (MidleIndex < FirstIndex) or (MidleIndex > LastIndex) then
          begin
            Break; //// BREAK ////
          end
          else
          if AList[MidleIndex] < AVAlue then
          begin
            if FirstIndex = MidleIndex then
              FirstIndex := MidleIndex + 1
            else
              FirstIndex := MidleIndex;
          end
          else
          begin
            LastIndex := MidleIndex;
          end;
        end
        else
        begin
          if AList[LastIndex] < AValue then
            IndexToInsert := LastIndex + 1
          else
            IndexToInsert := LastIndex;
          Break; //// BREAK ////
        end;
      end;
    end;
  end;}

  {РАБОТАЕТ
  if Alist.Count > 0 then
  begin
    FirstIndex := 0;
    LastIndex := AList.Count - 1;
    while FirstIndex <= LastIndex do
    begin
      if Alist[LastIndex] = AValue then
      begin
        IndexToInsert := LastIndex;
        Break; //// BREAK ////
      end
      else
      begin
        // Найти средний индекс
        MidleIndex := LastIndex;
        if LastIndex > FirstIndex then
          MidleIndex := FirstIndex + Trunc((LastIndex-FirstIndex)/2);
        // На всякий случай проверить, не вышел ли средний индекс за диапазон
        if (MidleIndex < FirstIndex) or (MidleIndex > LastIndex) then
        begin
          Break; //// BREAK ////
        end
        else
        if (AList[MidleIndex] < AVAlue) and (AVAlue < AList[LastIndex]) then
        begin
          if FirstIndex = MidleIndex then
            FirstIndex := MidleIndex + 1
          else
            FirstIndex := MidleIndex;
          IndexToInsert := MidleIndex + 1;
        end
        else
        begin
          LastIndex := MidleIndex;
          if AList[LastIndex] < AValue then
            IndexToInsert := LastIndex + 1
          else
            IndexToInsert := LastIndex;
        end;

        if FirstIndex = LastIndex then
          Break; //// BREAK ////
      end;
    end;
  end;}

  FindInSortedIntList(AValue, AList, IndexToInsert);

  AList.FItems.Insert(IndexToInsert, Pointer(AValue));
  Result := IndexToInsert;
end;

function IntListToList(AIntList: TIntList): TList;
var
  i: Integer;
  ptrInt: ^Integer;
begin
  Result := TList.Create;
  for i := 0 to AIntList.Count - 1 do
  begin
    GetMem(ptrInt, SizeOf(Integer));
    ptrInt^ := AIntList[i];
    Result.Add(ptrInt);
  end;
end;

function IntListToSorted(AIntList: TIntList): TIntList;
var
  i: integer;
begin
  Result := TIntList.Create;
  for i := 0 to AIntList.Count - 1 do
    InsertValueToSortetIntList(Integer(AIntList.List.List^[i]), Result);
end;

function GetObjFromStringsByStr(AStrings: TStrings; const AStr: String): TObject;
var
  ObjIndex: Integer;
begin
  Result := nil;
  ObjIndex := AStrings.IndexOf(AStr);
  if ObjIndex <> -1 then
    Result := AStrings.Objects[ObjIndex];
end;

function GetValueIndexFromSortedRapList(AValue: Pointer; AList: TRapList): Integer;
//var
  //FirstIndex: Integer;
  //LastIndex: Integer;
  //MidleIndex: Integer;
begin
  Result := -1;
  {try
    if Alist.Count > 0 then
    begin
      FirstIndex := 0;
      LastIndex := AList.Count - 1;
      while FirstIndex <= LastIndex do
      begin
        if LongInt(Alist.List^[LastIndex]) = LongInt(AValue) then
        begin
          Result := LastIndex;
          Break; //// BREAK ////
        end
        else
        begin
          // Найти средний индекс
          if LastIndex > FirstIndex then
          begin
            MidleIndex := FirstIndex + Trunc((LastIndex-FirstIndex)/2);
            // На всякий случай проверить, не вышел ли средний индекс за диапазон
            if (MidleIndex < FirstIndex) or (MidleIndex > LastIndex) then
            begin
              Break; //// BREAK ////
            end
            else
            if LongInt(AList.List^[MidleIndex]) < LongInt(AVAlue) then
            begin
              if FirstIndex = MidleIndex then
                FirstIndex := MidleIndex + 1
              else
                FirstIndex := MidleIndex;
            end
            else
            begin
              LastIndex := MidleIndex;
            end;
          end
          else
            Break; //// BREAK ////
        end;
      end;
    end;
  except
    on E: Exception do AddExceptionToLogEx('GetValueIndexFromSortedRapList', E.Message);
  end; }

  if Not FindInSortedRapList(AValue, AList, Result) then
    Result := -1;
end;

function GetValueIndexFromSortedIntList(AValue: Integer; AList: TIntList): Integer;
//var
  //FirstIndex: Integer;
  //LastIndex: Integer;
  //MidleIndex: Integer;
begin
  Result := -1;
  {if Alist.Count > 0 then
  begin
    FirstIndex := 0;
    LastIndex := AList.Count - 1;
    while FirstIndex <= LastIndex do
    begin
      if Alist[LastIndex] = AValue then
      begin
        Result := LastIndex;
        Break; //// BREAK ////
      end
      else
      begin
        // Найти средний индекс
        if LastIndex > FirstIndex then
        begin
          MidleIndex := FirstIndex + Trunc((LastIndex-FirstIndex)/2);
          // На всякий случай проверить, не вышел ли средний индекс за диапазон
          if (MidleIndex < FirstIndex) or (MidleIndex > LastIndex) then
          begin
            Break; //// BREAK ////
          end
          else
          if AList[MidleIndex] < AVAlue then
          begin
            if FirstIndex = MidleIndex then
              FirstIndex := MidleIndex + 1
            else
              FirstIndex := MidleIndex;
          end
          else
          begin
            LastIndex := MidleIndex;
          end;
        end
        else
          Break; //// BREAK ////
      end;
    end;
  end;     }

  if Not FindInSortedIntList(AValue, AList, Result) then
    Result := -1;
end;

procedure LoadIntListFromStream(AStream: TStream; AIntList: TIntList);
var
  StreamSize: Integer;
  StreamPos: Integer;
  CurrValue: Integer;
begin
  AIntList.Clear;

  StreamSize := AStream.Size;
  StreamPos := AStream.Position;
  while StreamPos < StreamSize do
  begin
    AStream.ReadBuffer(CurrValue, SizeOf(Integer));
    AIntList.Add(CurrValue);
    StreamPos := AStream.Position;
  end;
end;

procedure SaveIntListToStream(AStream: TStream; AIntList: TIntList);
var
  i: Integer;
  CurrValue: Integer;
begin
  for i := 0 to AIntList.Count - 1 do
  begin
    CurrValue := AIntList[i];
    AStream.WriteBuffer(CurrValue, SizeOf(Integer));
  end;
end;

{ TStreamList }

procedure TStreamList.Add(AStream: TStream; AStreamCode: Integer);
begin
  FStreams.Add(AStream);
  FStreamsCodes.Add(AStreamCode);
end;

procedure TStreamList.AfterCreate(AOwnObjects: Boolean);
begin
  FOwnObjects := AOwnObjects;
  FStreams := TObjectList.Create(FOwnObjects);
  FStreamsCodes := TIntList.Create;
  FFileStream := nil;

  Clear;
end;

procedure TStreamList.CheckIsEnd;
begin
  if FFileStream.Position >= FFileStream.Size then
    ReadFileEnd;
end;

procedure TStreamList.Clear;
begin
  FStreams.Clear;
  FStreamsCodes.Clear;
  FFileCode := 0;
  FFileCodeStr := '';
end;

constructor TStreamList.Create(AFileCode: Integer; AOwnObjects: Boolean);
begin
  inherited create;

  AfterCreate(AOwnObjects);

  FFileCode := AFileCode;
  FISStrCode := false;
end;

constructor TStreamList.Create(AFileCode: string; AOwnObjects: Boolean);
begin
  inherited create;

  AfterCreate(AOwnObjects);

  FFileCodeStr := AFileCode;
  FISStrCode := true;
end;

destructor TStreamList.Destroy;
begin
  Clear;
  FreeAndNil(FStreams);
  FreeAndNil(FStreamsCodes);

  inherited;
end;

function TStreamList.GetStreamByCode(ACode: Integer): TStream;
var
  StreamIndex: Integer;
  i: Integer;
begin
  Result := nil;
  StreamIndex := -1;
  for i := 0 to FStreamsCodes.FItems.Count - 1 do
    if Integer(FStreamsCodes.FItems.List^[i]) = ACode then
    begin
      StreamIndex := i;
      Break; //// BREAK ////
    end;
  if StreamIndex <> -1 then
    Result := TStream(FStreams[StreamIndex]);
end;

function TStreamList.LoadFromFile(AFileName: String): Boolean;
var
  CurrStreamCode: Integer;
  CurrStreamSize: Integer;
  CurrStream: TMemoryStream;
begin
  Result := false;
  if FileExists(AFileName) then
  begin
    if ReadFileHeader(AFileName, 0) then
    begin
      //*** Читать блоки
      while Not FEOF do
      begin
        CurrStream := TMemoryStream.Create;
        ReadStreamFromFile(CurrStream, true);
      end;
      Result := true;
    end;

    {try
      //*** Читать блоки
      while FFileStream.Position < FileStream.Size do
      begin
        FFileStream.ReadBuffer(CurrStreamCode, SizeOf(Integer));
        FFileStream.ReadBuffer(CurrStreamSize, SizeOf(Integer));
        CurrStream := TMemoryStream.Create;

        CurrStream.CopyFrom(FFileStream, CurrStreamSize);
        CurrStream.Position := 0;

        Add(CurrStream, CurrStreamCode);
      end;
      Result := true;
    finally
      FreeAndNil(FFileStream);
    end;}
  end;
end;

procedure TStreamList.ReadFileEnd;
begin
  FEOF := true;
  if FFileStream <> nil then
    FreeAndNil(FFileStream);
end;

function TStreamList.ReadFileHeader(AFileName: String; AFileCodeSizeToCheck: Integer): Boolean;
var
  StrSize: Integer;
  FirstBlockPos: Int64;
begin
  Result := false;

  if FileExists(AFileName) then
  begin
    Clear;
    FEOF := false;

    if FFileStream <> nil then
      FreeAndNil(FFileStream);

    FFileStream := SafeOpenFileStream(AFileName, fmOpenRead, 'TStreamList.ReadFileHeader'); //TFileStream.Create(AFileName, fmOpenRead);
    if FFileStream <> nil then
    begin
      Result := true;

      FFileStream.Position := 0;
      //*** Читать код файла
      if Not FISStrCode then
      begin
        FFileStream.ReadBuffer(FFileCode, SizeOf(Integer));
      end
      else
      begin
        FFileStream.ReadBuffer(StrSize, SizeOf(Integer));

        // проверяем размер сигнатуры
        if (AFileCodeSizeToCheck <> 0) and (AFileCodeSizeToCheck <> StrSize) then
        begin
          Result := false;
          FEOF := true;
          FreeAndNil(FFileStream);
        end
        else
        begin
          SetLength(FFileCodeStr, StrSize);
          //FFileStream.ReadBuffer(pchar(FFileCodeStr)^, StrSize);
          FFileStream.ReadBuffer(pAnsiChar(FFileCodeStr)^, StrSize);
        end
      end;
      if Result then
      begin
        //*** Читать позицию для чтения первого блока
        FFileStream.ReadBuffer(FirstBlockPos, SizeOf(Int64));
        FFileStream.Seek(FirstBlockPos, soFromBeginning);

        CheckIsEnd;
      end;
    end;
  end;
end;

function TStreamList.ReadStreamFromFile(AStream: TStream; AAddToList: Boolean): Boolean;
var
  CurrStreamCode: Integer;
  CurrStreamSize: Integer;
begin
  Result := Not FEOF;
  if Result then
  begin
    FFileStream.ReadBuffer(CurrStreamCode, SizeOf(Integer));
    FFileStream.ReadBuffer(CurrStreamSize, SizeOf(Integer));

    AStream.CopyFrom(FFileStream, CurrStreamSize);
    AStream.Position := 0;

    if AAddToList then
      Add(AStream, CurrStreamCode);

    FReadedStreamCode := CurrStreamCode;

    CheckIsEnd;
  end;
end;

procedure TStreamList.RotateList;
var
  i: Integer;
  TmpCode: Integer;
  TmpStream: TObject;
  ItemsCount: Integer;
  IndexAtEnd: Integer;
  SavedOwnsObjects: Boolean;
  // Tolik 28/08/2019 --
  //OldTick, CurrTick: Cardinal;
  OldTick, CurrTick: DWord;
  //
begin
  OldTick := GetTickCount;
  if FStreams.Count = FStreamsCodes.Count then
  begin
    SavedOwnsObjects := FStreams.OwnsObjects;
    FStreams.OwnsObjects := false;
    try
      ItemsCount := FStreams.Count;
      for i := 0 to (ItemsCount div 2) - 1 do
      begin
        TmpCode := FStreamsCodes[i];
        TmpStream := FStreams[i];

        IndexAtEnd := ItemsCount - i - 1;
        FStreamsCodes[i] := FStreamsCodes[IndexAtEnd];
        FStreams[i] := FStreams[IndexAtEnd];

        FStreamsCodes[IndexAtEnd] := TmpCode;
        FStreams[IndexAtEnd] := TmpStream;
      end;
    finally
      FStreams.OwnsObjects := SavedOwnsObjects;
    end;
  end;
  CurrTick := GetTickCount - OldTick;
  CurrTick := GetTickCount - OldTick;
end;

procedure TStreamList.SaveToFile(AFileName: String);
var
  FileStream: TFileStream;
  FirstBlockPos: Int64;
  CurrStream: TStream;
  IntToWrite: Integer;
  i: integer;
begin
  if FileExists(AFileName) then
    DeleteFile(AFileName);
  if Not FileExists(AFileName) then
  begin
    FileStream := TFileStream.Create(AFileName, fmCreate);
    try
      FileStream.Position := 0;

      //*** Записать код файла
      if Not FISStrCode then
        FileStream.WriteBuffer(FFileCode, SizeOf(Integer))
      else
      begin
        // длина строки
        IntToWrite := Length(FFileCodeStr);
        FileStream.WriteBuffer(IntToWrite, SizeOf(Integer));
        // Строка
        //FileStream.WriteBuffer(pchar(FFileCodeStr)^, Length(FFileCodeStr));
        FileStream.WriteBuffer(pAnsiChar(FFileCodeStr)^, Length(FFileCodeStr)); // Tolik 07/04/2019 --
      end;
      // Записать позицию для чтения первого блока
      FirstBlockPos := FileStream.Position +  SizeOf(Int64);
      FileStream.WriteBuffer(FirstBlockPos, SizeOf(Int64));

      //*** Записать блоки
      if FStreams.Count = FStreamsCodes.Count then
        for i := 0 to FStreams.Count - 1 do
        begin
          CurrStream := TStream(FStreams[i]);

          //*** Записать код стрима
          IntToWrite := FStreamsCodes[i];
          FileStream.WriteBuffer(IntToWrite, SizeOf(Integer));
          //*** Записать размер стрима
          IntToWrite := CurrStream.Size;
          FileStream.WriteBuffer(IntToWrite, SizeOf(Integer));
          //*** Записать стрим
          CurrStream.Position := 0;
          FileStream.CopyFrom(CurrStream, 0);
        end;
    finally
      FileStream.Free;
    end;
  end;
end;

function GetStrFromStringsByKey(AStrings: TStrings; const AKey: String): String;
var
  ObjIndex: Integer;
  Obj: TObject;
begin
  Result := '';
  ObjIndex := AStrings.IndexOf(AKey);
  if ObjIndex <> -1 then
  begin
    Obj := AStrings.Objects[ObjIndex];
    if Obj is TStringObject then
      Result := TStringObject(Obj).FString;
  end;
end;

function GetStrFromStringsByIdx(AStrings: TStrings; AIdx: Integer): String;
var
  Obj: TObject;
begin
  Result := '';
  if AIdx <> -1 then
  begin
    Obj := AStrings.Objects[AIdx];
    if Obj is TStringObject then
      Result := TStringObject(Obj).FString;
  end;
end;

procedure FreeStringsObjects(AStrings: TStrings; AClear: Boolean);
var
  i: Integer;
  Obj: TObject;
begin
  for i := 0 to AStrings.Count - 1 do
  begin
    Obj := AStrings.Objects[i];
    if Assigned(Obj) then
    begin
      Obj.Free;
      if Not AClear then
        AStrings.Objects[i] := nil;
    end;
  end;
  if AClear then
    AStrings.Clear;
end;

procedure SetStrToStringsByIdx(AStrings: TStrings; AIdx: Integer; const aVal: String);
var
  Obj: TObject;
begin
  if AIdx <> -1 then
  begin
    Obj := AStrings.Objects[AIdx];
    if Obj is TStringObject then
      TStringObject(Obj).FString := aVal;
  end;
end;

procedure SortListByItemField(AList: TList; AItem, AFieldAdress: Pointer);
var
  SortFieldOffset: Integer;
  function CompareItems(Item1, Item2: Pointer): Integer;
  var
    val1, val2: Integer;
  begin
    val1 := Integer(Pointer(Integer(Item1) + SortFieldOffset)^);
    val2 := Integer(Pointer(Integer(Item2) + SortFieldOffset)^);
    Result := CompareInt(val1, val2);
  end;
begin
  if (AList <> nil) and (AList.Count > 0) then
  begin
    SortFieldOffset := Integer(AFieldAdress) - Integer(AItem);
    QuickSortPointerList(AList.List, 0, AList.Count - 1, @CompareItems);
  end;
end;

{
procedure SortListByObjItemField(AList: TList; AItem: TObject; AFieldAdress: Pointer);
var
  temp: LongWord;
  SortFieldOffset: LongWord;
  ptr1, ptr2: LongWord;
  temp2: LongWord;

  function CmpItems(Item1, Item2: Pointer): Integer;
  var
    //ptr1, ptr2: LongWord;
    val1, val2: Integer;
  begin
    //ptr1 := Pointer(LongWord(Item1) + SortFieldOffset);
    //ptr2 := Pointer(LongWord(Item2) + SortFieldOffset);
    ptr1 := LongWord(Item1) + SortFieldOffset;
    ptr2 := LongWord(Item2) + SortFieldOffset;
    val1 := Integer(Pointer(ptr1)^);
    val2 := Integer(Pointer(ptr2)^);
    //val1 := Integer(Pointer(Integer(Item1) + SortFieldOffset)^);
    //val2 := Integer(Pointer(Integer(Item2) + SortFieldOffset)^);
    Result := CompareInt(val1, val2);
  end;

  function CompareItems(Item1, Item2: Pointer): Integer;
  begin
    Result := CmpItems(Item1, Item2);
  end;
begin
  if (AList <> nil) and (AList.Count > 0) then
  begin
    SortFieldOffset := Integer(AFieldAdress) - Integer(AItem);
    QuickSortPointerList(AList.List, 0, AList.Count - 1, @CompareItems);
  end;
end; }

procedure RotateTObjectList(AList: TObjectList);
var
  SavedOwnsObjects: Boolean;
begin
  SavedOwnsObjects := AList.OwnsObjects;
  AList.OwnsObjects := false;
  RotateTList(AList);
  AList.OwnsObjects := SavedOwnsObjects;
end;

procedure RotateTList(AList: TList);
var
  i: Integer;
  TmpValue: Pointer;
  TmpStream: TObject;
  ItemsCount: Integer;
  IndexAtEnd: Integer;
  SavedOwnsObjects: Boolean;
begin
  ItemsCount := AList.Count;
  for i := 0 to (ItemsCount div 2) - 1 do
  begin
    TmpValue := AList[i];

    IndexAtEnd := ItemsCount - i - 1;
    AList[i] := AList[IndexAtEnd];
    AList[IndexAtEnd] := TmpValue;
  end;
end;

{ TStringsHash }

constructor TStringsHash.Create;
begin
  FStrings := CreateStringListSorted;
end;

destructor TStringsHash.Destroy;
begin
  FreeStringsObjects(FStrings, True);
  inherited;
end;

function TStringsHash.GetVal(const aKey: String;
  var aVal: String): Boolean;
var
  ResIdx: Integer;
begin
  Result := false;
  ResIdx := FStrings.IndexOf(aKey);
  if ResIdx <> -1 then
  begin
    Result := true;
    aVal := GetStrFromStringsByIdx(FStrings, ResIdx);
  end;
end;

function TStringsHash.SetVal(const aKey, aVal: String): Integer;
begin
  Result := FStrings.IndexOf(aKey);
  if Result <> -1 then
  begin
    SetStrToStringsByIdx(FStrings, Result, aVal);
  end
  else
    Result := AddStrObjToStrings(FStrings, aKey, aVal);
end;

end.