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

piwo6bdm  于 2023-04-20  发布在  其他
关注(0)|答案(2)|浏览(339)

我尝试在小型企业环境中使用 Delphi Xe5的idHTTPserver本地提供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;
iszxjhcz

iszxjhcz1#

您永远不会释放TORDEN变量,因此会出现内存泄漏,并且当您尝试释放它时会出现错误,这是由以下行引起的:

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

LValued拥有,并将在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
owfi6suc

owfi6suc2#

对于其他任何可能需要这个的人。经过许多小时,我发现这阻止了那个讨厌的错误:

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;

请不要diss这个解决方案,因为它的工作,而它可能不会帮助你,它可能会帮助别人。

相关问题