786 lines
31 KiB
ObjectPascal
786 lines
31 KiB
ObjectPascal
unit ORMCDS;
|
|
|
|
interface
|
|
|
|
uses Data.DB,DBClient,mORMot,SynCommons,RTTI,TypInfo,Classes;
|
|
|
|
(*2014/12/01 - Version 1
|
|
|
|
TODO:
|
|
Ordered/(multi?)-Indexed or Ordered Arrays with TIDs
|
|
TADTFields for SETs?
|
|
*)
|
|
|
|
(*This is Info record that will be attached to root CDS .Tag and to each nested dataset (array or sub-TSQLRecord list) to
|
|
BOTH the TDatasetField.Tag and it's detail TClientdataset.Tag.
|
|
*)
|
|
|
|
type TORMCDSinfo = class(TObject)
|
|
public
|
|
CDS : TClientdataset; (*Nested TClientdataset*)
|
|
SQLRecordClass : TSQLRecordClass;(*IF it's SubList (not array), contain type*)
|
|
RecordTypeInfo : PTypeInfo; (*IF it';s array (not sublist, contain DynArray PTypeInfo*)
|
|
|
|
DatasetField : TDatasetField; (*Master CDS.TDatasetField*)
|
|
LinkField : RawUTF8; (*If it's SubList (not array), contain link field name that will be =MasterSQLRecord.ID*)
|
|
|
|
{ArrayKeyFields : RawUTF8;
|
|
ArrayOrdered : Boolean;}
|
|
(*Implement array comparing routines to handle key-fields in arrays and ordering
|
|
for finer-grained 'not touching' array elements when applying updates.
|
|
At the moment, when SAVEing, all array items are directly compared and overwritten if different from CDS*)
|
|
|
|
function IsArrayLink:Boolean;
|
|
end;
|
|
|
|
(*Attempt to create TField descentdants and nested Fields (for arrays) in the CDS*)
|
|
procedure ORM_CreateCDSFields(CDS:TClientdataset;AName:RawUTF8;ATypeInfo:PTypeInfo);
|
|
(*Add a TSQLRecord sub-class that is linked via DetailSQLrecord.ALinkField=MasterSQLRecord.ID*)
|
|
procedure ORM_AddSubField (CDS:TClientdataset;AFieldName,ALinkField:RawUTF8;AClass:TSQLRecordClass);overload;
|
|
(*Add a Dynamic Arrray nested field*)
|
|
procedure ORM_AddSubField (CDS:TClientdataset;AFieldName:RawUTF8;ADynArrayType:PTypeInfo);overload;
|
|
procedure ORM_LoadCDSFields (DB:TSQLRest;CDS:TClientdataset;AName:RawUTF8;AValue:TValue);
|
|
function ORM_SaveCDSFields (DB:TSQLRest;CDS:TClientdataset;AName:RawUTF8;var AValue:TValue;AForceUpdate:Boolean):Integer;
|
|
|
|
(*Link existing TClientdataset by creating TORMCDSinfo record.*)
|
|
procedure ORM_LinkCDS(ASourceCDS:TClientDataset;ATypeInfo:PTypeInfo;ALinkField:RawUTF8);
|
|
(*Free TORMCDSinfo record info, alternatively free dynamically created TClientdatasets*)
|
|
procedure ORM_FreeCDSInfo(CDS:TClientdataset;AFreeCDS:Boolean);
|
|
procedure ORM_LoadData(CDS:TClientdataset;aClient: TSQLRest;FormatSQLWhere: PUTF8Char;const BoundsSQLWhere: array of const;const aCustomFieldsCSV: RawUTF8='');
|
|
procedure ClearCDS(CDS:TClientDataset);
|
|
|
|
implementation
|
|
|
|
uses SysUtils,Datasnap.Provider;
|
|
|
|
procedure ClearCDS(CDS:TClientDataset);
|
|
begin;
|
|
if CDS.Active
|
|
then begin
|
|
CDS.EmptyDataSet;
|
|
CDS.Close;
|
|
end;
|
|
CDS.DataSetField:=nil;
|
|
CDS.Fields.Clear;
|
|
CDS.FieldDefs.Clear;
|
|
CDS.IndexDefs.Clear;
|
|
CDS.Params.Clear;
|
|
CDS.Aggregates.Clear;
|
|
CDS.IndexName := '';
|
|
CDS.IndexFieldNames := '';
|
|
end;
|
|
|
|
procedure ORM_LinkCDS(ASourceCDS:TClientDataset;ATypeInfo:PTypeInfo;ALinkField:RawUTF8);
|
|
var OInfo : TORMCDSinfo;
|
|
Field : TField;
|
|
I : Integer;
|
|
Cln : TClientdataset;
|
|
begin
|
|
OInfo:=TORMCDSinfo.Create;
|
|
OInfo.CDS:=ASourceCDS;
|
|
case ATypeInfo.Kind of
|
|
tkClass : begin
|
|
{$IFDEF DEBUG}
|
|
if not GetTypeData(ATypeInfo).ClassType.InheritsFrom(TSQLRecord)
|
|
then raise Exception.Create('ErrorMessage22');
|
|
{$ENDIF DEBUG}
|
|
OInfo.SQLRecordClass:=TSQLRecordClass(GetTypeData(ATypeInfo).ClassType);
|
|
OInfo.DatasetField :=ASourceCDS.DataSetField;
|
|
if ASourceCDS.DataSetField<>nil
|
|
then OInfo.LinkField:=ALinkField;
|
|
end;
|
|
tkDynArray:begin
|
|
if (ATypeInfo^.Kind<>tkDynArray)
|
|
then raise Exception.Create('ErrorMessage65');
|
|
OInfo.RecordTypeInfo:=ATypeInfo;
|
|
end
|
|
end;
|
|
|
|
ASourceCDS.Tag:=Integer(OInfo);
|
|
if ASourceCDS.DataSetField<>nil
|
|
then begin
|
|
ASourceCDS.DataSetField.Tag:=Integer(OInfo);
|
|
end;
|
|
end;
|
|
|
|
procedure ORM_FreeCDSInfo(CDS:TClientdataset;AFreeCDS:Boolean);
|
|
var Field : TField;
|
|
OInfo : TORMCDSinfo;
|
|
begin
|
|
if (TObject(CDS.Tag) is TORMCDSinfo)
|
|
then (TObject(CDS.Tag) as TORMCDSinfo).Free;
|
|
CDS.Tag:=0;
|
|
for Field in CDS.Fields do
|
|
begin
|
|
if (Field is TDatasetField)
|
|
then begin
|
|
OInfo:=TORMCDSinfo(Field.Tag);
|
|
if Assigned(OInfo)
|
|
then ORM_FreeCDSInfo(OInfo.CDS,AFreeCDS);
|
|
Field.Tag:=0;
|
|
end;
|
|
end;
|
|
if AFreeCDS
|
|
then CDS.Free;
|
|
end;
|
|
|
|
procedure ORM_LoadData(CDS:TClientdataset;aClient: TSQLRest;
|
|
FormatSQLWhere: PUTF8Char;
|
|
const BoundsSQLWhere: array of const;
|
|
const aCustomFieldsCSV: RawUTF8='');
|
|
var qRec : TSQLRecord;
|
|
OInfo:TORMCDSinfo;
|
|
OldDisabled : Boolean;
|
|
begin
|
|
OldDisabled:=CDS.ControlsDisabled;
|
|
if not OldDisabled
|
|
then CDS.DisableControls;
|
|
|
|
CDS.LogChanges:=False;
|
|
{$IFDEF DEBUG}
|
|
if not (TObject(CDS.Tag) is TORMCDSinfo)
|
|
then raise Exception.Create('ErrorMessage118');
|
|
{$ENDIF DEBUG}
|
|
OInfo:=TORMCDSinfo(CDS.Tag);
|
|
|
|
qRec:=OInfo.SQLRecordClass.CreateAndFillPrepare(aClient,FormatSQLWhere,BoundsSQLWhere,aCustomFieldsCSV);
|
|
while qRec.FillOne do
|
|
begin
|
|
ORM_LoadCDSFields(aClient,CDS,'root',qRec);
|
|
end;
|
|
qRec.Free;
|
|
CDS.MergeChangeLog;
|
|
CDS.LogChanges:=True;
|
|
if not OldDisabled
|
|
then CDS.EnableControls;
|
|
end;
|
|
|
|
procedure ORM_CreateCDSFields(CDS:TClientdataset;AName:RawUTF8;ATypeInfo:PTypeInfo);
|
|
var Ctx : TRttiContext;
|
|
Typ : TRttiType;
|
|
Fld : TField;
|
|
Cln : TClientDataset;
|
|
I : Integer;
|
|
S : String;
|
|
RField:TRttiField;
|
|
RProp :TRttiProperty;
|
|
OInfo :TORMCDSinfo;
|
|
begin
|
|
Ctx:=TRttiContext.Create;
|
|
Typ:=Ctx.GetType(ATypeInfo);
|
|
Fld:=CDS.FindField(AName);
|
|
case Typ.TypeKind of
|
|
tkString,
|
|
tkUString,
|
|
tkLString : begin
|
|
if Fld<>nil
|
|
then exit;
|
|
Fld:=TWideStringField.Create(CDS);
|
|
Fld.Name :=CDS.Name+AName;
|
|
Fld.FieldName:=AName;
|
|
Fld.DataSet:=CDS;
|
|
end;
|
|
tkInteger : begin
|
|
if Fld<>nil
|
|
then exit;
|
|
Fld:=TIntegerField.Create(CDS);
|
|
Fld.Name :=CDS.Name+AName;
|
|
Fld.FieldName:=AName;
|
|
Fld.DataSet:=CDS;
|
|
end;
|
|
tkEnumeration: begin
|
|
{???}{Maybe create a lookupfield?}
|
|
if Fld<>nil
|
|
then exit;
|
|
Fld:=TIntegerField.Create(CDS);
|
|
Fld.Name :=CDS.Name+AName;
|
|
Fld.FieldName:=AName;
|
|
Fld.DataSet:=CDS;
|
|
end;
|
|
tkSet : begin
|
|
case TRttiSetType(typ).ElementType.TypeKind of
|
|
tkEnumeration : begin
|
|
for I := TRttiEnumerationType(TRttiSetType(Typ).ElementType).MinValue to TRttiEnumerationType(TRttiSetType(Typ).ElementType).MaxValue do
|
|
begin
|
|
S:=GetEnumName(TRttiSetType(Typ).ElementType.Handle,I);
|
|
Fld:=CDS.FindField(AName+'_'+S);
|
|
if Fld<>nil
|
|
then exit;
|
|
Fld:=TBooleanField.Create(CDS);
|
|
Fld.Name :=CDS.Name+AName+'_'+S;
|
|
Fld.FieldName:=AName+'_'+S;
|
|
Fld.DataSet:=CDS;
|
|
end;
|
|
end
|
|
else raise Exception.Create('Error Message')
|
|
end;
|
|
end;
|
|
tkFloat : begin
|
|
if Fld<>nil
|
|
then exit;
|
|
Fld:=TFloatField.Create(CDS);
|
|
Fld.Name :=CDS.Name+AName;
|
|
Fld.FieldName:=AName;
|
|
Fld.DataSet:=CDS;
|
|
end;
|
|
tkInt64 : begin
|
|
if Fld<>nil
|
|
then exit;
|
|
Fld:=TLargeintField.Create(CDS);
|
|
Fld.Name :=CDS.Name+AName;
|
|
Fld.FieldName:=AName;
|
|
Fld.DataSet:=CDS;
|
|
end;
|
|
tkDynArray : begin
|
|
ORM_AddSubField (CDS,AName,TRttiDynamicArrayType(Typ).ElementType.Handle);
|
|
end;
|
|
tkRecord : begin
|
|
for RField in Typ.GetFields do
|
|
ORM_CreateCDSFields(CDS,RField.Name,RField.FieldType.Handle);
|
|
end;
|
|
tkClass : begin
|
|
if CDS.Tag=0
|
|
then begin(*Root CDS, create Info*)
|
|
OInfo:=TORMCDSinfo.Create;
|
|
OInfo.CDS:=CDS;
|
|
OInfo.SQLRecordClass:=TSQLRecordClass(TRttiInstanceType(Typ).MetaclassType);
|
|
CDS.Tag:=Integer(OInfo);
|
|
end;
|
|
|
|
for RProp in Typ.GetProperties do
|
|
begin
|
|
if RProp.IsWritable
|
|
then ORM_CreateCDSFields(CDS,RProp.Name,RProp.PropertyType.Handle);
|
|
end;
|
|
end
|
|
else raise Exception.Create('Error Message');
|
|
end;
|
|
Ctx.Free;
|
|
end;
|
|
|
|
procedure ORM_AddSubField (CDS:TClientdataset;AFieldName,ALinkField:RawUTF8;AClass:TSQLRecordClass);
|
|
var OInfo : TORMCDSinfo;
|
|
begin
|
|
OInfo:=TORMCDSinfo.Create;
|
|
OInfo.DatasetField:=TDatasetField.Create(CDS);
|
|
OInfo.DatasetField.Name :=CDS.Name+AFieldName;
|
|
OInfo.DatasetField.FieldName:=AFieldName;
|
|
OInfo.DatasetField.DataSet :=CDS;
|
|
|
|
OInfo.CDS :=TClientDataset.Create(CDS.Owner);
|
|
OInfo.CDS.Name:=AFieldName;
|
|
OInfo.CDS.DataSetField :=TDatasetField(OInfo.DatasetField);
|
|
|
|
OInfo.LinkField :=ALinkField;
|
|
OInfo.SQLRecordClass :=AClass;
|
|
|
|
OInfo.DatasetField.Tag:=Integer(OInfo);
|
|
OInfo.CDS .Tag:=Integer(OInfo);
|
|
|
|
ORM_CreateCDSFields(OInfo.CDS,AFieldName,AClass.ClassInfo);
|
|
end;
|
|
|
|
procedure ORM_AddSubField (CDS:TClientdataset;AFieldName:RawUTF8;ADynArrayType:PTypeInfo);
|
|
var OInfo:TORMCDSinfo;
|
|
begin
|
|
OInfo:=TORMCDSinfo.Create;
|
|
OInfo.DatasetField:=TDatasetField.Create(CDS);
|
|
OInfo.DatasetField.Name :=CDS.Name+AFieldName;
|
|
OInfo.DatasetField.FieldName:=AFieldName;
|
|
OInfo.DatasetField.DataSet :=CDS;
|
|
|
|
OInfo.CDS :=TClientDataset.Create(CDS.Owner);
|
|
OInfo.CDS.Name:=AFieldName;
|
|
OInfo.CDS.DataSetField :=TDatasetField(OInfo.DatasetField);
|
|
|
|
OInfo.RecordTypeInfo :=ADynArrayType;
|
|
|
|
ORM_CreateCDSFields(OInfo.CDS,AFieldName,ADynArrayType);
|
|
|
|
OInfo.DatasetField.Tag:=Integer(OInfo);
|
|
OInfo.CDS .Tag:=Integer(OInfo);
|
|
end;
|
|
|
|
procedure ORM_LoadCDSFields(DB:TSQLRest;CDS:TClientdataset;AName:RawUTF8;AValue:TValue);
|
|
var Ctx : TRttiContext;
|
|
Typ : TRttiType;
|
|
Fld : TField;
|
|
I : Integer;
|
|
S : String;
|
|
RField:TRttiField;
|
|
RProp :TRttiProperty;
|
|
BValue: TValue;
|
|
Obj : TObject;
|
|
DA : TDynArray;
|
|
Rec : TSQLRecord;
|
|
I64 : TID;
|
|
RSTR : PUTF8Char;
|
|
OInfo : TORMCDSinfo;
|
|
begin
|
|
Fld:=CDS.FindField(AName);
|
|
{ if Fld=nil
|
|
then exit;}
|
|
|
|
Ctx:=TRttiContext.Create;
|
|
Typ:=Ctx.GetType(AValue.TypeInfo);
|
|
case Typ.TypeKind of
|
|
tkString,
|
|
tkUString,
|
|
tkLString : begin
|
|
Fld.AsString:=AValue.AsString;
|
|
end;
|
|
tkInteger : begin
|
|
Fld.AsInteger:=AValue.AsInteger;
|
|
end;
|
|
tkEnumeration: begin
|
|
Fld.AsVariant:=Integer(AValue.GetReferenceToRawData^);
|
|
end;
|
|
tkSet : begin
|
|
case TRttiSetType(typ).ElementType.TypeKind of
|
|
tkEnumeration : begin
|
|
I:=Integer(AValue.GetReferenceToRawData^);
|
|
for I := TRttiEnumerationType(TRttiSetType(Typ).ElementType).MinValue to TRttiEnumerationType(TRttiSetType(Typ).ElementType).MaxValue do
|
|
begin
|
|
S:=GetEnumName(TRttiSetType(Typ).ElementType.Handle,I);
|
|
Fld:=CDS.FindField(AName+'_'+S);
|
|
if Fld<>nil
|
|
then begin
|
|
if ((1 shl I) and Integer(AValue.GetReferenceToRawData^))=(1 shl I)
|
|
then Fld.AsBoolean:=True
|
|
else Fld.AsBoolean:=False;
|
|
end;
|
|
end;
|
|
end
|
|
else raise Exception.Create('Error Message')
|
|
end;
|
|
end;
|
|
tkFloat : begin
|
|
Fld.AsFloat:=AValue.AsExtended;
|
|
end;
|
|
tkInt64 : begin
|
|
Fld.AsLargeInt:=AValue.AsInt64;
|
|
end;
|
|
tkDynArray : begin
|
|
if Fld<>nil
|
|
then begin
|
|
{$IFDEF DEBUG}
|
|
if not (TObject(Fld.Tag) is TORMCDSinfo)
|
|
then raise Exception.Create('ErrorMessage256');
|
|
{$ENDIF DEBUG}
|
|
OInfo:=TORMCDSinfo(Fld.Tag);
|
|
end;
|
|
{BValue.Make(nil,TRttiDynamicArrayType(Typ).ElementType.Handle,BValue);}
|
|
for I := 0 to Pred(AValue.GetArrayLength) do
|
|
begin
|
|
BValue:=AValue.GetArrayElement(I);
|
|
OInfo.CDS.Insert;
|
|
ORM_LoadCDSFields(DB,OInfo.CDS,'Value',BValue);
|
|
{ Cln.Post;}
|
|
end;
|
|
end;
|
|
tkRecord : begin
|
|
CDS.Insert;
|
|
for RField in Typ.GetFields do
|
|
begin
|
|
BValue:=RField.GetValue(AValue.GetReferenceToRawData);
|
|
ORM_LoadCDSFields(DB,CDS,RField.Name,BValue);
|
|
end;
|
|
{ CDS.Post;}
|
|
end;
|
|
tkClass : begin
|
|
Obj:=AValue.AsObject;
|
|
CDS.Insert;
|
|
for I := 0 to Pred(CDS.Fields.Count) do
|
|
begin
|
|
if (CDS.Fields[I] is TDataSetField)
|
|
then begin
|
|
{$IFDEF DEBUG}
|
|
if not(TObject(CDS.Fields[I].Tag) is TORMCDSinfo)
|
|
then raise Exception.Create('ErrorMessage286');
|
|
{$ENDIF DEBUG}
|
|
OInfo:=TORMCDSinfo(CDS.Fields[I].Tag);
|
|
if OInfo.IsArrayLink
|
|
then begin(*Array link*)
|
|
|
|
end
|
|
else begin(*Dataset link*)
|
|
RStr:=PUTF8Char(OInfo.LinkField+' = ?');
|
|
I64 :=TSQLRecord(Obj).ID;
|
|
Rec:=OInfo.SQLRecordClass.CreateAndFillPrepare(DB,RStr,[I64]);
|
|
while Rec.FillOne do
|
|
begin
|
|
ORM_LoadCDSFields(DB,OInfo.CDS,CDS.Fields[I].FieldName,Rec);
|
|
end;
|
|
Rec.Free;
|
|
continue;
|
|
end;
|
|
end;
|
|
RProp:=Typ.GetProperty(CDS.Fields[I].FieldName);
|
|
if RProp<>nil
|
|
then begin
|
|
(*BValue.Make(nil,RProp.PropertyType.Handle,BValue);*)
|
|
BValue:=RProp.GetValue(AValue.AsObject);
|
|
ORM_LoadCDSFields(DB,CDS,RProp.Name,BValue);
|
|
end;
|
|
end;
|
|
end
|
|
else raise Exception.Create('Error Message');
|
|
end;
|
|
Ctx.Free;
|
|
end;
|
|
|
|
function ORM_SaveCDSFields(DB:TSQLRest;CDS:TClientdataset;AName:RawUTF8;var AValue:TValue;AForceUpdate:Boolean):Integer;
|
|
(*AForceUpdate introduced to force update on usInserted record as TClientdataset does not always reflect OldValue=null on newly inserted record but rather OldValue=NewValue*)
|
|
var Ctx : TRttiContext;
|
|
Typ : TRttiType;
|
|
Fld : TField;
|
|
I,I2: Integer;
|
|
S : String;
|
|
RField:TRttiField;
|
|
RProp :TRttiProperty;
|
|
BValue: TValue;
|
|
Obj : TObject;
|
|
DA : TDynArray;
|
|
Rec : TSQLRecord;
|
|
I64 : TID;
|
|
RSTR : PUTF8Char;
|
|
PDS : TPacketDataSet;
|
|
Changed:Integer;
|
|
OInfo,
|
|
BInfo : TORMCDSinfo;
|
|
ArrLen : NativeInt;
|
|
P,PP : Pointer;
|
|
US : TUpdateStatus;
|
|
begin
|
|
Result:=0;
|
|
Fld:=CDS.FindField(AName);
|
|
{ if Fld=nil
|
|
then exit;}
|
|
|
|
Ctx:=TRttiContext.Create;
|
|
Typ:=Ctx.GetType(AValue.TypeInfo);
|
|
case Typ.TypeKind of
|
|
tkString,
|
|
tkLString : begin
|
|
if not AForceUpdate and (Fld.OldValue=Fld.NewValue)
|
|
then exit;
|
|
Inc(Result);
|
|
AValue:=Fld.AsString;
|
|
end;
|
|
tkInteger : begin
|
|
if not AForceUpdate and (Fld.OldValue=Fld.NewValue)
|
|
then exit;
|
|
Inc(Result);
|
|
AValue:=Fld.AsInteger;
|
|
end;
|
|
tkEnumeration: begin
|
|
if not AForceUpdate and (Fld.OldValue=Fld.NewValue)
|
|
then exit;
|
|
Inc(Result);
|
|
|
|
case Fld.DataType of
|
|
ftInteger: Integer(AValue.GetReferenceToRawData^):=Fld.AsInteger;
|
|
ftBoolean: Boolean(AValue.GetReferenceToRawData^):=Fld.AsBoolean
|
|
else raise Exception.Create('ErrorMessage429');
|
|
end;
|
|
end;
|
|
tkSet : begin
|
|
Inc(Result);
|
|
I:=Integer(AValue.GetReferenceToRawData^);
|
|
case TRttiSetType(typ).ElementType.TypeKind of
|
|
tkEnumeration : begin
|
|
I2:=0;
|
|
for I := TRttiEnumerationType(TRttiSetType(Typ).ElementType).MinValue to TRttiEnumerationType(TRttiSetType(Typ).ElementType).MaxValue do
|
|
begin
|
|
S:=GetEnumName(TRttiSetType(Typ).ElementType.Handle,I);
|
|
Fld:=CDS.FindField(AName+'_'+S);
|
|
if Fld<>nil
|
|
then begin
|
|
if Fld.AsBoolean
|
|
then I2:=I2 or (1 shl I);
|
|
end;
|
|
end;
|
|
if AForceUpdate or (I2<>Integer(AValue.GetReferenceToRawData^))
|
|
then begin
|
|
Inc(Result);
|
|
Integer(AValue.GetReferenceToRawData^):=I2;
|
|
end;
|
|
end
|
|
else raise Exception.Create('Error Message')
|
|
end;
|
|
end;
|
|
tkFloat : begin
|
|
if not AForceUpdate and (Fld.OldValue=Fld.NewValue)
|
|
then exit;
|
|
Inc(Result);
|
|
AValue:=Fld.AsFloat;
|
|
end;
|
|
tkInt64 : begin
|
|
if not AForceUpdate and (Fld.OldValue=Fld.NewValue)
|
|
then exit;
|
|
Inc(Result);
|
|
AValue:=Fld.AsLargeInt;
|
|
end;
|
|
tkDynArray : begin
|
|
if Fld=nil
|
|
then exit;
|
|
BInfo:=TORMCDSinfo(Fld.Tag);
|
|
BValue.Make(nil,TRttiDynamicArrayType(Typ).ElementType.Handle,BValue);
|
|
I:=AValue.GetArrayLength;
|
|
P :=PPointer(AValue.GetReferenceToRawData)^;
|
|
if I<>BInfo.CDS.RecordCount
|
|
then begin
|
|
Inc(Result);
|
|
{ ArrLen:=0;
|
|
DynArraySetLength(P,Typ.Handle,1,@ArrLen);}
|
|
|
|
(***************METHOD A *************************)
|
|
DA.Init(Typ.Handle,P);
|
|
I:=DA.Count;
|
|
DA.Count:=I+1;
|
|
I:=DA.Count;
|
|
(*************************************************)
|
|
|
|
|
|
(***************METHOD B *************************)
|
|
{ ArrLen:=BInfo.CDS.RecordCount;
|
|
DynArraySetLength(P,Typ.Handle,1,@ArrLen);}
|
|
(*************************************************)
|
|
|
|
AValue.Make(@P,Typ.Handle,AValue);(*Seems here old array in AValue is not dereferenced, causing memory leaks*)
|
|
I:=AValue.GetArrayLength;
|
|
(*I:=DA.Count;*)
|
|
end;
|
|
|
|
BInfo.CDS.First;
|
|
while not BInfo.CDS.Eof do
|
|
begin
|
|
US:=BInfo.CDS.UpdateStatus;
|
|
{TValue.Make(nil,TRttiDynamicArrayType(Typ).ElementType.Handle,BValue);}
|
|
BValue:=AValue.GetArrayElement(Pred(BInfo.CDS.RecNo));
|
|
if ORM_SaveCDSFields(DB,BInfo.CDS,(*Fld.FieldName*)BInfo.CDS.RecNo.ToString,BValue,True{(US=usInserted)}{AForceUpdate})>0
|
|
then begin
|
|
AValue.SetArrayElement(Pred(BInfo.CDS.RecNo),BValue);
|
|
Inc(Result);
|
|
end;
|
|
BInfo.CDS.Next;
|
|
end;
|
|
end;
|
|
tkRecord : begin
|
|
{$IFDEF DEBUG}
|
|
if not (TObject(CDS.Tag) is TORMCDSinfo)
|
|
then raise Exception.Create('ErrorMessage428');
|
|
{$ENDIF DEBUG}
|
|
OInfo:=TORMCDSinfo(CDS.Tag);
|
|
for Fld in CDS.Fields do
|
|
begin
|
|
RField:=Typ.GetField(Fld.FieldName);
|
|
|
|
{???}{Set/ENum fields!!!}
|
|
if RField=nil
|
|
then continue;
|
|
|
|
BInfo:=TORMCDSinfo(CDS.Fields[I].Tag);
|
|
if Assigned(BInfo) and not BInfo.IsArrayLink (*Skip sublists, do them separate later*)
|
|
then continue;
|
|
|
|
BValue.MakeWithoutCopy(nil,RField.FieldType.Handle,BValue);
|
|
BValue:=RField.GetValue(AValue.GetReferenceToRawData);
|
|
if ORM_SaveCDSFields(DB,OInfo.CDS,Fld.FieldName,BValue,AForceUpdate)>0
|
|
then begin
|
|
Inc(Result);
|
|
RField.SetValue(AValue.GetReferenceToRawData,BValue);
|
|
end;
|
|
end;
|
|
(*Check special-case SET fields*)
|
|
for RField in Typ.GetFields do
|
|
begin
|
|
case RField.FieldType.TypeKind of
|
|
tkSet : begin
|
|
BValue.From(RField.GetValue(AValue.GetReferenceToRawData));
|
|
BValue:=RField.GetValue(AValue.GetReferenceToRawData);
|
|
if ORM_SaveCDSFields(DB,CDS,RField.Name,BValue,AForceUpdate)>0
|
|
then begin
|
|
RField.SetValue(AValue.GetReferenceToRawData,BValue);
|
|
Inc(Result);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
tkClass : begin
|
|
{$IFDEF DEBUG}
|
|
if not (TObject(CDS.Tag) is TORMCDSinfo)
|
|
then raise Exception.Create('ErrorMessage428');
|
|
{$ENDIF DEBUG}
|
|
OInfo:=TORMCDSinfo(CDS.Tag);
|
|
Rec:=TSQLRecord(AValue.AsObject);
|
|
(*Update local fields*)
|
|
for I := 0 to Pred(CDS.Fields.Count) do
|
|
begin
|
|
Fld:=CDS.Fields[I];
|
|
RProp:=Typ.GetProperty(Fld.FieldName);
|
|
if RProp=nil
|
|
then continue;
|
|
BInfo:=TORMCDSinfo(CDS.Fields[I].Tag);
|
|
if Assigned(BInfo) and not BInfo.IsArrayLink (*Skip sublists, do them separate later*)
|
|
then continue;
|
|
|
|
BValue.MakeWithoutCopy(nil,RProp.PropertyType.Handle,BValue);
|
|
BValue:=RProp.GetValue(Rec);
|
|
if ORM_SaveCDSFields(DB,CDS,Fld.FieldName,BValue,AForceUpdate)>0
|
|
then begin
|
|
Changed:=Changed+1;
|
|
RProp.SetValue(Rec,BValue);
|
|
end;
|
|
end;
|
|
if Changed>0
|
|
then begin
|
|
if Rec.ID=0
|
|
then begin
|
|
I64:=DB.Add(Rec,True);
|
|
OInfo.CDS.Edit;
|
|
OInfo.CDS.FieldByName('ID').AsLargeInt:=I64;
|
|
end
|
|
else begin
|
|
I64:=Rec.ID;
|
|
DB.Update(Rec);
|
|
end;
|
|
end;
|
|
|
|
(*Update SubLists*)
|
|
for I := 0 to Pred(CDS.Fields.Count) do
|
|
begin
|
|
if not(TObject(CDS.Fields[I].Tag) is TORMCDSinfo) or ((TObject(CDS.Fields[I].Tag) as TORMCDSinfo).IsArrayLink)
|
|
then continue;
|
|
BInfo:=TORMCDSinfo(CDS.Fields[I].Tag);
|
|
|
|
{$IFDEF DEBUG}
|
|
if BInfo.LinkField=''
|
|
then raise Exception.Create('ErrorMessage457');
|
|
{$ENDIF}
|
|
|
|
BValue.MakeWithoutCopy(nil,TypeInfo(TSQLRecordClass),BValue);
|
|
BValue:=BInfo.SQLRecordClass;
|
|
BInfo.CDS.First;
|
|
while not BInfo.CDS.EOF do
|
|
begin
|
|
if (BInfo.CDS.FieldByName(BInfo.LinkField).AsLargeInt<>I64)
|
|
then begin
|
|
BInfo.CDS.Edit;
|
|
BInfo.CDS.FieldByName(BInfo.LinkField).AsLargeInt:=I64;
|
|
end;
|
|
BInfo.CDS.Next;
|
|
end;
|
|
|
|
Changed:=Changed+ORM_SaveCDSFields(DB,BInfo.CDS,CDS.Fields[I].FieldName,BValue,AForceUpdate);
|
|
BInfo.CDS.EnableControls;
|
|
end;
|
|
Result:=Changed;
|
|
end;
|
|
tkClassRef : begin
|
|
{$IFDEF DEBUG}
|
|
if not (TObject(CDS.Tag) is TORMCDSinfo)
|
|
then raise Exception.Create('ErrorMessage427');
|
|
{$ENDIF DEBUG}
|
|
CDS.DisableControls;
|
|
if CDS.State<>dsBrowse
|
|
then try
|
|
CDS.Post;
|
|
except
|
|
CDS.EnableControls;
|
|
exit;
|
|
end;
|
|
|
|
CDS.First;(*Fix uplinks before TPacketDataset fix*)
|
|
|
|
PDS := TPacketDataSet.Create(nil);
|
|
PDS.Data:=CDS.Data;
|
|
PDS.InitAltRecBuffers(True);
|
|
PDS.Free;
|
|
|
|
OInfo:=TORMCDSinfo(CDS.Tag);
|
|
CDS.First;(*Fix uplinks before TPacketDataset fix*)
|
|
if OInfo.LinkField<>''
|
|
then begin
|
|
while not CDS.EOF do
|
|
begin
|
|
if CDS.FieldByName(OInfo.LinkField).AsLargeInt=0
|
|
then begin
|
|
CDS.Edit;
|
|
CDS.FieldByName(OInfo.LinkField).AsLargeInt:=TClientDataset(OInfo.DatasetField.DataSet).FieldByNAme('ID').AsLargeint;
|
|
Inc(Changed);
|
|
end;
|
|
CDS.Next;
|
|
end;
|
|
end;
|
|
CDS.First;
|
|
|
|
|
|
CDS.StatusFilter:=[usDeleted];
|
|
CDS.First;
|
|
while not CDS.EOF do
|
|
begin
|
|
I64:=CDS.FieldByName('ID').AsLargeInt;
|
|
(*Delete all child records*)
|
|
for I := 0 to Pred(CDS.Fields.Count) do
|
|
begin
|
|
if not(TObject(CDS.Fields[I].Tag) is TORMCDSinfo) or ((TObject(CDS.Fields[I].Tag) as TORMCDSinfo).IsArrayLink)
|
|
then continue;
|
|
(*Delete all children tables*)
|
|
RStr:=PUTF8Char(TORMCDSinfo(CDS.Fields[I].Tag).LinkField+' = ?');
|
|
DB.Delete(TORMCDSinfo(CDS.Fields[I].Tag).SQLRecordClass,RStr^,[I64]);
|
|
end;
|
|
DB.Delete(OInfo.SQLRecordClass,I64);
|
|
CDS.Next;
|
|
Inc(Changed);
|
|
end;
|
|
|
|
CDS.StatusFilter:=[];
|
|
Rec:=OInfo.SQLRecordClass.Create;
|
|
CDS.First;
|
|
while not CDS.EOF do
|
|
begin
|
|
(*Check all fields for changes. Arrays must update as well.*)
|
|
US:=CDS.UpdateStatus;
|
|
{ if (CDS.UpdateStatus=usModified)or(CDS.UpdateStatus=usInserted)
|
|
then begin}
|
|
(*Update all fields+Arrays*)
|
|
I64:=CDS.FieldByName('ID').AsLargeInt;
|
|
{$IFDEF DEBUG}
|
|
{ US:=CDS.UpdateStatus;
|
|
if (I64=0)and (US=usModified)
|
|
then raise Exception.Create('ErrorMessage506');}
|
|
{$ENDIF DEBUG}
|
|
if I64=0
|
|
then begin
|
|
Rec.ClearProperties;
|
|
Changed:=Changed+1;
|
|
end
|
|
else DB.Retrieve(I64,Rec,True);
|
|
BValue:=Rec;
|
|
Changed:=Changed+ORM_SaveCDSFields(DB,CDS,CDS.Fields[I].FieldName,BValue,(I64=0));
|
|
if I64<>0
|
|
then DB.Unlock(Rec);
|
|
{end;}
|
|
CDS.Next;
|
|
end;
|
|
CDS.EnableControls;
|
|
Rec.Free;
|
|
Result:=Changed;
|
|
end
|
|
else raise Exception.Create('Error Message');
|
|
end;
|
|
Ctx.Free;
|
|
end;
|
|
{ TORMCDSinfo }
|
|
|
|
function TORMCDSinfo.IsArrayLink: Boolean;
|
|
begin
|
|
Result:=LinkField='';
|
|
end;
|
|
|
|
end.
|
|
|