Creating an auto free string list

Creating an auto free TStringList

The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list.

In such cases, you have to create your object, try it, and finally block to make sure your resources are properly destroyed. You end up with code like the following

var
                        List: TStringList;
                      begin
                        List := TStringList.Create;
                        try
                          //Some code to process the List
                        finally
                          FreeAndNil(List);
                        end;

Select all Open in new window

Here we have four extra lines of code that we could eliminate.

Imagine if you forgot to free the list, ran the the function a couple of times and suddenly your application is consuming an unimaginable amount of memory: ... mmm not good.
It would be nice if you just created the list and never worried about adding code to destroy it.

So let's create a StringList that frees itself.

I define an interface and add the common methods I would need from the TStringList;
I commonly use Count, Strings and Text. You can add others as you wish.

type
                        IAutoFreeStringList = interface
                        ['{20C54556-714C-4478-AF2D-D8F37219E36E}']
                          function GetListCount: Integer;
                          function GetListStrings(Index: Integer): string;
                          function GetListText: string;
                          function List: TStringList;
                          procedure PutListStrings(Index: Integer; const S: string);
                          procedure SetListText(const Value: string);
                      
                          function Add(const S: string): Integer;
                          function AddObject(const S: string; AObject: TObject): Integer;
                          procedure Clear;
                          procedure Delete(Index: Integer);
                          procedure Exchange(Index1, Index2: Integer);
                          function Find(const S: string; var Index: Integer): Boolean;
                          function IndexOf(const S: string): Integer;
                          procedure Insert(Index: Integer; const S: string);
                          procedure InsertObject(Index: Integer; const S: string; AObject: TObject);
                          procedure Sort;
                          procedure CustomSort(Compare: TStringListSortCompare);
                      
                          property Count: Integer read GetListCount;
                          property Strings[Index: Integer]: string read GetListStrings write PutListStrings; default;
                          property Text: string read GetListText write SetListText;
                        end;
                      
                        //Our Object
                        TAutoFreeStringList = class(TStringList, IInterface, IAutoFreeStringList)
                        protected
                          FRefCount: Integer;
                          function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
                          function _AddRef: Integer; stdcall;
                          function _Release: Integer; stdcall;
                          //IAutoFreeStringList
                          function GetListCount: Integer;
                          function GetListStrings(Index: Integer): string;
                          function GetListText: string;
                          procedure PutListStrings(Index: Integer; const S: string);
                          procedure SetListText(const Value: string);
                          function List: TStringList;
                        public
                          procedure AfterConstruction; override;
                          procedure BeforeDestruction; override;
                          class function NewInstance: TObject; override;
                          property RefCount: Integer read FRefCount;
                        end;
                      
                      implementation
                      
                      { TAutoFreeStringList }
                      
                      procedure TAutoFreeStringList.AfterConstruction;
                      begin
                        inherited AfterConstruction;
                        // Release the constructor's implicit refcount
                        InterlockedDecrement(FRefCount);
                      end;
                      
                      procedure TAutoFreeStringList.BeforeDestruction;
                      begin
                        //if our reference count is not 0 then we have a problem
                        if FRefCount <> 0 then
                          raise EListError.Create('Invalid reference count: ' + IntToStr(FRefCount));
                      
                        inherited BeforeDestruction;
                      end;
                      
                      function TAutoFreeStringList.GetListCount: Integer;
                      begin
                        Result := inherited GetCount;
                      end;
                      
                      function TAutoFreeStringList.GetListStrings(Index: Integer): string;
                      begin
                        Result := inherited Get(Index);
                      end;
                      
                      function TAutoFreeStringList.GetListText: string;
                      begin
                        Result := inherited GetTextStr;
                      end;
                      
                      function TAutoFreeStringList.List: TStringList;
                      begin
                        //Pass to methods that have TStrings parameter
                        Result := Self;
                      end;
                      
                      class function TAutoFreeStringList.NewInstance: TObject;
                      begin
                        Result := inherited NewInstance;
                        TAutoFreeStringList(Result).FRefCount := 1;
                      end;
                      
                      procedure TAutoFreeStringList.PutListStrings(Index: Integer; const S: string);
                      begin
                        inherited Put(Index, S);
                      end;
                      
                      function TAutoFreeStringList.QueryInterface(const IID: TGUID; out Obj): HResult;
                      begin
                        if GetInterface(IID, Obj) then
                          Result := NOERROR
                        else
                          Result := E_NOINTERFACE;
                      end;
                      
                      procedure TAutoFreeStringList.SetListText(const Value: string);
                      begin
                        inherited SetTextStr(Value);
                      end;
                      
                      function TAutoFreeStringList._AddRef: Integer;
                      begin
                        Result := InterlockedIncrement(FRefCount);
                      end;
                      
                      function TAutoFreeStringList._Release: Integer;
                      begin
                        Result := InterlockedDecrement(FRefCount);
                        if Result = 0 then  //nobody is referencing this anymore
                          Destroy;
                      end;

