TClientDataSetがメモリを解放しない

Question

特定のユーザーのセッションに固有のTSQLQuery、TDataSetProvider、およびTClientDataSetを作成するDataSnapサーバーがあります。このサーバーは、データベースからデータを取得してTClientDataSet.Data（ OleVariant）をクライアントに送信します。 1つの問題を除いて、非常にうまく動作します。

Openメソッドを呼び出してTClientDataSetを作成すると、ユーザーがクライアントをDataSnapサーバーから切断するまで、割り当てられたメモリは解放されません。ユーザーがアプリケーションを使用してDataSnapサーバーからデータを取得し続けると、メモリは引き続き割り当てられます（数百Megs）。ユーザーが切断すると、すべてのメモリーが解放されます。長い時間接続されているユーザーがすべてのRAMを消費してサーバーをクラッシュさせないように、各要求後に割り当てられたメモリを解放する必要があります。

ユーザーがデータを要求したときにTSQLQuery、TDataSetProvider、およびTClientDataSetコンポーネントを作成し、各要求後に直ちに破棄すると考えていました。これは行動を変えなかった。 RAMは引き続き割り当てられ、ユーザーが切断するまで解放されません。

各リクエスト後にコンポーネントが破棄された場合でも、DataSnapサーバーはTClientDataSetの使用時に割り当てられたメモリを保持するのはなぜですか？

おかげで、 ジェームズ

< < <編集：2011年7月7日6時23分PM >>>

パーイェルーンの勧告、私は問題を複製する小さなプログラムを作成しました。サーバー（4つのソースファイル）とクライアント（4つのソースファイル）の2つの部分があります。このディスカッションにファイルを添付する機能がある場合、私はまだそれを使用することができません - 評判のポイントが足りません...、私は下のコードを貼り付けています。サーバはサービスのため、構築後に登録する必要があります（例：C:\ProjectFolder\Server.exe /install）。

サーバーを構築する前に、SQLConnection1のプロパティを設定し、ServerMethodsUnit1.pasのSQLステートメントを編集します。メモリ割り当ての問題を見るための唯一の方法は、各リクエスト（例えば、500k）でかなりの量のデータを取得することです。私が照会しているテーブルには、uniqueidentifier,varchar(255),varchar(max),nvarchar(max),,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。ない

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

012顧客が ProxyMethods.Create(...)を使用する場合

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

、あなたはは、顧客側で作成されたオブジェクトへFreeを覚えておく必要があります。これを行うと、それは要求にサービスを提供するために作成されたオブジェクトを解放するサーバーを通知します。あなたがいないFreeクライアント側のオブジェクトを行う場合は、お客様側でのメモリリークで終わる、およびサーバは、顧客までのサービスオブジェクトを関連付けるのICTを解放するために知らない何QUI EST「切断」私が観察しました。私はそれは私のコードのバグではなくエンバカデロFrameworkはDataSnapのXEを持つすべてのコードを出荷しないためのDataSnapたうれしいので、私は変更とDataSnapの自分自身のフレームワークを（Is it possible to recompile the DataSnap packages in Delphi XE with a new/different version of Indy?を参照）を再コンパイルすることはできません。

私はFreeに上記のクライアント側のオブジェクトをサンプルコードを固定 - 場合に誰かがサンプルのDataSnapプロジェクトとしてそれを使用したいと考えています。

ジェームズ