<

Go Premium for a chance to win a PS4. Enter to Win

x

Creating an auto free string list

Published on
11,899 Points
5,299 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
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

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Join & Write a Comment

This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…
Suggested Courses

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month