"Out Of Memory" con clientdataset > 100.000 registros
 

Estimados y admirados amigos:
Tengo un procedimiento que en teoría recorre una tabla que hoy x hoy tiene mas de 100 mil registros (Mal diseño por supuesto).
Antes de ese numero no daba ningun lio por lo que no consideraba ninguna alternativa. sucede que al intentar grabar un nuevo registro luego de unos 3 segundos sale el error "Out Of Memory".
El copdigo con el que no he tenido problema sino solo hasta ahora que sobre paso un importante numero de registros es el siguiente:

Código Delphi [-]
procedure TFormPersonas.BitBtn7Click(Sender: TObject);
var
  Current_reg, I, vCurrentRepeticion: Integer;
begin
Des;
  CDSProcedimientos.DisableControls;
   try
    Current_reg := 0;
    CDSProcedimientos.First;

    while not CDSProcedimientos.EOF do
    begin
      for I := 0 to CDSProcedimientos.FieldCount - 1 do
      begin
       if ((Pos('CheckBox_', CDSProcedimientos.Fields[i].FieldName) = 0) and
          (Pos('Codigo_', CDSProcedimientos.Fields[i].FieldName) = 0) and
          (Pos('Valor_', CDSProcedimientos.Fields[i].FieldName) = 0) and
          (Pos('Repeticiones_', CDSProcedimientos.Fields[i].FieldName) = 0) and
          (Pos('Abono_', CDSProcedimientos.Fields[i].FieldName) = 0) and
          (Pos('Neto_', CDSProcedimientos.Fields[i].FieldName) = 0) and
          (Pos('Saldo_', CDSProcedimientos.Fields[i].FieldName) = 0) and
          (Pos('Copago_', CDSProcedimientos.Fields[i].FieldName) = 0)) then
        begin
           if CDSProcedimientos.FieldByName('CheckBox_' + vgEntidad)
            .AsBoolean then
          begin
            for vCurrentRepeticion := 1 to CDSProcedimientos.FieldByName
              ('Repeticiones_' + vgEntidad).AsInteger do
            begin
              Inc(Current_reg);
              if Current_reg <> 1 then
                DuplicarDatos(TablePersonas);

              TablePersonas.Edit;
              TablePersonasProcedimiento.AsString := CDSProcedimientos.Fields
                [i].AsString;
              TablePersonasCodigo_Procedimiento.AsInteger :=
                CDSProcedimientos.FieldByName('Codigo_' + vgEntidad).AsInteger;
              TablePersonasValor.AsFloat := CDSProcedimientos.FieldByName
                ('Valor_' + vgEntidad).AsFloat;
              TablePersonasAbono.AsFloat := CDSProcedimientos.FieldByName
                ('Abono_' + vgEntidad).AsFloat;
              TablePersonasSaldo.AsFloat := CDSProcedimientos.FieldByName
                ('Saldo_' + vgEntidad).AsFloat;
              TablePersonasCopago.AsFloat := CDSProcedimientos.FieldByName
                ('Copago_' + vgEntidad).AsFloat;
              TablePersonas.Post;
             end;
          end;
        end;
      end;
      CDSProcedimientos.Next;
    end;
      CDSProcedimientos.Close;
    for I := CDSProcedimientos.FieldCount - 1 downto 0 do
    begin
      CDSProcedimientos.Fields[i].DataSet := nil;
    end;

Luego de muchas horas de busquedas y lecturas y de leer incluso que esto no se ha solucionado o que es mejor cambiar el componente; tambien he visto que se puede solucionar con simplemente cerrar y abrir donde corresponda para liberar la memoria. Lo he intentado sin un positivo. agradezco a Uds alguna sugerencia en la medida de lo posible. Mil gracias.

Creeme. desde la perspectiva de la BD, es insignificante. No me parece que sea para considerarlo un error de diseño. Yo creo que el problema es levantar esa cantidad en un ClientDataSet. Creo que lo mejor que podes optar es por operar en batch, es decir, toma de a "montones" y no los 100 mil. Por ejemplo, podes tomar 10 mil registros, procesar todo, descartarlos, tomarlos 10 mil siguientes, y asi

Para darnos una idea más clara, ¿en qué línea ocurre el error? Probablemente estás disparando un manejador de eventos BeforePost o similar, que realiza alguna tarea que eleva esa excepción. Posible recursión, incluso.

