TClientDataSet不释放内存

时间：2011-07-07 18:27:37

标签： delphi memory datasnap tclientdataset

我有一个DataSnap服务器，它创建一个TSQLQuery，TDataSetProvider和一个TClientDataSet，这些服务器对于给定用户的会话是唯一的，它们被用于并重用来从数据库中检索数据并将TClientDataSet.Data（OleVariant）发送到客户端。除了一个问题外，它的效果非常好。

当我通过调用其Open方法填充TClientDataSet时，在用户断开其客户端与DataSnap服务器的连接之前，不会释放分配的内存。当用户使用该应用程序并继续从DataSnap服务器检索数据时，将继续分配内存（数百兆）。当用户断开连接时，将释放所有内存。它需要在每个请求之后释放分配的内存，以便长时间连接的用户不会通过占用其所有RAM来使服务器崩溃。

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

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

谢谢， 詹姆斯

＆LT;＆LT;＆LT;编辑：7/7/2011 6:23 PM＆gt;＆gt;＆gt;

按照Jeroen的建议，我创建了一个复制问题的小程序。有两个部分，服务器（4个源文件）和客户端（4个源文件）。如果有一个功能来附加文件到这个讨论，我还不能使用它 - 没有足够的声誉点...，所以我粘贴下面的代码。服务器是一项服务，因此必须在构建服务后进行注册（例如C:\ProjectFolder\Server.exe /install）。

在构建服务器之前，设置SQLConnection1的属性，并编辑ServerMethodsUnit1.pas中的SQL语句。查看内存分配问题的唯一方法是使用每个请求检索相当数量的数据（例如，500k）。我要查询的表包括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.

1 个答案:

答案 0 :(得分：2)

当客户端使用ProxyMethods.Create(...)时，必须记住Free在客户端创建的对象。这样做表示服务器释放它创建的对象以服务请求。如果您没有Free客户端对象，那么您最终会在客户端发生内存泄漏，并且服务器不知道在客户端“断开连接”之前释放其关联服务对象这是我观察到的。我很高兴这是我的代码中的错误，而不是DataSnap Framework，因为Embarcadero没有使用XE发送所有DataSnap代码，因此我无法自行更改和重新编译DataSnap Framework（请参阅Is it possible to recompile the DataSnap packages in Delphi XE with a new/different version of Indy?）

我将上面的示例代码修改为Free客户端对象 - 以防有人想将其用作示例DataSnap项目。

詹姆斯

相关问题
最新问题