[РЕШЕНО] Generic'и и ThreadList

[Brainenjii]

Хочу сделать 2 списка - GList<T> и GThreadList<T>, так, чтобы метод LockList GThreadList'а возвращал GList, специализированный тем же типом, что и GThreadList. Это возможно сделать общим образом, или нужно переопределять LockList для каждой специализации GThreadList'а?

[AlexVinS]

Вроде можно. Надо в GThreadList<T> определить тип TLockList = specialize GList<T>; LockList будет выглядеть как function LockList: TLockList;

[Brainenjii]

Вы не могли бы показать, как внутри класса объявить тип?

Добавлено спустя 12 минут:
Ещё одна странная проблема, наблюдается только в 1 Unit'e - когда пишу там

Код: Выделить всё

Type BObjectsList = Specialize BList<BObjectClass>;
Type BObjectsThreadTemplate = Specialize BThreadList<BObjectClass>;
Type

{ BObjectsThreadList }

BObjectsThreadList = Class(BObjectsThreadTemplate)
  Public
    Function LockList: BObjectsList;
End;

Я получаю ошибки на нереализованность методов:

/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(16,14) Error: Forward declaration not solved "BList$BObjectClass.GetItem(LongInt):BObjectClass;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(17,15) Error: Forward declaration not solved "BList$BObjectClass.SetItem(LongInt,const BObjectClass);"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(21,15) Error: Forward declaration not solved "BList$BObjectClass.Add(const BObjectClass);"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(22,15) Error: Forward declaration not solved "BList$BObjectClass.Insert(const LongInt,const BObjectClass);"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(23,15) Error: Forward declaration not solved "BList$BObjectClass.Remove(const BObjectClass);"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(24,15) Error: Forward declaration not solved "BList$BObjectClass.Delete(const LongInt);"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(25,15) Error: Forward declaration not solved "BList$BObjectClass.Clear;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(26,15) Error: Forward declaration not solved "BList$BObjectClass.Purge;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(27,14) Error: Forward declaration not solved "BList$BObjectClass.Count:LongInt;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(28,14) Error: Forward declaration not solved "BList$BObjectClass.Get(const LongInt):BObjectClass;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(30,17) Error: Forward declaration not solved "constructor BList$BObjectClass.Build;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(31,16) Error: Forward declaration not solved "destructor BList$BObjectClass.Burn;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(42,15) Error: Forward declaration not solved "BThreadList$BObjectClass.Add(const BObjectClass);"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(43,15) Error: Forward declaration not solved "BThreadList$BObjectClass.Remove(const BObjectClass);"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(44,15) Error: Forward declaration not solved "BThreadList$BObjectClass.Clear;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(45,15) Error: Forward declaration not solved "BThreadList$BObjectClass.Purge;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(47,15) Error: Forward declaration not solved "BThreadList$BObjectClass.UnlockList;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(49,17) Error: Forward declaration not solved "constructor BThreadList$BObjectClass.Build;"
/home/Brainenjii/Develop/BaseUnits/trunk/bobjectunit.pas(50,16) Error: Forward declaration not solved "destructor BThreadList$BObjectClass.Burn;"

Если закомментировать все вхождения BObjectsList и BObjectsThreadList -> скомпилировать модуль -> раскомментировать все вхождения -> всё работает. До первой правки этого модуля. В чем может быть ошибка?

UPD. так, кажется ошибка из-за "циклической" ссылки между модулями - в BObjectUnit есть ссылка на BListUnit в разделе Interface, а в BListUnit - ссылка на BObjectUnit в Implementation...
Можно ли считать возникновение проблем из-за этого багом? ^_^

[AlexVinS]

Можно ли считать возникновение проблем из-за этого багом? ^_^

Да это баг, известный, но пока так и не исправленный. Циклические ссылки interface-implementation не рекумендуется использовать (иногда работает иногда вылезют странные ошибки). Но я не помню чтобы от этого появлялось "Forward declaration not solved".

Вы не могли бы показать, как внутри класса объявить тип?

Код: Выделить всё

Type
{ BObjectsThreadList }

