为什么不发生MemoryLeak或AccessViolation?

时间:2019-07-17 22:34:53

标签: delphi memory-leaks access-violation

我发现了两个让我感到好奇的案例。

首先是为什么使用JSON库时不会发生内存泄漏。

如果GetValue返回未实现接口的TJSONValue。为什么我的“如果”没有引发内存泄漏?

procedure TFrmApp.btnJSONClick(Sender: TObject);
var
    JSONObject: TJSONObject;
    JSONStr: string;
begin
    JSONStr := '{"colors":[{"name":"red", "hex":"#f00"}]}';

    JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
    try

    // If GetValue returns a TJSONValue that does not implement an interface.
    // Why does my "if" not raise a memory leak?
    if JSONObject.GetValue('colors') <> nil then
        memo.Lines.Add('Colors exist.')
    else
        memo.Lines.Add('Colors not found.');

    finally
    JSONObject.Free;
    end;
end;

第二个原因就是为什么访问Cds的字段时不会发生访问冲突。

如果提供数据的Cds已从内存中释放。为什么不发生访问冲突?

procedure TFrmApp.btnDataSetClick(Sender: TObject);
var
    Cds: TClientDataSet;
begin
    Cds := TClientDataSet.Create(Self);
    try
    Cds.Data := Self.GetData;

    // If the Cds that provided the Data has been released from memory.
    // Why does not access violation occur?
    memo.Lines.Add('Name: ' + Cds.FieldByName('VendorName').AsString);
    memo.Lines.Add('City: ' + Cds.FieldByName('City').AsString);

    finally
    Cds.Free;
    end;
end;

function TFrmApp.GetData: OleVariant;
var
    Cds: TClientDataSet;
begin
    Cds := TClientDataSet.Create(Self);
    try
    Cds.LoadFromFile(TDirectory.GetCurrentDirectory + '\data.xml');

    Result := Cds.Data;
    finally
    Cds.Free;
    end;
end;

示例项目:

.DPR

program TestMemoryLeak;

uses
    Vcl.Forms,
    uApp in 'uApp.pas' {FrmApp};

{$R *.res}

begin
    ReportMemoryLeaksOnShutdown := true;
    Application.Initialize;
    Application.MainFormOnTaskbar := True;
    Application.CreateForm(TFrmApp, FrmApp);
    Application.Run;
end.

uAPP.pas

unit uApp;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.JSON, REST.Json, Datasnap.DBClient, Data.DB,
    System.IOUtils;

type
    TFrmApp = class(TForm)
    btnJSON: TButton;
    btnDataSet: TButton;
    memo: TMemo;
    procedure btnJSONClick(Sender: TObject);
    procedure btnDataSetClick(Sender: TObject);
    private
    { Private declarations }
    function GetData: OleVariant;
    public
    { Public declarations }
    end;

var
    FrmApp: TFrmApp;

implementation

{$R *.dfm}


procedure TFrmApp.btnJSONClick(Sender: TObject);
var
    JSONObject: TJSONObject;
    JSONStr: string;
begin
    JSONStr := '{"colors":[{"name":"red", "hex":"#f00"}]}';

    JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
    try

    // If GetValue returns a TJSONValue that does not implement an interface.
    // Why does my "if" not raise a memory leak?
    if JSONObject.GetValue('colors') <> nil then
        memo.Lines.Add('Colors exist.')
    else
        memo.Lines.Add('Colors not found.');

    finally
    JSONObject.Free;
    end;
end;

procedure TFrmApp.btnDataSetClick(Sender: TObject);
var
    Cds: TClientDataSet;
begin
    Cds := TClientDataSet.Create(Self);
    try
    Cds.Data := Self.GetData;

    // If the Cds that provided the Data has been released from memory.
    // Why does not access violation occur?
    memo.Lines.Add('Name: ' + Cds.FieldByName('VendorName').AsString);
    memo.Lines.Add('City: ' + Cds.FieldByName('City').AsString);

    finally
    Cds.Free;
    end;
end;

function TFrmApp.GetData: OleVariant;
var
    Cds: TClientDataSet;
begin
    Cds := TClientDataSet.Create(Self);
    try
    Cds.LoadFromFile(TDirectory.GetCurrentDirectory + '\data.xml');

    Result := Cds.Data;
    finally
    Cds.Free;
    end;
end;

end.

uApp.dfm

object FrmApp: TFrmApp
    Left = 0
    Top = 0
    Caption = 'FrmApp'
    ClientHeight = 245
    ClientWidth = 516
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    OldCreateOrder = False
    Position = poScreenCenter
    PixelsPerInch = 96
    TextHeight = 13
    object btnJSON: TButton
    Left = 24
    Top = 30
    Width = 75
    Height = 25
    Caption = 'JSON'
    TabOrder = 0
    OnClick = btnJSONClick
    end
    object btnDataSet: TButton
    Left = 24
    Top = 96
    Width = 75
    Height = 25
    Caption = 'DataSet'
    TabOrder = 1
    OnClick = btnDataSetClick
    end
    object memo: TMemo
    Left = 176
    Top = 8
    Width = 321
    Height = 229
    TabOrder = 2
    end
end

data.xml

<?xml version="1.0" standalone="yes"?>
<DATAPACKET Version="2.0">
    <METADATA>
        <FIELDS>
            <FIELD attrname="VendorNo" fieldtype="r8"/>
            <FIELD attrname="VendorName" fieldtype="string" WIDTH="30"/>
            <FIELD attrname="City" fieldtype="string" WIDTH="20"/>
            <FIELD attrname="State" fieldtype="string" WIDTH="20"/>
        </FIELDS>
        <PARAMS DEFAULT_ORDER="1" PRIMARY_KEY="1" LCID="1033"/>
    </METADATA>
    <ROWDATA>
        <ROW VendorNo="2014" VendorName="Cacor Corporation" City="Southfield" State="OH"/>
        <ROW VendorNo="2641" VendorName="Underwater" City="Indianapolis" State="IN" />
        <ROW VendorNo="2674" VendorName="J.W.  Luscher Mfg." City="Berkely" State="MA"/>
        <ROW VendorNo="3511" VendorName="Scuba Professionals" City="Rancho Dominguez"/>
        <ROW VendorNo="3819" VendorName="Divers&apos;  Supply Shop" City="Macon" State="GA"/>
    </ROWDATA>
</DATAPACKET>

1 个答案:

答案 0 :(得分:4)

  

为什么使用JSON库时不会发生内存泄漏。

     

如果GetValue返回未实现接口的TJSONValue。为什么我的“如果”没有引发内存泄漏?

TJSONObject.GetValue()返回指向TJSONValue内部拥有的TJSONObject对象的指针。释放TJSONValue时将释放TJSONObject,您可以在过程结束时进行此操作。 GetValue()不会为输出分配任何新的内存,因此没有什么可释放的,因此没有泄漏。

  

为什么访问Cds的字段时不会发生访问冲突。

     

如果提供数据的Cds已从内存中释放。为什么不发生访问冲突?

您要将源ClientDataSet的Data属性分配给OleVariant,然后将其分配给其他ClientDataSet的Data属性。 OleVariant对分配给它的所有数据进行复制(对于接口对象的[数组],它增加其引用计数),因此是释放原始的ClientDataSet还是释放它。没什么区别,因为OleVariant是独立的并管理它所保存的数据。