Vichingo455-RePacks/xtool
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity

source upload

Browse Source
This commit is contained in:
Razor12911
2022-01-17 22:16:47 +02:00
parent 12936d065b
commit 098e8c48de
1778 changed files with 1206749 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/CSV2ORM/CSV2ORM.dpr Normal file
View File

@@ -0,0 +1,15 @@
program CSV2ORM;
uses
MidasLib,
Vcl.Forms,
MAinFormU in 'MAinFormU.pas' {MainForm};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

16
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/CSV2ORM/Device.csv Normal file
View File

@@ -0,0 +1,16 @@
Desc,RawUTF8,Edit,50
Make,RawUTF8,ComboBox,30
Model,RawUTF8,ComboBox,30
Highsite,Integer,ComboBox
IP,RawUTF8,Edit,15
Software,RawUTF8,Edit,30
Username,RawUTF8,Edit,30
SkipMap,Boolean,Checkbox
Created,TDateTime,DateEdit
LastLogin,TDateTime,DateEdit
GPSlat,Double,Edit
GPSLon,Double,Edit
Active,Boolean,Checkbox
SiteType,Integer,RadioGroup
CapUsed,Int64,Edit
Throttle,RawUTF8,Edit,30
1 Desc,RawUTF8,Edit,50
2 Make,RawUTF8,ComboBox,30
3 Model,RawUTF8,ComboBox,30
4 Highsite,Integer,ComboBox
5 IP,RawUTF8,Edit,15
6 Software,RawUTF8,Edit,30
7 Username,RawUTF8,Edit,30
8 SkipMap,Boolean,Checkbox
9 Created,TDateTime,DateEdit
10 LastLogin,TDateTime,DateEdit
11 GPSlat,Double,Edit
12 GPSLon,Double,Edit
13 Active,Boolean,Checkbox
14 SiteType,Integer,RadioGroup
15 CapUsed,Int64,Edit
16 Throttle,RawUTF8,Edit,30

1079
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/CSV2ORM/MAinFormU.dfm Normal file
View File

File diff suppressed because it is too large Load Diff

426
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/CSV2ORM/MAinFormU.pas Normal file
View File