generic BObjectsThreadList <T> = Class
Public
  type
   TLockList = Specialize BList<T>
  private
   Flist: TLockList;
public
    Function LockList:TLockList  ;
End;


[Brainenjii]

Попробовал сделать так ^_^ Получил Fatal: Internal error 200512115 ^_^ Что это может быть?

Добавлено спустя 1 минуту 51 секунду:
UPD. кажется нашёл - http://62.166.198.202/view.php?id=17193
Надо обновляться до 2.5.1? Кросс-компиляцию, так полагаю, опять придётся переделывать?

[kipar]

Стыдно признаться, но я перешел с Lazarus назад на Delphi - только из-за генериков.
В Лазарусе сначала пришлось отказаться от оптимизации, потом в разных местах добавлять бессмысленные строчки, которые обходили баги компилятора, потом появились рандомные нарушения памяти.
Перевел на Delphi XE - все заработало как часы. Ну и фич там побольше, например можно наследовать генерики и ограничивать подстановку типов. Надеюсь, Lazarus рано или поздно тоже до такого состояния доведут.

[Brainenjii]

Реализовал следующим образом:

Код: Выделить всё


Generic BThreadList<T, U> = Class
  Protected
    bInternal: TThreadList;
  Public

    Procedure Add(Const aValue: T);
    Procedure Remove(Const aValue: T);
    Procedure Clear;
    Procedure Purge;
    Procedure Load(Const aList:U);

    Function LockList: U;
    Procedure UnlockList;

    Constructor Build;
    Destructor Burn;
End;

...

Type BUsersList = Specialize BList<BUserClass>;
Type BUsersThreadList = Specialize BThreadList<BUserClass, BUsersList>;


Всё работает ^_^

[dreel]

Brainenjii А можешь выложить полный код? Я пытался реализацию написать, мне Lazarus ругается ошибкой Error: VMT....

[Brainenjii]

как бы это ни было поразительно, но да, могу

Код: Выделить всё

Unit BListsUnit;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, syncobjs, fgl;

Type

{ BList }

  Generic BList<BManagedClass> = Class
  Private
    bInternalList: TList;
    Function BListCompare(Item1, Item2: Pointer): Integer;

    Function GetItem(aIndex: Integer): BManagedClass;
    Procedure SetItem(aIndex: Integer; Const aValue: BManagedClass);

    Procedure BSort(aLeft, aRight: Integer);
  Public
    Property Items[aIndex: Integer]: BManagedClass
      Read GetItem Write SetItem; Default;

    Procedure Add(Const aValue: BManagedClass);
    Function SafeAdd(Const aValue: BManagedClass;
      Const aExceptionOnDuplicate: Boolean = FALSE): Boolean;
    Function IndexOf(Const aValue: BManagedClass): Integer; Inline;
      Procedure Insert(Const aIndex: Integer; Const aValue: BManagedClass);
    Function Remove(Const aValue: BManagedClass): Integer;
    Procedure Delete(Const aIndex: Integer);
    Procedure Purge;
    Procedure Clear;

    Function Count: Integer;
    Function GetAt(Const aIndex: Integer): BManagedClass;
    Function Find(Const aID: Integer): BManagedClass;
    Function Present(Const aValue: BManagedClass): Boolean; Inline;

    Procedure Load(Const aList: BList);
    Procedure AddList(Const aList: TList);
    Function AsList: Tlist;
    Function AsString: String;

    Procedure Sort;
    Procedure Compare(Const aTarget: BList; Var aLack, aOver: BList);
    Procedure Compare(Const aTarget: BList; Var aSame, aLack, aOver: BList);

    Constructor Build;
    Destructor Burn;
End;

Type

{ BThreadList }

Generic BThreadList<BManagedClass> = Class
  Type BManagedList = Specialize BList<BManagedClass>;
  Protected
    bInternal: BManagedList;
    bSection: TCriticalSection;
  Public
    Procedure Add(Const aValue: BManagedClass);
    Procedure Remove(Const aValue: BManagedClass);
    Procedure Clear; Reintroduce;
    Procedure Purge;
    Procedure Load(Const aList:BManagedList);

    Function LockList: BManagedList;
    Procedure UnlockList;

    Constructor Build;
    Destructor Burn;
