6

我在 Delphi XE8 中使用 echostring 和 reversestring 示例方法创建了一个简单的 DataSnap 客户端/服务器应用程序。当我将“ReportMemoryLeaksOnShutdown:= True”放入服务器 dpr 并从客户端调用 echostring 和/或 reversestring 方法时,结果很好,但是当我关闭服务器应用程序(关闭客户端后)时,我总是得到 2 个或更多未知内存泄漏。这是我在互联网上找不到的已知错误还是有解决方案?

服务器代码:

unit ServerMethodsUnit;

interface

uses System.SysUtils, System.Classes, System.Json,
Datasnap.DSServer, Datasnap.DSAuth, DataSnap.DSProviderDataModuleAdapter;

type
{$METHODINFO ON}
  TServerMethods = class(TDataModule)
  private
    { Private declarations }
  public
    { Public declarations }
    function EchoString(Value: string): string;
    function ReverseString(Value: string): string;
  end;
{$METHODINFO OFF}

implementation

{%CLASSGROUP 'FMX.Controls.TControl'}

{$R *.dfm}


uses System.StrUtils;

function TServerMethods.EchoString(Value: string): string;
begin
  Result := Value;
end;

function TServerMethods.ReverseString(Value: string): string;
begin
  Result := System.StrUtils.ReverseString(Value);
end;

end.

dfm

object ServerContainer: TServerContainer
  OldCreateOrder = False
  Height = 271
  Width = 415
  object DSServer1: TDSServer
    Left = 96
    Top = 11
  end
  object DSTCPServerTransport1: TDSTCPServerTransport
    Server = DSServer1
    Filters = <>
    Left = 96
    Top = 73
  end
  object DSServerClass1: TDSServerClass
    OnGetClass = DSServerClass1GetClass
    Server = DSServer1
    Left = 200
    Top = 11
  end
end

dfm 项目文件

program DataSnap_Server;

uses
  FMX.Forms,
  Web.WebReq,
  IdHTTPWebBrokerBridge,
  ServerMainForm in 'ServerMainForm.pas' {Form2},
  ServerMethodsUnit in 'ServerMethodsUnit.pas' {ServerMethods: TDataModule},
  ServerContainerUnit in 'ServerContainerUnit.pas' {ServerContainer: TDataModule};

{$R *.res}

begin
  ReportMemoryLeaksOnShutdown := True;
  Application.Initialize;
  Application.CreateForm(TForm2, Form2);
  Application.CreateForm(TServerContainer, ServerContainer);
  Application.Run;
end.

客户端代码生成源

// 
// Created by the DataSnap proxy generator.
// 14-5-2015 22:45:56
// 

unit ClientClassesUnit;

interface

uses System.JSON, Data.DBXCommon, Data.DBXClient, Data.DBXDataSnap, Data.DBXJSON, Datasnap.DSProxy, System.Classes, System.SysUtils, Data.DB, Data.SqlExpr, Data.DBXDBReaders, Data.DBXCDSReaders, Data.DBXJSONReflect;

type
  TServerMethodsClient = class(TDSAdminClient)
  private
    FEchoStringCommand: TDBXCommand;
    FReverseStringCommand: TDBXCommand;
  public
    constructor Create(ADBXConnection: TDBXConnection); overload;
    constructor Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean); overload;
    destructor Destroy; override;
    function EchoString(Value: string): string;
    function ReverseString(Value: string): string;
  end;

implementation

function TServerMethodsClient.EchoString(Value: string): string;
begin
  if FEchoStringCommand = nil then
  begin
    FEchoStringCommand := FDBXConnection.CreateCommand;
    FEchoStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FEchoStringCommand.Text := 'TServerMethods.EchoString';
    FEchoStringCommand.Prepare;
  end;
  FEchoStringCommand.Parameters[0].Value.SetWideString(Value);
  FEchoStringCommand.ExecuteUpdate;
  Result := FEchoStringCommand.Parameters[1].Value.GetWideString;
end;

function TServerMethodsClient.ReverseString(Value: string): string;
begin
  if FReverseStringCommand = nil then
  begin
    FReverseStringCommand := FDBXConnection.CreateCommand;
    FReverseStringCommand.CommandType := TDBXCommandTypes.DSServerMethod;
    FReverseStringCommand.Text := 'TServerMethods.ReverseString';
    FReverseStringCommand.Prepare;
  end;
  FReverseStringCommand.Parameters[0].Value.SetWideString(Value);
  FReverseStringCommand.ExecuteUpdate;
  Result := FReverseStringCommand.Parameters[1].Value.GetWideString;
end;


constructor TServerMethodsClient.Create(ADBXConnection: TDBXConnection);
begin
  inherited Create(ADBXConnection);
