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.