TClientDataSet不释放内存 [英] TClientDataSet Doesn't Release Memory

问题描述

我有一个DataSnap服务器，该服务器创建给定用户会话所独有的TSQLQuery，TDataSetProvider和TClientDataSet，使用并重用它们从数据库中检索数据并将TClientDataSet.Data(OleVariant)发送给客户端.除一个问题外，它运行得很好.

I have a DataSnap server that creates a TSQLQuery, TDataSetProvider and a TClientDataSet that are unique to a given user's session, which are used and reused to retrieve data from a database and send TClientDataSet.Data (an OleVariant) to the client. It works very well, except for one problem.

当我通过调用TClientDataSet的Open方法来填充TClientDataSet时，分配的内存不会释放，直到用户将其客户端与DataSnap服务器断开连接.当用户使用该应用程序并继续从DataSnap服务器检索数据时，将继续分配内存(数百兆).当用户断开连接时，将释放所有内存.它需要在每次请求后释放分配的内存，以使长时间连接的用户不会因为消耗其所有RAM而使服务器崩溃.

When I populate the TClientDataSet by calling its Open method, the memory that is allocated is not freed until the user disconnects their client from the DataSnap server. As the user uses the application and continues to retrieve data from the DataSnap server, memory continues to be allocated (hundreds of megs). When the user disconnects, all memory is freed. It needs to free the allocated memory after each request so that users that are connected for long periods of time don't crash the server by consuming all of its RAM.

我认为当用户请求数据时创建TSQLQuery，TDataSetProvider和TClientDataSet组件，然后在每次请求后立即销毁它们可能会起作用.这并没有改变行为. RAM继续分配，直到用户断开连接后才释放.

I thought it might work to create the TSQLQuery, TDataSetProvider and TClientDataSet components when the user requests data, and then immediately destroy them after each request. This did not change the behavior. RAM continues to be allocated and not released until the user disconnects.

使用TClientDataSet时，即使在每次请求后销毁了组件，为什么DataSnap服务器也要保留分配的内存?

Why does the DataSnap server to hold on to the allocated memory when using a TClientDataSet, even when the components are destroyed after each request?

谢谢， 詹姆斯

<<<2011年7月7日下午6:23 >>>

<<< Edit : 7/7/2011 6:23 PM >>>

根据Jeroen的建议，我创建了一个重复该问题的小程序.有两个部分，服务器(4个源文件)和客户端(4个源文件).如果有一个可以在此讨论中附加文件的功能，则我无法使用它-信誉点不足...，因此我将其粘贴在下面的代码中.服务器是一项服务，因此必须在服务器构建后对其进行注册(例如，C:\ProjectFolder\Server.exe /install).

Per Jeroen's recommendation, I have created a small program that duplicates the problem. There are two parts, the Server (4 source files) and the Client (4 source files). If there's a feature to attach files to this discussion, I can't use it yet -- not enough reputation points..., so I'm pasting the code below. The Server is a service so it must be registered after it is built (e.g., C:\ProjectFolder\Server.exe /install).

在构建服务器之前，请设置SQLConnection1的属性，然后在ServerMethodsUnit1.pas中编辑SQL语句.解决内存分配问题的唯一方法是每次请求都检索相当数量的数据(例如500k).我正在查询的表包括uniqueidentifier，varchar(255)，varchar(max)，nvarchar(max)，int，bit，datetime和其他列.我验证了所有数据库数据类型都存在内存问题.传输到客户端的数据集越大，服务器在不释放内存的情况下分配内存的速度就越快.

Before building the server, set the properties for SQLConnection1, and edit the SQL statements in ServerMethodsUnit1.pas. The only way to see the memory allocation issue is to retrieve a fair amount of data with each request (e.g., 500k). The tables I'm querying include uniqueidentifier, varchar(255), varchar(max), nvarchar(max), int, bit, datetime and other columns. I verified that all database datatypes exhibit the memory issue. The larger the dataset that is transferred to the client, the quicker the server allocates memory without releasing it.

两个应用程序均已构建并且服务已注册/启动后，请使用ProcessExplorer查看服务器服务使用的内存.然后启动客户端，单击连接，然后单击按钮以获取数据.请注意，ProcessExplorer中服务器的内存增加了.单击断开连接"，然后观察内存是否全部释放.

