复杂 json 对象中的 TJSONObject 内存泄漏

Question

我正在尝试使用 idHTTPserver 和 Delphi Xe5 在小型企业环境中本地提供 REST API 服务。我在将文件发送给客户端之前对其进行了预处理，此时出现了问题。该过程完成后不会释放内存。
创建的 JSON 对象毕竟被正确发送到客户端（AngularJS App）

我做错了什么？

当我收到 HTTP 客户端请求时，我会这样做..

Procedure TMain.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
Var
  // Here Var Types

  Json,LFilename:String;
  ROOTCOMANDAS,TORDEN,DATA,MSG : TJSONObject;
  Dlnew,d : TJSONArray
  files:tfilestream;

Begin

LFilename := ARequestInfo.Document;

if AnsiSameText(LFilename, '/resto/orders/jsondata') then
begin
  files := TFileStream.Create('htd' + LFilename, fmOpenRead + fmShareDenyWrite);
  Json := ReadStringFromStream(files);
  files.Free;
  ROOTCOMANDAS := TJSONOBJECT.ParseJSONValue(TEncoding.ASCII.GetBytes(Json), 0) as TJSONOBJECT;
  try
    Data := ROOTCOMANDAS.Get('data').JSONValue as TJSONOBJECT;
    d := Data.Get('d').JSONValue as TJSONArray;
    dlnew := TJSONArray.Create;

    for LValue in d do
      if (LValue as TJSONOBJECT).GetValue('ss').Value = '0' then
        dlnew.AddElement(LValue);

    TORDEN := TJSONOBJECT.Create;

    Msg := TJSONOBJECT.Create;
    Msg.AddPair(TJSONPair.Create('t', TJSONString.Create('m5000_325')));
    Msg.AddPair(TJSONPair.Create('tipo', TJSONNumber.Create(5)));

    TORDEN.AddPair(TJSONPair.Create('msg', Msg));

    Msg := TJSONOBJECT.Create;

    Msg.AddPair(TJSONPair.Create('et', TJSONString.Create(ETAGL)));
    Msg.AddPair(TJSONPair.Create('d', dlnew));

    TORDEN.AddPair(TJSONPair.Create('data', Msg));
    TORDEN.AddPair(TJSONPair.Create('ok', TJSONTrue.Create));
    TORDEN.AddPair(TJSONPair.Create('md', TJSONNumber.Create(iFD)));
    TORDEN.AddPair(TJSONPair.Create('time', TJSONString.Create(UTC)));

    Json := TORDEN.ToString;

    AResponseInfo.CacheControl := 'no-cache';
    AResponseInfo.CustomHeaders.Values['Access-Control-Allow-Headers'] := 'Content-Type';
    AResponseInfo.CustomHeaders.Values['Access-Control-Allow-methods'] := 'GET,POST,OPTIONS';
    AResponseInfo.CustomHeaders.Values['Access-Control-Allow-origin'] := '*';
    AResponseInfo.CharSet := 'utf-8';
    AResponseInfo.Pragma := 'Public';
    AResponseInfo.Server := 'Drone';
    AResponseInfo.ContentText := Json;
  finally
    ROOTCOMANDAS.Free;
  end;

  exit;
end;

Answer 1

你永远不会释放

TORDEN

变量，因此内存泄漏和当你尝试释放它时出现的错误是由以下几行引起的：

for LValue in d do
  if (LValue as TJSONOBJECT).GetValue('ss').Value = '0' then
    dlnew.AddElement(LValue);

LValue

由

d

拥有，将在

d

发布时发布，并且您正在将

LValue

添加到也将要发布它的

dlnew

。你在这里有所有权问题，因为两个对象想要拥有和释放同一个包含的对象。

尝试以下更改来解决问题：

for LValue in d do
  if (LValue as TJSONOBJECT).GetValue('ss').Value = '0' then
    begin
      dlnew.AddElement(LValue);
      // here you are saying that you don't want to release object when ROOTCOMANDAS is released
      LValue.Owned := false;
    end;
// release ROOTCOMANDAS and d along with it
ROOTCOMANDAS.Free;
// Set back owned property to true so you don't leak objects
for LVaue in dlnew do
  LValue.Owned := true;
...
    Json := TORDEN.ToString;
    TORDEN.Free;

... remove superfluous ROOTCOMANDAS.Free; in finally part

Answer 2

对于任何可能需要它的人。 几个小时后，我发现这阻止了那个讨厌的错误：

procedure TForm1.DoEndDownload(const AsyncResult: IAsyncResult);
// happens after beginGet when sampledownload is invoked
var
isCan:boolean;
begin
...
       try
        isCan:= FAsyncResult.Cancel;  
        FAsyncResult.AsyncContext.Free;
       except
            on e:exception do
           //        memoMessages.Lines.Add('Cancelling Error: ' + e.Message);
       end;
...
end;

SampleDownload 程序包括：

    URL := EditURL.Text+'/'+editTopic.Text+'/'+editParams.text;

     LResponse := FClient.Head(URL);
     LSize := LResponse.ContentLength;
     LResponse := nil;  // do not send a response because waiting for data

           FDownloadStream := TMemoryStream.Create();//(LFileName, fmCreate);


         // ---  Start the download/polling process  ----
        try
           FAsyncResult := FClient.BeginGet(DoEndDownload, URL, FDownloadStream);
            except
             on e:exception do
             log.Add('FClient BeginGet except: '+e.Message);
         end;

请不要讨论这个解决方案，因为它有效，虽然它可能对您没有帮助，但可能对某人有帮助。