Saludos.

Hola Muchachos gracias por su interes pra la colaboracion que pido...
Al mira que cuando ejecuto con depurador Delphi me envia a esa tlinea de codigo (la de color rojo). curiosamente este es otro procedimiento relacinado que no habia tenido en cuenta.
Sobre lo que comenta [AgustinOrtu]; pues tambien me suena mucho. voy a ir estudiando esta solucion tambien.
Mil gracias a ambos.

Que se busca;

Este codigo Filtra de una tabla llama procedimientos una serie de productos y servicios que vende un laboratorio de patologia; y nos muestra (Junto con el diseño) unas opciones entre otras cosas de repetir 2 o mas veces la misma venta del procedimiento.
El codigo anterior graba esa venta que puede ser de un procedimiento unico o de uno repetido muchas veces. con el error de "out Of Memory" solo me grba 1 las repeticiones no las hace y salta el error.

Gracias

Código Delphi [-]
procedure TFormPersonas.Button9Click(Sender: TObject);
Var
  QPacientes, QCategorias, QProcedimiento: TQuery;
  vFields: array of TStringField;
  vCamposBool: array of TBooleanField;
  vCodigoProc, vRepeticiones: array of TIntegerField;
  vValorProc, vCopago, vAbono, vNeto, vSaldo: array of TFloatField;
  I: Integer;