Once both apps are built and the service is registered/started, use ProcessExplorer to view the memory used by the server service. Then start the client, click connect and click the buttons to get data. Notice the memory in ProcessExplorer increase for the server. Click Disconnect and watch the memory all be released.

Server.dpr

Server.dpr

program Server;

uses
  SvcMgr,
  ServerMethodsUnit1 in 'ServerMethodsUnit1.pas',
  ServerContainerUnit1 in 'ServerContainerUnit1.pas' {ServerContainer1: TService};

{$R *.RES}

begin
  if not Application.DelayInitialize or Application.Installing then
    Application.Initialize;
  Application.CreateForm(TServerContainer1, ServerContainer1);
  Application.Run;
end.

ServerContainerUnit1.dfm

ServerContainerUnit1.dfm

object ServerContainer1: TServerContainer1
  OldCreateOrder = False
  OnCreate = ServiceCreate
  DisplayName = 'DSServer'
  OnStart = ServiceStart
  Height = 271
  Width = 415
  object DSServer1: TDSServer
    OnConnect = DSServer1Connect
    AutoStart = True
    HideDSAdmin = False
    Left = 96
    Top = 11
  end
  object DSTCPServerTransport1: TDSTCPServerTransport
    Port = 212
    PoolSize = 0
    Server = DSServer1
    BufferKBSize = 32
    Filters = <>
    Left = 96
    Top = 73
  end
  object DSServerClass1: TDSServerClass
    OnGetClass = DSServerClass1GetClass
    Server = DSServer1
    LifeCycle = 'Session'
    Left = 200
    Top = 11
  end
  object SQLConnection1: TSQLConnection
    LoginPrompt = False
    Left = 352
    Top = 208
  end
end

ServerContainerUnit1.pas

ServerContainerUnit1.pas

unit ServerContainerUnit1;

interface

uses
  SysUtils, Classes,
  SvcMgr,
  DSTCPServerTransport,
  DSServer, DSCommonServer, DSAuth, DB, SqlExpr, DBXMSSQL, ExtCtrls;

type
  TServerContainer1 = class(TService)
    DSServer1: TDSServer;
    DSTCPServerTransport1: TDSTCPServerTransport;
    DSServerClass1: TDSServerClass;
    SQLConnection1: TSQLConnection;
    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure DSServer1Connect(DSConnectEventObject: TDSConnectEventObject);
    procedure DoConnectToDBTimer(Sender: TObject);
    procedure ServiceCreate(Sender: TObject);
  private
    FDBConnect: TTimer;
  protected
    function DoStop: Boolean; override;
    function DoPause: Boolean; override;
    function DoContinue: Boolean; override;
    procedure DoInterrogate; override;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  ServerContainer1: TServerContainer1;

implementation

uses Windows, ServerMethodsUnit1, DBXCommon;

{$R *.dfm}

procedure TServerContainer1.DSServer1Connect(DSConnectEventObject: TDSConnectEventObject);
begin
  ServerMethodsUnit1.SQLConnection := SQLConnection1;
end;

