2

我有一个 DataSnap 服务器，它创建一个 TSQLQuery、TDataSetProvider 和一个 TClientDataSet，它们对给定用户的会话是唯一的，用于从数据库中检索数据并将 TClientDataSet.Data（一个 OleVariant）发送到客户端。它工作得很好，除了一个问题。

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

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

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

谢谢，詹姆斯

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

根据 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 中服务器的内存增加。单击断开连接，观察内存全部释放。

服务器.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.

客户端.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.

代理方法.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.
4

1 回答 1

2

客户端使用ProxyMethods.Create(...)时，一定要记住Free在客户端创建的对象。这样做会向服务器发出信号，以释放它为服务请求而创建的对象。如果您没有Free客户端对象，那么您最终会在客户端出现内存泄漏，并且服务器不知道释放其相关的服务对象，直到客户端“断开连接”，这就是我观测到的。我很高兴这是我的代码中的一个错误，而不是 DataSnap 框架，因为 Embarcadero 没有使用 XE 提供所有 DataSnap 代码，所以我不能自己更改和重新编译 DataSnap 框架（请参阅是否可以重新编译Delphi XE 中的 DataSnap 包与新/不同版本的 Indy？）。

我将上面的示例代码固定到Free客户端对象——以防有人想将它用作示例 DataSnap 项目。

詹姆士

于 2011-07-08T20:56:42.127 回答