Al González
03-06-2012, 23:55:44
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:
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í.
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.
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:
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í.
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.