是否有在单个过程中在运行时初始化可变数量的对象的过程？

Posted 2023-02-16

【中文标题】是否有在单个过程中在运行时初始化可变数量的对象的过程？

【英文标题】：Is there a procedure to initialize a variable number of objects at runtime in single procedure?

【发布时间】：2013-12-18 13:58:38

【问题描述】：

我一般都是在程序开始的时候初始化一些变量，比如TStringList类型，然后释放它们。单独初始化感觉很尴尬，比如

listOne := TStringList.Create;
listTwo := TStringList.Create;
listTree := TString.Create;
 etc, etc

我更喜欢这样的程序，用另一个 for Free 来结束它们：

CreateStrings(listOne, listTwo, listThree);
CreateStrings([listOne, listTwo, listTree]); //using an array

是否有一个程序可以对可变数量的对象执行类似的操作？

如果不能对任意对象类型做到这一点，至少对于相似类型或具有相同创建签名的类型？

【问题讨论】：

如果 a) 你经常这样做并且 b) 它们倾向于在代码中一起使用，你可以将列表包装在一个类中

【参考方案1】：

我能想到的最好的是：

PROCEDURE CreateObjects(ClassType : TClass ; VAR O1); OVERLOAD;
  BEGIN
    TObject(O1):=NIL;
    TObject(O1):=ClassType.Create
  END;

PROCEDURE CreateObjects(ClassType : TClass ; VAR O1,O2); OVERLOAD;
  BEGIN
    TObject(O1):=NIL; TObject(O2):=NIL;
    TObject(O1):=ClassType.Create; TObject(O2):=ClassType.Create
  END;

PROCEDURE CreateObjects(ClassType : TClass ; VAR O1,O2,O3); OVERLOAD;
  BEGIN
    TObject(O1):=NIL; TObject(O2):=NIL; TObject(O3):=NIL;
    TObject(O1):=ClassType.Create; TObject(O2):=ClassType.Create; TObject(O3):=ClassType.Create
  END;

PROCEDURE FreeObjects(CONST Objects : ARRAY OF TObject);
  VAR
    O   : TObject;
    E   : Exception;
    ADR : POINTER;

  BEGIN
    E:=NIL;
    FOR O IN Objects DO TRY
      O.Free
    EXCEPT
      ON X:Exception DO BEGIN
        E:=X; ADR:=ExceptAddr
      END
    END;
    IF Assigned(E) THEN RAISE E AT ADR
  END;

PROCEDURE TMainForm.FormCreate(Sender : TObject);
  VAR
    SL1,SL2 : TStrings;

  BEGIN
    CreateObjects(TStringList,SL1,SL2);
    FreeObjects([SL1,SL2])
  END;

您需要为要同时创建的每个对象计数创建一个重载过程。同一个 CreateObjects 调用中的所有对象都将被创建为相同的类型（您将作为第一个参数给出），并且只能使用该类型的无参数构造函数来创建。

在构造之前进行 NIL 赋值的原因是为了确保传入的变量始终具有有效值（NIL 或指向所请求类型的类）。这也意味着与普通代码相比：

O:=TObject.Create;
TRY
  // Blah, Blah
FINALLY
  O.Free
END;

你应该使用

TRY
  CreateObjects(TObject,O1,O2);
  // Blah, Blah
FINALLY
  FreeObjects([O1,O2])
END;

即。在 TRY/FINALLY 块内移动对象的创建。

如果你是 FreeAndNIL 的支持者，那么你可以这样做：

PROCEDURE FreeAndNilObjects(VAR O1,O2); OVERLOAD;
  BEGIN
    TRY
      FreeAndNIL(O1)
    FINALLY
      FreeAndNIL(O2)
    END
  END;

PROCEDURE FreeAndNilObjects(VAR O1,O2,O3); OVERLOAD;
  BEGIN
    TRY
      FreeAndNIL(O1)
    FINALLY
      TRY
        FreeAndNIL(O2)
      FINALLY
        FreeAndNIL(O3)
      END
    END
  END;

这个有点奇怪的结构确保在所有传入的对象上调用 FreeAndNIL，但也意味着如果发生任何异常，它将是您将收到的最后一个引发的异常，并且任何先前的异常都将是丢失。但是，它确实确保所有对象都（尝试）释放。

编辑：更新了 FreeObjects 以正确处理任何对象的 .Free 调用中可能发生的任何异常。与 FreeAndNilObjects 过程一样，它会吃掉除最后一个以外的任何异常，并在确保至少尝试在每个传入的对象上调用 .Free 后重新引发此异常。

【参考方案2】：

procedure CreateObjects(Vars: array of Pointer; ClassType: TClass);
var
  I: Integer;
begin
  for I := Low(Vars) to High(Vars) do
    TObject(Vars[I]^) := ClassType.Create;
end;

procedure FreeObjects(Vars: array of TObject);
var
  I: Integer;
begin
  for I := Low(Vars) to High(Vars) do
    Vars[I].Free;
end;

procedure TForm2.Button1Click(Sender: TObject);
const
  TestString = 'A,B,C,"4th line","line 5","last line"';
var
  StringList1: TStringList;
  StringList2: TStringList;
  StringList3: TStringList;
begin
  CreateObjects([@StringList1, @StringList2, @StringList3], TStringList);
  try
    StringList1.CommaText := TestString;
    StringList2.CommaText := TestString;
    StringList3.CommaText := TestString;
    Memo1.Lines.Assign(StringList1);
    ListBox1.Items.Assign(StringList2);
    RichEdit1.Lines.Assign(StringList3);
  finally
    FreeObjects([StringList1, StringList2, StringList3]);
  end;
end;

【讨论】：

StringList1创建成功，但是在创建StringList2的过程中出现异常怎么办？

@HeartWare 是的。由于所有对象都属于同一类型，因此我想象的例外是 EOutOfMemory；那么这将是你最少的问题。但是感谢您的警告；严格来说，这段代码可能会泄漏对象。

不一定 (EOutOfMemory)。如果类类型是“TMyOwnClassTypeThatFailsOnEvery2ndCall”（即，构造函数可能由于 EOutOfMemory 以外的任何其他原因而失败，但出于非常“自然”的原因？）怎么办？前任一个清空队列并将信息传输到其内部变量然后队列干涸的构造函数？