[TBufDataSet] Deallocate memory
lazarus / 16-Databases

----------------------------------------------------------------------
dev.Antunes · 2024-05-29 14:12

Hi,

I am facing a problem and need help.

When I use TBufDataSet together with a DBGrid, after inserting items
and deallocating the memory with the Free command, the RAM does not
decrease.

What can it be?



unit datamodule;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, DB, BufDataset, memds, fpjsondataset;

type

  { TDm }

  TDm = class(TDataModule)
    dsTeste: TDataSource;
    JSONDataSet1: TJSONDataSet;
    JSONDataSet2: TJSONDataSet;
    procedure DataModuleCreate(Sender: TObject);
  private
    FtbBuf: TBufDataset;
    FtbMemBuf: TMemDataset;
    FtbListBuf: TStringList;
  public
    procedure DoClearBufDataSet(ADataSet: TBufDataSet);
    procedure DoClearMemDataSet(ADataSet: TMemDataset);
    procedure ObterDadosBuf();
    procedure ObterDadosMemBuf();
    procedure ObterDadosListBuf();
    procedure DoClearListDataSet(ADataSet: TStringList);
    procedure Destruir();
    property tbBuf : TBufDataSet read FtbBuf write FtbBuf;
    property tbMemBuf : TMemDataset read FtbMemBuf write FtbMemBuf;
    property tbListBuf : TStringList read FtbListBuf write FtbListBuf;
  end;
var
  Dm: TDm;

implementation

{$R *.lfm}

procedure TDm.ObterDadosBuf;
var
  i : Integer;
begin
  try
    FtbBuf := TBufDataSet.Create(nil);
    FtbBuf.FieldDefs.Add('col_descr_qtd', ftString, 30);
    FtbBuf.FieldDefs.Add('seqcontrole', ftInteger);
    dsTeste.DataSet := FtbBuf;

    i := 0;
    while (i < 10000) do
    begin
      if not FtbBuf.Active then
        FtbBuf.CreateDataset;

      FtbBuf.Open;
      FtbBuf.First;
      FtbBuf.Insert;
      FtbBuf.FieldByName('seqcontrole').Value := 0;
      FtbBuf.FieldByName('col_descr_qtd').Value :=
Concat('00','teste','00');

      FtbBuf.FieldByName('seqcontrole').Value := 1;
      FtbBuf.FieldByName('col_descr_qtd').Value :=
Concat('01','teste','01');

      FtbBuf.FieldByName('seqcontrole').Value := 2;
      FtbBuf.FieldByName('col_descr_qtd').Value :=
Concat('02','teste','02');

      FtbBuf.FieldByName('seqcontrole').Value := 3;
      FtbBuf.FieldByName('col_descr_qtd').Value :=
Concat('03','teste','03');
      FtbBuf.Post;
      i := i + 1;
    end;
  finally
    //DoClearBufDataSet(FtbBuf);
  end;
end;

procedure TDm.ObterDadosMemBuf;
var
  i : Integer;
begin
  try
    if not Assigned(FtbMemBuf) then
    begin
      FtbMemBuf := TMemDataset.Create(nil);
      FtbMemBuf.FieldDefs.Add('col_descr_qtd', ftString, 30);
      FtbMemBuf.FieldDefs.Add('seqcontrole', ftInteger);
      dsTeste.DataSet := tbMemBuf;
    end;

    i := 0;
    while (i < 10000) do
    begin
      FtbMemBuf.Open;
      FtbMemBuf.First;
      FtbMemBuf.Append;
      FtbMemBuf.FieldByName('seqcontrole').Value := 0;
      FtbMemBuf.FieldByName('col_descr_qtd').Value :=
Concat('00','teste','00');

      FtbMemBuf.FieldByName('seqcontrole').Value := 1;
      FtbMemBuf.FieldByName('col_descr_qtd').Value :=
Concat('01','teste','01');

      FtbMemBuf.FieldByName('seqcontrole').Value := 2;
      FtbMemBuf.FieldByName('col_descr_qtd').Value :=
Concat('02','teste','02');

      FtbMemBuf.FieldByName('seqcontrole').Value := 3;
      FtbMemBuf.FieldByName('col_descr_qtd').Value :=
Concat('03','teste','03');
      FtbMemBuf.Post;
      i := i + 1;
    end;
  finally
    //DoClearMemDataSet(FtbMemBuf);
  end;
end;

procedure TDm.ObterDadosListBuf();
var
  i : Integer;
begin
  try
    FtbListBuf := TStringList.Create;
    i := 0;
    while (i < 1000) do
    begin
      FtbListBuf.Add('0' + IntToStr(i));
      i := i + 1;
    end;
  finally
  end;
end;

procedure TDm.DoClearListDataSet(ADataSet: TStringList);
begin

end;

procedure TDm.Destruir;
begin
  if Assigned(FtbBuf) then begin
    FtbBuf.Fields.Clear;
    FtbBuf.FieldDefs.Clear;
    FreeAndNil(FtbBuf);
  end;

  if Assigned(FtbMemBuf) then begin
    FtbMemBuf.Fields.Clear;
    FtbMemBuf.FieldDefs.Clear;
    FreeAndNil(FtbMemBuf);
  end;
end;

procedure TDm.DataModuleCreate(Sender: TObject);
begin
end;

procedure TDm.DoClearBufDataSet(ADataSet: TBufDataSet);
begin
  with ADataSet do
  begin
    try
      First;
      DisableControls;
      while not EoF do
        Delete;
    finally
      EnableControls;
    end;
  end;
end;

procedure TDm.DoClearMemDataSet(ADataSet: TMemDataset);
begin
  with ADataSet do
  begin
    try
      First;
      DisableControls;
      while not EoF do
        Delete;
    finally
      EnableControls;
    end;
  end;
end;

end.