TClientDataSet Doesn't Release Memory

问题

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.

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.

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.

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?

Thanks, James

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

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).

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.

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

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

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

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

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

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

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

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

//
// 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.

回答1:

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?).

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

James

来源：https://stackoverflow.com/questions/6615357/tclientdataset-doesnt-release-memory