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
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;
Function TFixedClientDataSet.CheckStatus (Const Status, Value :DBResult)
:Boolean;
Begin
If Status = Value Then
Result := True
Else
Begin
Check (Status); Result := False; 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;
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;
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
AuxCursor := CreateCursor;
SetBaseOrder (AuxCursor);
Check (AuxCursor.MoveToEOF);
CheckStatus (AuxCursor.MoveRelative (-1), dberr_BOF);
Inherited AddDataPacket (Data, HitEOF);
If Not CheckStatus (AuxCursor.MoveRelative (1), dberr_EOF) Then
Begin
FirstRec := CursorRecNumber (AuxCursor);
FieldDescs := GetFieldDescs;
For I := 0 To High (FieldDescs) Do
If FieldDescs [i].bCalculated Then
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.