source upload
This commit is contained in:
Razor12911
@@ -0,0 +1,785 @@
|
||||
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.
|
||||
|
||||
Reference in New Issue
Block a user