Delphi iTask 随机生成内存不足错误

Question

我必须在 5 个不同的时间间隔内处理特定的代码。每个代码都非常相似，只是一些参数彼此不同。 为了完成这项工作，我创建了一个 iTask 数组，其中任务数根据间隔数（在我的示例中为 5）。

我创建了一个函数“CreateiTask”，它返回 iTask。该函数有两个填充在函数内部的 Tstrings 参数。 我还创建了一个过程 CreateArrayofiTask，它根据参数 pInterval 的大小创建 iTask 数组。

虽然似乎两个方法都是相应创建的，但主程序随机地呈现访问冲突。 我不知道出了什么问题以及如何解决它。

这是完整的代码：

unit UntArrayofiTask;
interface

Uses
     System.Classes, System.SysUtils, System.Threading;

TYPE
    ArriTask     = array of iTask;
    TArrString   = array of string;


Function   CreateiTask ( pInterval_A     : string;
                         pParamrequest_A : TStrings;
                         pResults_A      : TStrings ) : iTask;

Procedure  CreateArrayofiTask ( pInterval : Tarray<string>;
                            pParamrequest : TStrings; pResults : TStrings);


implementation


Function CreateiTask ( pInterval_A     : string;
                       pParamrequest_A : TStrings;
                       pResults_A      : TStrings ) : iTask;
begin
     RESULT := TTask.Create
             (
               procedure
               var
                 lnum : integer;
                 lstr : string;
               begin
                    pResults_A.Add('Intervalo: ' + pInterval_A);

                    for lnum:=0 to pParamrequest_A.Count-1 do
                        pResults_A.Add(pParamrequest_A[lnum]);

                    pResults_A.Add('-------------------------------');
               end
            );
end;

Procedure CreateArrayofiTask ( pInterval : Tarray<string>;
                               pParamrequest : Tstrings; pResults : TStrings);
var
   lArrayTask          : array of iTask;
   idxinterval,lsize  : byte;
begin
     lsize := Length(pInterval);
     SetLength(lArrayTask,lSize);
     for idxinterval := Low(lArrayTask) to High(lArrayTask) do
     begin
          lArrayTask[idxinterval]:= CreateiTask ( pInterval[idxinterval],pParamrequest,pResults);
          lArrayTask[idxinterval].Start;
     end;
     TTask.WaitForAll(lArrayTask);
end;

end.

这是主程序 - VCL 程序

unit FRMThreadArrayiTask;

interface

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

  UntArrayofiTask;

type
  TFormArrayTask = class(TForm)
    BTRunTasks: TButton;
    MemoResults: TMemo;
    LBoxInterval: TListBox;
    EdtExecucao: TEdit;
    LBExecucao: TLabel;
    MemoIterations: TMemo;
    LBParameter: TLabel;
    LBResults: TLabel;
    LBResultIteration: TLabel;
    procedure BTRunTasksClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormArrayTask: TFormArrayTask;

implementation

{$R *.dfm}

procedure TFormArrayTask.BTRunTasksClick(Sender: TObject);
var
   idx,iteration    : byte;
   larrstrinterval  : Tarray<string>;
   lparam        : Tstrings;
   lresults      : Tstrings;
   ldtin,ldtfin  : TDateTime;
begin
     ReportMemoryLeaksOnShutdown := True;

     memoResults.Clear;
     memoIterations.Lines.Clear;

     //Run n times to get the error happen
     for iteration := 1 to  StrToint(EdtExecucao.text) do
     BEGIN
           SetLength(larrstrinterval,LBoxInterval.Items.Count);
           lparam   := Tstringlist.Create;
           lresults := Tstringlist.Create;
           TRY
               memoResults.lines.Text :='';

               lParam.AddPair('StartTime',FormatDateTime('YYYY-MM-DD''T''hh:nn:ss',strToDate('11/01/2021')));
               lParam.AddPair('EndTime'  ,FormatDateTime('YYYY-MM-DD''T''hh:nn:ss',strToDate('11/01/2021')));
               lParam.AddPair('Location','SP');

               //Add the interval values ( 'DAILY','WEEKLY','MONTLHY','QUARTERLY','ANNUAL')
               for idx := 0 to LBoxInterval.Items.Count-1 do
               begin
                    larrstrinterval[idx] := LBoxInterval.Items[idx];
               end;

               //Create an iTask array with n intervals and run each TTask
               CreateArrayofiTask(larrstrinterval,lparam,lresults);

               memoResults.lines.Text := lresults.text;
           FINALLY
                lparam.Free;
                lresults.Free;
           END;
           memoIterations.Lines.Add('Iterarion # : ' + iteration.ToString) ;
     END;

end;

end.

当运行此代码 5 次或更多次时，会发生一些错误：

有时也会冻结:

函数的iTask数组声明有问题吗？ 通过函数和过程传递给主程序的参数是否有问题？ 这段代码的问题出在哪里？

感谢您的帮助！

Answer 1

问题是您使用来自所有不同任务（线程）的变量 (TStringList)

lResults

，而没有防止同时访问。

同时访问扰乱了 TStringList 的内部内存重新分配。

通过添加一个关键部分来修复它，就像这样——它确保一次只有一个任务（线程）可以修改字符串列表：

var
  CritSect: TCriticalSection;  // Global variable

Function CreateiTask ( pInterval_A     : string;
                       pParamrequest_A : TStrings;
                       pResults_A      : TStrings ) : iTask;
begin
     RESULT := TTask.Create
             (
               procedure
               var
                 lnum : integer;
                 lstr : string;
               begin
                    CritSect.Acquire;  // <------------- ADDED LINE
                    try
                      pResults_A.Add('Intervalo: ' + pInterval_A);

                      for lnum:=0 to pParamrequest_A.Count-1 do
                          pResults_A.Add(pParamrequest_A[lnum]);

                      pResults_A.Add('-------------------------------');
                    finally
                      CritSect.Release;  // <------------- ADDED LINE
                    end;
               end
            );
end;

initialization
  CritSect := TCriticalSection.Create;
finalization
  CritSect.Free;
end.

（不是绝对必要的，但从人的角度来看，代码会受益于更多地遵守代码格式标准：类型通常以 Object Pascal 中的前缀 T 开头，关键字通常全部小写（类型、开始、结束）、空格通常不会被大量使用 - 但即使没有这些调整也能正常工作。）