Select all Open in new window

Now let us see how we can use this new list. I have created a form with two list boxes. The first list box will be populated by passing the List method of the new object to other methods.

function list returns a TStringList and allows you to work with the object like any other TStringList.

The second List Box is populated by directly working with the TAutoFreeStringList. As you will see, it is treated exactly as you would treat a TStringList. A common mistake would be to declare the List variable as TAutoFreeStringList, so make sure to declare your list variable as IAutoFreeStringList e.g

IList: IAutoFreeStringList

With this said, here is the code

unit Unit1;
                      
                      interface
                      
                      uses
                        Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
                        Dialogs, StdCtrls;
                      
                      type
                        TForm1 = class(TForm)
                          ListBox1: TListBox;
                          Button1: TButton;
                          ListBox2: TListBox;
                          procedure Button1Click(Sender: TObject);
                        private
                        public
                          procedure SortList(AList: TStringList);
                          procedure DisplayList(AList: TStringList);
                          procedure PlayWithList;
                        end;
                      
                      var
                        Form1: TForm1;
                      
                      implementation
                      
                      {$R *.dfm}
                      
                      { TForm1 }
                      
                      procedure TForm1.Button1Click(Sender: TObject);
                      begin
                        PlayWithList;
                      end;
                      
                      procedure TForm1.DisplayList(AList: TStringList);
                      var
                        I: Integer;
                      begin
                        ListBox1.Items.Add('');
                        for I := 0 to AList.Count - 1 do
                          ListBox1.Items.Add(AList[I])
                      end;
                      
                      procedure TForm1.PlayWithList;
                      var
                        ITempList: IAutoFreeStringList;  //remember to use interface
                        I: Integer;
                      begin
                        Randomize;
                      
                        ITempList := TAutoFreeStringList.Create;
                      
                        for I := 1 to 10 do
                          ITempList.Add(IntToStr(Random(100)));
                      
                        //Pass the Objects List to this functions
                        DisplayList(ITempList.List);
                        SortList(ITempList.List);
                        DisplayList(ITempList.List);
                      
                        //work direcly with the list
                        ITempList.Clear;
                        for I := 1 to 10 do
                          ITempList.Add(IntToStr(Random(100)));
                      
                        ListBox2.Items.Add('');
                        for I := 0 to ITempList.Count - 1 do
                          ListBox2.Items.Add(ITempList[I]);
                      
                        ITempList.Sort;
                        ListBox2.Items.Add('');
                        for I := 0 to ITempList.Count - 1 do
                          ListBox2.Items.Add(ITempList[I]);
                      end;
                      
                      procedure TForm1.SortList(AList: TStringList);
                      begin
                        AList.Sort;
                      end;
                      
                      end.

Select all Open in new window

So there you have it, a TStringList that cleans after itself -- no need to call the Free method of the Object.