即使在运行EmptyDataSet,Close,甚至Free方法

时间:2018-05-30 20:53:31

标签: delphi tclientdataset delphi-6

我的应用程序包含ClientDataSet连接的DataSetProvider,该TIBQuery连接在procedure TAggregator.Load(ASql: string); begin try FQry.SQL.Text := ASql; FCds.SetProvider(FDsp); FCds.Open; FCds.EmptyDataSet; FCds.Close; except on e: Exception do raise e; end; end; Delphi 6 )中。

我运行了几个查询,在每个查询之后运行EmptyDataSet,Close和Free方法。

例如:

program CdsConsumptionTest;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  IBDatabase,
  uAggregator in 'uAggregator.pas';

var
  database: TIBDatabase;
  transaction: TIBTransaction;
  aggregator: TAggregator;
  tables: TStringList;
  index: integer;

begin
  try
    try
      database := TIBDatabase.Create(nil);
      transaction := TIBTransaction.Create(nil);
      try
        database.DefaultTransaction := transaction;
        database.Params.Values['user_name'] := 'SYSDBA';
        database.Params.Values['password'] := 'masterkey';
        database.SQLDialect := 3;
        database.LoginPrompt := false;
        database.DatabaseName := 'C:\bases\17011\BASE.GDB';

        tables := TStringList.Create;
        aggregator := TAggregator.Create(database);
        try
          database.GetTableNames(tables);

          Writeln('Connection successful!');
          Write('Press ENTER to continue ...');

          // After that you can see the memory being increased and no longer released
          Readln;

          for index := 0 to pred(tables.Count) do
          begin
            aggregator.Load('select * from ' + tables[index]);
          end;
        finally
          tables.Free;
          aggregator.Free;
        end;

      finally
        database.Free;
        transaction.Free;
      end;
    except
      on e:Exception do
      begin
        Writeln('');
        Writeln('ERROR! ' + e.Message);
        Writeln('');
      end;
    end;
  finally
    Write('Process completed! Press ENTER to exit ...');
    Readln;
  end;
end.

这是我的最小应用示例中的两个文件,用于重现问题:

unit uAggregator;

interface

uses
  IBQuery, DBClient, Provider, IBDatabase, SysUtils;

type
  TAggregator = class
  private
    FQry: TIBQuery;
    FCds: TClientDataSet;
    FDsp: TDataSetProvider;
  public
    constructor Create(AIBDatabase: TIBDatabase); reintroduce;
    destructor Destroy; override;
  public
    procedure Load(ASql: string);
  end;

implementation

{ TAgregador }

constructor TAggregator.Create(AIBDatabase: TIBDatabase);
begin
  inherited Create;
  FQry := TIBQuery.Create(nil);
  FQry.Database := AIBDatabase;

  FDsp := TDataSetProvider.Create(nil);
  FDsp.DataSet := FQry;

  FCds := TClientDataSet.Create(nil);
  FCds.SetProvider(FDsp);
  FCds.PacketRecords := -1;  
end;

destructor TAggregator.Destroy;
begin
  FCds.Free;
  FDsp.Free;
  FQry.Free;
  inherited;
end;

procedure TAggregator.Load(ASql: string);
begin
  try
    FQry.SQL.Text := ASql;
    FCds.SetProvider(FDsp);
    FCds.Open;
    FCds.EmptyDataSet;
    FCds.Close;
  except
    on e: Exception do
      raise e;
  end;
end;

end.

和...

def user_login(request):
context = {}
if request.method == "POST":
    username = request.POST['username']
    password = request.POST["password"]
    user = authenticate(request,username=username,password=password)
    if user.is_authenticated:
        print("1")
        login(request, user)
        if request.GET.get('next',None):
            print("2")
            return HttpResponseRedirect(request.GET['next'])
        return HttpResponseRedirect(reverse('success'))
    else:
        print("3")
        context["error"] = "nieprawidlowe dane"
        return render(request,'auth/login.html',context)
else:
    print("4")
    return render(request,'auth/login.html',context)


 @login_required(login_url="/login/")
def success(request):
    c = {}
    c['user'] = request.user
    return render(request,'auth/success.html',c)

当我启动应用程序时,我发现分配了大量内存 按下ENTER以启动查询后,Windows任务管理器看到内存正在递增并且从未释放 直到进程到达我需要按ENTER键终止应用程序的程度,然后才释放分配的内存(即使在FreeData of ClientDataSet之后)。

在这个小例子中,它并不是一个大问题 但在我的实际应用程序中,这是一个Out Of Memory类型异常。

我如何解决这个问题?

修改

使用FastMM4进行测试我收到了以下报告:

FastMM4 Report

我不明白。

0 个答案:

没有答案