从包含字符串字段的记录数组中删除元素?

Removing elements from an array of records containing string fields?

检查下面的示例...我有一个包含记录元素的数组 TSrvClientList.Items。这些元素有字符串字段。当我删除一个元素时,我需要将空 space 中的以下元素移到左边。我不喜欢一个字段一个字段地复制...而且我想我会使用 Move 函数来更快地完成它,但我不确定这是否是一个正确的方法。如果记录只包含非托管类型,我确定没问题,我用了很多次。但是对于那些字符串,我不知道...我应该先调用 Finalize 吗?或者以不同的方式做?我的测试代码似乎按原样工作,直接移动这些字符串,但我想确保这不仅仅是巧合。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics,  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, SynCommons, System.SyncObjs,
  Vcl.StdCtrls;

type
  TSrvClientInfo = record
   ClientIP: String;
   ClientGUID: Cardinal;
   AESKey: THash256;
   TransCons: Integer;
  end;

  TSrvClientList = record
   private
    Valid: DWord;
   public
    Items: array of TSrvClientInfo;
    procedure Init;
    procedure Free;
    procedure AddClient(const IP: String; GUID: Cardinal; AESKey: THash256);
    procedure RemoveClient(const IP: String; GUID: Cardinal);
  end;

  TForm1 = class(TForm)
    BAddItem: TButton;
    BRemoveItem: TButton;
    procedure FormCreate(Sender: TObject);
    procedure BAddItemClick(Sender: TObject);
    procedure BRemoveItemClick(Sender: TObject);
  public
    Code: Byte;
    Clients: TSrvClientList;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//===== TSrvClientList =======================================================

procedure TSrvClientList.Init;
begin
 if Valid <> 344321 then begin
  Valid:= 344321;
  SetLength(Items, 0);
 end;
end;

procedure TSrvClientList.Free;
begin
 if Valid = 344321 then begin
  SetLength(Items, 0);
  Valid:= 0;
 end;
end;

procedure TSrvClientList.AddClient(const IP: String; GUID: Cardinal; AESKey: THash256);
var I: Integer;
begin
 if Valid <> 344321 then Exit;
 I:= Length(Items); SetLength(Items, I+1);
 Items[I].ClientIP:= IP;
 Items[I].ClientGUID:= GUID;
 Items[I].AESKey:= AESKey;
 Items[I].TransCons:= 0;
end;

procedure TSrvClientList.RemoveClient(const IP: String; GUID: Cardinal);
var I, R: Integer;
begin
 if Valid <> 344321 then Exit;
 I:= 0; while (I < Length(Items)) and ((Items[I].ClientIP <> IP) or (Items[I].ClientGUID <> GUID)) do Inc(I);
 if (I > High(Items)) then Exit;
 R:= High(Items) - I;
 if R > 0 then Move(Items[I+1], Items[I], SizeOf(TSrvClientInfo) * R);
 SetLength(Items, Length(Items)-1);
end;

// ----------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
 Clients.Init;
 Code:= 1;
end;

procedure TForm1.BAddItemClick(Sender: TObject);
var IP: String;
    GUID: Cardinal;
    AESKey: THash256;
begin
 IP:= '192.168.0.3';
 GUID:= 345678;
 FillChar(AESKey[0], 32, 0); AESKey[0]:= Code; Inc(Code);
 Clients.AddClient(IP, GUID, AESKey);
 Caption:= IntToStr(Length(Clients.Items));
end;

procedure TForm1.BRemoveItemClick(Sender: TObject);
var IP: String;
    GUID: Cardinal;
begin
 IP:= '192.168.0.3';
 GUID:= 345678;
 Clients.RemoveClient(IP, GUID);
 Caption:= IntToStr(Length(Clients.Items));
end;

end.

如您所料,由于字符串成员的原因,您不能这样做。这是因为正如您所说,字符串是托管类型。

考虑以下更小的示例:

procedure TForm1.FormCreate(Sender: TObject);
var
  A: array of string;
begin

  ReportMemoryLeaksOnShutdown := True;

  SetLength(A, 6);
  A[0] := 'cats';      A[1] := 'dogs';     A[2] := 'rats';
  A[3] := 'rabbits';   A[4] := 'horses';   A[5] := 'guinea pigs';

  Move(A[3], A[2], 3 * SizeOf(string));
  SetLength(A, Length(A) - 1);

end;

注意:我选择而不是来使用更简单的(post-XE7)方法

A := ['cats', 'dogs', 'rats', 'rabbits', 'horses', 'guinea pigs'];

因为那样的话动态数组堆对象的引用计数会是2而不是1,分析起来会比较复杂

在您退出应用程序之前,这似乎可以正常工作。然后您会收到以下通知:

这是非常令人期待的。回想长字符串的 internal data format 。长字符串被引用计数。让我们看看 Move 之前 rats 的堆对象(打开 Memory 面板并转到 Pointer(A[2])^):

注意引用计数是1(字符串长度是4)。如果您单步执行代码,您会注意到这个堆对象再也没有被触及过。它被泄露是因为 RTL 永远没有机会清除它。

您可以通过在 Move.

之前添加 Finalize(A[2]) 来修复此漏洞

但是,还有一个问题。移动之后,A[4]A[5] 都指向同一个长字符串堆对象。这是数组堆对象(引用计数、长度和六个指针):

转到这个地址,我们发现:

这是一个引用计数为 1 的长字符串 -- 但我们希望它为 2。当您调用 SetLength 删除最后一项时会发生什么?这不会导致堆对象达到引用计数 0 并被释放,这意味着新的最后一个字符串指针 A[4] 将悬空吗?

是的,我也这么认为。

如果我尝试

procedure TForm1.FormCreate(Sender: TObject);
var
  A: array of string;
begin

  ReportMemoryLeaksOnShutdown := True;

  SetLength(A, 6);
  A[0] := 'cats';      A[1] := 'dogs';     A[2] := 'rats';
  A[3] := 'rabbits';   A[4] := 'horses';   A[5] := 'guinea pigs';

  Finalize(A[2]);
  Move(A[3], A[2], 3 * SizeOf(string));
  SetLength(A, Length(A) - 1);

  for var s in A do
    ShowMessage(s);

end;

我看到“猫”、“狗”、“兔子”、“马”、“d”。您可能会观察到不同的行为。

这可能可以通过清除 SetLength 之前 RTL 后面的最后一个指针来解决:

procedure TForm1.FormCreate(Sender: TObject);
var
  A: array of string;
begin

  ReportMemoryLeaksOnShutdown := True;

  SetLength(A, 6);
  A[0] := 'cats';      A[1] := 'dogs';     A[2] := 'rats';
  A[3] := 'rabbits';   A[4] := 'horses';   A[5] := 'guinea pigs';

  Finalize(A[2]);               // frees the A[2]^ string and sets A[2] to nil
  Move(A[3], A[2], 3 * SizeOf(string));
  NativeInt(A[5]) := 0;         // sets A[5] to nil
  SetLength(A, Length(A) - 1);

  for var s in A do
    ShowMessage(s);

end;

我需要告诉你这是不应该使用的 hack 吗?


有趣的是,如果我改用“数组文字”,动态数组的初始引用计数为 2,因此 SetLength 将创建一个新的动态数组堆对象,至少在我的系统上是这样现在,行为似乎是正确的,但我还没有详细分析程序。

无需调用 FinalizeMoveSetLength。内在的 Delete 已经为您处理了所有这些:

Delete(Items, I, 1);