begin
  CDSProcedimientos.Free;
  CDSProcedimientos := TClientDataSet.Create(Self);
  CDSProcedimientos.OnCalcFields := CDSProcedimientosCalcFields;
  DataSource2.DataSet := CDSProcedimientos;

  QProcedimiento := TQuery.Create(nil);
  QCategorias := TQuery.Create(nil);
  try
    QProcedimiento.DatabaseName := 'Clara';
    QProcedimiento.SQL.Clear;
    QProcedimiento.SQL.Add('select distinct Nombreentidad, procedimiento, codigo_procedimiento, valor from procedimientos where NombreEntidad = :Entidad');

    if DBLookupComboBox2.Text <> '' then
    begin
      QProcedimiento.SQL.Add('and convenio= :convenio');
      QProcedimiento.ParamByName('convenio').AsString :=
      TableConveniosConvenio.AsString;
    end;

    QProcedimiento.Close;
    QProcedimiento.ParamByName('Entidad').AsString := DBComboBox9.Text;
    QProcedimiento.Open;

    vgEntidad := DBComboBox9.Text;

    QCategorias.DatabaseName := 'Clara';
    QCategorias.SQL.Clear;
    QCategorias.SQL.Add('select distinct NombreEntidad from procedimientos where NombreEntidad= :Entidad');

    if DBLookupComboBox2.Text <> '' then
    begin
      QCategorias.SQL.Add('and convenio=:convenio');
      QCategorias.ParamByName('convenio').AsString :=
        TableConveniosConvenio.AsString;
    end;

    QCategorias.Close;
    QCategorias.ParamByName('Entidad').AsString := DBComboBox9.Text;
    QCategorias.Open;

    //if QCategorias.RecordCount = 0 then
    begin
      try
        CDSProcedimientos.Close;
        // CDSProcedimientos.ClearFields;
        CDSProcedimientos.CreateDataSet;
      except
      end;

      // Abort;
    end;

    CDSProcedimientos.Close;

    for I := CDSProcedimientos.FieldCount - 1 downto 0 do
    begin
      CDSProcedimientos.Fields[i].DataSet := nil;
    end;

    // try
    // CDSProcedimientos.Edit;
    // CDSProcedimientos.ClearFields;
    // CDSProcedimientos.Close;
    // except
    // end;

    I := 0;

    SetLength(vFields, QCategorias.RecordCount);
    SetLength(vCamposBool, QCategorias.RecordCount);
    SetLength(vCodigoProc, QCategorias.RecordCount);
    SetLength(vValorProc, QCategorias.RecordCount);
    SetLength(vCopago, QCategorias.RecordCount);
    SetLength(vAbono, QCategorias.RecordCount);
    SetLength(vNeto, QCategorias.RecordCount);
    SetLength(vSaldo, QCategorias.RecordCount);
    SetLength(vRepeticiones, QCategorias.RecordCount);

    QCategorias.First;
    while not QCategorias.EOF do
    begin
      if Assigned(vFields[i]) then
        vFields[i].Free;

      if Assigned(vCamposBool[i]) then
        vCamposBool[i].Free;

      if Assigned(vCodigoProc) then
        vCodigoProc[i].Free;

      if Assigned(vValorProc) then
        vValorProc[i].Free;

      vFields[i] := TStringField.Create(CDSProcedimientos);
      vCamposBool[i] := TBooleanField.Create(CDSProcedimientos);
      vCodigoProc[i] := TIntegerField.Create(CDSProcedimientos);
      vValorProc[i] := TFloatField.Create(CDSProcedimientos);
      vCopago[i] := TFloatField.Create(CDSProcedimientos);
      vAbono[i] := TFloatField.Create(CDSProcedimientos);
      vNeto[i] := TFloatField.Create(CDSProcedimientos);
      vSaldo[i] := TFloatField.Create(CDSProcedimientos);
      vRepeticiones[i] := TIntegerField.Create(CDSProcedimientos);

      vCamposBool[i].FieldName := 'CheckBox_' + QCategorias.Fields[0].AsString;
      if CDSProcedimientos.Fields.FindField('CheckBox_' + QCategorias.Fields[0]
        .AsString) = nil then
        vCamposBool[i].DataSet := CDSProcedimientos;
      vCamposBool[i].DisplayLabel := 'Elegir';
      vCamposBool[i].OnValidate := Validate;

      vRepeticiones[i].FieldName := 'Repeticiones_' + QCategorias.Fields
        [0].AsString;
      if CDSProcedimientos.Fields.FindField('Repeticiones_' + QCategorias.Fields
        [0].AsString) = nil then
        vRepeticiones[i].DataSet := CDSProcedimientos;
      vRepeticiones[i].DisplayLabel := 'Repite';
      vRepeticiones[i].DisplayFormat := '###,###,##0';
      vRepeticiones[i].Visible := True;

      vFields[i].FieldName := QCategorias.Fields[0].AsString;
      vFields[i].ReadOnly := False;
      if CDSProcedimientos.Fields.FindField(QCategorias.Fields[0].AsString)
        = nil then
        vFields[i].DataSet := CDSProcedimientos;
      vFields[i].DisplayLabel := 'Procedimiento';

      vCodigoProc[i].FieldName := 'Codigo_' + QCategorias.Fields[0].AsString;
      if CDSProcedimientos.Fields.FindField('Codigo_' + QCategorias.Fields[0]
        .AsString) = nil then
        vCodigoProc[i].DataSet := CDSProcedimientos;
      vCodigoProc[i].DisplayLabel := 'Codigo';
      vCodigoProc[i].Visible := True;

      vValorProc[i].FieldName := 'Valor_' + QCategorias.Fields[0].AsString;
      if CDSProcedimientos.Fields.FindField('Valor_' + QCategorias.Fields[0]
        .AsString) = nil then
        vValorProc[i].DataSet := CDSProcedimientos;
      vValorProc[i].DisplayLabel := 'Valor';
      vValorProc[i].DisplayFormat := '###,###,##0.00';
      vValorProc[i].OnChange := CDSProcedimientosValor_Change;
      vValorProc[i].Visible := True;

      vCopago[i].FieldName := 'Copago_' + QCategorias.Fields[0].AsString;
      if CDSProcedimientos.Fields.FindField('Copago_' + QCategorias.Fields[0]
        .AsString) = nil then
        vCopago[i].DataSet := CDSProcedimientos;
      vCopago[i].DisplayLabel := 'Cop./Part.';
      vCopago[i].DisplayFormat := '###,###,##0.00';
      vCopago[i].Visible := True;

      vAbono[i].FieldName := 'Abono_' + QCategorias.Fields[0].AsString;
      if CDSProcedimientos.Fields.FindField('Abono_' + QCategorias.Fields[0]
        .AsString) = nil then
        vAbono[i].DataSet := CDSProcedimientos;
      vAbono[i].DisplayLabel := 'Abono';
      vAbono[i].DisplayFormat := '###,###,##0.00';
      vAbono[i].Visible := True;

      vNeto[i].FieldName := 'Neto_' + QCategorias.Fields[0].AsString;
      vNeto[i].FieldKind := fkCalculated;
      if CDSProcedimientos.Fields.FindField('Neto_' + QCategorias.Fields[0]
        .AsString) = nil then
        vNeto[i].DataSet := CDSProcedimientos;
      vNeto[i].DisplayLabel := 'Neto';
      vNeto[i].DisplayFormat := '###,###,##0.00';
      vNeto[i].Visible := True;

      vSaldo[i].FieldName := 'Saldo_' + QCategorias.Fields[0].AsString;
      vSaldo[i].FieldKind := fkCalculated;
      if CDSProcedimientos.Fields.FindField('Saldo_' + QCategorias.Fields[0]
        .AsString) = nil then
        vSaldo[i].DataSet := CDSProcedimientos;
      vSaldo[i].DisplayLabel := 'Saldo';
      vSaldo[i].DisplayFormat := '###,###,##0.00';
      vSaldo[i].Visible := True;

      Inc(I);

      QCategorias.Next;
    end;

    try
      CDSProcedimientos.Close;
      CDSProcedimientos.CreateDataSet;
    except
    end;

    // CDSProcedimientos.Close;
    CDSProcedimientos.Open;

    QProcedimiento.DisableControls;
    try
      QProcedimiento.First;
      while not QProcedimiento.EOF do
      begin
        if BuscaLinea(QProcedimiento.Fields[0].AsString) <> nil then
          CDSProcedimientos.Edit
        else
          CDSProcedimientos.Append;

        CDSProcedimientos.FieldByName(QProcedimiento.Fields[0].AsString)
          .AsString := QProcedimiento.Fields[1].AsString;

        CDSProcedimientos.FieldByName('CheckBox_' + QProcedimiento.Fields[0]
          .AsString).AsBoolean := False;

        CDSProcedimientos.FieldByName('Codigo_' + QProcedimiento.Fields[0]
          .AsString).AsInteger := QProcedimiento.Fields[2].AsInteger;

        CDSProcedimientos.FieldByName('Valor_' + QProcedimiento.Fields[0]
          .AsString).AsFloat := QProcedimiento.Fields[3].AsFloat;

        // CDSProcedimientos.FieldByName('Copago_' + QProcedimiento.Fields[0]
        // .AsString).AsFloat := 0;

        CDSProcedimientos.FieldByName('Abono_' + QProcedimiento.Fields[0]
          .AsString).AsFloat := 0;

        CDSProcedimientos.FieldByName('Neto_' + QProcedimiento.Fields[0]
          .AsString).AsFloat := 0;

        CDSProcedimientos.FieldByName('Saldo_' + QProcedimiento.Fields[0]
          .AsString).AsFloat := 0;

        CDSProcedimientos.FieldByName('Repeticiones_' + QProcedimiento.Fields[0]
          .AsString).AsFloat := 1;

        CDSProcedimientos.Post;
        QProcedimiento.Next;
      end;
      CDSProcedimientos.First;
    finally
      QProcedimiento.EnableControls;
    end;

    for I := 0 to DBGCategoria.Columns.Count - 1 do
    begin
      if (Pos('CheckBox_', DBGCategoria.Columns[i].FieldName) = 0) and
        (Pos('Copago_', DBGCategoria.Columns[i].FieldName) = 0) and
        (Pos('Abono_', DBGCategoria.Columns[i].FieldName) = 0) and
        (Pos('Repeticiones_', DBGCategoria.Columns[i].FieldName) = 0) and
        (Pos('Valor_', DBGCategoria.Columns[i].FieldName) = 0) then
        DBGCategoria.Columns[i].ReadOnly := True;
    end;
  finally
    QCategorias.Free;
    QProcedimiento.Free;
  end;
  DBGCategoria.Columns[0].Title.Caption := 'Elegir';
  DBGCategoria.Columns[1].Alignment := taCenter;
  DBGCategoria.Columns[3].Alignment := taCenter;
  DBGCategoria.Columns[4].Alignment := taCenter;
  DBGCategoria.Columns[5].Alignment := taCenter;
  DBGCategoria.Columns[6].Alignment := taCenter;
  DBGCategoria.Columns[7].Alignment := taCenter;
  DBGCategoria.Columns[8].Alignment := taCenter;
