字符串创建列表_创建自动释放字符串列表

字符串创建列表

Creating an auto free TStringList

创建一个自动的免费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.

TStringList是Delphi中一个基本且经常使用的对象。 在很多情况下，您可能想要创建一个临时列表，处理列表中的某些项目并使用该列表完成操作。

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;

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.

想象一下，如果您忘记释放列表，运行了几次该功能，突然您的应用程序正在消耗不可思议的内存量：... mmm不好。

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.

因此，让我们创建一个释放自身的StringList。

I define an interface and add the common methods I would need from the TStringList;

我定义一个接口，并从TStringList中添加所需的通用方法。

I commonly use Count, Strings and Text. You can add others as you wish.

我通常使用Count，Strings和Text。 您可以根据需要添加其他人。

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;

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.

现在让我们看看如何使用这个新列表。 我创建了一个带有两个列表框的表单。 通过将新对象的List方法传递给其他方法来填充第一个列表框。

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

函数列表返回一个TStringList，并允许您像其他任何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

通过直接使用TAutoFreeStringList填充第二个列表框。 正如您将看到的，它的处理方式与TStringList的处理方式完全相同。 一个常见的错误是将List变量声明为TAutoFreeStringList，因此请确保将您的列表变量声明为IAutoFreeStringList，例如

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.

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

因此，有了它，一个TStringList便会自动清除-无需调用Object的Free方法。

翻译自: https://www.experts-exchange.com/articles/3659/Creating-an-auto-free-string-list.html

字符串创建列表