End;

Type

{ BLinkedList }

Generic BLinkedList<BManagedClass> = Class
  Type BFlatList = Specialize BList<BManagedClass>;
  Private
    bInternal: TList;
    Function GetFirst: BManagedClass; Inline;
    Function GetLast: BManagedClass; Inline;
  Public
    Property First: BManagedClass Read GetFirst;
    Property Last: BManagedClass Read GetLast;

    Procedure Add(Const aObject: BManagedClass);
    Procedure SafeAdd(Const aObject: BManagedClass); Inline;
    Procedure Insert(aObject: BManagedClass; Const aNext: BManagedClass = nil);

    Procedure Remove(Const aObject: BManagedClass);

    Function Present(Const aObject: BManagedClass): Boolean;

    Procedure Load(Const aList: BLinkedList);
    Function AsList: BFlatList;

    Constructor Build;
    Destructor Burn;
End;

Type

{ BLinkedThreadList }

Generic BLinkedThreadList<BManagedClass> = Class
  Type BManagedList = Specialize BLinkedList<BManagedClass>;
  Private
    bInternal: BManagedList;
    bSection: TCriticalSection;
  Public
    Procedure Add(Const aObject: BManagedClass);
    Procedure Load(Const aList: BManagedList);

    Procedure Remove(Const aObject: BManagedClass);
    Function LockList: BManagedList;
    Procedure UnlockList;

    Constructor Build;
    Destructor Burn;
