<

Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x

Creating an auto free string list

Published on
11,807 Points
5,207 Views
1 Endorsement
Last Modified:
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;

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;

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.

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.
1
Comment
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 32

Author Comment

by:Ephraim Wangoya
I should have put this in the category for Tips and Tricks
0
 
LVL 38

Expert Comment

by:Geert Gruwez
Nice article.

More suggestions: AddStrings and using a variable in DisplayList procedure

procedure TForm1.DisplayList(InList: TStrings; AList: TStringList);
begin
  InList.BeginUpdate;
  try
    InList.Add('');
    InList.AddStrings(AList);
  finally
    InList.EndUpdate;
  end;
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(ListBox1.Items, ITempList.List);
  SortList(ITempList.List);
  DisplayList(ListBox1.Items, ITempList.List);

  //work direcly with the list
  ITempList.Clear;
  for I := 1 to 10 do
    ITempList.Add(IntToStr(Random(100)));

  DisplayInList(ListBox2.Items, ITempList.List);

  ITempList.Sort;
  DisplayInList(ListBox2.Items, ITempList.List);
end;



0
 
LVL 15

Expert Comment

by:Eric AKA Netminder
ewangoya,

Congratulations! Your article has been published.

ericpete
Page Editor
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Join & Write a Comment

This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
We’ve all felt that sense of false security before—locking down external access to a database or component and feeling like we’ve done all we need to do to secure company data. But that feeling is fleeting. Attacks these days can happen in many w…
Suggested Courses

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month