procedure TServerContainer1.DSServerClass1GetClass(
  DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := ServerMethodsUnit1.TDataUtils;
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  ServerContainer1.Controller(CtrlCode);
end;

function TServerContainer1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TServerContainer1.DoConnectToDBTimer(Sender: TObject);
begin
  // Connect to DB and free timer
  FDBConnect.Enabled := False;
  FreeAndNil(FDBConnect);
  SQLConnection1.Open;
end;

function TServerContainer1.DoContinue: Boolean;
begin
  Result := inherited;
  DSServer1.Start;
end;

procedure TServerContainer1.DoInterrogate;
begin
  inherited;
end;

function TServerContainer1.DoPause: Boolean;
begin
  DSServer1.Stop;
  Result := inherited;
end;

function TServerContainer1.DoStop: Boolean;
begin
  DSServer1.Stop;
  Result := inherited;
end;

procedure TServerContainer1.ServiceCreate(Sender: TObject);
begin
  FDBConnect := TTimer.Create(Self);
end;

procedure TServerContainer1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  DSServer1.Start;
  // Connecting to the DB here fails, so defer it 5 seconds
  FDBConnect.Enabled := False;
  FDBConnect.Interval := 5000;
  FDBConnect.OnTimer := DoConnectToDBTimer;
  FDBConnect.Enabled := True;
end;

end.

ServerMethodsUnit1.pas

ServerMethodsUnit1.pas

unit ServerMethodsUnit1;

interface

uses
  SysUtils, Classes, DSServer, DBXCommon, SQLExpr;

type
{$METHODINFO ON}
  TDataUtils = class(TComponent)
  private
    FResult: OleVariant;
  public
    function GetData(const Option: Integer): OleVariant;
    procedure FreeServerMemory;
  end;
{$METHODINFO OFF}

threadvar
  SQLConnection: TSQLConnection;

implementation

uses
  DBClient, Provider;

{ TDataUtils }

procedure TDataUtils.FreeServerMemory;
begin
  VarClear(FResult);
end;

function TDataUtils.GetData(const Option: Integer): OleVariant;
var
  cds: TClientDataSet;
  dsp: TDataSetProvider;
  qry: TSQLQuery;
begin
  qry := TSQLQuery.Create(nil);
  try
    qry.MaxBlobSize := -1;
    qry.SQLConnection := SQLConnection;
    dsp := TDataSetProvider.Create(nil);
    try
      dsp.ResolveToDataSet := True;
      dsp.Exported := False;
      dsp.DataSet := qry;
      cds := TClientDataSet.Create(nil);
      try
        cds.DisableStringTrim := True;
        cds.ReadOnly := True;
        cds.SetProvider(dsp);

        qry.Close;
        case Option of
          1:
          begin
            qry.CommandText := 'exec GetLMTree :alias, :levels'; // stored procedure; returns 330 rows; 550k of raw data
            qry.Params.ParamByName('alias').Value := 'root';
            qry.Params.ParamByName('levels').Value := -1;
          end;

          2:
          begin
            qry.CommandText := 'select * from az_item'; // returns 555 rows; 550k of raw data; 786k of raw data
          end;
        end;

        cds.Open;
        FResult := cds.Data;
      finally
        FreeAndNil(cds);
      end;
    finally
      FreeAndNil(dsp);
    end;
  finally
    FreeAndNil(qry);
  end;
  Exit(FResult);
end;


end.

Client.dpr

Client.dpr

program Client;

uses
  Forms,
  ClientUnit1 in 'ClientUnit1.pas' {Form1},
  ProxyMethods in 'ProxyMethods.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

ClientUnit1.dfm

ClientUnit1.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 301
  ClientWidth = 562
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 8
    Top = 39
    Width = 546
    Height = 254
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
  end
  object Button1: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Connect'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 89
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Get Data (1)'
    TabOrder = 2
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 251
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Disconnect'
    TabOrder = 3
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 170
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Get Data (2)'
    TabOrder = 4
    OnClick = Button2Click
  end
  object SQLConnection1: TSQLConnection
    DriverName = 'Datasnap'
    LoginPrompt = False
    Params.Strings = (
      'DriverUnit=DBXDataSnap'
      'HostName=localhost'
      'Port=212'
      'CommunicationProtocol=tcp/ip'
      'DatasnapContext=datasnap/'

        'DriverAssemblyLoader=Borland.Data.TDBXClientDriverLoader,Borland' +
        '.Data.DbxClientDriver,Version=$ASSEMBLY_VERSION$,Culture=neutral' +
        ',PublicKeyToken=91d62ebb5b0d1b1b'
      'Filters={}')
    Left = 520
    Top = 256
    UniqueId = '{F04CF8B5-7AE7-4010-81CF-7EBE29564C00}'
  end
  object ClientDataSet1: TClientDataSet
    Aggregates = <>
    Params = <>
    Left = 456
    Top = 256
  end
  object DataSource1: TDataSource
    DataSet = ClientDataSet1
    Left = 488
    Top = 256
  end
end

ClientUnit1.pas

ClientUnit1.pas

unit ClientUnit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DBXDataSnap, DBXCommon, DB, SqlExpr, StdCtrls, Grids, DBGrids,
  DBClient;

type
  TForm1 = class(TForm)
    SQLConnection1: TSQLConnection;
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ProxyMethods;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  SQLConnection1.Open;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with ProxyMethods.TDataUtilsClient.Create(SQLConnection1.DBXConnection, True) do // let ProxyMethods do its own cleanup
  try
    ClientDataSet1.Close;
    if Sender = Button2 then
      ClientDataSet1.Data := GetData(1);
    if Sender = Button4 then
      ClientDataSet1.Data := GetData(2);
    FreeServerMemory;
  finally
    //
    // *** Answer to Server Memory Allocation Issue ***
    //
    // It appears that the server keeps its object in memory so long as the client
    // keeps the objected created with ProxyMethods...Create in memory.  We *must*
    // explicitly free the object on the client side or the server will not release
    // its object until the client disconnects.  Doing this also solves a memory
    // leak in the client.
    Free;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  SQLConnection1.Close;
end;

end.

ProxyMethods.pas

ProxyMethods.pas

//
// Created by the DataSnap proxy generator.
// 7/7/2011 5:43:35 PM
//

unit ProxyMethods;

interface

uses DBXCommon, DBXClient, DBXJSON, DSProxy, Classes, SysUtils, DB, SqlExpr, DBXDBReaders, DBXJSONReflect;

type
  TDataUtilsClient = class(TDSAdminClient)
  private
    FGetDataCommand: TDBXCommand;
    FFreeServerMemoryCommand: TDBXCommand;
  public
    constructor Create(ADBXConnection: TDBXConnection); overload;
    constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
    destructor Destroy; override;
    function GetData(Option: Integer): OleVariant;
    procedure FreeServerMemory;
  end;

implementation

function TDataUtilsClient.GetData(Option: Integer): OleVariant;
begin
  if FGetDataCommand = nil then
  begin
    FGetDataCommand := FDBXConnection.CreateCommand;
    FGetDataCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FGetDataCommand.Text := 'TDataUtils.GetData';
    FGetDataCommand.Prepare;
  end;
  FGetDataCommand.Parameters[0].Value.SetInt32(Option);
  FGetDataCommand.ExecuteUpdate;
  Result := FGetDataCommand.Parameters[1].Value.AsVariant;
end;

procedure TDataUtilsClient.FreeServerMemory;
begin
  if FFreeServerMemoryCommand = nil then
  begin
    FFreeServerMemoryCommand := FDBXConnection.CreateCommand;
    FFreeServerMemoryCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FFreeServerMemoryCommand.Text := 'TDataUtils.FreeServerMemory';
    FFreeServerMemoryCommand.Prepare;
  end;
  FFreeServerMemoryCommand.ExecuteUpdate;
end;


constructor TDataUtilsClient.Create(ADBXConnection: TDBXConnection);
begin
  inherited Create(ADBXConnection);
end;


constructor TDataUtilsClient.Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean);
begin
  inherited Create(ADBXConnection, AInstanceOwner);