End;

    Type

    { BPrimitiveList }

  generic BPrimitiveList<T> = class(TFPSList)
  private
    type
      TCompareFunc = function(const Item1, Item2: T): Integer;
      TTypeList = array[0..MaxGListSize] of T;
      PTypeList = ^TTypeList;
      PT = ^T;
      BPrimitiveListEnumeratorSpec = specialize TFPGListEnumerator<T>;
  {$ifndef OldSyntax}protected var{$else}var protected{$endif}
      FOnCompare: TCompareFunc;
    procedure CopyItem(Src, Dest: Pointer); override;
    procedure Deref(Item: Pointer); override;
    function  Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif}
    function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
    function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
    procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
    function GetLast: T; {$ifdef CLASSESINLINE} inline; {$endif}
    procedure SetLast(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
    function GetFirst: T; {$ifdef CLASSESINLINE} inline; {$endif}
    procedure SetFirst(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
  public
    constructor Create;
    Constructor Build;
    Destructor Burn;
    function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
    function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
    property First: T read GetFirst write SetFirst;
    function GetEnumerator: BPrimitiveListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
    function IndexOf(const Item: T): Integer;
    procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
    property Last: T read GetLast write SetLast;
    Procedure Load(Const aList: BPrimitiveList);
    {$ifndef VER2_4}
    procedure Assign(Source: BPrimitiveList);
    {$endif}
    function Remove(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
    procedure Sort(Compare: TCompareFunc);
    property Items[Index: Integer]: T read Get write Put; default;
    property List: PTypeList read GetList;
  end;

Type

{ BPrimitiveThreadList }

  Generic BPrimitiveThreadList<T> = Class
  Type BManagedList = Specialize BPrimitiveList<T>;
  Protected
    bInternal: BManagedList;
    bSection: TCriticalSection;
  Public
    Procedure Add(Const aValue: T);
    Procedure Remove(Const aValue: T);
    Procedure Clear; Reintroduce;

    Procedure Load(Const aList: BManagedList);

    Function LockList: BManagedList;
    Procedure UnlockList;

    Function Present(Const aValue: T): Boolean;

    Function AsList: String;

    Constructor Build;
    Destructor Burn;
End;

Type BStringsList = Specialize BPrimitiveList<String>;
Type BStringsThreadList = Specialize BPrimitiveThreadList<String>;

Type BIntegersList = Specialize BPrimitiveList<Integer>;
Type BIntegersThreadList = Specialize BPrimitiveThreadList<Integer>;

Type BDoublesList = Specialize BPrimitiveList<Double>;
Type BDoublesThreadList = Specialize BPrimitiveThreadList<Double>;

Type BDateTimesList = Specialize BPrimitiveList<TDateTime>;
Type BDateTimesThreadList = Specialize BPrimitiveThreadList<TDateTime>;

Implementation

{ BList }

Function BList.BListCompare(Item1, Item2: Pointer): Integer;
Begin
  If (Item1 = nil) Or (Item2 = nil) Then
    Begin
      If Item1 = nil Then
        If Not(Item2 = nil) Then Result := 1
        Else Result := 0
      Else
        Result := -1
    End
  Else
    Result := BManagedClass(Item2).ID - BManagedClass(Item1).ID;
End;

Function BList.GetItem(aIndex: Integer): BManagedClass;
Begin
  Result := BManagedClass(bInternalList.Items[aIndex]);
end;

Procedure BList.SetItem(aIndex: Integer; Const aValue: BManagedClass);
Begin
  If aValue = nil Then Raise Exception.Create('Attempt of Nill adding');
  bInternalList.Items[aIndex] := aValue;
end;

Procedure BList.Add(Const aValue: BManagedClass);
Begin
  If aValue = nil Then
    Raise Exception.Create('Attempt of Nill adding');
  bInternalList.Add(aValue);
End;

Function BList.SafeAdd(Const aValue: BManagedClass;
  Const aExceptionOnDuplicate: Boolean): Boolean;
Var
  i: Integer;
  aPresent: Boolean;
Begin
  Result := FALSE;
  aPresent := FALSE;
  For i := 0 To Count - 1 Do
    If GetAt(i).Equals(aValue) Then
      Begin
        aPresent := TRUE;
        Break;
      End;
  If aPresent Then
    If aExceptionOnDuplicate Then
      Raise Exception.Create('Value already present in list')
    Else
      Exit;
  Add(aValue);
  Result := TRUE;
End;

Function BList.IndexOf(Const aValue: BManagedClass): Integer;
Begin
  Result := bInternalList.IndexOf(aValue);
End;

Procedure BList.Insert(Const aIndex: Integer; Const aValue: BManagedClass);
Begin
  bInternalList.Insert(aIndex, aValue);
End;

Function BList.Remove(Const aValue: BManagedClass): Integer;
Begin
  Result := bInternalList.Remove(aValue);
End;

Procedure BList.Delete(Const aIndex: Integer);
Begin
  bInternalList.Delete(aIndex);
End;

Procedure BList.Purge;
Var
  i: Integer;
Begin
  For i := 0 To Count - 1 Do
    Items[i].Burn;
  bInternalList.Clear;
End;

Procedure BList.Clear;
Begin
  bInternalList.Clear;
End;

Function BList.Count: Integer;
Begin
  Result := bInternalList.Count;
End;

Function BList.GetAt(Const aIndex: Integer): BManagedClass;
Begin
  If Items[aIndex] = nil Then Raise Exception.Create('HERE!');
  Result := BManagedClass(Items[aIndex]);
End;

Function BList.Find(Const aID: Integer): BManagedClass;
Var
  i: Integer;
Begin
  Result := nil;
  For i := 0 To Count - 1 Do
    If GetAt(i).ID = aID Then
      Begin
        Result := GetAt(i);
        Break;
      End;
End;

Function BList.Present(Const aValue: BManagedClass): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  For i := 0 To Count - 1 Do
    If GetAt(i).Equals(aValue) Then Exit(TRUE);
End;

Procedure BList.Load(Const aList: BList);
Begin
  bInternalList.Clear;
  AddList(aList.bInternalList);
End;

Procedure BList.BSort(aLeft, aRight: Integer);
Var
  i, j: Integer;
  aFirst, aBuffer: BManagedClass;
Begin
  Repeat
    i := aLeft;
    j := aRight;
    aFirst := Items[(aLeft + aRight) div 2];
    Repeat
      While Items[i].ID < aFirst.ID Do
        i += 1;
      While Items[j].ID > aFirst.ID Do
        j -= 1;
      If i <= j Then
        Begin
          aBuffer := Items[i];
          Items[i] := Items[j];
          Items[j] := aBuffer;
          i += 1;
          j -= 1;
        End;
    Until i > j;
    If aLeft < j Then BSort(aLeft, j);
    aLeft := i;
  Until Not(i < aRight);
End;

Procedure BList.AddList(Const aList: TList);
Begin
  bInternalList.AddList(aList);
End;

Function BList.AsList: Tlist;
Begin
  Result := bInternalList;
End;

Function BList.AsString: String;
Var
  i: Integer;
Begin
  Result := '';
  For i := 0 To bInternalList.Count - 1 Do
    Begin
      If Not(Result = '') Then Result += ',';
      Result += IntToStr(BManagedClass(bInternalList[i]).ID);
    End;
End;

Procedure BList.Sort;
Begin
  If Count < 2 Then Exit;
  BSort(0, Count - 1);
End;

Procedure BList.Compare(Const aTarget: BList; Var aLack, aOver: BList);
Var
  aSame: BList;
Begin
  aSame := BList.Build;
  Compare(aTarget, aSame, aLack, aOver);
  aSame.Burn;
End;

Procedure BList.Compare(Const aTarget: BList; Var aSame, aLack, aOver: BList);
Var
  i, j: Integer;
  aID, aTargetID: Integer;
Begin
  If aTarget = nil Then Raise Exception.Create('Illegal nil Target');

  Sort;
  aTarget.Sort;

  i := 0;
  j := 0;
  While TRUE Do
    Begin
      If i = Count Then aID := -1
      Else aID := GetAt(i).ID;
      If j = aTarget.Count Then aTargetID := -1
      Else aTargetID := aTarget.GetAt(j).ID;

      If (aID = -1) And (aTargetID = -1) Then Break;

      If aID = aTargetID Then
        Begin
          aSame.Add(GetAt(i));
          Inc(i);
          Inc(j);
        End
      Else
        Begin
          If ((aID < aTargetID) Or (aTargetID = -1)) And Not(aID = -1) Then
            Begin
              aOver.Add(GetAt(i));
              Inc(i)
            End;
          If ((aID > aTargetID) Or (aID = -1)) And Not(aTargetID = -1) Then
            Begin
              aLack.Add(aTarget.GetAt(j));
              Inc(j);
            End;
      End;
    End;
End;

Constructor BList.Build;
Begin
  bInternalList := TList.Create;
End;

Destructor BList.Burn;
Begin
  bInternalList.Free;
End;

{ BThreadList }

Procedure BThreadList.Add(Const aValue: BManagedClass);
Begin
  bSection.Enter;
  bInternal.Add(aValue);
  bSection.Leave;
End;

Procedure BThreadList.Remove(Const aValue: BManagedClass);
Begin
  bSection.Enter;
  bInternal.Remove(aValue);
  bSection.Leave;
End;

Procedure BThreadList.Clear;
Begin
  bSection.Enter;
  bInternal.Clear;
  bSection.Leave;
End;

Procedure BThreadList.Purge;
Var
  i: Integer;
Begin
  bSection.Enter;
  For i := 0 To bInternal.Count - 1 Do
    bInternal.GetAt(i).Burn;
  bInternal.Clear;
  bSection.Leave;
End;

Procedure BThreadList.Load(Const aList: BManagedList);
Begin
  bSection.Enter;
  bInternal.Load(aList);
  bSection.Leave;
End;

Function BThreadList.LockList: BManagedList;
Begin
  bSection.Enter;
  Result := bInternal;
End;

Procedure BThreadList.UnlockList;
Begin
   bSection.Leave;
End;

Constructor BThreadList.Build;
Begin
  bSection := TCriticalSection.Create;
  bInternal := BManagedList.Build;
End;

Destructor BThreadList.Burn;
Begin
  bInternal.Burn;
  bSection.Free;
End;

{ BLinkedList }

Function BLinkedList.GetFirst: BManagedClass;
Var
  i: Integer;
Begin
  Result := nil;
  For i := 0 To bInternal.Count - 1 Do
    If BManagedClass(bInternal[i]).Prior = nil Then
      Exit(BManagedClass(bInternal[i]));
end;

Function BLinkedList.GetLast: BManagedClass;
Var
  i: Integer;
Begin
  Result := nil;
  For i := 0 To bInternal.Count - 1 Do
    If BManagedClass(bInternal[i]).Next = nil Then
      Exit(BManagedClass(bInternal[i]));
end;

Procedure BLinkedList.Add(Const aObject: BManagedClass);
Begin
  bInternal.Add(aObject);
End;

Procedure BLinkedList.SafeAdd(Const aObject: BManagedClass);
Begin
  If Not(Present(aObject)) Then Add(aObject);
End;

Procedure BLinkedList.Insert(aObject: BManagedClass;Const aNext: BManagedClass);
Var
  aIndex: Integer;
Begin
  If aObject = nil Then Raise Exception.Create('Nil insertion attempted');
  If (aNext = nil) Or (bInternal.Count = 0) Then Add(aObject)
  Else
    Begin
      aIndex := bInternal.IndexOf(aNext);
      If aIndex = -1 Then bInternal.Add(aObject)
      Else bInternal.Insert(aIndex, aObject);
    End;
End;

Procedure BLinkedList.Remove(Const aObject: BManagedClass);
Begin
  If Not(aObject.Prior = nil) Then aObject.Prior.Next := aObject.Next;
  If Not(aObject.Next = nil) Then aObject.Next.Prior := aObject.Prior;
  bInternal.Remove(aObject);
End;

//Procedure BLinkedList.Delete(Const aIndex: Integer);
//Begin
//
//End;
//
Function BLinkedList.Present(Const aObject: BManagedClass): Boolean;
Begin

End;

Procedure BLinkedList.Load(Const aList: BLinkedList);
Begin
  bInternal.Clear;
  bInternal.AddList(aList.bInternal);
End;

Function BLinkedList.AsList: BFlatList;
Begin
  Result :=  BFlatList(bInternal);
End;

Constructor BLinkedList.Build;
Begin
  bInternal := TList.Create;
End;

Destructor BLinkedList.Burn;
Begin
  bInternal.Free;
End;

{ BLinkedThreadList }

Procedure BLinkedThreadList.Add(Const aObject: BManagedClass);
Begin
  bSection.Enter;
  bInternal.Add(aObject);
  bSection.Leave;
End;

Procedure BLinkedThreadList.Load(Const aList: BManagedList);
Begin
  bSection.Enter;
  bInternal.Load(aList);
  bSection.Leave;
End;

Procedure BLinkedThreadList.Remove(Const aObject: BManagedClass);
Begin
  bSection.Enter;
  bInternal.Remove(aObject);
  bSection.Leave;
End;

Function BLinkedThreadList.LockList: BManagedList;
Begin
  bSection.Enter;
  Result := bInternal;
End;

Procedure BLinkedThreadList.UnlockList;
Begin
  bSection.Leave;
End;

Constructor BLinkedThreadList.Build;
Begin
  bSection := TCriticalSection.Create;
  bInternal := BManagedList.Build;
End;

Destructor BLinkedThreadList.Burn;
Begin
  bInternal.Burn;
  bSection.Free;
End;

{ BPrimitiveThreadList }

Procedure BPrimitiveThreadList.Add(Const aValue: T);
Begin
  bSection.Enter;
  bInternal.Add(aValue);
  bSection.Leave;
End;

Procedure BPrimitiveThreadList.Remove(Const aValue: T);
Begin
  bSection.Enter;
  bInternal.Remove(aValue);
  bSection.Leave;
End;

Procedure BPrimitiveThreadList.Clear;
Begin
  bSection.Enter;
  bInternal.Clear;
  bSection.Leave;
End;

Procedure BPrimitiveThreadList.Load(Const aList: BManagedList);
Var
  i: Integer;
Begin
  bInternal.Clear;
  For i := 0 To aList.Count - 1 Do
    bInternal.Add(aList[i]);
End;

Function BPrimitiveThreadList.LockList: BManagedList;
Begin
  bSection.Enter;
  Result := bInternal;
End;

Procedure BPrimitiveThreadList.UnlockList;
Begin
  bSection.Leave;
End;

Function BPrimitiveThreadList.Present(Const aValue: T): Boolean;
Var
  i: Integer;
Begin
  Result := FALSE;
  bSection.Enter;
  For i := 0 To bInternal.Count - 1 Do
    Begin
      If bInternal[i] = aValue Then
        Begin
          Result := TRUE;
          Break;
        End;
    End;
  bSection.Leave;
End;

Function BPrimitiveThreadList.AsList: String;
Var
  i: Integer;
  aValue: T;
  aBuffer: String;
Begin
  Result := '';
  bSection.Enter;
  For i := 0 To bInternal.Count - 1 Do
    Begin
      If Not(Result = '') Then Result += ',';
      aValue := bInternal[i];
      //Str(aValue:0:2, aBuffer);
      Result += aBuffer;
    End;
  bSection.Leave;
End;

Constructor BPrimitiveThreadList.Build;
Begin
  bSection := TCriticalSection.Create;
  bInternal := BManagedList.Create;
End;

Destructor BPrimitiveThreadList.Burn;
Begin
  bInternal.Free;
  bSection.Free;
End;

constructor BPrimitiveList.Create;
begin
  inherited Create(sizeof(T));
end;

procedure BPrimitiveList.CopyItem(Src, Dest: Pointer);
begin
  T(Dest^) := T(Src^);
end;

procedure BPrimitiveList.Deref(Item: Pointer);
begin
  Finalize(T(Item^));
end;

function BPrimitiveList.Get(Index: Integer): T;
begin
  Result := T(inherited Get(Index)^);
end;

function BPrimitiveList.GetList: PTypeList;
begin
  Result := PTypeList(FList);
end;

function BPrimitiveList.ItemPtrCompare(Item1, Item2: Pointer): Integer;
begin
  Result := FOnCompare(T(Item1^), T(Item2^));
end;

procedure BPrimitiveList.Put(Index: Integer; const Item: T);
begin
  inherited Put(Index, @Item);
end;

function BPrimitiveList.Add(const Item: T): Integer;
begin
  Result := inherited Add(@Item);
end;

function BPrimitiveList.Extract(const Item: T): T;
begin
  inherited Extract(@Item, @Result);
end;

function BPrimitiveList.GetFirst: T;
begin
  Result := T(inherited GetFirst^);
end;

procedure BPrimitiveList.SetFirst(const Value: T);
begin
  inherited SetFirst(@Value);
end;

function BPrimitiveList.GetEnumerator: BPrimitiveListEnumeratorSpec;
begin
  Result := BPrimitiveListEnumeratorSpec.Create(Self);
end;

function BPrimitiveList.IndexOf(const Item: T): Integer;
Var
  i: Integer;
begin
  Result := -1;
  For i := 0 To Count - 1 Do
    If (Items[i] = Item) Then Exit(i);
end;

procedure BPrimitiveList.Insert(Index: Integer; const Item: T);
begin
  T(inherited Insert(Index)^) := Item;
end;

function BPrimitiveList.GetLast: T;
begin
  Result := T(inherited GetLast^);
end;

procedure BPrimitiveList.SetLast(const Value: T);
begin
  inherited SetLast(@Value);
end;

Procedure BPrimitiveList.Load(Const aList: BPrimitiveList);
Begin
  Assign(aList);
End;

{$ifndef VER2_4}
Procedure BPrimitiveList.Assign(Source: BPrimitiveList);
var
  i: Integer;
begin
  Clear;
  for I := 0 to Source.Count - 1 do
    Add(Source[i]);
End;
{$endif}

function BPrimitiveList.Remove(const Item: T): Integer;
begin
  Result := IndexOf(Item);
  if Result >= 0 then
    Delete(Result);
end;

procedure BPrimitiveList.Sort(Compare: TCompareFunc);
begin
  FOnCompare := Compare;
  inherited Sort(@ItemPtrCompare);
end;

Constructor BPrimitiveList.Build;
Begin
  Inherited Create;
End;

Destructor BPrimitiveList.Burn;
Begin
  Inherited Destroy;
End;

End.


кодом, правда, не пользовался уже лет 5, так что даже и не скажу - работает ли Вообще, сам в шоке что нашёл.

Извините за некропостинг