end;

Si me permites quisiera hacer los siguientes comentarios

{1}: Estas liberando el objeto CDSProcedimientos, esto es eliminar todos los campos persistentes que podría tener definido.
{2}: Estas creando un nuevo objeto CDSProcedimientos, sin ningún campo persistente
{3}: Estas creando un nuevo dataset vacío, para agregar registros a el, pero no haz definido los campos que contiene.
{4}: Debería ir el código que define los campos del dataset antes de llamar al Createdataset

Código Delphi [-]
...
  CDSProcedimientos.Free; {1}

  CDSProcedimientos := TClientDataSet.Create(Self); {2}
  CDSProcedimientos.OnCalcFields := CDSProcedimientosCalcFields;

...
    //if QCategorias.RecordCount = 0 then
    begin
      try
        CDSProcedimientos.Close;
        // CDSProcedimientos.ClearFields;
      {4}...
        CDSProcedimientos.CreateDataSet; {3}
      except
      end;

      // Abort;
    end;

...

Te adjunto un ejemplo de creación de un TClientDatset, obtenido desde TCustomClientDataSet.CreateDataSet

Código Delphi [-]
with CDS2 do
  begin
    with FieldDefs.AddFieldDef do
    begin
      DataType := ftInteger;
      Name := 'Field1';
    end;
    with FieldDefs.AddFieldDef do
    begin
      DataType := ftString;
      Size := 10;
      Name := 'Field2';
    end;
    with IndexDefs.AddIndexDef do
    begin
      Fields := 'Field1';
      Name := 'IntIndex';
    end;
    CreateDataSet;
  end;

