盒子论坛 v2.1

我的datasnap服务端，每连结一次，内就会增加1M多，还有用一段时间后，就不能连结了，请各位大神帮我检查一下代码，看看是哪里的问题

1，
unit Unit2;

interface

uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Data.FMTBcd, Vcl.StdCtrls, Data.DB, Data.SqlExpr, DBGridEhGrouping,
  DBClientEx,
  ToolCtrlsEh, DBGridEhToolCtrls, DynVarsEh, EhLibVCL, GridsEh, DBAxisGridsEh,
  DBGridEh, Vcl.ComCtrls, Datasnap.DBClient, Datasnap.Provider, frxClass,
  frxDBSet,ShellAPI;

type
  Tmainform = class(TForm)
    ClientDataSetEx1: TClientDataSetEx;
    Button1: TButton;
    Label1: TLabel;
    autowf: TCheckBox;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    // procedure print(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    bRestart : Boolean;
  end;

  // Procedure GetPrnFieldWidth(cds:Tclientdatasetex);

var
  mainform: Tmainform;
  // Prn_FieldWidth: Array of integer;

implementation

{$R *.dfm}

uses  PRINTERS;

procedure Tmainform.Button1Click(Sender: TObject);
begin
  bRestart := True;
  CLose;
end;

procedure Tmainform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   {if (bRestart) and (autowf.Checked=true) then
   ShellExecute(Self.Handle, 'open', PChar(Application.ExeName), nil, nil, SW_SHOWNORMAL);}
end;

procedure Tmainform.FormCreate(Sender: TObject);
begin
   //mainform.bRestart := false;
end;

end.

2，
unit ServerContainerUnit1;

interface

uses System.SysUtils, System.Classes,
  Datasnap.DSTCPServerTransport,
  Datasnap.DSServer, Datasnap.DSCommonServer,
  IPPeerServer, IPPeerAPI, Datasnap.DSAuth, IdTCPConnection, Datasnap.DSSession,
  System.Generics.Collections, FireDAC.Stan.Intf, FireDAC.Stan.Option,
  FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
  FireDAC.Phys, FireDAC.Comp.Client, Vcl.ExtCtrls;