end;


destructor TDataUtilsClient.Destroy;
begin
  FreeAndNil(FGetDataCommand);
  FreeAndNil(FFreeServerMemoryCommand);
  inherited;
end;

end.

推荐答案

当客户端使用ProxyMethods.Create(...)时，您必须记住Free在客户端创建的对象.这样做将向服务器发出信号，以释放它创建的用于服务请求的对象.如果不Free客户端对象，则最终会导致客户端内存泄漏，并且服务器不知道要释放其相关的服务对象，直到客户端断开连接"为止.是我观察到的我很高兴这是我的代码中的一个错误，而不是DataSnap框架中的一个错误，因为Embarcadero并未将所有DataSnap代码与XE一起交付，因此我自己无法更改和重新编译DataSnap Framework(请参阅

When the client uses ProxyMethods.Create(...), you must remember to Free the object created on the client side. Doing this signals the server to release the object it created to service the request. If you do not Free the client-side object, then you end up with a memory leak on the client side, and the server doesn't know to release its correlating service object(s) until the client 'disconnects', which is what I observed. I'm glad it was a bug in my code and not the DataSnap Framework because Embarcadero doesn't ship all of the DataSnap code with XE, so I can't change and recompile the DataSnap Framework myself (see Is it possible to recompile the DataSnap packages in Delphi XE with a new/different version of Indy?).

我将上面的示例代码固定到了客户端对象Free上，以防有人想要将其用作示例DataSnap项目.

I fixed the sample code above to Free the client-side object -- in case someone wants to use it as a sample DataSnap project.

詹姆斯

这篇关于TClientDataSet不释放内存的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！