////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Thread safe list classes.                                                  //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20240103 - Created by A.K.                                                 //
////////////////////////////////////////////////////////////////////////////////

unit _crw_tslist; //  Thread Safe List

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc;

////////////////////////////////////////////////////////////////////////////////
// TSafeList is thread safe wrapper for TList class.
////////////////////////////////////////////////////////////////////////////////
type
 TSafeList=class(TLatch)
 private
  myList : TList;
  function  GetCount:Integer;
  function  GetItems(i:Integer):Pointer;
  procedure SetItems(i:Integer; const aItem:Pointer);
 public
  constructor Create;
  destructor  Destroy; override;
 public
  function  RawList:TList;       // NB: to use only inside Lock/Unlock block !!!
 public
  property  Count:Integer read GetCount;
  property  Items[i:Integer]:Pointer read GetItems write SetItems; default;
 public
  function  IndexOf(const aItem:Pointer):Integer;
  function  Add(aItem:Pointer):Integer;
  function  Insert(aIndex:Integer; const aItem:Pointer):Integer;
  function  Delete(aIndex:Integer):Integer;
  procedure Clear;
  procedure Pack;
  function  Remove(const aItem:Pointer):Integer;
  procedure Sort(Compare:TListSortCompare);
  function  First: Pointer;
  function  Last: Pointer;
  function  Move(CurIndex,NewIndex:Integer):Integer;
 end;

////////////////////////////////////////////////////////////////////////////////
// TSafeStringList is thread safe wrapper for TStringList class.
////////////////////////////////////////////////////////////////////////////////
type
 TSafeStringList=class(TLatch)
 private
  myList : TStringList;
  function  GetCount:Integer;
  function  GetStrings(i:Integer):LongString;
  procedure SetStrings(i:Integer; const S:LongString);
  function  GetObjects(i:Integer):TObject;
  procedure SetObjects(i:Integer; const aObject:TObject);
  function  GetNames(i:Integer):LongString;
  function  GetValues(const aName:LongString):LongString;
  procedure SetValues(const aName:LongString; const aValue:LongString);
  function  GetText:LongString;
  procedure SetText(aText:LongString);
 public
  constructor Create;
  destructor  Destroy; override;
 public
  function  RawList:TStringList; // NB: To use only inside Lock/Unlock block !!!
 public
  property  Count:Integer read GetCount;
  property  Text:LongString read GetText write SetText;
  property  Names[i:Integer]:LongString read GetNames;
  property  Values[aName:LongString]:LongString read GetValues write SetValues;
  property  Strings[i:Integer]:LongString read GetStrings write SetStrings; default;
  property  Objects[i:Integer]:TObject read GetObjects write SetObjects;
 public
  function  IndexOf(const S:LongString):Integer;
  function  IndexOfName(const aName:LongString):Integer;
  function  IndexOfObject(aObject:TObject):Integer;
  function  Add(const S:LongString):Integer;
  function  AddText(const S:LongString):Integer;
  function  AddObject(const S:LongString; aObject:TObject):Integer;
  function  AddPair(const aName,aValue:LongString; aObject:TObject=nil):Integer;
  function  Insert(aIndex:Integer; const S:LongString):Integer;
  function  InsertObject(aIndex:Integer; const S:LongString; aObject:TObject):Integer;
  function  Delete(aIndex:Integer):Integer;
  procedure Clear;
  function  Remove(const S:LongString):Integer;
  procedure Sort(Compare:TStringListSortCompare=nil);
 end;

procedure Kill(var TheObject:TSafeList); overload;
procedure Kill(var TheObject:TSafeStringList); overload;

implementation

///////////////////////////
// TSafeList implementation
///////////////////////////

constructor TSafeList.Create;
begin
 inherited Create;
 Lock;
 try
  myList:=TList.Create;
 finally
  Unlock;
 end;
end;

destructor TSafeList.Destroy;
begin
 Lock;
 try
  Kill(myList);
 finally
  Unlock;
 end;
 inherited Destroy;
end;

function  TSafeList.RawList:TList;
begin
 if Assigned(Self)
 then Result:=myList
 else Result:=nil;
end;

function  TSafeList.GetCount:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.Count;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetCount');
 end;
end;

function  TSafeList.GetItems(i:Integer):Pointer;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList) and InRange(i,0,myList.Count-1)
   then Result:=myList.Items[i];
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetItems');
 end;
end;

procedure TSafeList.SetItems(i:Integer; const aItem:Pointer);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList) and InRange(i,0,myList.Count-1)
   then myList.Items[i]:=aItem;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetItems');
 end;
end;

function TSafeList.IndexOf(const aItem:Pointer):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.IndexOf(aItem);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'IndexOf');
 end;
end;

function TSafeList.Add(aItem:Pointer):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.Add(aItem);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Add');
 end;
end;

function TSafeList.Insert(aIndex:Integer; const aItem:Pointer):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=aIndex;
   if Assigned(myList) and InRange(aIndex,0,myList.Count-1)
   then myList.Insert(aIndex,aItem)
   else Result:=-1;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Insert');
 end;
end;

function TSafeList.Delete(aIndex:Integer):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=aIndex;
   if Assigned(myList) and InRange(aIndex,0,myList.Count-1)
   then myList.Delete(aIndex)
   else Result:=-1;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Delete');
 end;
end;

procedure TSafeList.Clear;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then myList.Clear;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Clear');
 end;
end;

procedure TSafeList.Pack;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then myList.Pack;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Pack');
 end;
end;