Saludos cordiales

Mil gracias cloayza por tu tiempo y colaboracion.
Ahora mismo hago esa revision y cambio las cosas. sinembargo me queda una inquietud. Esos comentarios acertados que me haces si tienen como consecuencia un "Out Of Memory"; por que antes de los 100 mil registros aun estando igual no daba ese error. Gracias Amigo cloayza

Ademas, este tipo de procesos es mas rapido si se ejecuta dentro del motor de SQL y usando SQL.

Que motor usas?

Yo creo que tu problema no es la base de datos si no que los arrays que tienes, están almacenando todos los registros en ellos y te quedaste sin memoria.

Y porque no mides la memoria? Puedes usar el monitor de rendimiento para ello.

Y el porque antes si y ahora no?

Porque antes lo que hacias cabia en memoria, pero le subiste 1 y ya no. La memoria es finita.

Hola Manuel mil gracias por tu aporte.
yo tambien me encamino por ahi, creo que el problema real esta en lo que planteas. desafortunadamente no se como particionarlo o segmentarlo. solo y es solo si tuvieras el tiempo de echarme una manito con una orientacion te prometo que estudio y lo saco adelante. gracias.

Hola mi compatriota mil gracias por tu apoyo.
Resulta que esta base de datos era en Paradox Pero migre a Firebird y no he tenido el tiempo para cambiar todos los Componentes BDE y cambiar la programacion ajustado los procedimientos al Firebird. Entonces es un hibrido ahi raro de BD firebird con componentes BDE y algunas tablas y querys que he logrado modernizar con componentes IBX. Espero una manita en este asunto

El asunto es que el código es un spaguetti, y optimizarlos es... re escribirlo.

Por seguro, cuando un código es simple es generalmente eficiente, y es más fácil de optimizar.

En terminos generales, deberias poder visualizar el codigo siguiendo esta idea:

La idea es que cuando llegues a la GUI, tengas los datos estructurados de forma tal que solo tengas que hacer transformaciones de visualizacion esteticas o ajustar al idioma/locale del usuario.

Esto se llama un pipeline de datos o linea de datos.

Pregunta, ¿para que cargas en un array lo datos?, eso nos podría dar luces.

Gracias mamcx lo tendre en cuenta para cuando cambie toda la metodologia de ese programa. Gracias

Hola Manuel. Cuando quiero introducir un registro mas una vez (siendo identico) entonces lo cargo y con una funioncilla que hay por ahi inmersa en el codigo lo repito las veces que yo le indique. Por ejemplo: Ape1, ape2, Nom1, Nom2, Codigo, Procedimiento, valor..... esa informacion la cargo la repito 5 veces. Es por eso. Con el primero no da lio lo graba bien a partir del segundo es que ouchhhh.... el error.

No se te entiende bien lo que dices. Seria mejor que pusieras un ejemplo con datos.