Prueba y solución de problema en MIDAS: falta de "blank flag" tras AppendData.

[[Al González]]

Hola amigos.

La clase TClientDataSet posee un método para añadir al conjunto de datos los registros contenidos en un OLEVariant, del tal manera que puede ser utilizado para copiar los registros de un TClientDataSet a otro:

Código Delphi [-]
CDS1.AppendData (CDS2.Data, True);

Cabe decir que la función para la cual fue diseñado originalmente no es copiar filas entre conjuntos de datos clientes, sino agregar los registros provenientes de un objeto proveedor. Sin embargo, tanto estos registros como la propiedad Data de TClientDataSet vienen bajo el mismo formato: un data packet. De ahí que pueda ejecutarse una sentencia como la anterior (se agregan los registros que están en CDS2 al contenido actual de CDS1).

No copia los campos de tipo fkInternalCalc, lo cual es normal, porque un proveedor no proporciona valores para campos que solamente existen del lado cliente.

El problema es que después de varias llamadas al método AppendData de una misma instancia TClientDataSet, los campos InternalCalc de los registros agregados, que deberían estar en blanco (propiedad IsNull regresando True), aparecen con valor (un 0 para los de tipo Integer y valores que suelen producir excepciones en campos que requieren transformación como TDateTimeField). A los campos InternalCalc, en esos registros recientemente agregados, MIDAS "olvida" asignar cierta bandera especial para señalarlos como carentes de valor (nulos).

Hace tiempo elaboré una "corrección" a esta circunstancia, para que toda llamada a AppendData haga que los campos InternalCalc de los registros nuevos tengan esa bandera debidamente asignada. Esto en Delphi 7 y revisado ya en la versión 2007.

No he tenido oportunidad de probarla en versiones posteriores, por lo cual recurro a su amable disposición para asegurar que esto compile y funcione en tales versiones. No le había dado demasiada importancia hasta que hace algunas semanas me contactó un colega de Polonia planteando la necesidad de una solución en Delphi 2010 (descubrí que no soy el único que ha hecho AppendData con campos InternalCalc :p).

Al final de este mensaje aparece un pequeño proyecto Delphi. Pueden descargarlo, descomprimirlo y ejecutarlo en las versiones más recientes que tengan, todo lo que hay que hacer es oprimir un botón varias veces. Les estaré agradecido. :)

El siguiente es el código de la solución (incluido en el archivo anexo). Lo escribí hace tiempo como parte de Magia Data, pero he logrado aislar lo que concierne solamente a lo planteado aquí.

Código Delphi [-]
Uses
  DBClient, DSIntf;

Const
  { Error codes.  This constants are based on native error codes used
    internally by MIDAS. }
  errBase_InvalidReq = $2700;
  errCode_OutOfRange = 1;
  dberr_OutOfRange = errBase_InvalidReq + errCode_OutOfRange;