function TSafeList.Remove(const aItem:Pointer):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.Remove(aItem);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Remove');
 end;
end;

procedure TSafeList.Sort(Compare:TListSortCompare);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then myList.Sort(Compare);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Sort');
 end;
end;

function TSafeList.First:Pointer;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.First;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'First');
 end;
end;

function  TSafeList.Last:Pointer;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.Last;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Last');
 end;
end;

function TSafeList.Move(CurIndex,NewIndex:Integer):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=NewIndex;
   if Assigned(myList) and InRange(CurIndex,0,myList.Count-1) and InRange(NewIndex,0,myList.Count-1)
   then myList.Move(CurIndex,NewIndex)
   else Result:=-1;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Move');
 end;
end;

procedure Kill(var TheObject:TSafeList); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

/////////////////////////////////
// TSafeStringList implementation
/////////////////////////////////

constructor TSafeStringList.Create;
begin
 inherited Create;
 Lock;
 try
  myList:=TStringList.Create;
 finally
  Unlock;
 end;
end;

destructor TSafeStringList.Destroy;
begin
 Lock;
 try
  Kill(myList);
 finally
  Unlock;
 end;
 inherited Destroy;
end;

function  TSafeStringList.RawList:TStringList;
begin
 if Assigned(Self)
 then Result:=myList
 else Result:=nil;
end;

function  TSafeStringList.GetCount:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.Count;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetCount');
 end;
end;

function  TSafeStringList.GetStrings(i:Integer):LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList) and InRange(i,0,myList.Count-1)
   then Result:=myList.Strings[i];
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetStrings');
 end;
end;

procedure TSafeStringList.SetStrings(i:Integer; const S:LongString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList) and InRange(i,0,myList.Count-1)
   then myList.Strings[i]:=S;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetStrings');
 end;
end;

function  TSafeStringList.GetObjects(i:Integer):TObject;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList) and InRange(i,0,myList.Count-1)
   then Result:=myList.Objects[i];
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetObjects');
 end;
end;

procedure TSafeStringList.SetObjects(i:Integer; const aObject:TObject);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList) and InRange(i,0,myList.Count-1)
   then myList.Objects[i]:=aObject;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetObjects');
 end;
end;

function  TSafeStringList.GetNames(i:Integer):LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList) and InRange(i,0,myList.Count-1)
   then Result:=myList.Names[i];
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetNames');
 end;
end;

function  TSafeStringList.GetValues(const aName:LongString):LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.Values[aName];
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetValues');
 end;
end;

procedure TSafeStringList.SetValues(const aName:LongString; const aValue:LongString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then myList.Values[aName]:=aValue;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetValues');
 end;
end;

function  TSafeStringList.GetText:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.Text;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetText');
 end;
end;

procedure TSafeStringList.SetText(aText:LongString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then myList.Text:=aText;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetText');
 end;
end;

function TSafeStringList.IndexOf(const S:LongString):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.IndexOf(S);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'IndexOf');
 end;
end;

function TSafeStringList.IndexOfName(const aName:LongString):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.IndexOfName(aName);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'IndexOfName');
 end;
end;

function TSafeStringList.IndexOfObject(aObject:TObject):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.IndexOfObject(aObject);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'IndexOfObject');
 end;
end;

function TSafeStringList.Add(const S:LongString):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.Add(S);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Add');
 end;
end;

function TSafeStringList.AddObject(const S:LongString; aObject:TObject):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.AddObject(S,aObject);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'AddObject');
 end;
end;

function TSafeStringList.AddPair(const aName,aValue:LongString; aObject:TObject=nil):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList) then begin
    myList.AddPair(aName,aValue,aObject);
    Result:=myList.IndexOfName(aName);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'AddPair');
 end;
end;

function TSafeStringList.AddText(const S:LongString):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=Count;
   if Assigned(myList)
   then myList.AddText(S)
   else Result:=-1;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'AddText');
 end;
end;

function TSafeStringList.Insert(aIndex:Integer; const S:LongString):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=aIndex;
   if Assigned(myList) and InRange(aIndex,0,myList.Count-1)
   then myList.Insert(aIndex,S)
   else Result:=-1;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Insert');
 end;
end;

function TSafeStringList.InsertObject(aIndex:Integer; const S:LongString; aObject:TObject):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=aIndex;
   if Assigned(myList) and InRange(aIndex,0,myList.Count-1)
   then myList.InsertObject(aIndex,S,aObject)
   else Result:=-1;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'InsertObject');
 end;
end;

function TSafeStringList.Delete(aIndex:Integer):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=aIndex;
   if Assigned(myList) and InRange(aIndex,0,myList.Count-1)
   then myList.Delete(aIndex) else Result:=-1;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Delete');
 end;
end;

procedure TSafeStringList.Clear;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then myList.Clear;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Clear');
 end;
end;

function TSafeStringList.Remove(const S:LongString):Integer;
begin
 Result:=-1;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList)
   then Result:=myList.IndexOf(S);
   if (Result>=0) then myList.Delete(Result);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Remove');
 end;
end;

procedure TSafeStringList.Sort(Compare:TStringListSortCompare=nil);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myList) then begin
    if Assigned(Compare)
    then myList.CustomSort(Compare)
    else myList.Sort;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Sort');
 end;
end;

procedure Kill(var TheObject:TSafeStringList); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_tslist;
begin
end;

procedure Free_crw_tslist;
begin
end;

initialization

 Init_crw_tslist;

finalization

 Free_crw_tslist;

end.

//////////////
// END OF FILE
//////////////