type
  TServerContainer1 = class(TDataModule)
    DSServer1: TDSServer;
    DSTCPServerTransport1: TDSTCPServerTransport;
    DSServerClass3: TDSServerClass;
    FDManager1: TFDManager;
    Timer1: TTimer;
    procedure DSServerClass1GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
    procedure DSServerClass2GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
    procedure DSServerClass3GetClass(DSServerClass: TDSServerClass;
      var PersistentClass: TPersistentClass);
    procedure DSTCPServerTransport1Connect(Event: TDSTCPConnectEventObject);
    procedure DSTCPServerTransport1Disconnect
      (Event: TDSTCPDisconnectEventObject);
    procedure DataModuleCreate(Sender: TObject);
    procedure DSServer1Connect(DSConnectEventObject: TDSConnectEventObject);
    procedure Timer1Timer(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
    //sClient: String;
    //ConnInfoStr: String;

  class var
    iSessionNumber: integer;
    FConnections: TObjectDictionary<TIdTCPConnection, TDSTCPChannel>;

    procedure UpdateClientConnections;
    procedure UpdateSessionNumber;
    procedure ShowClientConnections(DSConnectEventObject
      : TDSConnectEventObject);

    procedure AddSessionListener;
    procedure ReleaseAnySessionObject(const Session: TDSSession);
    procedure AddConnectionToList(Conn: TIdTCPConnection;
      Channel: TDSTCPChannel);

    procedure UpdateTCPMonitorInfo;
  public
    procedure DisConnectConnection(theConnection: TIdTCPConnection);
  end;

var
  ServerContainer1: TServerContainer1;

implementation

{$R *.dfm}

uses
  ServerMethodsUnit3;

procedure TServerContainer1.UpdateClientConnections;
begin
  // mainform.lbClients.Items.Add(sClient);
end;

procedure TServerContainer1.UpdateSessionNumber;
begin
  // mainform.edtSessionNumber.Text := IntToStr(FConnections.Count);
end;

procedure TServerContainer1.ShowClientConnections(DSConnectEventObject
  : TDSConnectEventObject);
var
  sb: TStringBuilder;
  ClientConnection: TIdTCPConnection;
  sClient: String;
begin
  sb := TStringBuilder.Create;
  ClientConnection := TIdTCPConnection(DSConnectEventObject.ChannelInfo.Id);
  try
    sb.Append('AppName : ' + DSConnectEventObject.ChannelInfo.
      ClientInfo.AppName);
    sb.Append(' ');
    sb.Append('Protocol : ' + DSConnectEventObject.ChannelInfo.
      ClientInfo.Protocol);
    sb.Append(' ');
    sb.Append('IpAddress : ' + DSConnectEventObject.ChannelInfo.ClientInfo.
      IpAddress);
    sb.Append(' ');
    sb.Append('ClientPort : ' + DSConnectEventObject.ChannelInfo.ClientInfo.
      ClientPort);
    sb.Append(' ');
    sb.Append('id : ' + IntToStr(DSConnectEventObject.ChannelInfo.Id));

    sClient := sb.ToString;
    TThread.Synchronize(nil, UpdateClientConnections);
  finally
    sb.Free;
  end;
end;

procedure TServerContainer1.Timer1Timer(Sender: TObject);
var
timevalue:string;
ipos:integer;
trunctime:integer;
begin
  { timer1.Enabled:=false;

   timevalue:= FormatDateTime('hh:nn:ss',Now());
   ipos:=pos(':',timevalue);
   if ipos>0 then
   timevalue:=copy(timevalue,1,ipos-1);
   trunctime:=strtoint(timevalue);
   if (trunctime>=0) and (trunctime<=1) then
   begin
      mainform.bRestart := true;
      repeat
          sleep(1000);
          timevalue:= FormatDateTime('hh:nn:ss',Now());
          ipos:=pos(':',timevalue);
          if ipos>0 then
          timevalue:=copy(timevalue,1,ipos-1);
          trunctime:=strtoint(timevalue);
          mainform.Label1.Caption:='服务器将在2个小时内重起';
      until   (trunctime>1);
      mainform.CLose;
   end;

   timer1.Enabled:=true;}
end;

procedure TServerContainer1.AddSessionListener;
begin
  TDSSessionManager.Instance.AddSessionEvent(
    procedure(Sender: TObject; const EventType: TDSSessionEventType;
      const Session: TDSSession)
    begin
      case EventType of
        SessionCreate:
          begin
          // Inc(iSessionNumber);
          // TThread.Synchronize(nil, UpdateSessionNumber);
          end;
        SessionClose:
          begin
          ReleaseAnySessionObject(Session);
          end;
      end;
    end);
end;

procedure TServerContainer1.ReleaseAnySessionObject(const Session: TDSSession);
begin
  if (Session.HasObject(Session.SessionName)) then
  begin
    Session.RemoveObject(Session.SessionName, True);
  end;
end;

procedure TServerContainer1.AddConnectionToList(Conn: TIdTCPConnection;
Channel: TDSTCPChannel);
VAR
pConn: TIdTCPConnection;
ConnInfoStr: String;
begin
  pConn := Conn;
  if (Conn <> nil) and (Channel <> nil) and (Channel.ChannelInfo <> nil) and
    (Channel.ChannelInfo.ClientInfo.IpAddress <> EmptyStr) then
  begin
    with Channel.ChannelInfo.ClientInfo do
    begin

      ConnInfoStr := Format('%s:%s:%s', [IpAddress, ClientPort,
        Channel.SessionId]);
    end;
  end
  else
    ConnInfoStr := '通道咨询错误。';
end;

procedure TServerContainer1.UpdateTCPMonitorInfo;
begin
  // mainform.lbTCPMonitorInfo.Items.AddObject(ConnInfoStr, pConn);
end;

procedure TServerContainer1.DataModuleCreate(Sender: TObject);
begin
  FDManager.ConnectionDefs.Clear;
end;

procedure TServerContainer1.DataModuleDestroy(Sender: TObject);
begin
   FDManager.ConnectionDefs.Clear;
end;

procedure TServerContainer1.DisConnectConnection(theConnection
  : TIdTCPConnection);
var
  theChannel: TDSTCPChannel;
begin
  if (theConnection <> nil) then
  begin
    FConnections.TryGetValue(theConnection, theChannel);

    { TThread.Synchronize(nil,
      procedure
      var
      i:integer;
      sip,sport:string;
      begin
      sip:=theChannel.ChannelInfo.ClientInfo.IpAddress;
      sport:=theChannel.ChannelInfo.ClientInfo.ClientPort;
      //     disstr:=Format('%s:%s',[sIP,sport]);
      i:= frmMainForm.lbTcpMonitorInfo.Items.IndexOf(Format('%s:%s',[sIP,sport]));
      if i<>-1 then
      frmMainForm.lbTcpMonitorInfo.Items[i]:=Format('%s:%s 被动断开',[sip,sport]);
      end
      ); }
    System.TMonitor.Enter(FConnections);
    FConnections.Remove(theConnection);
    System.TMonitor.Exit(FConnections);

    theChannel.Close;
    theChannel:=nil;
  end;
end;

procedure TServerContainer1.DSServer1Connect(
  DSConnectEventObject: TDSConnectEventObject);
var
      ip:string;
begin
      ClientConnection := DSConnectEventObject.ChannelInfo.ClientInfo;
      ip:=ClientConnection.IpAddress;
      //mainform.Label1.Caption:=ip;
      ip:='';
end;

procedure TServerContainer1.DSServerClass1GetClass(DSServerClass
  : TDSServerClass; var PersistentClass: TPersistentClass);
begin
  //PersistentClass := ServerMethodsUnit1.TServerMethods1;
end;

procedure TServerContainer1.DSServerClass2GetClass(DSServerClass
  : TDSServerClass; var PersistentClass: TPersistentClass);
begin
  //PersistentClass := ServerMethodsUnit2.TServerMethods2;
end;

procedure TServerContainer1.DSServerClass3GetClass(DSServerClass
  : TDSServerClass; var PersistentClass: TPersistentClass);
begin
  PersistentClass := ServerMethodsUnit3.TServerMethods3;
end;

procedure TServerContainer1.DSTCPServerTransport1Connect
  (Event: TDSTCPConnectEventObject);
begin
  { System.TMonitor.Enter(FConnections);
    try
    FConnections.Add(TIdTCPConnection(Event.Connection), Event.Channel);
    finally
    System.TMonitor.Exit(FConnections);
    end;

    AddConnectionToList(TIdTCPConnection(Event.Connection), Event.Channel);
    TThread.Synchronize(nil, UpdateTCPMonitorInfo);
    TThread.Synchronize(nil, UpdateSessionNumber); }

end;

procedure TServerContainer1.DSTCPServerTransport1Disconnect
  (Event: TDSTCPDisconnectEventObject);
var
  sip, sport, s: string;
  Conn: TIdTCPConnection;
  i: integer;
begin
  { conn:=TIdTCPConnection(Event.Connection);

    if Assigned(conn) then
    begin
    sip:=conn.Socket.Binding.PeerIP;
    sport:=IntToStr(conn.Socket.Binding.PeerPort);
    System.TMonitor.Enter(ServerContainer1.FConnections);
    if FConnections.ContainsKey(conn) then
    FConnections.Remove(conn);
    System.TMonitor.Exit(FConnections);
    s := Format('%s:%s',[sip,sport]);
    for I := 0 to mainform.lbTcpMonitorInfo.Items.Count - 1 do
    begin

    if mainform.lbTcpMonitorInfo.Items[i].IndexOf(s)<>-1 then
    begin
    mainform.lbTcpMonitorInfo.Items[i]:=Format('%s:%s 主动断开',[sip,sport]);
    break
    end;
    end;
    end;
    mainform.edtSessionNumber.Text:=IntToStr(FConnections.Count);
  }
  sip:='';
  sport:='';
  s:='';;
  Conn:=nil;

end;

end.

3，
unit ServerMethodsUnit3;

interface

uses System.SysUtils, System.Classes, System.Json,
  DataSnap.DSProviderDataModuleAdapter,
  DataSnap.DSServer, DataSnap.DSAuth, DataSnap.Provider, Data.DB,
  Data.Win.ADODB, ProviderEx, DBClient, Data.FMTBcd, Data.DBXMSSQL,
  Data.SqlExpr, dateutils, windows, vcl.forms, UniProvider,
  SQLServerUniProvider,
  DBAccess, Uni, dbclientex, typinfo, variants, MemDS, FireDAC.Stan.Intf,
  FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
  FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt,
  FireDAC.UI.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Phys,
  FireDAC.VCLUI.Wait, FireDAC.Comp.Client, FireDAC.Comp.DataSet,
  FireDAC.Phys.MSSQL, FireDAC.Phys.MSSQLDef,Data.DBXTransport, Vcl.ExtCtrls;

type
  TServerMethods3 = class(TDSServerModule)
    DataSetProvider1: TDataSetProvider;
    DataSetProviderEx1: TDataSetProviderEx;
    DataSetProvider2: TDataSetProvider;
    DataSetProvider3: TDataSetProvider;
    DataSetProvider4: TDataSetProvider;
    ClientDataSetEx1: TClientDataSetEx;
    UniStoredProc1: TUniStoredProc;
    softdsp: TDataSetProvider;
    servercds: TClientDataSetEx;
    UniStoredProc5: TUniStoredProc;
    c11dsp: TDataSetProvider;
    c12dsp: TDataSetProvider;
    UniStoredProc2: TUniStoredProc;
    fxdsp1: TDataSetProvider;
    fxdsp2: TDataSetProvider;
    execsqldsp: TDataSetProvider;
    FDQuery1: TFDQuery;
    FDQuery2: TFDQuery;
    FDQuery3: TFDQuery;
    FDQuery4: TFDQuery;
    FDQuery5: TFDQuery;
    execsqlqry: TFDQuery;
    FDQuery7: TFDQuery;
    FDQuery8: TFDQuery;
    FDQuery9: TFDQuery;
    FDQuery10: TFDQuery;
    FDQuery11: TFDQuery;
    FDConnection1: TFDConnection;
    FDQuery6: TFDQuery;
    gndsp: TDataSetProvider;
    procedure DSPUpdateError(Sender: TObject; DataSet: TCustomClientDataSet;
      E: EUpdateError; UpdateKind: TUpdateKind;
      var Response: TResolverResponse);
    // procedure DSServerModuleCreate(Sender: TObject);
    function getswdate(year, week, one: string): string;
    procedure DataSetProvider3BeforeApplyUpdates(Sender: TObject;
      var OwnerData: OleVariant);
    procedure DSServerModuleCreate(Sender: TObject);
    function execsqldspDataRequest(Sender: TObject; Input: OleVariant)
      : OleVariant;
    function gndspDataRequest(Sender: TObject; Input: OleVariant): OleVariant;
    procedure DSServerModuleDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function EchoString(Value: string): string;
    function ReverseString(Value: string): string;
    // function getserverdspname: string;
    // function getdsp(ProviderName:string):TDataSetProviderEx;
    // procedure Releaseserverdspname(ProviderName: string);
    // function cleardsp:TDataSetProviderEx;
    function getdjbh(djtype: string): string;
    // procedure setck;
    // procedure setdjck(djsn:string);
    // procedure setdjgys(djsn:string);
    // procedure djgz(djsn:string);
    // procedure setclsqd(djsn:string);
    // procedure setusergn;
    // procedure setkcb(djsn:string);
    // procedure setbxdfp(djsn:string);
    // procedure createbxdyf(djsn:string);
    function delck(ckname: string): boolean;
    // function getcanfp:double;
    // procedure getsgbz;
    // procedure getgnbz;
    // procedure setkcdbxzpro;
    procedure setf1;
    // procedure setygkcpro(djsn:string);
    // procedure setgrgz(year,ym:integer);
    // procedure setgngz(year,ym:integer);
    function getmaxsn(tbname: string): integer;

    function getdjsn(f154: string): string;
    function CreateDSProvider(ProviderName: String): boolean;
    function CreateDSProviderEx(ProviderName, SQL, KeyFields: string;
      Detail: OleVariant): boolean;

    function ResetDspDataSetSQL(ProviderName, SQL: string): boolean;
    function ResetDspDataSetSQLEx(Provider: TDataSetProviderEx;
      SQL, KeyFields: string; Detail: OleVariant): boolean;

    procedure setserverdb(var DB: string);
    procedure gscon;
    function gtserverdb: string;
    procedure settb(tb, fdlist: string);

    function getnowtdate: string;
    function getclientip:string;
  end;

  var
   ClientConnection:TDBXClientInfo;
   serverdb:string;

implementation

// var

{$R *.dfm}

uses System.StrUtils, dspPool, DbHelper, MIDASLIB, func, ServerContainerUnit1;

procedure SetSysDateFormat;
var
  fs: TFormatSettings;
begin
  // 设置WINDOWS系统的短日期的格式
  SetLocaleInfo(LOCALE_SYSTEM_DEFAULT, LOCALE_SSHORTDATE, 'yyyy-MM-dd');
  Application.UpdateFormatSettings := false;
  // 设定程序本身所使用的日期时间格式
  fs.LongDateFormat := 'yyyy-MM-dd';
  fs.ShortDateFormat := 'yyyy-MM-dd';
  fs.LongTimeFormat := 'hh:nn:ss';
  fs.ShortTimeFormat := 'hh:nn:ss';
  fs.DateSeparator := '-';
  fs.timeSeparator := ':';
end;

function TServerMethods3.getnowtdate: string;
var
  str: string;
begin
  // str:=datetostr(trunc(now));
  result :=FormatdateTime('c',now);
end;

function TServerMethods3.getswdate(year, week, one: string): string;
var
  str: string;
begin
  // year:=formatdatetime('yyyy',date);
  result := datetostr(StartOfAWeek(strtoint(year), strtoint(week),
    strtoint(one)));
end;

function TServerMethods3.gndspDataRequest(Sender: TObject; Input: OleVariant)
  : OleVariant;
var
  f672, f61: string;
  ipos: integer;
  maxsn: integer;
begin
  {
    with fdquery6 do
    begin
    close;
    sql.Clear;
    sql.Add('select MAX(convert(int,c9)) from c9');
    //parambyname('f672').Value:=f672;
    //parambyname('f61').Value:=f61;
    open;
    if isempty
    then
    maxsn:=1
    else
    maxsn:=fields[0].Value;
    end;
  }

  ipos := pos(';', Input);
  if ipos > 0 then
  begin
    f672 := copy(Input, 0, ipos - 1);
    f61 := copy(Input, ipos + 1, length(Input));
    with FDQuery6 do
    begin
      close;
      parambyname('f672').Value := f672;
      parambyname('f61').Value := f61;
      execsql;
    end;
  end;
end;

function MyCreateDetailDataSet(AOwner: TComponent; DataSource: TDataSource;
  const AName: String; const ASQL: String): TDataSet; stdcall;
var
  Qry: TFDQuery;
begin
  Qry := TFDQuery.Create(AOwner);
  Qry.Connection := TFDQuery(DataSource.DataSet).Connection;
  Qry.Name := AName;
  Qry.MasterSource := DataSource;
  Qry.SQL.Text := ASQL;
  result := Qry;
end;

function MyCreateProviderEx(AOwner: TComponent; FDConnection: TFDConnection;
  ProviderName, SQL, KeyFields: string; Detail: OleVariant;
  SetFieldsReadOnly: boolean; EUpdateError: TResolverErrorEvent): boolean;
var
  ProvComp: TComponent;
  Qry: TFDQuery;
  DsProvider: TDataSetProviderEx;
begin

  Qry := TFDQuery.Create(AOwner);
  Qry.Connection := FDConnection;
  Qry.SQL.Text := SQL;
  DsProvider := TDataSetProviderEx.Create(AOwner);
  DsProvider.Name := ProviderName;
  DsProvider.Options :=[poCascadeDeletes,poCascadeUpdates,poAllowCommandText,poUseQuoteChar,poFetchBlobsOnDemand];
  // DsProvider.ResolveToDataSet := True;
  DsProvider.UpdateMode := upWhereKeyOnly;
  DsProvider.DataSet := Qry;
  DsProvider.KeyFields := KeyFields;
  DsProvider.OnUpdateError := EUpdateError;
  DsProvider.CreateDetailDataSet(AOwner, Detail, @MyCreateDetailDataSet);
end;

function MyCreateProvider(AOwner: TComponent; UniConnection: TSQLConnection;
  ProviderName: String; SetFieldsReadOnly: boolean;
  EUpdateError: TResolverErrorEvent): boolean;
var
  ProvComp: TComponent;
  Qry: TSQLQuery;
  DsProvider: TDataSetProvider;
begin
  Qry := TSQLQuery.Create(AOwner);
  // if not SetFieldsReadOnly then
  // Qry.Options.SetFieldsReadOnly := False;
  Qry.sqlConnection := UniConnection;
  // Qry.UniDirectional := True;
  DsProvider := TDataSetProvider.Create(AOwner);
  DsProvider.Name := ProviderName;
  DsProvider.Options := DsProvider.Options + [poAllowCommandText];
  // DsProvider.ResolveToDataSet := True;
  // DsProvider.UpdateMode := upWhereKeyOnly;
  DsProvider.DataSet := Qry;
  DsProvider.OnUpdateError := EUpdateError;
end;

{ procedure setaqrsn(mxcds,mxsncds: TADOQuery);
  var
  maxsn:integer;
  begin
  if mxcds.State<>dsInactive  then
  begin
  maxsn:=getmaxsn(mxsncds);
  with mxcds do
  begin
  //edit;
  first;
  repeat
  if fieldbyname('sn').Value=-1 then
  begin
  edit;
  fieldbyname('sn').Value:=maxsn;
  post;
  maxsn:=maxsn+1;
  end;
  next
  until eof;
  end;
  end;
  end; }

function TServerMethods3.EchoString(Value: string): string;
begin
  result := Value;
end;

function TServerMethods3.execsqldspDataRequest(Sender: TObject;
  Input: OleVariant): OleVariant;
var
  sqltxt, txt, paramlist, para, paramvalue: string;
  sqllist: Tstringlist;
  ipos, ipos1: integer;
begin
  try
    sqllist := Tstringlist.Create;
    sqllist.Text := Input;
    paramlist := sqllist.Strings[0];
    sqllist.Delete(0);
    // txt:=input;
    // execsqlqry.sq
    with execsqlqry do
    begin
      close;
      SQL.Clear;
      SQL.Add(sqllist.Text);
      //sql.SaveToFile('c:\123.txt');
      // sql:=sqllist;
      prepared;
      ipos := pos(',', paramlist);
      while ipos <> 0 do
      begin
        para := copy(paramlist, 0, ipos - 1);
        paramlist := copy(paramlist, ipos + 1, paramlist.length);
        ipos1 := pos('=', para);
        paramvalue := copy(para, ipos1 + 1, para.length);
        para := copy(para, 1, ipos1 - 1);
        parambyname(para).Value := paramvalue;
        ipos := pos(',', paramlist);
      end;
      execsql;
      close;
    end;
  finally
    sqllist.Free;
  end;
end;

{
  function TServerMethods3.getserverdspname: string;
  begin
  Result := Getdspname();

  end;

  function TServerMethods3.getdsp(ProviderName:string):TDataSetProviderEx;
  var
  i,count:integer;
  begin
  count:=self.ComponentCount - 1;
  result:=nil;
  for i := 0 to count do
  begin
  if self.Components[i] is TDataSetProviderEx then
  begin
  if self.Components[i].Name = ProviderName then
  begin
  result:=TDataSetProviderEx(self.Components[i]);
  break;
  end;
  //list.Add(self.Components[i]);
  end;
  end;
  end; }

function TServerMethods3.getdjbh(djtype: string): string;
var
  i, count: integer;
  bhcds: TClientDataSetEx;
begin

  with UniStoredProc1 do
  begin

    //
    parambyname('djtype').Value := djtype;
    // parambyname('kddate').Value := strtodate('2017-07-17');
    // parambyname('djsn').Value:='';
    // open;
    execute;
    result := UniStoredProc1.parambyname('djsn').Value;
    // result:=bhcds.fields[0].Value;
    close;
  end;

end;

function TServerMethods3.delck(ckname: string): boolean;
var
  i, count: integer;
  bhcds: TClientDataSetEx;
begin

  with UniStoredProc1 do
  begin

    //
    parambyname('ckname').Value := ckname;
    // parambyname('kddate').Value := strtodate('2017-07-17');
    // parambyname('djsn').Value:='';
    // open;
    execute;
    result := UniStoredProc1.parambyname('have').Value;
    // result:=bhcds.fields[0].Value;
    close;
  end;

end;

function TServerMethods3.getdjsn(f154: string): string;
begin

  with UniStoredProc1 do
  begin
    storedprocname := 'getdjsn;1';
    // UniDirectional := false;
    PrepareSQL;
    parambyname('f154').Value := f154;
    execute;
    result := UniStoredProc1.parambyname('f150').Value;
    close;
  end;
end;

procedure TServerMethods3.settb(tb, fdlist: string);
begin

  with UniStoredProc1 do
  begin
    storedprocname := 'checktbfd;1';
    // UniDirectional := false;
    PrepareSQL;
    parambyname('tb').Value := tb;
    parambyname('fdlist').Value := fdlist;
    execute;
    // result:=UniStoredProc1.ParamByName('f150').Value;
    close;
  end;
end;

procedure TServerMethods3.Timer1Timer(Sender: TObject);
var
i:integer;
begin

end;

function TServerMethods3.getmaxsn(tbname: string): integer;
var
  i, count: integer;
  bhcds: TClientDataSetEx;
begin

  with UniStoredProc1 do
  begin
    UniStoredProc1.storedprocname := 'getmaxsn;1';
    UniStoredProc1.Prepare;
    parambyname('tb').Value := tbname;
    // parambyname('kddate').Value := strtodate('2017-07-17');
    // parambyname('djsn').Value:='';
    // open;
    execute;
    result := UniStoredProc1.parambyname('maxsn').Value;
    // result:=bhcds.fields[0].Value;
    close;
  end;

end;

{
  function TServerMethods3.getcanfp:double;
  var
  i,count:integer;
  bhcds:Tclientdatasetex;
  begin

  with fpsqnum do
  begin

  //
  //parambyname('tb').Value:=tbname;
  //parambyname('kddate').Value := strtodate('2017-07-17');
  //parambyname('djsn').Value:='';
  //open;
  execute;
  result:=fpsqnum.ParamByName('fpsqnum').Value;
  //result:=bhcds.fields[0].Value;
  close;
  end;

  end;
}

procedure TServerMethods3.setf1;
var
  i, count: integer;
  bhcds: TClientDataSetEx;
begin

  with UniStoredProc5 do
  begin

    //
    // parambyname('tb').Value:=tbname;
    // parambyname('kddate').Value := strtodate('2017-07-17');
    // parambyname('djsn').Value:='';
    // open;
    execute;
    // result:=fpsqnum.ParamByName('fpsqnum').Value;
    // result:=bhcds.fields[0].Value;
    close;
  end;

end;
{
  procedure TServerMethods3.Releaseserverdspname(ProviderName: string);
  var
  i: integer;
  list: Tlist;
  dsp: TDataSetProviderEx;
  count:integer;
  begin
  //list := Tlist.Create;
  Releasedspname(ProviderName);

  dsp:=nil;
  dsp:=getdsp(ProviderName);
  if dsp<>nil then
  BEGIN
  dsp.dataset.free;
  dsp.Free;
  END;

  end; }
{
  function TServerMethods3.cleardsp:TDataSetProviderEx;
  var
  i,count:integer;
  dsp:TDataSetProviderEx;
  Qry: TUniQuery;
  begin
  count:=self.ComponentCount - 1;
  result:=nil;
  for i := count downto 0 do
  //repeat
  begin
  if self.Components[i] is TDataSetProviderEx then
  begin
  dsp:=TDataSetProviderEx(self.Components[i]);
  dsp.DataSet.Free;
  DSP.Free;
  //count:=self.ComponentCount - 1;
  end;
  //list.Add(self.Components[i]);

  end;

  count:=self.ComponentCount - 1;
  for i := count downto 0 do
  begin
  if self.Components[i] is TUniQuery then
  begin
  qry:=TUniQuery(self.Components[i]);
  //dsp.DataSet.Free;
  qry.Free;
  //list.Add(self.Components[i]);
  end;
  end;
  end; }

function TServerMethods3.ReverseString(Value: string): string;
begin
  result := System.StrUtils.ReverseString(Value);
end;

function TServerMethods3.CreateDSProvider(ProviderName: String): boolean;
begin
  result := false;
  // MyCreateProvider(self, 公司数据库, ProviderName, True, DSPUpdateError);
  result := True;
end;

function TServerMethods3.CreateDSProviderEx(ProviderName, SQL,
  KeyFields: string; Detail: OleVariant): boolean;
var
  i: integer;
  dsp: TDataSetProviderEx;
  dspExist: boolean;
begin
  dspExist := false;
  for i := 0 to self.ComponentCount - 1 do
  begin
    if (self.Components[i].Name = ProviderName) then
    begin
      dspExist := True;
      if self.Components[i] is TDataSetProviderEx then
      begin
        dsp := (self.Components[i]) as TDataSetProviderEx;
{$IFDEF DEBUG_ON}
        dsp.Free;
        dspExist := false;
{$ENDIF}
      end
      else
      begin
{$IFDEF DEBUG_ON}
        self.Components[i].Free;
        dspExist := false;
{$ENDIF}
      end;
      Break;
    end;
  end;

  if not dspExist then
    MyCreateProviderEx(self, FDConnection1, ProviderName, SQL, KeyFields,
      Detail, True, DSPUpdateError);
end;

procedure TServerMethods3.DataSetProvider3BeforeApplyUpdates(Sender: TObject;
  var OwnerData: OleVariant);
begin
  // OwnerData.fieldbyname('sn').value:=-1
end;

procedure TServerMethods3.DSPUpdateError(Sender: TObject;
  DataSet: TCustomClientDataSet; E: EUpdateError; UpdateKind: TUpdateKind;
  var Response: TResolverResponse);
begin
  raise E;
end;

procedure TServerMethods3.DSServerModuleCreate(Sender: TObject);
begin
  // xx.SaveToStream;
  // setserverdb('data00000000001');
end;

procedure TServerMethods3.DSServerModuleDestroy(Sender: TObject);
var
    dsp: TDataSetProviderEx;
    Qry :TFDQuery;
    i:integer;
begin
   FDConnection1.Close;
   FDManager.DeleteConnectionDef(serverdb);
   //ClientConnection.;

  {for i := 0 to self.ComponentCount - 1 do
  begin

      if self.Components[i] is TDataSetProviderEx then
      begin
        dsp := (self.Components[i]) as TDataSetProviderEx;
        dsp.Free;
      end;

      if self.Components[i] is TFDQuery then
      begin
        Qry := (self.Components[i]) as TFDQuery;
        Qry.Free;
      end;
  end;}
   //serverdb:=nil;
end;

{
  procedure TServerMethods3.DSServerModuleCreate(Sender: TObject);
  begin
  namePool := TdspPool.Create;

  //dspre.Open;
  //clcds.Open;
  // namePool.FMaxCount:=1000;
  end;
}
procedure TServerMethods3.setserverdb(var DB: string);
var
  nowdate: Tdate;
  oDef: IFDStanConnectionDef;
  olist: Tstringlist;
begin
  try
      olist := Tstringlist.Create;
      // olist.Add('DriverID = MSSQL');
      olist.Add('server=127.0.0.1');
      olist.Add('database=' + DB);
      olist.Add('User_name=sa');
      olist.Add('Password=JiaJiang2015');
      olist.Add('CharacterSet=UTF8');
      // olist.Add('Pooled=true');

      oDef := ServerContainer1.FDManager1.ConnectionDefs.FindConnectionDef
        ('mycon_' + DB);
      if oDef = nil then
        FDManager.AddConnectionDef('mycon_' + DB, 'MSSQL', olist);
      // FDConnection1.Params.Clear;
      FDConnection1.ConnectionDefName := 'mycon_' + DB;
      serverdb:='mycon_' + DB;
      FDConnection1.Connected := True;
  finally
      olist.Free;
  end;

  { showmessage('1');
    FDConnection1.Params.Clear;
    oDef := ServerContainer1.FDManager1.ConnectionDefs.FindConnectionDef('mycon');
    if oDef=nil then
    begin
    oDef := ServerContainer1.FDManager1.ConnectionDefs.AddConnectionDef;
    oDef.Name := 'mycon';
    //oDef.Params.DriverID := 'MSSQL';
    oDef.Params.add('DriverID := MSSQL');
    oDef.Params.Add('[server]=127.0.0.1');
    oDef.Params.Add('Database ='+DB);
    oDef.Params.Add('User_name =sa');
    oDef.Params.Add('Password =JiaJiang2015');
    // oDef.Params.Add('OSAuthent = True');
    // oDef.Params.Add('pooled = True');
    oDef.Params.Pooled := True;
    oDef.MarkPersistent;
    oDef.Apply;
    end;
    showmessage('2');
    FDConnection1.ConnectionDefName := 'mycon';
    FDConnection1.Connected := True; }
end;

procedure TServerMethods3.gscon;
begin
  { FDConnection1.Connected:=false;
    FDConnection1.Params.clear;
    FDConnection1.Params.Add('DriverID=MSSQL');
    FDConnection1.Params.Add('Database:=zfsoft');
    FDConnection1.Params.Add('server:=127.0.0.1');
    FDConnection1.Params.Add('username:=sa');
    FDConnection1.Params.Add('password:=JiaJiang2015');
    FDConnection1.connected:=true; }
  // ServerMethods1.公司数据库.Database:=db;
  // rverMethods3.
  // namePool.FMaxCount:=1000;
end;

function TServerMethods3.getclientip:string;
begin
result:=ClientConnection.IpAddress;
end;

function TServerMethods3.gtserverdb: string;
begin
  // softunicon.Connected:=false;
  // result:=FDConnection1.params.Database;
  // softunicon.server:='127.0.0.1';
  // softunicon.username:='sa';
  // softunicon.password:='JiaJiang2015';
  // softunicon.connected:=true;
  // ServerMethods1.公司数据库.Database:=db;
  // rverMethods3.
  // namePool.FMaxCount:=1000;
end;

procedure SetSQLProperty(AControl: TComponent;
  { PropName: string; } Value: String);
var
  pInfo: PPropInfo;
  objTemp: TObject;
begin
  if IsPublishedProp(AControl, 'CommandText') then
  begin
    SetPropValue(AControl, 'CommandText', Value);
    Exit;
  end;
  pInfo := GetPropInfo(AControl.ClassInfo, 'SQL');
  if (pInfo <> nil) and (pInfo^.PropType^.Kind = tkClass) then
  begin
    objTemp := GetObjectProp(AControl, pInfo);
    if Assigned(objTemp) then
    begin
      TStrings(objTemp).Text := Value;
      // pInfo := GetPropInfo(objTemp.ClassInfo, 'Text');
      // if pInfo <> nil then
      // SetPropValue(objTemp, 'Text', Value);
    end;
  end;
end;

function TServerMethods3.ResetDspDataSetSQL(ProviderName, SQL: string): boolean;
var
  i: integer;
  dsp: TDataSetProvider;
begin
  result := false;
  for i := 0 to self.ComponentCount - 1 do
  begin
    if SameText(self.Components[i].Name, ProviderName) then
    begin
      if (self.Components[i] is TDataSetProviderEx) or
        (self.Components[i] is TDataSetProvider) then
      begin
        dsp := (self.Components[i]) as TDataSetProvider;
        if dsp.DataSet <> nil then
        begin
          SetSQLProperty(dsp.DataSet, SQL);
          result := True;
        end;
      end;
      Break;
    end;
  end;
end;

procedure ResetDspChildDetailDatasetSQLEx(DetailDataSetItem
  : TProviderDetailDataSetColumn; const Detail: OleVariant);
var
  i: integer;
  ChildDetail: OleVariant;
begin
  if not VarIsNull(Detail) and VarIsArray(Detail) and VarIsArray(Detail[0]) then
  begin
    for i := 0 to VarArrayHighBound(Detail, 1) do
    begin
      with DetailDataSetItem.ChildDetailDataSet.Items[i] do
      begin
        DataSet.Name := Detail[i][0]; // name
        SetSQLProperty(DataSet, Detail[i][1]); // sql
        KeyFields := Detail[i][2];
        ChildDetail := Detail[i][3];
        ResetDspChildDetailDatasetSQLEx
          (DetailDataSetItem.ChildDetailDataSet.Items[i], ChildDetail);
      end;
    end;
  end;
end;

function ResetDspDataSetSQLEx2(Provider: TDataSetProviderEx;
  SQL, KeyFields: string; Detail: OleVariant): boolean;
var
  HighBound, i: integer;
  ChildDetail: OleVariant;
begin
  // TUniQuery(Provider.DataSet).SQL.text := sql;
  SetSQLProperty(Provider.DataSet, SQL);
  // Provider.UpdateMode := upWhereKeyOnly;
  Provider.KeyFields := KeyFields;

  if not VarIsNull(Detail) and VarIsArray(Detail) and VarIsArray(Detail[0]) then
  begin
    for i := 0 to VarArrayHighBound(Detail, 1) do
    begin
      HighBound := VarArrayHighBound(Detail[i], 1);
      with Provider.DetailDataSet.Items[i] do
      begin
        DataSet.Name := Detail[i][0]; // name
        SetSQLProperty(DataSet, Detail[i][1]); // sql
        KeyFields := Detail[i][2];
        ChildDetail := Detail[i][3];
        ResetDspChildDetailDatasetSQLEx(Provider.DetailDataSet.Items[i],
          ChildDetail);
      end;
    end;
  end;
end;

function TServerMethods3.ResetDspDataSetSQLEx(Provider: TDataSetProviderEx;
  SQL, KeyFields: string; Detail: OleVariant): boolean;
begin
  result := false;
  ResetDspDataSetSQLEx2(Provider, SQL, KeyFields, Detail);
  result := True;
end;

end.
----------------------------------------------
-

作者：

ccxpts (渔夫)	★☆☆☆☆	-
	普通会员

2018/12/20 9:59:05

1楼：

我在生产上也碰到类似问题，用berlin10.1编译的运行几个月都正常，但是如果用tokyo10.2编译的最多一周就死机了
----------------------------------------------
-

作者：

dragon_cbx (旺财，小强)	★☆☆☆☆	-
	盒子活跃会员

2018/12/20 10:12:01

2楼：

你们同时在线的用户有多少人
----------------------------------------------
老程序员

作者：

xfyserver (s)	★☆☆☆☆	-
	普通会员

2018/12/20 10:30:52

3楼：

我现在用户不多，几个用户，往往用一天就不行了
不过这个代码是已经修正了一些问题的代码，但是内存还是增加，没有解决，贴出来让大家帮忙看看
----------------------------------------------
-

作者：

wanlgrm (么么)	▲▲▲▲▲	-
	普通会员

2018/12/20 10:44:19

4楼：

ReportMemoryLeaksOnShutdown 先看看泄露的问题呗
----------------------------------------------
-只会复制粘贴！

作者：

sxqwhxq (步惊云)	★☆☆☆☆	-
	普通会员

2018/12/20 11:42:53

5楼：

建议使用5soft提供的部分http.sys替代indy技术，可部分解决这一问题，使用这一改进技术，虽然申请内存、句柄数也会增加，但加到一定程度就不再增长了，不会影响效率，更不会死机。另外建议使用datasnap REST代替datasnap。
----------------------------------------------
-

作者：

sensorwu (老吴)	▲▲▲△△	-
	普通会员

2018/12/21 11:20:12

6楼：

DataSnap确实存在这样的问题，主要是因为DataSnap是采用的有状态连接，特别是过一段时间，断开重连比较麻烦，不稳定，我们以前一直用DataSnap，就是因为问题太多，现在全部更改成自己写的三层架构了，稳定了，内存不会增加，因为无状态连接，通过Token认证，不存在重连的问题。如果确实要使用三层数据库的，建议还是不要使用DataSnap。当然也许是我们对DataSnap理解的不透彻，用的不好。
----------------------------------------------
喜欢编程的一个DOS级程序员

作者：

xfyserver (s)	★☆☆☆☆	-
	普通会员

2018/12/21 11:37:06

7楼：

搞定了，控件的问题，内存泄漏在柏林版以后都解决了啊
----------------------------------------------
-

作者：

abea (abea)	★☆☆☆☆	-
	盒子活跃会员

2018/12/21 11:48:39

8楼：

怎么解决的？
----------------------------------------------
-

信息

登陆以后才能回复