Type
  TFixedClientDataSet = Class (TClientDataSet)
    Protected
      Function CheckStatus (Const Status, Value :DBResult) :Boolean;
      Function CreateCursor :IDSCursor;
      Function CursorRecNumber (Const Cursor :IDSCursor) :Cardinal;
      Function GetFieldDescs :TFieldDescList;
      Procedure SetBaseOrder (Const Cursor :IDSCursor);
      Procedure AddDataPacket (Const Data :OLEVariant; HitEOF :Boolean);
        Override;
  End;

  { TFixedClientDataSet implementation }

  Function TFixedClientDataSet.CheckStatus (Const Status, Value :DBResult)
    :Boolean;
  Begin
    If Status = Value Then
      Result := True
    Else
    Begin
      Check (Status);  // Exception if Status <> 0
      Result := False;  // Status = 0
    End;
  End;

  Function TFixedClientDataSet.CreateCursor :IDSCursor;
  Begin
    CreateDbClientObject (ClsID_DSCursor, IDSCursor, Result);
    Result.InitCursor (DSBase);
  End;

  Function TFixedClientDataSet.CursorRecNumber (Const Cursor :IDSCursor)
    :Cardinal;
  Begin
    Check (Cursor.GetRecordNumber (Result));
  End;

  // Based on TCustomClientDataSet.InternalInitFieldDefs method
  Function TFixedClientDataSet.GetFieldDescs :TFieldDescList;
  Var
    Props :DSProps;
  Begin
    DSBase.SetProp (dspropCompressArrays, 1);
    DSBase.GetProps (Props);
    SetLength (Result, Props.iFields);
    DSBase.GetFieldDescs (PDSFldDesc (Result));
  End;

  Procedure TFixedClientDataSet.SetBaseOrder (Const Cursor :IDSCursor);
  Const
    BaseOrder = '_BaseOrder';
  Var
    Index :DSIDXDesc;

    Function Activate :DBResult;
    Begin
      Result := Cursor.UseIndexOrder (BaseOrder);
    End;
  Begin
    If Not CheckStatus (Activate, dberr_NoSuchIndex) Then
      Exit;

    { We add the "natural" base index (rows as they were created/appended).
      NOTE: the default order (szDefault_Order) is not necessarily equal to
      this "base order". }
    ZeroMemory (@Index, SizeOf (Index));
    StrLCopy (Index.szName, BaseOrder, SizeOf (Index.szName) - 1);
    Check (DSBase.CreateIndex (Index));

    Check (Activate);
  End;

  Procedure TFixedClientDataSet.AddDataPacket (Const Data :OLEVariant;
    HitEOF :Boolean);
  Var
    AuxCursor :IDSCursor;
    FieldDescs :TFieldDescList;
    FirstRec, I, J :Integer;
  Begin
    { NOTE: The IDSBase.AppendData method does not copy internally
      calculated fields, but, if called multiple times, it sets their
      "blank" flag incorrectly (MIDAS bug).  We correct this problem, by
      activating that flag on the added records. }

    { We need a clean cursor (not filtered or ranged) in "base order",
      with the purpose of to get the internal record number of the first
      row added }
    AuxCursor := CreateCursor;
    SetBaseOrder (AuxCursor);
    Check (AuxCursor.MoveToEOF);

    // Current last record (or BOF if the cursor is empty)
    CheckStatus (AuxCursor.MoveRelative (-1), dberr_BOF);

    // We append the row packet to internal record list
    Inherited AddDataPacket (Data, HitEOF);

    // Go to first record added (if there is one)
    If Not CheckStatus (AuxCursor.MoveRelative (1), dberr_EOF) Then
    Begin
      FirstRec := CursorRecNumber (AuxCursor);
      FieldDescs := GetFieldDescs;  // Field descriptors

      For I := 0 To High (FieldDescs) Do
        If FieldDescs [i].bCalculated Then  // InternalCalc field
          { From the first record added up to the last one + 1 (the limit
            for the IDSBase.PutBlank method is the internal "iRecNoNext"
            index), we put the field to "blank" by simply activating its
            blank flag in each record }
          For J := FirstRec To MaxInt Do
            If CheckStatus (DSBase.PutBlank (Nil, J,
            FieldDescs [i].iFieldID, 1), dberr_OutOfRange) Then
              Break;
    End;
  End;

Ojalá no tenga mayores problemas en las tres o cuatro versiones más recientes de Delphi. Muchas gracias.

Al González.

[Casimiro Notevi]

No tengo versiones más modernas de delphi, pero me apunto a este tema para seguirlo
Por cierto, me parece un trabajo extraordinario.

[[ElKurgan]]

Pues acabo de probarlo en Delphi XE2 y a la tercera pulsación aparece el cero en los campos calculados. Eso si, ha compilado a la primera

Un saludo

[[Al González]]

Muchas gracias, ElKurgan. Eso quiere decir que la anomalía sigue presente en las últimas versiones de MIDAS (asumo que usas el propio MIDAS.dll / MIDASLib.dcu de Delphi XE2).

Bien, notarás que la rejilla del lado derecho muestra los resultados de la misma operación, pero aplicando el parche. Por lo tanto en ella no deben aparecer esos ceros, ¿podrías confirmarlo?

Saludos.

[[ElKurgan]]

Confirmado. En la derecha aparece correctamente

Espero haberte ayudado.

Un saludo

[[Al González]]

Empezado por ElKurgan

Confirmado. En la derecha aparece correctamente

Espero haberte ayudado.

Sí, bastante. Muchas gracias.

Queda esto para quien pueda necesitarlo.

[novato_erick]

Hola Al González

Al final de este mensaje aparece un pequeño proyecto Delphi. Pueden descargarlo, descomprimirlo y ejecutarlo en las versiones más recientes que tengan, todo lo que hay que hacer es oprimir un botón varias veces. Les estaré agradecido.

Por cierto no le he encontrado para descargar tu proyecto ya que necesito algo parecido a lo que describes en el post...


Saludos

novato_erick

[[Al González]]

Mil disculpas, Erick. Hace poco se saturó mi cuota de archivos adjuntos y creo que borré por accidente el ZIP que había anexado al primer mensaje.

Acabo de poner ese proyecto en el FTP del club para mayor facilidad de descarga: http://terawiki.clubdelphi.com/Delph...a_NullFlag.zip

Por cierto, esta mejora está también en el componente TghClientDataSet. De hecho de ahí proviene.

[novato_erick]

Agradezco tu ayuda Al... Personas como usted hacen recordar el verdadero valor de amar nuestra profesión.....

Saludos

novato_erick

[[Al González]]

Un placer, Erick.

No estaría mal que nos compartieras algo de contexto sobre lo que andas haciendo con MIDAS.