@@ -0,0 +1,426 @@
unit MAinFormU;
interface
{*****************************************}
{*** Please see ReadMe file ***}
{*** No copyright/license ***}
{*** No guarantees ***)
{*** Free to use/modify/distribute ***)
(*** Created by Anton Ekermans ***)
(*** antone@true.co.za ***)
(*** Original : ***)
(*** ftp://ftp.true.co.za/CSV2ORM.zip ***)
{*****************************************}
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.DBCtrls, Data.DB,
Vcl.Grids, Vcl.DBGrids, JvExDBGrids, JvDBGrid, JvDBUltimGrid,
Datasnap.DBClient, Vcl.StdCtrls, Vcl.Buttons, Vcl.Menus, Vcl.ComCtrls,
JvExExtCtrls, JvExtComponent, JvCaptionPanel, JvExControls, JvDBLookup;
type
TMainForm = class(TForm)
CDS: TClientDataSet;
CDSName: TStringField;
CDSTipe: TStringField;
CDSControl: TStringField;
DS: TDataSource;
FileOpenDialog1: TFileOpenDialog;
FileSaveDialog1: TFileSaveDialog;
PopupMenu1: TPopupMenu;
ImportthisasNameType1: TMenuItem;
CDSOrde: TIntegerField;
CDSSize: TIntegerField;
CDSField: TStringField;
CDSControlName: TStringField;
CDSFieldAs: TStringField;
PageMain: TPageControl;
TSProject: TTabSheet;
TSTemplates: TTabSheet;
Panel2: TPanel;
JvDBUltimGrid1: TJvDBUltimGrid;
DBMemo1: TDBMemo;
Memo1: TMemo;
Splitter1: TSplitter;
Panel1: TPanel;
BitBtn1: TBitBtn;
DBNavigator1: TDBNavigator;
Templates: TClientDataSet;
DSTemplates: TDataSource;
TemplatesName: TStringField;
TemplatesFiles: TDataSetField;
Files: TClientDataSet;
FilesFileName: TStringField;
FilesSource: TBlobField;
DSFiles: TDataSource;
Panel3: TPanel;
BtnTemplSave: TBitBtn;
PanelLeft: TPanel;
PanelFiles: TJvCaptionPanel;
PanelTemplates: TJvCaptionPanel;
Splitter2: TSplitter;
JvDBUltimGrid2: TJvDBUltimGrid;
JvDBUltimGrid3: TJvDBUltimGrid;
MemoSource: TDBMemo;
BtnGenerate: TBitBtn;
ComboTempl: TJvDBLookupCombo;
CDSDBControl: TStringField;
procedure BitBtn1Click(Sender: TObject);
procedure ImportthisasNameType1Click(Sender: TObject);
procedure BtnTemplSaveClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtnGenerateClick(Sender: TObject);
private
{ Private declarations }
procedure AnalyseData;
public
{ Public declarations }
ObjName:String;
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses idGlobal;
procedure TMainForm.BitBtn1Click(Sender: TObject);
begin
if FileOpenDialog1.Execute
then {CDS.LoadFromFile(FileSaveDialog1.FileName);}
ImportthisasNameType1Click(nil);
BtnGenerate.Enabled:=True;
end;
procedure TMainForm.BtnGenerateClick(Sender: TObject);
var SS,
SD,
ST : TStringList;
FileName : String;
I,K,T : Integer;
S1,S2,S3 : String;
MyTop : Integer;
MyTabOrder : Integer;
begin
if CDS.RecordCount=0
then begin
ShowMessage('Import a CSV file first with MetaData.');
exit;
end;
if ComboTempl.Text=''
then begin
ShowMEssage('Select a template first.');
exit;
end;
SS:=TStringList.Create;
SD:=TStringList.Create;
ST:=TStringList.Create;
Files.First;
while not Files.EOF do
begin
FileName:=FilesFileName.AsString;
FileName:=StringReplace(FileName,'MyObj',ObjName,[rfReplaceAll]);
SS.Clear;
SD.Clear;
SS.Text:=MemoSource.Lines.Text;
I:=0;
while I<SS.Count do
begin
S1:=SS[I];
if Pos('[Fields]',S1)>0
then begin
ST.Clear;
ST.Add(S1);
K:=I;
Inc(I);
while Pos('[/Fields]',S1)<=0 do
begin
try
S1:=SS[I];
except
ShowMessage('Unresolved [Fields] loop on line '+IntToStr(K)+' in '+FilesFileName.AsString);
break;
end;
ST.Add(S1);
Inc(I);
end;
CDS.First;
while not CDS.EOF do
begin
for t := 0 to Pred(ST.Count) do
begin
S1:=ST[T];
if (Pos('[Size]',S1)>0)and (CDSSize.AsInteger=0)
then continue;
if (Pos('[!Size]',S1)>0)and (CDSSize.AsInteger>0)
then continue;
S2:=StringReplace(S1,'[Fields]','',[rfReplaceAll]);
S2:=StringReplace(S2,'[/Fields]','',[rfReplaceAll]);
S2:=StringReplace(S2,'[Size]','',[rfReplaceAll]);
S2:=StringReplace(S2,'[!Size]','',[rfReplaceAll]);
S2:=StringReplace(S2,'MyObj',ObjName,[rfReplaceAll]);
S2:=StringReplace(S2,'MyType',CDSTipe.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyName',CDSName.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyFieldAs',CDSFieldAs.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyField',CDSField.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MySize',CDSSize.AsString,[rfReplaceAll]);
SD.Add(S2);
end;
CDS.Next;
end;
Continue;
end;
if Pos('[Controls]',S1)>0
then begin
ST.Clear;
ST.Add(S1);
K:=I;
Inc(I);
while Pos('[/Controls]',S1)<=0 do
begin
try
S1:=SS[I];
except
ShowMessage('Unresolved [Controls] loop on line '+IntToStr(K)+' in '+FilesFileName.AsString);
break;
end;
ST.Add(S1);
Inc(I);
end;
MyTop:=21;
MyTabOrder:=0;
CDS.First;
while not CDS.EOF do
begin
if CDSControl.AsString=''
then begin
CDS.Next;
continue;
end;
for t := 0 to Pred(ST.Count) do
begin
S1:=ST[T];
if (Pos('[Size]',S1)>0)and (CDSSize.AsInteger=0)
then continue;
if (Pos('[!Size]',S1)>0)and (CDSSize.AsInteger>0)
then continue;
S2:=StringReplace(S1,'[Controls]','',[rfReplaceAll]);
S2:=StringReplace(S2,'[/Controls]','',[rfReplaceAll]);
S2:=StringReplace(S2,'[Size]','',[rfReplaceAll]);
S2:=StringReplace(S2,'[!Size]','',[rfReplaceAll]);
S2:=StringReplace(S2,'MyObj',ObjName,[rfReplaceAll]);
S2:=StringReplace(S2,'MyType',CDSTipe.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyName',CDSName.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyFieldAs',CDSFieldAs.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyField',CDSField.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyControlName',CDSControlName.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyControl',CDSControl.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyDBControl',CDSDBControl.AsString,[rfReplaceAll]);
S2:=StringReplace(S2,'MyTop',IntToStr(MyTop),[rfReplaceAll]);
S2:=StringReplace(S2,'MyTabOrder',IntToStr(MyTabORder),[rfReplaceAll]);
S2:=StringReplace(S2,'MySize',CDSSize.AsString,[rfReplaceAll]);
SD.Add(S2);
end;
Inc(MyTop,21);
Inc(MyTabOrder);
CDS.Next;
end;
Continue;
end;
S1:=StringReplace(S1,'MyObj',ObjName,[rfReplaceAll]);
S1:=StringReplace(S1,'MyType',CDSTipe.AsString,[rfReplaceAll]);
SD.Add(S1);
Inc(I);
end;
SD.SaveToFile(FileName);
Files.Next;
end;
end;
procedure TMainForm.AnalyseData;
var S1 : String;
begin
CDS.First;
while not CDS.EOF do
begin
(*CDS fields*)
CDS.Edit;
S1:='';
CDSField.Clear;
if CompareText(CDSTipe.AsString,'Integer')=0
then begin
CDSField.AsString:='TIntegerField';
CDSFieldAs.AsString:='AsInteger';
end;
if CompareText(CDSTipe.AsString,'Int64')=0
then begin
CDSField.AsString:='TLargeIntField';
CDSFieldAs.AsString:='AsLargeInt';
end;
if CompareText(CDSTipe.AsString,'RawUTF8')=0
then begin
CDSField.AsString:='TStringField';
CDSFieldAs.AsString:='AsString';
end;
if CompareText(CDSTipe.AsString,'Boolean')=0
then begin
CDSField.AsString:='TBooleanField';
CDSFieldAs.AsString:='AsBoolean';
end;
if CompareText(CDSTipe.AsString,'TDateTime')=0
then begin
CDSField.AsString:='TDateTimeField';
CDSFieldAs.AsString:='AsDateTime';
end;
if CompareText(CDSTipe.AsString,'Double')=0
then begin
CDSField.AsString:='TFloatField';
CDSFieldAs.AsString:='AsFloat';
end;
if CompareText(CDSTipe.AsString,'Currency')=0
then begin
CDSField.AsString:='TCurrencyField';
CDSFieldAs.AsString:='AsCurrency';
end;
if CDSField.AsString=''
then raise Exception.Create('Error Message 141 - Unknown type : '+CDSTipe.AsString);
(*PAS UI controls*)
CDSControlName.Clear;
if (CDSControl.AsString='')or
(CDSControl.AsString='-none-')
then begin
CDSControl.Clear;
CDS.Post;
CDS.Next;
continue;
end;
S1:='';
if CompareText(CDSControl.AsString,'Edit')=0
then begin
CDSControl .AsString:='TEdit';
CDSDBControl.AsString:='TDBEdit';
CDSControlName.AsString:='Edit'+CDSName.AsString;
end;
if CompareText(CDSControl.AsString,'Combo')=0
then begin
CDSControl.AsString:='TComboBox';
CDSDBControl.AsString:='TDBComboBox';
CDSControlName.AsString:='Combo'+CDSName.AsString;
end;
if CompareText(CDSControl.AsString,'ComboBox')=0
then begin
CDSControl.AsString:='TComboBox';
CDSDBControl.AsString:='TDBComboBox';
CDSControlName.AsString:='Combo'+CDSName.AsString;
end;
if CompareText(CDSControl.AsString,'Radio')=0
then begin
CDSControl.AsString:='TRadioGroup';
CDSDBControl.AsString:='TDBRadioGroup';
CDSControlName.AsString:='Radio'+CDSName.AsString;
end;
if CompareText(CDSControl.AsString,'RadioGroup')=0
then begin
CDSControl.AsString:='TRadioGroup';
CDSDBControl.AsString:='TDBRadioGroup';
CDSControlName.AsString:='Radio'+CDSName.AsString;
end;
if CompareText(CDSControl.AsString,'RadioButton')=0
then begin
CDSControl.AsString:='TDBRadioGroup';
CDSDBControl.AsString:='TRadioGroup';
CDSControlName.AsString:='Radio'+CDSName.AsString;
end;
if CompareText(CDSControl.AsString,'Check')=0
then begin
CDSControl.AsString:='TCheckBox';
CDSDBControl.AsString:='TDBCheckBox';
CDSControlName.AsString:='Check'+CDSName.AsString;
end;
if CompareText(CDSControl.AsString,'CheckBox')=0
then begin
CDSControl.AsString:='TCheckBox';
CDSDBControl.AsString:='TDBCheckBox';
CDSControlName.AsString:='Check'+CDSName.AsString;
end;
if CompareText(CDSControl.AsString,'DateEdit')=0
then begin
CDSControl.AsString:='TJvDateEdit';
CDSDBControl.AsString:='TJvDBDateEdit';
CDSControlName.AsString:='Edit'+CDSName.AsString;
end;
if CDSControlName.AsString=''
then raise Exception.Create('Error Message 170 - Unknown control : '+CDSControl.AsString);
CDS.Post;
CDS.Next;
end;
end;
procedure TMainForm.BtnTemplSaveClick(Sender: TObject);
begin
Templates.SaveToFile;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var I : Integer;
begin
try
Templates.LoadFromFile;
except
I:=0;
end;
end;
procedure TMainForm.ImportthisasNameType1Click(Sender: TObject);
var SL,SL2 : TStringList;
S1,
S2,
S3,
S4 : String;
I : Integer;
begin
CDS.EmptyDataSet;
ObjName:=ExtractFileName(FileOpenDialog1.FileName);
ObjName:=Fetch(ObjName,'.',True);
SL:=TStringList.Create;
SL2:=TStringList.Create;
SL.LoadFromFile(FileOpenDialog1.FileName);
I:=0;
while SL.Count>0 do
begin
SL2.CommaText:=Trim(SL[0]);
S1:=Trim(SL2[0]);
S2:=Trim(SL2[1]);
S3:=Trim(SL2[2]);
if SL2.Count>3
then S4:=Trim(SL2[3])
else S4:='0';
SL.Delete(0);
if S1=''
then break;
CDS.Insert;
CDSOrde .AsInteger:=I;
CDSName .AsString :=S1;
CDSTipe .AsString :=S2;
CDSControl.AsString :=S3;
CDSSize .AsString :=S4;
CDS.Post;
Inc(I);
end;
SL2.Free;
SL .Free;
AnalyseData;
end;
end.

87
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/CSV2ORM/ReadMe.md Normal file
View File

@@ -0,0 +1,87 @@
# Description
This tool takes a CSV file with basic metadata and expand it into a source file(s) for use in Delphi based on pre-defined templates.
Using single and multi-file templates you can make almost any unit or form. Included example includes generating a *mORMot* `TSQLRecord` descendant as well as a CDS-based form for editing a single record/object.
It is not intended as a full-fledged RAD tool but rather to generate the bulk of repetitive code so you can copy to your project and edit from there on.
# Forum Thread
See http://synopse.info/forum/viewtopic.php?id=1911
# Usage
Create CSV file
e.g. `SampleObj.csv`:
Code,RawUTF8,Edit,30
Desc,RawUTF8,Edit,512
ItemType,RawUTF8,ComboBox,30
Cost,Currency,Edit
LastCostD,TDateTime,DateEdit
VatCat,Integer,RadioGroup
Active,Boolean,CheckBox
# Format
<Property/Field name>, DataType, Control[, Size]
Save with `FileName` of class name, e.g. `SampleObj.csv` would create e.g. classes:
DataSampleObj.pas (class TSQLSampleObj)
SampleObjFormU.pas (Class TSampleObjForm)
SampleObjFormU.dfm
When creating template, keep in mind the following, there are few magic-cookies that get replaced with your text and some tags.
Some magic-cookies:
* MyObj = ClassName, e.g. SampleObj (Determined by filename)
* MyName = property name e.g. BirthDate
* MyType = property type, e.g. `RawUTF8`
* MyField = property CDS Field type `TStringField`
* MyFieldAs = CDS field get/setter str, e.g. `AsString`
* MyControl = If assigned, expanded control type, e.g. `TEdit`
* MyDBControl = If assigned, expanded DB control type, e.g. `TDBEdit`
* MyControlName = If assigned, control name, e.g. `EditBirthDate`
* MyTop = Value that start at 21 and get incremented by 21 on each control, to space controls underneath each other.
* MySize = Size of CDS string field, see 'Tags' below.
# Tags
There are 3 tags:
* `[Fields]...[/Fields]` Cause a loop, passing all properties
* `[Controls] ..[/Controls]` Cause a loop, passing all properties that have a control assigned.
* `[Size]` Only include this line (tag can be anywhere on the line) if the current field have a size>0, used for TStringField size.
* `[!Size]` Only onclude this line if current filed have `Size=0` (i.o.w. not a String field)
E.g.:
[Fields][Size]Obj.MyName :=StringToUTF8(CDSMyName .MyFieldAs);
[!Size]Obj.MyName := CDSMyName .MyFieldAs;[/Fields]
This would create a line for each field/property. String fields will get 1st line `[Size]` with `StringToRawUTF8`, other fields will be rendered with 2nd line `[!Size]`, e.g.:
Obj.Code :=StringToRAWUTF8(CDSCode.AsString);
Obj.Cost := CDSCost.AsInteger;
Templates for generated files can be edited/saved. It is saved in `TClientdataset` binary format, so make backups as upgrades might make it useless.
# Future needed changes
* Make magic-cookies customizable.
* Use syntax-highlighter for code editing.
* Better tags or scripting to make more versatile.
* Support for more data-types and control types. (In meantime, use `Integer`/`RawUTF8` or `TEdit` for unsupported types and edit code afterwards)
* Way to indent code - prettyfy.
* Save templates in separate text files that can be edited in external editor.
# Changelog
* 2014/07/28 - ver 1.1
- Added Templates and non-DB controls.
- Added Tags for Field/Control loops and [Size]/[!Size] to make conditional render of string fields. (Fields with a size limit)

BIN
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/CSV2ORM/Templates.cds Normal file
View File

Binary file not shown.

35
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/DataModU.dfm Normal file
View File

@@ -0,0 +1,35 @@
object DataMod: TDataMod
OldCreateOrder = False
Height = 150
Width = 215
object cdsPerson: TClientDataSet
Aggregates = <>
Params = <>
Left = 32
Top = 16
object cdsPersonID: TLargeintField
FieldName = 'ID'
end
object cdsPersonName: TStringField
FieldName = 'Name'
Size = 50
end
object cdsPersonInt: TIntegerField
FieldName = 'Int'
end
object cdsPersonPhones: TDataSetField
FieldName = 'Phones'
end
object cdsPersonGender: TIntegerField
FieldName = 'Gender'
end
object cdsPersonChildren: TDataSetField
FieldName = 'Children'
end
end
object DSPerson: TDataSource
DataSet = cdsPerson
Left = 32
Top = 72
end
end

56
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/MAinFormU.dfm Normal file
View File

@@ -0,0 +1,56 @@
object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'mORMot into Nested TClientdatasets 1.1'
ClientHeight = 287
ClientWidth = 489
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 70
Width = 473
Height = 187
Alignment = taCenter
AutoSize = False
Caption =
'This will demo ORMCDS routines that convert mORMot TSQLRecord cl' +
'asses into nested TClientdatasets for easy UI handlng.'#13#10'It will ' +
'also apply delta updates, i.e. only update fields in records tha' +
't have changed in UI, giving field-level isolation when multiple' +
' users edit the same record in UI.'#13#10#13#10'Dynamic arrays of records ' +
'are created as nested CDS as well as linked TSQLRecord tables.'#13#10 +
#13#10'Simple reconcilliation is done to handle deleted, inserted rec' +
'ords, array re-ordering, etc.'#13#10#13#10'First verion with many untested' +
' scenarios... Use at own risk!'
WordWrap = True
end
object BtnSample1: TButton
Left = 88
Top = 8
Width = 305
Height = 25
Caption = 'Sample 1 - Static TClientdataset+Fields'
TabOrder = 0
OnClick = BtnSample1Click
end
object BtnSample2: TButton
Left = 88
Top = 39
Width = 305
Height = 25
Caption = 'Sample 2 - Dynamic TClientdataset+Fields'
TabOrder = 1
OnClick = BtnSample2Click
end
end

163
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/MAinFormU.pas Normal file
View File

@@ -0,0 +1,163 @@
unit MAinFormU;
interface
uses
Winapi.Windows, Winapi.Messages, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,mORMot,mORMotSQLite3, SynSQLite3Static,SynCommons,
Vcl.StdCtrls, Data.DB, Datasnap.DBClient,Contnrs, Vcl.Grids, Vcl.DBGrids,
Xml.xmldom, Datasnap.Provider,
Xmlxform;
type
TMainForm = class(TForm)
BtnSample1: TButton;
BtnSample2: TButton;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure BtnSample1Click(Sender: TObject);
procedure BtnSample2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Model : TSQLModel;
DB : TSQLRestServerDB;
procedure CreateDefaults;
end;
type TPhoneType = (ptWork, ptHome,ptFax,ptSMS);
TPhoneTypeSet = set of TPhoneType;
type TPhone = packed record
Number : RawUTF8;
PType : TPhoneTypeSet;
end;
TPhoneArr = Array of TPhone;
type TGender = (gnUnknown,gnMale,gnFemale);
type TSQLPerson = class(TSQLRecord)
private
fName : RawUTF8;
fInt : Integer;
fGender : TGender;
fPhones : TPhoneArr;
public
protected
published
property Name : RawUTF8 read fName write fName;
property Int : Integer read fInt write fInt;
property Phones : TPhoneArr read fPhones write fPhones;
property Gender : TGender read fGender write fGender;
end;
type TSQLChild = class(TSQLRecord)
private
fParent : TID;
fChildName : RawUTF8;
fChildGender : TGender;
published
property Parent : TID read fParent write fParent;
property ChildName : RawUTF8 read fChildName write fChildName;
property ChildGender : TGender read fChildGender write fChildGender;
end;
var MainForm: TMainForm;
implementation
{$R *.dfm}
uses SysUtils,RTTI, TypInfo, ORMCDS, SampleForm1U, SampleForm2U;
procedure TMainForm.BtnSample1Click(Sender: TObject);
begin
Application.CreateForm(TSampleForm1,SampleForm1);
SampleForm1.ShowModal;
SampleForm1.Release;
end;
procedure TMainForm.BtnSample2Click(Sender: TObject);
begin
Application.CreateForm(TSampleForm1,SampleForm1);
SampleForm1.ShowModal;
SampleForm1.Release;
end;
procedure TMainForm.CreateDefaults;
var Person : TSQLPerson;
DA : TDynArray;
Ph : TPhone;
Ch : TSQLChild;
begin
Person:=TSQLPerson.Create;
Person.Name:='Guy';
Person.Int :=1;
DA:=Person.DynArray('Phones');
Ph.Number:='1234';
Ph.PType :=[ptWork];
DA.Add(Ph);
Ph.Number:='5678';
Ph.PType :=[ptHome,ptSMS];
DA.Add(Ph);
DB.Add(Person,True);
Ch:=TSQLChild.Create;
Ch.Parent :=Person.ID;
Ch.ChildName:='Boy1';
Ch.ChildGender:=gnMale;
DB.Add(Ch,True);
Ch.ChildName:='Boy2';
Ch.ChildGender:=gnMale;
DB.Add(Ch,True);
Person.Free;
Ch.Free;
Person:=TSQLPerson.Create;
Person.Name:='Gal';
Person.Int :=1;
DA:=Person.DynArray('Phones');
Ph.Number:='AA1234';
Ph.PType :=[ptHome];
DA.Add(Ph);
Ph.Number:='BB5678';
Ph.PType :=[ptSMS];
DA.Add(Ph);
DB.Add(Person,True);
Ch:=TSQLChild.Create;
Ch.Parent :=Person.ID;
Ch.ChildName:='GirlA';
Ch.ChildGender:=gnFeMale;
DB.Add(Ch,True);
Ch.ChildName:='ChildB';
Ch.ChildGender:=gnUnknown;
DB.Add(Ch,True);
Person.Free;
Ch.Free;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var FN : String;
IsNew : Boolean;
begin
FN:=ChangeFileExt(paramstr(0),'.db3');
IsNew:=not FileExists(FN);
{ DeleteFile(FN);}
Model := TSQLModel.Create([TSQLChild,TSQLPerson]);
DB := TSQLRestServerDB.Create(Model,FN);
TSQLRestServerDB(DB).CreateMissingTables(0);
if IsNew
then CreateDefaults;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
DB.Free;
Model.Free;
end;
end.

785
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/ORMCDS.pas Normal file
View File

@@ -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.

18
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/ORMCDS_Test.dpr Normal file
View File

@@ -0,0 +1,18 @@
program ORMCDS_Test;
uses
FastMM4,
Vcl.Forms,
MAinFormU in 'MAinFormU.pas' {MainForm},
ORMCDS in 'ORMCDS.pas',
SampleForm1U in 'SampleForm1U.pas' {SampleForm1},
SampleForm2U in 'SampleForm2U.pas' {SampleForm2};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

32
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/ReadMe.md Normal file
View File

@@ -0,0 +1,32 @@
# Description
Unit to convert `TSQLRecord` and it's sub-arrays/records to Nested `TClientdataset`.
Some key features:
* Create `TClientdataset` hierarchy dynamically based on data.
* Also work with static `TClientDataset`+Static fields.
* Handle sub-`TSQLRecord` lists. (See sample)
* Convert Set of ENUM to/from multiple `Boolean` fields for grid checkboxes
* Most importantly: Apply delta-changes back to *mORMot*. i.e. only changed fields.
* (With RTTI adjustments), should work on any platform that support `TClientdataset`, e.g. Intraweb
It is very first version so not tested on insert/delete yet nor many types of data, guaranteed to be buggy & lacking at this stage, but working, with the latest versions of Delphi only (this first version uses the new Rtti.pas unit, and not *mORMot*'s RTTI).
# Forum Thread
See http://synopse.info/forum/viewtopic.php?id=1911
# Supplied Demo project
Choose Static or Dynamic demo, select 'Load' to load data, edit any field or nested data, click 'Apply'.
This Demo would need the JVCL Grid to compile - see http://wiki.delphi-jedi.org/wiki/JVCL_Help:TJvDBUltimGrid
Best is to see code to get more info.
# Disclaimer
My first try with RTTI and new at *mORMot* so I'm sure it could have been done more elegantly with mORMot's RTTI built-support.
Also not optimized for speed but should be pretty fast.

259
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/SampleForm1U.dfm Normal file
View File

@@ -0,0 +1,259 @@
object SampleForm1: TSampleForm1
Left = 0
Top = 0
Caption = 'Static CDS+Fields'
ClientHeight = 404
ClientWidth = 630
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 334
Top = 8
Width = 288
Height = 388
Alignment = taCenter
AutoSize = False
Caption =
'Core work is done by creating a TORMCDSinfo object for every nes' +
'ted TClientdataset.'#13#10'This is then linked to the TORMCDSinfo(TDat' +
'asetField.Tag) as well as the nested-child TClientdataset.Tag.'#13#10 +
'These TORMCDSinfo objects are referenced by the routines to esta' +
'blish relations and supply type info.'#13#10#13#10'When TClientdatasets ex' +
'ist, just run ORM_LinkCDS '
WordWrap = True
end
object Button2: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Caption = 'Load'
TabOrder = 0
OnClick = Button2Click
end
object JvDBUltimGrid1: TJvDBUltimGrid
Left = 8
Top = 39
Width = 320
Height = 120
DataSource = DSPerson
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
OnGetCellParams = JvDBUltimGrid1GetCellParams
SelectColumnsDialogStrings.Caption = 'Select columns'
SelectColumnsDialogStrings.OK = '&OK'
SelectColumnsDialogStrings.NoSelectionWarning = 'At least one column must be visible!'
EditControls = <>
RowsHeight = 17
TitleRowHeight = 17
Columns = <
item
Expanded = False
FieldName = 'Name'
Width = 150
Visible = True
end
item
Expanded = False
FieldName = 'Int'
Visible = True
end
item
Expanded = False
FieldName = 'Gender'
Visible = True
end>
end
object JvDBUltimGrid2: TJvDBUltimGrid
Left = 8
Top = 165
Width = 320
Height = 120
DataSource = DSPhones
TabOrder = 2
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
OnGetCellParams = JvDBUltimGrid1GetCellParams
SelectColumnsDialogStrings.Caption = 'Select columns'
SelectColumnsDialogStrings.OK = '&OK'
SelectColumnsDialogStrings.NoSelectionWarning = 'At least one column must be visible!'
EditControls = <>
RowsHeight = 17
TitleRowHeight = 17
Columns = <
item
Expanded = False
FieldName = 'Number'
Width = 98
Visible = True
end
item
Expanded = False
FieldName = 'PType_ptWork'
Title.Caption = 'Work'
Width = 37
Visible = True
end
item
Expanded = False
FieldName = 'PType_ptHome'
Title.Caption = 'Home'
Width = 37
Visible = True
end
item
Expanded = False
FieldName = 'PType_ptFax'
Title.Caption = 'Fax'
Width = 37
Visible = True
end
item
Expanded = False
FieldName = 'PType_ptSMS'
Title.Caption = 'SMS'
Visible = True
end>
end
object JvDBUltimGrid3: TJvDBUltimGrid
Left = 8
Top = 278
Width = 320
Height = 120
DataSource = DSChildren
TabOrder = 3
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
OnGetCellParams = JvDBUltimGrid1GetCellParams
SelectColumnsDialogStrings.Caption = 'Select columns'
SelectColumnsDialogStrings.OK = '&OK'
SelectColumnsDialogStrings.NoSelectionWarning = 'At least one column must be visible!'
EditControls = <>
RowsHeight = 17
TitleRowHeight = 17
Columns = <
item
Expanded = False
FieldName = 'ChildName'
Width = 187
Visible = True
end
item
Expanded = False
FieldName = 'ChildGender'
Width = 74
Visible = True
end>
end
object BtnApply: TButton
Left = 253
Top = 8
Width = 75
Height = 25
Caption = 'Apply'
TabOrder = 4
OnClick = BtnApplyClick
end
object DSPerson: TDataSource
DataSet = cdsPerson
Left = 168
Top = 112
end
object DSPhones: TDataSource
DataSet = cdsPhones
Left = 232
Top = 112
end
object DSChildren: TDataSource
DataSet = cdsChildren
Left = 296
Top = 112
end
object cdsChildren: TClientDataSet
Aggregates = <>
DataSetField = cdsPersonChildren
Params = <>
Left = 296
Top = 56
object cdsChildrenID: TLargeintField
FieldName = 'ID'
end
object cdsChildrenParent: TLargeintField
FieldName = 'Parent'
end
object cdsChildrenChildName: TStringField
FieldName = 'ChildName'
Size = 50
end
object cdsChildrenChildGender: TIntegerField
FieldName = 'ChildGender'
end
end
object cdsPhones: TClientDataSet
Aggregates = <>
DataSetField = cdsPersonPhones
Params = <>
Left = 232
Top = 56
object cdsPhonesNumber: TStringField
FieldName = 'Number'
Size = 30
end
object cdsPhonesPType_ptWork: TBooleanField
FieldName = 'PType_ptWork'
end
object cdsPhonesPType_ptHome: TBooleanField
FieldName = 'PType_ptHome'
end
object cdsPhonesPType_ptFax: TBooleanField
FieldName = 'PType_ptFax'
end
object cdsPhonesPType_ptSMS: TBooleanField
FieldName = 'PType_ptSMS'
end
end
object cdsPerson: TClientDataSet
Aggregates = <>
Params = <>
Left = 168
Top = 56
object cdsPersonID: TLargeintField
FieldName = 'ID'
end
object cdsPersonName: TStringField
FieldName = 'Name'
Size = 50
end
object cdsPersonInt: TIntegerField
FieldName = 'Int'
end
object cdsPersonPhones: TDataSetField
FieldName = 'Phones'
end
object cdsPersonGender: TIntegerField
FieldName = 'Gender'
end
object cdsPersonChildren: TDataSetField
FieldName = 'Children'
end
end
end

107
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/SampleForm1U.pas Normal file
View File

@@ -0,0 +1,107 @@
unit SampleForm1U;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.DBGrids, JvExDBGrids,
JvDBGrid, JvDBUltimGrid, Vcl.StdCtrls, Data.DB, Datasnap.DBClient;
type
TSampleForm1 = class(TForm)
DSPerson: TDataSource;
DSPhones: TDataSource;
DSChildren: TDataSource;
cdsChildren: TClientDataSet;
cdsChildrenID: TLargeintField;
cdsChildrenParent: TLargeintField;
cdsChildrenChildName: TStringField;
cdsChildrenChildGender: TIntegerField;
cdsPhones: TClientDataSet;
cdsPhonesNumber: TStringField;
cdsPhonesPType_ptWork: TBooleanField;
cdsPhonesPType_ptHome: TBooleanField;
cdsPhonesPType_ptFax: TBooleanField;
cdsPhonesPType_ptSMS: TBooleanField;
cdsPerson: TClientDataSet;
cdsPersonID: TLargeintField;
cdsPersonName: TStringField;
cdsPersonInt: TIntegerField;
cdsPersonPhones: TDataSetField;
cdsPersonGender: TIntegerField;
cdsPersonChildren: TDataSetField;
Button2: TButton;
JvDBUltimGrid1: TJvDBUltimGrid;
JvDBUltimGrid2: TJvDBUltimGrid;
JvDBUltimGrid3: TJvDBUltimGrid;
BtnApply: TButton;
Label1: TLabel;
procedure Button2Click(Sender: TObject);
procedure BtnApplyClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure JvDBUltimGrid1GetCellParams(Sender: TObject; Field: TField;
AFont: TFont; var Background: TColor; Highlight: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
SampleForm1: TSampleForm1;
implementation
{$R *.dfm}
uses MainFormU,ORMCDS,mORMot,RTTI,Provider;
procedure TSampleForm1.BtnApplyClick(Sender: TObject);
var Value : TValue;
begin
Value.From(TSQLRecord);
Value:=TSQLRecord;
ORM_SaveCDSFields(MainForm.DB,cdsPerson,'Person',Value,False);
Close;
end;
procedure TSampleForm1.Button2Click(Sender: TObject);
var Person : TSQLPerson;
begin
ORM_LinkCDS(cdsPerson ,TypeInfo(TSQLPerson),'');
ORM_LinkCDS(cdsPhones ,TypeInfo(TPhoneArr ),'');
ORM_LinkCDS(cdsChildren,TypeInfo(TSQLChild ),'Parent');
cdsPerson.CreateDataSet;
cdsPerson.LogChanges:=False;
cdsPerson.SaveToFile('FileX.xml');
Person:=TSQLPerson.Create;
MAinForm.DB.Retrieve(1,Person);
ORM_LoadCDSFields(MainForm.DB,cdsPerson,'Person',Person);
MainForm.DB.Retrieve(2,Person);
ORM_LoadCDSFields(MainForm.DB,cdsPerson,'Person',Person);
Person.Free;
cdsPerson.MergeChangeLog;
cdsPerson.LogChanges:=True;
cdsPerson.SaveToFile('FileY.xml');
end;
procedure TSampleForm1.FormDestroy(Sender: TObject);
begin
ORM_FreeCDSInfo(cdsPerson,False);
end;
procedure TSampleForm1.JvDBUltimGrid1GetCellParams(Sender: TObject;
Field: TField; AFont: TFont; var Background: TColor; Highlight: Boolean);
begin
case TClientDataset(Field.DataSet).UpdateStatus of
usUnmodified : Background:=clWhite;
usModified : BAckground:=clMoneyGreen;
usInserted : Background:=clSkyBlue;
usDeleted : Background:=clRed
else raise Exception.Create('Error Message');
end;
end;
end.

169
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/SampleForm2U.dfm Normal file
View File

@@ -0,0 +1,169 @@
object SampleForm2: TSampleForm2
Left = 0
Top = 0
Caption = 'Dynamic CDS+Fields'
ClientHeight = 404
ClientWidth = 334
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Button2: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Caption = 'Load'
TabOrder = 0
OnClick = Button2Click
end
object BtnApply: TButton
Left = 253
Top = 8
Width = 75
Height = 25
Caption = 'Apply'
TabOrder = 1
OnClick = BtnApplyClick
end
object JvDBUltimGrid1: TJvDBUltimGrid
Left = 8
Top = 39
Width = 320
Height = 120
DataSource = DSPerson
TabOrder = 2
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
SelectColumnsDialogStrings.Caption = 'Select columns'
SelectColumnsDialogStrings.OK = '&OK'
SelectColumnsDialogStrings.NoSelectionWarning = 'At least one column must be visible!'
EditControls = <>
RowsHeight = 17
TitleRowHeight = 17
Columns = <
item
Expanded = False
FieldName = 'Name'
Width = 150
Visible = True
end
item
Expanded = False
FieldName = 'Int'
Visible = True
end
item
Expanded = False
FieldName = 'Gender'
Visible = True
end>
end
object JvDBUltimGrid3: TJvDBUltimGrid
Left = 8
Top = 278
Width = 320
Height = 120
DataSource = DSChildren
TabOrder = 3
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
SelectColumnsDialogStrings.Caption = 'Select columns'
SelectColumnsDialogStrings.OK = '&OK'
SelectColumnsDialogStrings.NoSelectionWarning = 'At least one column must be visible!'
EditControls = <>
RowsHeight = 17
TitleRowHeight = 17
Columns = <
item
Expanded = False
FieldName = 'ChildName'
Width = 187
Visible = True
end
item
Expanded = False
FieldName = 'ChildGender'
Width = 74
Visible = True
end>
end
object JvDBUltimGrid2: TJvDBUltimGrid
Left = 8
Top = 159
Width = 320
Height = 120
DataSource = DSPhones
TabOrder = 4
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
SelectColumnsDialogStrings.Caption = 'Select columns'
SelectColumnsDialogStrings.OK = '&OK'
SelectColumnsDialogStrings.NoSelectionWarning = 'At least one column must be visible!'
EditControls = <>
RowsHeight = 17
TitleRowHeight = 17
Columns = <
item
Expanded = False
FieldName = 'Number'
Width = 98
Visible = True
end
item
Expanded = False
FieldName = 'PType_ptWork'
Title.Caption = 'Work'
Width = 37
Visible = True
end
item
Expanded = False
FieldName = 'PType_ptHome'
Title.Caption = 'Home'
Width = 37
Visible = True
end
item
Expanded = False
FieldName = 'PType_ptFax'
Title.Caption = 'Fax'
Width = 37
Visible = True
end
item
Expanded = False
FieldName = 'PType_ptSMS'
Title.Caption = 'SMS'
Visible = True
end>
end
object DSPerson: TDataSource
Left = 168
Top = 112
end
object DSPhones: TDataSource
Left = 232
Top = 112
end
object DSChildren: TDataSource
Left = 296
Top = 112
end
end

86
contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/AntonE/ORMCDS/SampleForm2U.pas Normal file
View File

@@ -0,0 +1,86 @@
unit SampleForm2U;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.DBGrids, JvExDBGrids,
JvDBGrid, JvDBUltimGrid, Vcl.StdCtrls,DBClient, Data.DB;
type
TSampleForm2 = class(TForm)
Button2: TButton;
BtnApply: TButton;
JvDBUltimGrid1: TJvDBUltimGrid;
JvDBUltimGrid3: TJvDBUltimGrid;
DSPerson: TDataSource;
DSPhones: TDataSource;
DSChildren: TDataSource;
JvDBUltimGrid2: TJvDBUltimGrid;
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure BtnApplyClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
TmpCDS:TClientdataset;
end;
var
SampleForm2: TSampleForm2;
implementation
{$R *.dfm}
uses RTTI,mORMot,MAinFormU,ORMCDS;
procedure TSampleForm2.BtnApplyClick(Sender: TObject);
var Value : TValue;
begin
Value.From(TSQLRecord);
Value:=TSQLRecord;
ORM_SaveCDSFields(MAinForm.DB,TmpCDS,'Person',Value,False);
Close;
end;
procedure TSampleForm2.Button2Click(Sender: TObject);
var Person : TSQLPerson;
Ctx : TRttiContext;
begin
TmpCDS:=TClientdataset.Create(self);
Ctx:=TRttiContext.Create;
ORM_CreateCDSFields(TmpCDS ,'Person' ,Ctx.GetType(TSQLPerson).Handle);
ORM_AddSubField (TmpCDS ,'Children','Parent',TSQLChild);
TmpCDS.CreateDataSet;
TmpCDS.LogChanges:=False;
TmpCDS.SaveToFile('FileX.xml');
Person:=TSQLPerson.Create;
MainForm.DB.Retrieve(1,Person);
ORM_LoadCDSFields(MainForm.DB,TmpCDS,'Person',Person);
MainForm.DB.Retrieve(2,Person);
ORM_LoadCDSFields(MainForm.DB,TmpCDS,'Person',Person);
Person.Free;
TmpCDS.LogChanges:=True;
TmpCDS.MergeChangeLog;
TmpCDS.SaveToFile('FileY.xml');
(*Link Datasources to Tmp TClientdatasets*)
DSPerson.DataSet:=TmpCDS;
DSPhones.DataSet:=TORMCDSinfo(TmpCDS.FieldByName('Phones').Tag).CDS;
DSPhones .DataSet:=TORMCDSinfo(TmpCDS.FieldByName('Phones' ).Tag).CDS;
DSChildren.DataSet:=TORMCDSinfo(TmpCDS.FieldByName('Children').Tag).CDS;
end;
procedure TSampleForm2.FormDestroy(Sender: TObject);
begin
if Assigned(TmpCDS)
then ORM_FreeCDSInfo(TmpCDS,True);
end;
end.