TClientDataSet не освобождает память

Question

У меня есть сервер DataSnap, который создает TSQLQuery, TDataSetProvider и TClientDataSet, которые являются уникальными для сеанса данного пользователя, которые используются и повторно используются для извлечения данных из базы данных и отправки TClientDataSet.Data (OleVariant) клиенту.Он работает очень хорошо, за исключением одной проблемы.

Когда я заполняю TClientDataSet, вызывая его метод Open, выделенная память не освобождается, пока пользователь не отключит свой клиент от сервера DataSnap.Когда пользователь использует приложение и продолжает получать данные с сервера DataSnap, память продолжает выделяться (сотни мегабайт).Когда пользователь отключается, вся память освобождается.Он должен освобождать выделенную память после каждого запроса, чтобы пользователи, подключенные в течение длительных периодов времени, не ломали сервер, потребляя всю его оперативную память.

Я думал, что это может сработать для создания TSQLQuery,Компоненты TDataSetProvider и TClientDataSet, когда пользователь запрашивает данные, а затем немедленно уничтожают их после каждого запроса.Это не изменило поведение.ОЗУ продолжает выделяться и не освобождаться до тех пор, пока пользователь не отключится.

Почему сервер DataSnap удерживает выделенную память при использовании TClientDataSet, даже если компоненты уничтожаются после каждого запроса?

Спасибо, Джеймс

<<< Редактировать: 07.07.2011 18:23 >>>

По рекомендации Йероена я создал небольшую программу, которая дублирует проблему.Он состоит из двух частей: сервера (4 исходных файла) и клиента (4 исходных файла).Если есть возможность прикрепить файлы к этому обсуждению, я пока не могу ее использовать - недостаточно очков репутации ..., поэтому я вставляю код ниже.Сервер является службой, поэтому он должен быть зарегистрирован после сборки (например, C:\ProjectFolder\Server.exe /install).

Перед сборкой сервера установите свойства для SQLConnection1 и измените операторы SQL в ServerMethodsUnit1.pas.Единственный способ увидеть проблему выделения памяти - это получить достаточное количество данных с каждым запросом (например, 500 КБ).Таблицы, к которым я обращаюсь, включают uniqueidentifier, varchar(255), varchar(max), nvarchar(max), int, bit, datetime и другие столбцы.Я проверил, что все типы данных базы данных имеют проблему с памятью.Чем больше набор данных, который передается клиенту, тем быстрее сервер выделяет память, не освобождая ее.

Как только оба приложения созданы и служба зарегистрирована / запущена, используйте ProcessExplorer для просмотра памяти, используемой серверомоказание услуг.Затем запустите клиент, нажмите «Подключиться» и нажмите кнопки, чтобы получить данные.Обратите внимание на увеличение памяти в ProcessExplorer для сервера.Нажмите «Отключить» и просмотрите, как освободится вся память.

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.

Answer 1

Когда клиент использует ProxyMethods.Create(...), вы должны запомнить Free объект, созданный на стороне клиента.Это сигнализирует серверу об освобождении созданного им объекта для обслуживания запроса.Если вы не Free объект на стороне клиента, то вы в конечном итоге с утечкой памяти на стороне клиента, и сервер не знает, чтобы освободить свои соответствующие объекты службы, пока клиент "отключается", чтоэто то, что я заметилЯ рад, что это была ошибка в моем коде, а не в DataSnap Framework, потому что Embarcadero не поставляет весь код DataSnap с XE, поэтому я не могу изменить и перекомпилировать DataSnap Framework самостоятельно (см. Возможно ли этоперекомпилировать пакеты DataSnap в Delphi XE с новой / другой версией Indy? ).

Я исправил приведенный выше пример кода на Free объект на стороне клиента - на тот случай, если кто-то захочетиспользуйте его как пример проекта DataSnap.

Джеймс