Author: Tomas Rutkauskas

How to create an interfaced TStringList

Answer:

1   unit InterfacedStrings;
2   
3   interface
4   
5   uses
6     Classes;
7   
8   type
9     IudStrings = interface
10      ['{3F36AFFE-8D71-4C24-AAE4-620A6D58E4D1}']
11      function Strings: TStrings;
12    end;
13  
14    TInterfacedStringList = class(TStringList, IudStrings)
15    private
16      FRefCount: Integer;
17    protected
18      { IudStrings }
19      function Strings: TStrings;
20      { IInterface }
21      function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
22      function _AddRef: Integer; stdcall;
23      function _Release: Integer; stdcall;
24    public
25      procedure AfterConstruction; override;
26      class function NewInstance: TObject; override;
27    end;
28  
29  implementation
30  
31  { TInterfacedStringList }
32  
33  function TInterfacedStringList.Strings: TStrings;
34  begin
35    Result := Self;
36  end;
37  
38  function TInterfacedStringList._AddRef: Integer;
39  begin
40    Result := InterlockedIncrement(FRefCount);
41  end;
42  
43  function TInterfacedStringList._Release: Integer;
44  begin
45    Result := InterlockedDecrement(FRefCount);
46    if Result = 0 then
47      Destroy;
48  end;
49  
50  function TInterfacedStringList.QueryInterface(const IID: TGUID; out Obj): HResult;
51  begin
52    if GetInterface(IID, Obj) then
53      Result := 0
54    else
55      Result := E_NOINTERFACE;
56  end;
57  
58  procedure TInterfacedStringList.AfterConstruction;
59  begin
60    inherited;
61    InterlockedDecrement(FRefCount);
62  end;
63  
64  class function TInterfacedStringList.NewInstance: TObject;
65  begin
66    Result := inherited NewInstance;
67    TInterfacedStringList(Result).FRefCount := 1;
68  end;
69  
70  end.