end;


constructor TServerMethodsClient.Create(ADBXConnection: TDBXConnection; AInstanceOwner: Boolean);
begin
  inherited Create(ADBXConnection, AInstanceOwner);
end;


destructor TServerMethodsClient.Destroy;
begin
  FEchoStringCommand.DisposeOf;
  FReverseStringCommand.DisposeOf;
  inherited;
end;

end.

自有来源

unit ClientMainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  ClientModuleUnit;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := ClientModule.ServerMethodsClient.EchoString(Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Label1.Caption := ClientModule.ServerMethodsClient.ReverseString(Edit1.Text);
end;

end.
4

2 回答 2

0

内存泄漏看起来总是存在,或者,我们做错了什么。

我检查了什么:

我将所有服务器应用程序代码移动到一个单元中。我尝试没有 FMX 的服务器应用程序 - 使用 VCL。我尝试使用父 Self 和 Nil 在运行时创建 TDSServer、TDSTCPServerTransport、TDSServerClass。我尝试使用 TServerMethod 类所有者 TPersistance 和 TComponent(Delphi 帮助说要使用它)。我尝试在 Delphi XE7 Update 1 和 Delphi XE8 中将编译的服务器应用程序作为 32 位和 64 位应用程序。

EurekaLog 7.2.2 也无法捕获有关内存泄漏的详细信息。为了避免 EurekaLog 捕获访问冲突,需要在退出前使用 DSServer1.Stop。

正如我们所见,当您使用 EurekaLog 时发生访问冲突 基本上它在 System.TObject.InheritsFrom(???) System._IsClass($64AE4E0,TDSServerTransport) Datasnap.DSCommonServer.TDSCustomServer.StopTransports Datasnap.DSCommonServer.TDSCustomServer.Stop Datasnap 中。 DSServer.TDSServer.Stop Datasnap.DSServer.TDSServer.Destroy System.TObject.Free System.Classes.TComponent.DestroyComponents System.Classes.TComponent.Destroy System.Classes.TDataModule.Destroy System.TObject.Free System.Classes.TComponent.DestroyComponents FMX.Forms.DoneApplication System.SysUtils.DoExitProc System._Halt0 :00408da8 TObject.InheritsFrom + $8

服务器应用程序:

unit ufmMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Datasnap.DSServer, Datasnap.DSTCPServerTransport, Datasnap.DSAuth, DataSnap.DSProviderDataModuleAdapter, Datasnap.DSCommonServer,
  IPPeerServer;

type
{$METHODINFO ON}
  TServerMethods = class(TComponent)
  private
    { Private declarations }
  public
    { Public declarations }
    function EchoString(Value: string): string;
  end;
{$METHODINFO OFF}


  TfmMain = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    DSServer1: TDSServer;
    DSTCPServerTransport1: TDSTCPServerTransport;
    DSServerClass1: TDSServerClass;
    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
  end;

var
  fmMain: TfmMain;

implementation

{$R *.dfm}

uses System.StrUtils;

function TServerMethods.EchoString(Value: string): string;
begin
  Result := Value;
end;

procedure TfmMain.DSServerClass1GetClass(DSServerClass: TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := TServerMethods;
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
  DSServer1 := TDSServer.Create(nil);
  DSServer1.Name := 'DSServer1';
  DSServer1.AutoStart := False;

  DSTCPServerTransport1 := TDSTCPServerTransport.Create(nil);
  DSTCPServerTransport1.Server := DSServer1;

  DSServerClass1 := TDSServerClass.Create(nil);
  DSServerClass1.Server := DSServer1;
  DSServerClass1.OnGetClass := DSServerClass1GetClass;

  DSServer1.Start;
end;

procedure TfmMain.FormDestroy(Sender: TObject);
begin
  DSServer1.Stop;

  DSServerClass1.Free;
  DSTCPServerTransport1.Free;
  DSServer1.Free;
end;

end.
于 2015-05-15T22:41:56.303 回答
0

我想现在这是 XE8 的一个已知错误,我认为它非常严重,至少严重到足以让我们在 Embarcadero 给我们一个关于正在发生的事情的答案之前不要使用 XE8。我们在 XE2 中也遇到过类似的问题,据我所知,这是在大量回调中。

这个 Eurekalog 并没有告诉我太多,它看起来像是在 datasnap 的深处,抱歉我不知道如何使日志更具可读性。

编辑:我向 Embarcadero 报告了这个问题,今天得到了回复:

//嗨亨里克,

部分内存泄漏是由于 System.Collections.Generics.pas 中的错误造成的,我们正在考虑在不久的将来发布此问题的修复程序。

brgds

罗伊。//

以为你可能想知道:)

于 2015-08-18T16:26:18.000 回答