Menu
▾
▴
instantobjects-cvscommit — Generates a message for every commit made on CVS
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(13) |
Sep
(25) |
Oct
(10) |
Nov
(19) |
Dec
(20) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
|
Feb
(206) |
Mar
(43) |
Apr
(25) |
May
(20) |
Jun
(69) |
Jul
(121) |
Aug
(95) |
Sep
(122) |
Oct
(213) |
Nov
(46) |
Dec
(39) |
| 2006 |
Jan
(28) |
Feb
(57) |
Mar
(21) |
Apr
(7) |
May
(11) |
Jun
(2) |
Jul
(8) |
Aug
(13) |
Sep
(2) |
Oct
(2) |
Nov
(20) |
Dec
(16) |
| 2007 |
Jan
(9) |
Feb
(15) |
Mar
|
Apr
(4) |
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
|
Nov
|
Dec
|
| 2008 |
Jan
|
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
|
Jul
(3) |
Aug
(1) |
Sep
(9) |
Oct
|
Nov
(1) |
Dec
|
| 2009 |
Jan
|
Feb
|
Mar
(8) |
Apr
(1) |
May
|
Jun
|
Jul
(11) |
Aug
(57) |
Sep
(2) |
Oct
(6) |
Nov
|
Dec
(7) |
| 2010 |
Jan
(11) |
Feb
(1) |
Mar
|
Apr
(1) |
May
|
Jun
|
Jul
(1) |
Aug
(2) |
Sep
(27) |
Oct
(3) |
Nov
(7) |
Dec
(1) |
| 2011 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
(10) |
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
(8) |
Feb
(1) |
Mar
|
Apr
|
May
|
Jun
|
Jul
(1) |
Aug
|
Sep
|
Oct
(3) |
Nov
(1) |
Dec
(1) |
| 2013 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(3) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
|
Nov
(4) |
Dec
|
| 2015 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(1) |
Sep
(1) |
Oct
|
Nov
|
Dec
|
| 2016 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(3) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
|
Feb
|
Mar
(1) |
Apr
(4) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2018 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
(3) |
Oct
|
Nov
(4) |
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(1) |
|
From: <na...@us...> - 2007-02-25 15:46:54
|
Revision: 768
http://svn.sourceforge.net/instantobjects/revision/?rev=768&view=rev
Author: nandod
Date: 2007-02-25 07:46:50 -0800 (Sun, 25 Feb 2007)
Log Message:
-----------
* res files updated for 2.1.
Modified Paths:
--------------
trunk/ReleaseTools/InstantVersion.res
trunk/Source/Brokers/ADO/D2005/DclIOADO.res
trunk/Source/Brokers/ADO/D2005/IOADO.res
trunk/Source/Brokers/ADO/D2006/DclIOADO.res
trunk/Source/Brokers/ADO/D2006/IOADO.res
trunk/Source/Brokers/ADO/D5/DclIOADO_D5.res
trunk/Source/Brokers/ADO/D5/IOADO_D5.res
trunk/Source/Brokers/ADO/D6/DclIOADO.res
trunk/Source/Brokers/ADO/D6/IOADO.res
trunk/Source/Brokers/ADO/D7/DclIOADO.res
trunk/Source/Brokers/ADO/D7/IOADO.res
trunk/Source/Brokers/ADS/D5/DclIOADS_D5.res
trunk/Source/Brokers/ADS/D5/ioads_D5.res
trunk/Source/Brokers/BDE/D2005/DclIOBDE.res
trunk/Source/Brokers/BDE/D2005/IOBDE.res
trunk/Source/Brokers/BDE/D2006/DclIOBDE.res
trunk/Source/Brokers/BDE/D2006/IOBDE.res
trunk/Source/Brokers/BDE/D5/DclIOBDE_D5.res
trunk/Source/Brokers/BDE/D5/Iobde_D5.res
trunk/Source/Brokers/BDE/D6/DclIOBDE.res
trunk/Source/Brokers/BDE/D6/IOBDE.res
trunk/Source/Brokers/BDE/D7/DclIOBDE.res
trunk/Source/Brokers/BDE/D7/IOBDE.res
trunk/Source/Brokers/DBISAM/D6/DclDBISAM.res
trunk/Source/Brokers/DBISAM/D6/IODBISAM.res
trunk/Source/Brokers/DBISAM/D7/DclDBISAM.res
trunk/Source/Brokers/DBISAM/D7/IODBISAM.res
trunk/Source/Brokers/DBX/D2005/DclIODBX.res
trunk/Source/Brokers/DBX/D2005/IODBX.res
trunk/Source/Brokers/DBX/D2006/DclIODBX.res
trunk/Source/Brokers/DBX/D2006/IODBX.res
trunk/Source/Brokers/DBX/D6/DclIODBX.res
trunk/Source/Brokers/DBX/D6/IODBX.res
trunk/Source/Brokers/DBX/D7/DclIODBX.res
trunk/Source/Brokers/DBX/D7/IODBX.res
trunk/Source/Brokers/DBX/K3/DclIODBX.res
trunk/Source/Brokers/DBX/K3/IODBX.res
trunk/Source/Brokers/FlashFiler/D5/DclIOff_D5.res
trunk/Source/Brokers/FlashFiler/D5/ioff_D5.res
trunk/Source/Brokers/IBX/D2005/DclIOIBX.res
trunk/Source/Brokers/IBX/D2005/IOIBX.res
trunk/Source/Brokers/IBX/D2006/DclIOIBX.res
trunk/Source/Brokers/IBX/D2006/IOIBX.res
trunk/Source/Brokers/IBX/D5/DclIOIBX_D5.res
trunk/Source/Brokers/IBX/D5/Ioibx_D5.res
trunk/Source/Brokers/IBX/D6/DclIOIBX.res
trunk/Source/Brokers/IBX/D6/IOIBX.res
trunk/Source/Brokers/IBX/D7/DclIOIBX.res
trunk/Source/Brokers/IBX/D7/IOIBX.res
trunk/Source/Brokers/NexusDb/D2005/DclIONexusDB.res
trunk/Source/Brokers/NexusDb/D2005/IONexusDB.res
trunk/Source/Brokers/NexusDb/D2006/DclIONexusDB.res
trunk/Source/Brokers/NexusDb/D2006/IONexusDB.res
trunk/Source/Brokers/NexusDb/D5/DclIONexusDB_D5.res
trunk/Source/Brokers/NexusDb/D5/IONexusDB_D5.res
trunk/Source/Brokers/NexusDb/D6/DclIONexusDB.res
trunk/Source/Brokers/NexusDb/D6/IONexusDB.res
trunk/Source/Brokers/NexusDb/D7/DclIONexusDB.res
trunk/Source/Brokers/NexusDb/D7/IONexusDB.res
trunk/Source/Brokers/UIB/D2005/DclIOUIB.res
trunk/Source/Brokers/UIB/D2005/IOUIB.res
trunk/Source/Brokers/UIB/D2006/DclIOUIB.res
trunk/Source/Brokers/UIB/D2006/IOUIB.res
trunk/Source/Brokers/UIB/D5/DclIOUIB_D5.res
trunk/Source/Brokers/UIB/D5/IOUIB_D5.res
trunk/Source/Brokers/UIB/D6/DclIOUIB.res
trunk/Source/Brokers/UIB/D6/IOUIB.res
trunk/Source/Brokers/UIB/D7/DclIOUIB.res
trunk/Source/Brokers/UIB/D7/IOUIB.res
trunk/Source/Brokers/XML/D2005/DclIOXML.res
trunk/Source/Brokers/XML/D2005/IOXML.res
trunk/Source/Brokers/XML/D2006/DclIOXML.res
trunk/Source/Brokers/XML/D2006/IOXML.res
trunk/Source/Brokers/XML/D5/DclIOXML_D5.res
trunk/Source/Brokers/XML/D5/Ioxml_D5.res
trunk/Source/Brokers/XML/D6/DclIOXML.res
trunk/Source/Brokers/XML/D6/IOXML.res
trunk/Source/Brokers/XML/D7/DclIOXML.res
trunk/Source/Brokers/XML/D7/IOXML.res
trunk/Source/Brokers/XML/k3/DclIOXML.res
trunk/Source/Brokers/XML/k3/IOXML.res
trunk/Source/Brokers/ZeosDBO/D2005/DclIOZeosDBO.res
trunk/Source/Brokers/ZeosDBO/D2005/IOZeosDBO.res
trunk/Source/Brokers/ZeosDBO/D2006/DclIOZeosDBO.res
trunk/Source/Brokers/ZeosDBO/D2006/IOZeosDBO.res
trunk/Source/Brokers/ZeosDBO/D5/DclIOZeosDBO_D5.res
trunk/Source/Brokers/ZeosDBO/D5/IOZeosDBO_D5.res
trunk/Source/Brokers/ZeosDBO/D6/DclIOZeosDBO.res
trunk/Source/Brokers/ZeosDBO/D6/IOZeosDBO.res
trunk/Source/Brokers/ZeosDBO/D7/DclIOZeosDBO.res
trunk/Source/Brokers/ZeosDBO/D7/IOZeosDBO.res
trunk/Source/Catalogs/IBFb/D2005/IOIBFbCatalog.res
trunk/Source/Catalogs/IBFb/D2006/IOIBFbCatalog.res
trunk/Source/Catalogs/IBFb/D5/IOIBFbCatalog_D5.res
trunk/Source/Catalogs/IBFb/D6/IOIBFbCatalog.res
trunk/Source/Catalogs/IBFb/D7/IOIBFbCatalog.res
trunk/Source/Catalogs/IBFb/K3/IOIBFbCatalog.res
trunk/Source/Catalogs/MSSql/D2005/IOMSSqlCatalog.res
trunk/Source/Catalogs/MSSql/D2006/IOMSSqlCatalog.res
trunk/Source/Catalogs/MSSql/D5/IOMSSqlCatalog_D5.res
trunk/Source/Catalogs/MSSql/D6/IOMSSqlCatalog.res
trunk/Source/Catalogs/MSSql/D7/IOMSSqlCatalog.res
trunk/Source/Catalogs/MSSql/K3/IOMSSqlCatalog.res
trunk/Source/Core/D2005/IOCore.res
trunk/Source/Core/D2006/IOCore.res
trunk/Source/Core/D5/IOCore_D5.res
trunk/Source/Core/D6/IOCore.res
trunk/Source/Core/D7/IOCore.res
trunk/Source/Core/K3/IOCore.res
trunk/Source/Design/D2005/DclIOCore.res
trunk/Source/Design/D2006/DclIOCore.res
trunk/Source/Design/D5/DclIOCore_D5.res
trunk/Source/Design/D6/DclIOCore.res
trunk/Source/Design/D7/DclIOCore.res
trunk/Source/Design/K3/DclIOCore.res
Modified: trunk/ReleaseTools/InstantVersion.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D2005/DclIOADO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D2005/IOADO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D2006/DclIOADO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D2006/IOADO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D5/DclIOADO_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D5/IOADO_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D6/DclIOADO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D6/IOADO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D7/DclIOADO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADO/D7/IOADO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADS/D5/DclIOADS_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ADS/D5/ioads_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D2005/DclIOBDE.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D2005/IOBDE.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D2006/DclIOBDE.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D2006/IOBDE.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D5/DclIOBDE_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D5/Iobde_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D6/DclIOBDE.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D6/IOBDE.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D7/DclIOBDE.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/BDE/D7/IOBDE.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBISAM/D6/DclDBISAM.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBISAM/D6/IODBISAM.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBISAM/D7/DclDBISAM.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBISAM/D7/IODBISAM.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/D2005/DclIODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/D2005/IODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/D2006/DclIODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/D2006/IODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/D6/DclIODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/D6/IODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/D7/DclIODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/D7/IODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/K3/DclIODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/DBX/K3/IODBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/FlashFiler/D5/DclIOff_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/FlashFiler/D5/ioff_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D2005/DclIOIBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D2005/IOIBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D2006/DclIOIBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D2006/IOIBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D5/DclIOIBX_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D5/Ioibx_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D6/DclIOIBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D6/IOIBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D7/DclIOIBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/IBX/D7/IOIBX.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D2005/DclIONexusDB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D2005/IONexusDB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D2006/DclIONexusDB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D2006/IONexusDB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D5/DclIONexusDB_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D5/IONexusDB_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D6/DclIONexusDB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D6/IONexusDB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D7/DclIONexusDB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/NexusDb/D7/IONexusDB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D2005/DclIOUIB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D2005/IOUIB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D2006/DclIOUIB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D2006/IOUIB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D5/DclIOUIB_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D5/IOUIB_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D6/DclIOUIB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D6/IOUIB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D7/DclIOUIB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/UIB/D7/IOUIB.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D2005/DclIOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D2005/IOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D2006/DclIOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D2006/IOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D5/DclIOXML_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D5/Ioxml_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D6/DclIOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D6/IOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D7/DclIOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/D7/IOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/k3/DclIOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/XML/k3/IOXML.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D2005/DclIOZeosDBO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D2005/IOZeosDBO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D2006/DclIOZeosDBO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D2006/IOZeosDBO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D5/DclIOZeosDBO_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D5/IOZeosDBO_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D6/DclIOZeosDBO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D6/IOZeosDBO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D7/DclIOZeosDBO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Brokers/ZeosDBO/D7/IOZeosDBO.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/IBFb/D2005/IOIBFbCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/IBFb/D2006/IOIBFbCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/IBFb/D5/IOIBFbCatalog_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/IBFb/D6/IOIBFbCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/IBFb/D7/IOIBFbCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/IBFb/K3/IOIBFbCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/MSSql/D2005/IOMSSqlCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/MSSql/D2006/IOMSSqlCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/MSSql/D5/IOMSSqlCatalog_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/MSSql/D6/IOMSSqlCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/MSSql/D7/IOMSSqlCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Catalogs/MSSql/K3/IOMSSqlCatalog.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Core/D2005/IOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Core/D2006/IOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Core/D5/IOCore_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Core/D6/IOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Core/D7/IOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Core/K3/IOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Design/D2005/DclIOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Design/D2006/DclIOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Design/D5/DclIOCore_D5.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Design/D6/DclIOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Design/D7/DclIOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Design/K3/DclIOCore.res
===================================================================
(Binary files differ)
|
|
From: <na...@us...> - 2007-02-25 09:44:47
|
Revision: 767
http://svn.sourceforge.net/instantobjects/revision/?rev=767&view=rev
Author: nandod
Date: 2007-02-25 01:44:46 -0800 (Sun, 25 Feb 2007)
Log Message:
-----------
* Docs updated for 2.1.
Modified Paths:
--------------
trunk/Docs/Changes.txt
trunk/Docs/Install.txt
trunk/Readme1st.txt
trunk/Source/PackageGroups/Install.txt
Modified: trunk/Docs/Changes.txt
===================================================================
--- trunk/Docs/Changes.txt 2007-02-24 23:49:44 UTC (rev 766)
+++ trunk/Docs/Changes.txt 2007-02-25 09:44:46 UTC (rev 767)
@@ -1,6 +1,77 @@
VERSION HISTORY
---------------
+Version 2.1 (2.1.0.0) (2007-02-26)
+
+- Support for SQL Server 2005; catalog support for SQL Server 7;
+ better support for SQL Server in general.
+
+- Support for ModelMaker 6.20 to 9; better ModelMaker support
+ in general in ObjectFoundry.
+
+- Support for InstantDate and InstantTime for date-only and
+ time-only attribute types.
+
+- Instant Model Explorer enhancements:
+ - Class B has a base class A and subclasses C, D, etc.
+ making a three tier class hierarchy. If Class B is deleted
+ classes C, D, etc. will become subclasses of class A.
+ Previously they would become subclasses of TInstantObject.
+ - New class B in model unit X has a base class A in model unit Y.
+ When adding new class B, unit Y will be automatically
+ added to the Interface uses clause of unit X.
+ - Whenever a unit is added to the uses clause of an interface
+ section, that unit is removed from the implementation
+ section uses clause if present. Whenever a unit is added to the
+ implementation section uses clause, check the interface section
+ uses clause and if the unit is there then don't add anything.
+
+- Instant model Explorer now uses the newer ToolsAPI on Delphi 7+.
+
+- Improved object circular reference detection.
+
+- Added ability to disable circular reference checking
+ by undefining IO_CIRCULAR_REFERENCE_CHECK.
+
+- Enhanced SQL statement logging: now logs all statements,
+ including select statements.
+
+- BDE broker: fixed incomplete implementation of IdDataType
+ and IdSize.
+
+- ADO broker: fixed incomplete implementation of IdDataType
+ and IdSize.
+
+- XML broker: now only creates one file for each object,
+ in the concrete class' folder.
+
+- XML broker: removed support for versioning and
+ utf-8 "BOT" encoding.
+
+- XML broker: fixed failure on query refresh.
+
+- XML broker restructured for easier customization.
+
+- Refactored InstantPersistence.pas into:
+ InstantPersistence.pas - Remains the main 'IO interface' unit.
+ InstantBrokers.pas - Contains the descendant brokers, connectors classes.
+ InstantMetadata.pas - Contains the metadata, scheme, etc. classes.
+ InstantTypes - Contains some type declarations.
+
+- Ubmock and fpcunit integrated into the source tree
+ for easier test development.
+
+- Help file has been greatly improved.
+
+- Added explanatory document for IO to InterBase
+ and Firebird data type mappings.
+
+- Various fixes and enhancements (see tracker).
+
+Version 2.0 (2.0.0.0) (2006-08-07)
+
+- All 2.0 RC changes.
+
Version 2.0 RC 1 (1.9.2.1) (2006-05-07)
- Help file has been improved.
Modified: trunk/Docs/Install.txt
===================================================================
--- trunk/Docs/Install.txt 2007-02-24 23:49:44 UTC (rev 766)
+++ trunk/Docs/Install.txt 2007-02-25 09:44:46 UTC (rev 767)
@@ -1,6 +1,6 @@
------------------------------------------------------------------
- InstantObjects 2.0 for Delphi, Kylix, FPC
+ InstantObjects for Delphi, Kylix, FPC
Mozilla Public License 1.1
Based on Seleqt InstantObjects.
Modified: trunk/Readme1st.txt
===================================================================
--- trunk/Readme1st.txt 2007-02-24 23:49:44 UTC (rev 766)
+++ trunk/Readme1st.txt 2007-02-25 09:44:46 UTC (rev 767)
@@ -1,6 +1,6 @@
------------------------------------------------------------------
- InstantObjects 2.0 for Delphi, Kylix, FPC
+ InstantObjects for Delphi, Kylix, FPC
Mozilla Public License 1.1 Edition
Based on Seleqt InstantObjects.
Modified: trunk/Source/PackageGroups/Install.txt
===================================================================
--- trunk/Source/PackageGroups/Install.txt 2007-02-24 23:49:44 UTC (rev 766)
+++ trunk/Source/PackageGroups/Install.txt 2007-02-25 09:44:46 UTC (rev 767)
@@ -1,10 +1,9 @@
------------------------------------------------------------------
- InstantObjects 2.0 Beta 2 (1.9.2.1) for Delphi, Kylix, FPC
+ InstantObjects for Delphi, Kylix, FPC
Mozilla Public License 1.1 Edition
- January 2006 release
-
+
Based on Seleqt InstantObjects.
Portions created by Seleqt are Copyright (c) 2001-2003 Seleqt.
Other portions and changes are Copyright (c) the authors.
|
|
From: <jcm...@us...> - 2007-02-24 23:49:56
|
Revision: 766
http://svn.sourceforge.net/instantobjects/revision/?rev=766&view=rev
Author: jcmoraisjr
Date: 2007-02-24 15:49:44 -0800 (Sat, 24 Feb 2007)
Log Message:
-----------
Fixed bug #1174283
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2007-02-24 23:45:06 UTC (rev 765)
+++ trunk/Source/Core/InstantBrokers.pas 2007-02-24 23:49:44 UTC (rev 766)
@@ -3993,15 +3993,13 @@
Resolver.AddIdParam(Params, InstantParentIdFieldName, AttributeOwner.Id);
Resolver.AddStringParam(Params, InstantParentClassFieldName,
AttributeOwner.ClassName);
- Resolver.AddStringParam(Params, InstantChildClassFieldName,
- Attribute.Metadata.ObjectClassName);
DataSet := Broker.AcquireDataSet(Statement, Params);
try
DataSet.Open;
try
while not DataSet.Eof do
begin
- Obj := Attribute.Metadata.ObjectClass.Retrieve(
+ Obj := InstantFindClass(DataSet.FieldByName(InstantChildClassFieldName).AsString).Retrieve(
// DataSet.Fields[1].AsString, False, False, AObject.Connector);
DataSet.FieldByName(InstantChildIdFieldName).AsString,
False, False, Attribute.Connector) as TInstantObject;
@@ -4039,8 +4037,6 @@
Resolver.AddIdParam(Params, InstantParentIdFieldName, AObjectId);
Resolver.AddStringParam(Params, InstantParentClassFieldName,
AttributeOwner.ClassName);
- Resolver.AddStringParam(Params, InstantChildClassFieldName,
- Attribute.Metadata.ObjectClassName);
DataSet := Broker.AcquireDataSet(Statement, Params);
try
DataSet.Open;
@@ -4680,10 +4676,9 @@
begin
FieldStr := Format('%s, %s, %s', [EmbraceField(InstantChildClassFieldName),
EmbraceField(InstantChildIdFieldName), EmbraceField(InstantSequenceNoFieldName)]);
- WhereStr := Format('%s = :%s AND %s = :%s AND %s = :%s',
+ WhereStr := Format('%s = :%s AND %s = :%s',
[EmbraceField(InstantParentClassFieldName), InstantParentClassFieldName,
- EmbraceField(InstantParentIdFieldName), InstantParentIdFieldName,
- EmbraceField(InstantChildClassFieldName), InstantChildClassFieldName]);
+ EmbraceField(InstantParentIdFieldName), InstantParentIdFieldName]);
Result := Format('SELECT %s FROM %s WHERE %s ORDER BY %s',
[FieldStr, EmbraceTable('%s'), WhereStr, EmbraceField(InstantSequenceNoFieldName)]);
end;
|
|
From: <jcm...@us...> - 2007-02-24 23:45:10
|
Revision: 765
http://svn.sourceforge.net/instantobjects/revision/?rev=765&view=rev
Author: jcmoraisjr
Date: 2007-02-24 15:45:06 -0800 (Sat, 24 Feb 2007)
Log Message:
-----------
Fixed bug #1668108.
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2007-02-24 20:08:53 UTC (rev 764)
+++ trunk/Source/Core/InstantPersistence.pas 2007-02-24 23:45:06 UTC (rev 765)
@@ -4227,7 +4227,7 @@
if Assigned(Metadata) and (Metadata.StorageKind = skEmbedded) then
raise EInstantError.CreateFmt(SUnsupportedAttributeOperation,
['AddReference', ClassName, Name, 'StorageKind = skEmbedded']);
- if RequiredClassName <> AObjectClassName then
+ if not InstantFindClass(AObjectClassName).InheritsFrom(RequiredClass) then
raise EInstantValidationError.CreateFmt(SInvalidObjectClass,
[AObjectClassName, ClassName, Name, RequiredClass.ClassName]);
|
|
From: <jcm...@us...> - 2007-02-24 20:08:53
|
Revision: 764
http://svn.sourceforge.net/instantobjects/revision/?rev=764&view=rev
Author: jcmoraisjr
Date: 2007-02-24 12:08:53 -0800 (Sat, 24 Feb 2007)
Log Message:
-----------
Included svn eol-style and mime-type properties.
Modified Paths:
--------------
trunk/Source/Core/InstantMetadata.pas
Property Changed:
----------------
trunk/Source/Core/InstantMetadata.pas
Modified: trunk/Source/Core/InstantMetadata.pas
===================================================================
--- trunk/Source/Core/InstantMetadata.pas 2007-02-24 20:07:25 UTC (rev 763)
+++ trunk/Source/Core/InstantMetadata.pas 2007-02-24 20:08:53 UTC (rev 764)
@@ -1,1970 +1,1970 @@
-(*
- * InstantObjects
- * Metadata Classes
- *)
-
-(* ***** BEGIN LICENSE BLOCK *****
- * Version: MPL 1.1
- *
- * The contents of this file are subject to the Mozilla Public License Version
- * 1.1 (the "License"); you may not use this file except in compliance with
- * the License. You may obtain a copy of the License at
- * http://www.mozilla.org/MPL/
- *
- * Software distributed under the License is distributed on an "AS IS" basis,
- * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
- * for the specific language governing rights and limitations under the
- * License.
- *
- * The Original Code is: Seleqt InstantObjects
- *
- * The Initial Developer of the Original Code is: Seleqt
- *
- * Portions created by the Initial Developer are Copyright (C) 2001-2003
- * the Initial Developer. All Rights Reserved.
- *
- * Contributor(s):
- * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
- * Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas,
- * Riceball Lee, David Moorhouse
- *
- * ***** END LICENSE BLOCK ***** *)
-
-unit InstantMetadata;
-
-{$IFDEF LINUX}
-{$I '../InstantDefines.inc'}
-{$ELSE}
-{$I '..\InstantDefines.inc'}
-{$ENDIF}
-
-interface
-
-uses Classes, Contnrs, Db, InstantClasses, InstantTypes, InstantConsts;
-
-type
- TInstantAttributeMap = class;
- TInstantAttributeMaps = class;
- TInstantAttributeMetadata = class;
- TInstantAttributeMetadatas = class;
- TInstantCatalog = class;
- TInstantClassMetadata = class;
- TInstantClassMetadatas = class;
- TInstantFieldMetadata = class;
- TInstantFieldMetadatas = class;
- TInstantIndexMetadata = class;
- TInstantIndexMetadatas = class;
- TInstantMetadatas = class;
- TInstantScheme = class;
- TInstantTableMetadata = class;
- TInstantTableMetadatas = class;
-
- TInstantMetadata = class(TInstantCollectionItem)
- private
- function GetCollection: TInstantMetadatas;
- procedure SetCollection(Value: TInstantMetadatas);
- {$IFDEF D6+}reintroduce; {$ENDIF}
- protected
- function InternalEquals(const Other: TInstantMetadata): Boolean; virtual;
- public
- function Equals(const Other: TInstantMetadata): Boolean;
- property Collection: TInstantMetadatas read GetCollection
- write SetCollection;
- end;
-
- TInstantClassMetadata = class(TInstantMetadata)
- private
- FAttributeMetadatas: TInstantAttributeMetadatas;
- FDefaultContainerName: string;
- FMemberMap: TInstantAttributeMap;
- FParent: TInstantClassMetadata;
- FParentName: string;
- FPersistence: TInstantPersistence;
- FStorageMap: TInstantAttributeMap;
- FStorageMaps: TInstantAttributeMaps;
- FStorageName: string;
- procedure BuildAttributeMap(Map: TInstantAttributeMap; Complete: Boolean);
- procedure BuildStorageMaps(Maps: TInstantAttributeMaps);
- procedure DestroyAttributeViews;
- function GetAttributeMetadatas: TInstantAttributeMetadatas;
- function GetCollection: TInstantClassMetadatas;
- procedure GetDistinctAttributeMetadatas(Map: TInstantAttributeMap);
- function GetIsEmpty: Boolean;
- function GetIsStored: Boolean;
- function GetMemberMap: TInstantAttributeMap;
- function GetParent: TInstantClassMetadata;
- function GetParentName: string;
- function GetStorageMap: TInstantAttributeMap;
- function GetStorageMaps: TInstantAttributeMaps;
- function GetTableName: string;
- procedure SetCollection(Value: TInstantClassMetadatas);
- procedure SetParent(Value: TInstantClassMetadata);
- procedure SetParentName(const Value: string);
- procedure SetTableName(const Value: string);
- protected
- procedure ClearParent;
- class procedure ConvertToBinary(Converter: TInstantTextToBinaryConverter);
- override;
- class procedure ConvertToText(Converter: TInstantBinaryToTextConverter);
- override;
- procedure ReadObject(Reader: TInstantReader); override;
- procedure WriteObject(Writer: TInstantWriter); override;
- public
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- property AttributeMetadatas: TInstantAttributeMetadatas
- read GetAttributeMetadatas;
- property Collection: TInstantClassMetadatas read GetCollection
- write SetCollection;
- property IsEmpty: Boolean read GetIsEmpty;
- property IsStored: Boolean read GetIsStored;
- property MemberMap: TInstantAttributeMap read GetMemberMap;
- property Parent: TInstantClassMetadata read GetParent write SetParent;
- property StorageMap: TInstantAttributeMap read GetStorageMap;
- property StorageMaps: TInstantAttributeMaps read GetStorageMaps;
- property TableName: string read GetTableName write SetTableName;
- published
- property DefaultContainerName: string read FDefaultContainerName
- write FDefaultContainerName;
- property ParentName: string read GetParentName write SetParentName;
- property Persistence: TInstantPersistence read FPersistence
- write FPersistence;
- property StorageName: string read FStorageName write FStorageName;
- end;
-
- TInstantFieldMetadata = class(TInstantMetadata)
- private
- FDataType: TInstantDataType;
- FOptions: TInstantFieldOptions;
- FSize: Integer;
- FAlternateDataTypes: TInstantDataTypes;
- function GetCollection: TInstantFieldMetadatas;
- function GetTableMetadata: TInstantTableMetadata;
- protected
- function InternalEquals(const Other: TInstantMetadata): Boolean; override;
- public
- constructor Create(ACollection: TInstantFieldMetadatas); reintroduce;
- procedure Assign(Source: TPersistent); override;
- // Returns True if one of the data types of Other (Other.DataType and
- // Other.AlternateDataTypes) equals one of the data types of Self.
- function DataTypesEqual(const Other: TInstantFieldMetadata): Boolean;
- property Collection: TInstantFieldMetadatas read GetCollection;
- property DataType: TInstantDataType read FDataType write FDataType;
- // When field metadata is gathered from a database, there might be more
- // TInstantDataType values that apply (for example when the database
- // represents dtBoolean and dtInteger attributes with the same column type).
- // In that case, a datatype is chosen as the value of the DataType
- // property, and the others are put in AlternateDataTypes. The
- // DataTypesEqual method considers both DataType and AlternateDataTypes when
- // deciding upon data type "equality".
- property AlternateDataTypes: TInstantDataTypes
- read FAlternateDataTypes write FAlternateDataTypes;
- property Options: TInstantFieldOptions read FOptions write FOptions;
- property Size: Integer read FSize write FSize;
- property TableMetadata: TInstantTableMetadata read GetTableMetadata;
- end;
-
- TInstantIndexMetadata = class(TInstantMetadata)
- private
- FFields: string;
- FOptions: TIndexOptions;
- function GetCollection: TInstantIndexMetadatas;
- function GetTableMetadata: TInstantTableMetadata;
- protected
- function InternalEquals(const Other: TInstantMetadata): Boolean; override;
- public
- constructor Create(ACollection: TInstantMetadatas); reintroduce;
- procedure Assign(Source: TPersistent); override;
- property Collection: TInstantIndexMetadatas read GetCollection;
- // Returns True if the field identified by AFieldMetadata is part of this
- // index.
- function IsFieldIndexed(const AFieldMetadata: TInstantFieldMetadata):
- Boolean;
- property TableMetadata: TInstantTableMetadata read GetTableMetadata;
- published
- property Fields: string read FFields write FFields;
- property Options: TIndexOptions read FOptions write FOptions;
- end;
-
- TInstantTableMetadata = class(TInstantMetadata)
- private
- FFieldMetadatas: TInstantFieldMetadatas;
- FIndexMetadatas: TInstantIndexMetadatas;
- function GetFieldMetadatas: TInstantFieldMetadatas;
- function GetIndexMetadatas: TInstantIndexMetadatas;
- function GetScheme: TInstantScheme;
- function GetFieldMetadataCount: Integer;
- function GetIndexMetadataCount: Integer;
- public
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- property Scheme: TInstantScheme read GetScheme;
- published
- property FieldMetadataCount: Integer read GetFieldMetadataCount;
- property FieldMetadatas: TInstantFieldMetadatas read GetFieldMetadatas;
- function FindFieldMetadata(const AName: string): TInstantFieldMetadata;
- function FindIndexMetadata(const AName: string): TInstantIndexMetadata;
- property IndexMetadataCount: Integer read GetIndexMetadataCount;
- property IndexMetadatas: TInstantIndexMetadatas read GetIndexMetadatas;
- end;
-
- TInstantMetadatas = class(TInstantOwnedCollection)
- private
- function GetItems(Index: Integer): TInstantMetadata;
- procedure SetItems(Index: Integer; const Value: TInstantMetadata);
- public
- function Find(const AName: string): TInstantMetadata;
- property Items[Index: Integer]: TInstantMetadata read GetItems
- write SetItems; default;
- end;
-
- TInstantClassMetadatas = class(TInstantMetadatas)
- private
- function GetItems(Index: Integer): TInstantClassMetadata;
- procedure SetItems(Index: Integer; Value: TInstantClassMetadata);
- protected
- class function CreateInstance(Arg: Pointer = nil): TInstantCollection;
- override;
- public
- constructor Create(AOwner: TPersistent);
- function Add: TInstantClassMetadata;
- function Find(const AName: string): TInstantClassMetadata;
- property Items[Index: Integer]: TInstantClassMetadata read GetItems
- write SetItems; default;
- end;
-
- TInstantFieldMetadatas = class(TInstantMetadatas)
- private
- function GetItems(Index: Integer): TInstantFieldMetadata;
- procedure SetItems(Index: Integer; Value: TInstantFieldMetadata);
- public
- constructor Create(AOwner: TInstantTableMetadata);
- procedure AddFieldMetadata(const AName: string; ADataType: TInstantDataType;
- ASize: Integer; AOptions: TInstantFieldOptions = []);
- function Add: TInstantFieldMetadata;
- function Find(const AName: string): TInstantFieldMetadata;
- property Items[Index: Integer]: TInstantFieldMetadata read GetItems
- write SetItems; default;
- function Owner: TInstantTableMetadata;
- end;
-
- TInstantIndexMetadatas = class(TInstantMetadatas)
- private
- function GetItems(Index: Integer): TInstantIndexMetadata;
- procedure SetItems(Index: Integer; Value: TInstantIndexMetadata);
- public
- constructor Create(AOwner: TInstantTableMetadata);
- procedure AddIndexMetadata(const AName, AFields: string;
- AOptions: TIndexOptions);
- function Add: TInstantIndexMetadata;
- function Find(const AName: string): TInstantIndexMetadata;
- // Returns True if the field identified by AFieldMetadata is part of a
- // defined index.
- function IsFieldIndexed(const AFieldMetadata: TInstantFieldMetadata):
- Boolean;
- property Items[Index: Integer]: TInstantIndexMetadata read GetItems
- write SetItems; default;
- function Owner: TInstantTableMetadata;
- end;
-
- TInstantTableMetadatas = class(TInstantMetadatas)
- private
- function GetItems(Index: Integer): TInstantTableMetadata;
- public
- constructor Create(AOwner: TPersistent);
- function Add: TInstantTableMetadata;
- function Find(const AName: string): TInstantTableMetadata;
- property Items[Index: Integer]: TInstantTableMetadata read GetItems;
- default;
- end;
-
- TInstantModel = class(TPersistent)
- private
- FClassMetadatas: TInstantClassMetadatas;
- function GetClassMetadatas: TInstantClassMetadatas;
- protected
- procedure DestroyClassMetadatas;
- public
- destructor Destroy; override;
- procedure LoadFromFile(const FileName: string);
- procedure LoadFromResFile(const FileName: string);
- procedure SaveToFile(const FileName: string);
- procedure SaveToResFile(const FileName: string);
- property ClassMetadatas: TInstantClassMetadatas read GetClassMetadatas;
- end;
-
- TInstantScheme = class(TInstantStreamable)
- private
- FOnWarning: TInstantWarningEvent;
- FCatalog: TInstantCatalog;
- FTableMetadataCollection: TInstantTableMetadatas;
- FBlobStreamFormat: TInstantStreamFormat;
- FIdSize: Integer;
- FIdDataType: TInstantDataType;
- function GetTableMetadataCollection: TInstantTableMetadatas;
- function GetTableMetadatas(Index: Integer): TInstantTableMetadata;
- function GetTableMetadataCount: Integer;
- procedure SetCatalog(const Value: TInstantCatalog);
- procedure CatalogWarningEventHandler(const Sender: TObject;
- const AWarningText: string);
- protected
- procedure DoWarning(const AWarningText: string);
- function AttributeTypeToDataType(
- AttributeType: TInstantAttributeType): TInstantDataType; virtual;
- property TableMetadataCollection: TInstantTableMetadatas
- read GetTableMetadataCollection;
- public
- constructor Create;
- destructor Destroy; override;
- property Catalog: TInstantCatalog read FCatalog write SetCatalog;
- function FindTableMetadata(const AName: string): TInstantTableMetadata;
- property TableMetadataCount: Integer read GetTableMetadataCount;
- property TableMetadatas[Index: Integer]: TInstantTableMetadata
- read GetTableMetadatas;
- property BlobStreamFormat: TInstantStreamFormat read FBlobStreamFormat
- write FBlobStreamFormat default sfBinary;
- property IdDataType: TInstantDataType read FIdDataType write FIdDataType
- default dtString;
- property IdSize: Integer read FIdSize write FIdSize
- default InstantDefaultFieldSize;
- // Triggered when the scheme has something to report about its activity,
- // typically during database building/evolution, which is not a fatal error.
- property OnWarning: TInstantWarningEvent read FOnWarning write FOnWarning;
- end;
-
- // An object that provides the metadata info used by a TInstantScheme object
- // to build itself. It abstracts the way the information is fetched and its
- // source. It always works with a TInstantScheme. It is usually created
- // together with a TInstantScheme object:
- // Scheme := TInstantScheme.Create;
- // Scheme.Catalog := Broker.CreateCatalog(Scheme);
- // and the object ownership is transferred to Scheme, which is then
- // responsible for destroying the catalog object.
- TInstantCatalog = class
- private
- FScheme: TInstantScheme;
- FOnWarning: TInstantWarningEvent;
- protected
- function GetFeatures: TInstantCatalogFeatures; virtual;
- procedure DoWarning(const WarningText: string);
- public
- // Creates an instance and binds it to the specified TInstantScheme object.
- constructor Create(const AScheme: TInstantScheme);
- // A reference to the TInstantScheme object to which the current object is
- // bound, assigned on creation. The TInstantScheme object is responsible for
- // the current object's lifetime.
- property Scheme: TInstantScheme read FScheme;
- // Initializes ATableMetadatas from the catalog.
- procedure InitTableMetadatas(ATableMetadatas: TInstantTableMetadatas);
- virtual; abstract;
- // Returns a set of supported features. The predefined implementation
- // says that the catalog support everything; derived classes might not
- // support all features.
- property Features: TInstantCatalogFeatures read GetFeatures;
- // Triggered when the catalog has something to report about its activity,
- // typically during InitTableMetadatas, which is not a fatal error.
- property OnWarning: TInstantWarningEvent
- read FOnWarning write FOnWarning;
- end;
-
- // A TInstantCatalog that gathers its info from a TInstantModel.
- TInstantModelCatalog = class(TInstantCatalog)
- private
- FModel: TInstantModel;
- public
- // Creates an instance and binds it to the specified TInstantScheme object.
- // AModel is written to the Model property.
- constructor Create(const AScheme: TInstantScheme;
- const AModel: TInstantModel);
- // Initializes ATableMetadatas reading maps from the model.
- procedure InitTableMetadatas(ATableMetadatas: TInstantTableMetadatas);
- override;
- // A reference to the TInstantModel from which the catalog reads metadata
- // info.
- property Model: TInstantModel read FModel;
- end;
-
- TInstantAttributeMap = class(TInstantNamedList)
- private
- FClassMetadata: TInstantClassMetadata;
- FName: string;
- function GetItems(Index: Integer): TInstantAttributeMetadata;
- procedure SetItems(Index: Integer; Value: TInstantAttributeMetadata);
- function GetIsRootMap: Boolean;
- protected
- function GetName: string; override;
- procedure SetName(const Value: string); override;
- public
- constructor Create(AClassMetadata: TInstantClassMetadata);
- function Add(Item: TInstantAttributeMetadata): Integer;
- function AddUnique(Item: TInstantAttributeMetadata): Integer;
- function Find(const AName: string): TInstantAttributeMetadata;
- function IndexOf(Item: TInstantAttributeMetadata): Integer;
- procedure Insert(Index: Integer; Item: TInstantAttributeMetadata);
- function Remove(Item: TInstantAttributeMetadata): Integer;
- property ClassMetadata: TInstantClassMetadata read FClassMetadata;
- property IsRootMap: Boolean read GetIsRootMap;
- property Items[Index: Integer]: TInstantAttributeMetadata read GetItems
- write SetItems; default;
- end;
-
- TInstantAttributeMaps = class(TObjectList)
- private
- FClassMetadata: TInstantClassMetadata;
- function GetItems(Index: Integer): TInstantAttributeMap;
- function GetRootMap: TInstantAttributeMap;
- procedure SetItems(Index: Integer; Value: TInstantAttributeMap);
- public
- constructor Create(AClassMetadata: TInstantClassMetadata);
- function Add: TInstantAttributeMap; overload;
- function Add(Item: TInstantAttributeMap): Integer; overload;
- function Find(const AName: string): TInstantAttributeMap;
- function FindMap(const AttributeName: string): TInstantAttributeMap;
- function EnsureMap(const AName: string): TInstantAttributeMap;
- function IndexOf(Item: TInstantAttributeMap): Integer;
- procedure Insert(Index: Integer; Item: TInstantAttributeMap);
- function Remove(Item: TInstantAttributeMap): Integer;
- property ClassMetadata: TInstantClassMetadata read FClassMetadata;
- property RootMap: TInstantAttributeMap read GetRootMap;
- property Items[Index: Integer]: TInstantAttributeMap read GetItems
- write SetItems; default;
- end;
-
- TInstantAttributeMetadata = class(TInstantMetadata)
- private
- FAttributeType: TInstantAttributeType;
- FDefaultValue: string;
- FDisplayWidth: Integer;
- FEditMask: string;
- FIsIndexed: Boolean;
- FIsRequired: Boolean;
- FObjectClassName: string;
- FSize: Integer;
- FStorageName: string;
- FValidChars: TChars;
- FStorageKind: TInstantStorageKind;
- FExternalStorageName: string;
- function GetAttributeClass: TInstantAbstractAttributeClass;
- function GetAttributeClassName: string;
- function GetAttributeTypeName: string;
- function GetCategory: TInstantAttributeCategory;
- function GetClassMetadata: TInstantClassMetadata;
- function GetClassMetadataName: string;
- function GetCollection: TInstantAttributeMetadatas;
- function GetFieldName: string;
- function GetHasValidChars: Boolean;
- function GetIsDefault: Boolean;
- function GetObjectClass: TInstantAbstractObjectClass;
- function GetObjectClassMetadata: TInstantClassMetadata;
- function GetTableName: string;
- function GetValidChars: TChars;
- function GetValidCharsString: string;
- procedure SetAttributeClass(const AClass: TInstantAbstractAttributeClass);
- procedure SetAttributeClassName(const Value: string);
- procedure SetAttributeTypeName(const Value: string);
- procedure SetCollection(Value: TInstantAttributeMetadatas);
- procedure SetFieldName(const Value: string);
- procedure SetIsDefault(const Value: Boolean);
- procedure SetValidCharsString(const Value: string);
- public
- function CreateAttribute(AObject: TInstantAbstractObject):
- TInstantAbstractAttribute;
- procedure Assign(Source: TPersistent); override;
- procedure CheckAttributeClass(AClass: TInstantAbstractAttributeClass);
- procedure CheckCategory(ACategory: TInstantAttributeCategory);
- procedure CheckIsIndexed;
- function IsAttributeClass(AClass: TInstantAbstractAttributeClass): Boolean;
- property AttributeClass: TInstantAbstractAttributeClass
- read GetAttributeClass write SetAttributeClass;
- property AttributeClassName: string read GetAttributeClassName
- write SetAttributeClassName;
- property Category: TInstantAttributeCategory read GetCategory;
- property ClassMetadataName: string read GetClassMetadataName;
- property Collection: TInstantAttributeMetadatas read GetCollection
- write SetCollection;
- property IsDefault: Boolean read GetIsDefault write SetIsDefault;
- property ObjectClass: TInstantAbstractObjectClass read GetObjectClass;
- property ObjectClassMetadata: TInstantClassMetadata
- read GetObjectClassMetadata;
- property FieldName: string read GetFieldName write SetFieldName;
- property HasValidChars: Boolean read GetHasValidChars;
- property TableName: string read GetTableName;
- property ValidChars: TChars read GetValidChars write FValidChars;
- published
- property AttributeType: TInstantAttributeType read FAttributeType
- write FAttributeType default atUnknown;
- property AttributeTypeName: string read GetAttributeTypeName
- write SetAttributeTypeName stored False;
- property ClassMetadata: TInstantClassMetadata read GetClassMetadata;
- property DefaultValue: string read FDefaultValue write FDefaultValue;
- property DisplayWidth: Integer read FDisplayWidth write FDisplayWidth
- default 0;
- property EditMask: string read FEditMask write FEditMask;
- property ExternalStorageName: string read FExternalStorageName
- write FExternalStorageName;
- property StorageKind: TInstantStorageKind read FStorageKind
- write FStorageKind default skEmbedded;
- property IsIndexed: Boolean read FIsIndexed write FIsIndexed;
- property IsRequired: Boolean read FIsRequired write FIsRequired;
- property ObjectClassName: string read FObjectClassName
- write FObjectClassName;
- property Size: Integer read FSize write FSize default 0;
- property StorageName: string read FStorageName write FStorageName;
- property ValidCharsString: string read GetValidCharsString
- write SetValidCharsString;
- end;
-
- TInstantAttributeMetadatas = class(TInstantMetadatas)
- private
- function GetItems(Index: Integer): TInstantAttributeMetadata;
- procedure SetItems(Index: Integer; Value: TInstantAttributeMetadata);
- protected
- procedure Changed;
- public
- constructor Create(AOwner: TInstantClassMetadata);
- function Add: TInstantAttributeMetadata;
- procedure Clear;
- function Find(const AName: string): TInstantAttributeMetadata;
- procedure Remove(Item: TInstantAttributeMetadata);
- property Items[Index: Integer]: TInstantAttributeMetadata read GetItems
- write SetItems; default;
- function Owner: TInstantClassMetadata;
- end;
-
-implementation
-
-uses SysUtils, TypInfo, InstantPersistence, InstantUtils;
-
-const
- AttributeClasses: array[TInstantAttributeType] of TInstantAttributeClass = (
- nil, TInstantInteger, TInstantFloat, TInstantCurrency, TInstantBoolean,
- TInstantString, TInstantDateTime, TInstantBlob, TInstantMemo,
- TInstantGraphic, TInstantPart, TInstantReference, TInstantParts,
- TInstantReferences, TInstantDate, TInstantTime);
-
-{ TInstantMetadata }
-
-function TInstantMetadata.Equals(const Other: TInstantMetadata): Boolean;
-begin
- Result := InternalEquals(Other);
-end;
-
-function TInstantMetadata.GetCollection: TInstantMetadatas;
-begin
- Result := inherited Collection as TInstantMetadatas;
-end;
-
-function TInstantMetadata.InternalEquals(
- const Other: TInstantMetadata): Boolean;
-begin
- { TODO : This only works for case-insensitive object names! }
- Result := SameText(Other.Name, Name);
-end;
-
-procedure TInstantMetadata.SetCollection(Value: TInstantMetadatas);
-begin
- inherited Collection := Value;
-end;
-
-destructor TInstantClassMetadata.Destroy;
-begin
- FAttributeMetadatas.Free;
- DestroyAttributeViews;
- inherited;
-end;
-
-{ TInstantClassMetadata }
-
-procedure TInstantClassMetadata.Assign(Source: TPersistent);
-begin
- inherited;
- if Source is TInstantClassMetadata then
- with TInstantClassMetadata(Source) do
- begin
- Self.FDefaultContainerName := FDefaultContainerName;
- Self.FStorageName := FStorageName;
- Self.FPersistence := FPersistence;
- end;
-end;
-
-procedure TInstantClassMetadata.BuildAttributeMap(Map: TInstantAttributeMap;
- Complete: Boolean);
-begin
- GetDistinctAttributeMetadatas(Map);
- if Assigned(Parent) and (Complete or not Parent.IsStored) then
- Parent.BuildAttributeMap(Map, Complete);
-end;
-
-procedure TInstantClassMetadata.BuildStorageMaps(Maps: TInstantAttributeMaps);
-var
- I: Integer;
- Map: TInstantAttributeMap;
-begin
- if IsStored then
- begin
- Map := Maps.EnsureMap(TableName);
- for I := 0 to Pred(StorageMap.Count) do
- Map.AddUnique(StorageMap[I]);
- end;
- if Assigned(Parent) then
- Parent.BuildStorageMaps(Maps)
-end;
-
-procedure TInstantClassMetadata.ClearParent;
-begin
- FParent := nil;
-end;
-
-class procedure TInstantClassMetadata.ConvertToBinary(
- Converter: TInstantTextToBinaryConverter);
-begin
- with Converter do
- begin
- ConvertProperties(InstantBuildStartTag(InstantAttributeMetadatasTagName));
- Processor.ReadTag;
- if (Processor.Token = xtTag) and not SameText(Processor.PeekTag,
- InstantBuildEndTag(InstantAttributeMetadatasTagName)) then
- Convert;
- Processor.ReadTag;
- end;
-end;
-
-class procedure TInstantClassMetadata.ConvertToText(
- Converter: TInstantBinaryToTextConverter);
-begin
- inherited;
- with Converter do
- begin
- Producer.WriteStartTag(InstantAttributeMetadatasTagName);
- if not Reader.EndOfList then
- Convert;
- Producer.WriteEndTag;
- end;
-end;
-
-procedure TInstantClassMetadata.DestroyAttributeViews;
-begin
- FreeAndNil(FStorageMap);
- FreeAndNil(FStorageMaps);
- FreeAndNil(FMemberMap);
-end;
-
-function TInstantClassMetadata.GetAttributeMetadatas:
- TInstantAttributeMetadatas;
-begin
- if not Assigned(FAttributeMetadatas) then
- FAttributeMetadatas := TInstantAttributeMetadatas.Create(Self);
- Result := FAttributeMetadatas;
-end;
-
-function TInstantClassMetadata.GetCollection: TInstantClassMetadatas;
-begin
- Result := inherited Collection as TInstantClassMetadatas;
-end;
-
-procedure TInstantClassMetadata.GetDistinctAttributeMetadatas(
- Map: TInstantAttributeMap);
-var
- I: Integer;
- AttribMeta: TInstantAttributeMetadata;
-begin
- with AttributeMetadatas do
- for I := 0 to Pred(Count) do
- begin
- AttribMeta := Items[I];
- if not Assigned(Map.Find(AttribMeta.Name)) then
- Map.Add(AttribMeta);
- end;
-end;
-
-function TInstantClassMetadata.GetIsEmpty: Boolean;
-begin
- Result := (Persistence = peEmbedded) and (AttributeMetadatas.Count = 0)
- and (StorageName = '');
-end;
-
-function TInstantClassMetadata.GetIsStored: Boolean;
-begin
- Result := Persistence = peStored;
-end;
-
-function TInstantClassMetadata.GetMemberMap: TInstantAttributeMap;
-begin
- if not Assigned(FMemberMap) then
- begin
- FMemberMap := TInstantAttributeMap.Create(Self);
- BuildAttributeMap(FMemberMap, True);
- end;
- Result := FMemberMap;
-end;
-
-function TInstantClassMetadata.GetParent: TInstantClassMetadata;
-begin
- if not Assigned(FParent) then
- FParent := Collection.Find(FParentName);
- Result := FParent;
-end;
-
-function TInstantClassMetadata.GetParentName: string;
-begin
- if Assigned(FParent) then
- Result := FParent.Name
- else
- Result := FParentName;
-end;
-
-function TInstantClassMetadata.GetStorageMap: TInstantAttributeMap;
-begin
- if not Assigned(FStorageMap) and IsStored then
- begin
- FStorageMap := TInstantAttributeMap.Create(Self);
- BuildAttributeMap(FStorageMap, False);
- end;
- Result := FStorageMap;
-end;
-
-function TInstantClassMetadata.GetStorageMaps: TInstantAttributeMaps;
-begin
- if not Assigned(FStorageMaps) and IsStored then
- begin
- FStorageMaps := TInstantAttributeMaps.Create(Self);
- BuildStorageMaps(FStorageMaps);
- end;
- Result := FStorageMaps;
-end;
-
-function TInstantClassMetadata.GetTableName: string;
-begin
- if FStorageName = '' then
- Result := InstantClassNameToName(Name)
- else
- Result := FStorageName;
-end;
-
-procedure TInstantClassMetadata.ReadObject(Reader: TInstantReader);
-begin
- inherited;
- if not Reader.EndOfList then
- Reader.ReadObject(AttributeMetadatas);
-end;
-
-procedure TInstantClassMetadata.SetCollection(Value: TInstantClassMetadatas);
-begin
- if Value <> Collection then
- begin
- ClearParent;
- inherited Collection := Value;
- end;
-end;
-
-procedure TInstantClassMetadata.SetParent(Value: TInstantClassMetadata);
-begin
- if Value <> FParent then
- begin
- FParent := Value;
- FParentName := '';
- end;
-end;
-
-procedure TInstantClassMetadata.SetParentName(const Value: string);
-begin
- if Value <> ParentName then
- begin
- ClearParent;
- FParentName := Value;
- end;
-end;
-
-procedure TInstantClassMetadata.SetTableName(const Value: string);
-begin
- if InstantNameToClassName(Value) = Name then
- StorageName := ''
- else
- StorageName := Value;
-end;
-
-procedure TInstantClassMetadata.WriteObject(Writer: TInstantWriter);
-begin
- inherited;
- if AttributeMetadatas.Count > 0 then
- Writer.WriteObject(AttributeMetadatas);
-end;
-
-constructor TInstantFieldMetadata.Create(ACollection: TInstantFieldMetadatas);
-begin
- inherited Create(ACollection);
-end;
-
-{ TInstantFieldMetadata }
-
-procedure TInstantFieldMetadata.Assign(Source: TPersistent);
-begin
- inherited;
- if Source is TInstantFieldMetadata then
- with TInstantFieldMetadata(Source) do
- begin
- Self.FDataType := FDataType;
- Self.FAlternateDataTypes := FAlternateDataTypes;
- Self.FOptions := FOptions;
- Self.FSize := FSize;
- end;
-end;
-
-function TInstantFieldMetadata.DataTypesEqual(
- const Other: TInstantFieldMetadata): Boolean;
-begin
- Result := (DataType = Other.DataType) or
- (DataType in Other.AlternateDataTypes) or
- (Other.DataType in AlternateDataTypes);
-end;
-
-function TInstantFieldMetadata.GetCollection: TInstantFieldMetadatas;
-begin
- Result := inherited Collection as TInstantFieldMetadatas;
-end;
-
-function TInstantFieldMetadata.GetTableMetadata: TInstantTableMetadata;
-begin
- Result := Collection.Owner;
-end;
-
-function TInstantFieldMetadata.InternalEquals(
- const Other: TInstantMetadata): Boolean;
-begin
- Result := inherited InternalEquals(Other);
- if Result then
- Result := (Other is TInstantFieldMetadata) and
- (DataTypesEqual(TInstantFieldMetadata(Other)));
- if DataType = dtString then
- Result := Result and (Size = TInstantFieldMetadata(Other).Size);
-end;
-
-constructor TInstantIndexMetadata.Create(ACollection: TInstantMetadatas);
-begin
- inherited Create(ACollection);
-end;
-
-{ TInstantIndexMetadata }
-
-procedure TInstantIndexMetadata.Assign(Source: TPersistent);
-begin
- inherited;
- if Source is TInstantIndexMetadata then
- with TInstantIndexMetadata(Source) do
- begin
- Self.FFields := FFields;
- Self.FOptions := FOptions;
- end;
-end;
-
-function TInstantIndexMetadata.GetCollection: TInstantIndexMetadatas;
-begin
- Result := inherited Collection as TInstantIndexMetadatas;
-end;
-
-function TInstantIndexMetadata.GetTableMetadata: TInstantTableMetadata;
-begin
- Result := Collection.Owner;
-end;
-
-function TInstantIndexMetadata.InternalEquals(
- const Other: TInstantMetadata): Boolean;
-begin
- Result := inherited InternalEquals(Other);
- if Result then
- Result := (Other is TInstantIndexMetadata) and
- (TInstantIndexMetadata(Other).Options = Options) and
- { TODO : This only works for case-insensitive field names! }
- SameText(TInstantIndexMetadata(Other).Fields, Fields);
-end;
-
-function TInstantIndexMetadata.IsFieldIndexed(
- const AFieldMetadata: TInstantFieldMetadata): Boolean;
-var
- I: Integer;
- List: TStringList;
-begin
- List := TStringList.Create;
- try
- InstantStrToList(Fields, List, [';']);
- Result := False;
- for I := 0 to Pred(List.Count) do
- begin
- { TODO : This only works for case-insensitive field names! }
- Result := SameText(List[I], AFieldMetadata.Name);
- if Result then
- Break;
- end;
- finally
- List.Free;
- end;
-end;
-
-destructor TInstantTableMetadata.Destroy;
-begin
- FFieldMetadatas.Free;
- FIndexMetadatas.Free;
- inherited;
-end;
-
-{ TInstantTableMetadata }
-
-procedure TInstantTableMetadata.Assign(Source: TPersistent);
-begin
- inherited;
- if Source is TInstantTableMetadata then
- with TInstantTableMetadata(Source) do
- begin
- Self.FieldMetadatas.Assign(FieldMetadatas);
- Self.IndexMetadatas.Assign(IndexMetadatas);
- end;
-end;
-
-function TInstantTableMetadata.FindFieldMetadata(
- const AName: string): TInstantFieldMetadata;
-begin
- Result := FieldMetadatas.Find(AName);
-end;
-
-function TInstantTableMetadata.FindIndexMetadata(
- const AName: string): TInstantIndexMetadata;
-begin
- Result := IndexMetadatas.Find(AName);
-end;
-
-function TInstantTableMetadata.GetFieldMetadataCount: Integer;
-begin
- Result := FieldMetadatas.Count;
-end;
-
-function TInstantTableMetadata.GetFieldMetadatas: TInstantFieldMetadatas;
-begin
- if not Assigned(FFieldMetadatas) then
- FFieldMetadatas := TInstantFieldMetadatas.Create(Self);
- Result := FFieldMetadatas;
-end;
-
-function TInstantTableMetadata.GetIndexMetadataCount: Integer;
-begin
- Result := IndexMetadatas.Count;
-end;
-
-function TInstantTableMetadata.GetIndexMetadatas: TInstantIndexMetadatas;
-begin
- if not Assigned(FIndexMetadatas) then
- FIndexMetadatas := TInstantIndexMetadatas.Create(Self);
- Result := FIndexMetadatas;
-end;
-
-function TInstantTableMetadata.GetScheme: TInstantScheme;
-begin
- if Assigned(Collection) and (Collection.Owner is TInstantScheme) then
- Result := TInstantScheme(Collection.Owner)
- else
- Result := nil;
-end;
-
-{ TInstantMetadatas }
-
-function TInstantMetadatas.Find(const AName: string): TInstantMetadata;
-begin
- Result := TInstantMetadata(inherited Find(AName));
-end;
-
-function TInstantMetadatas.GetItems(Index: Integer): TInstantMetadata;
-begin
- Result := inherited Items[Index] as TInstantMetadata;
-end;
-
-procedure TInstantMetadatas.SetItems(Index: Integer;
- const Value: TInstantMetadata);
-begin
- inherited Items[Index] := Value;
-end;
-
-constructor TInstantClassMetadatas.Create(AOwner: TPersistent);
-begin
- inherited Create(AOwner, TInstantClassMetadata);
-end;
-
-{ TInstantClassMetadatas }
-
-function TInstantClassMetadatas.Add: TInstantClassMetadata;
-begin
- Result := TInstantClassMetadata(inherited Add);
-end;
-
-class function TInstantClassMetadatas.CreateInstance(
- Arg: Pointer): TInstantCollection;
-begin
- Result := Create(Arg);
-end;
-
-function TInstantClassMetadatas.Find(
- const AName: string): TInstantClassMetadata;
-begin
- Result := TInstantClassMetadata(inherited Find(AName));
-end;
-
-function TInstantClassMetadatas.GetItems(Index: Integer): TInstantClassMetadata;
-begin
- Result := TInstantClassMetadata(inherited Items[Index]);
-end;
-
-procedure TInstantClassMetadatas.SetItems(Index: Integer;
- Value: TInstantClassMetadata);
-begin
- inherited Items[Index] := Value;
-end;
-
-constructor TInstantFieldMetadatas.Create(AOwner: TInstantTableMetadata);
-begin
- inherited Create(AOwner, TInstantFieldMetadata);
-end;
-
-{ TInstantFieldMetadatas }
-
-function TInstantFieldMetadatas.Add: TInstantFieldMetadata;
-begin
- Result := TInstantFieldMetadata(inherited Add);
-end;
-
-procedure TInstantFieldMetadatas.AddFieldMetadata(const AName: string;
- ADataType: TInstantDataType; ASize: Integer;
- AOptions: TInstantFieldOptions = []);
-begin
- with Add do
- begin
- Name := AName;
- DataType := ADataType;
- Size := ASize;
- Options := AOptions;
- end;
-end;
-
-function TInstantFieldMetadatas.Find(
- const AName: string): TInstantFieldMetadata;
-begin
- Result := inherited Find(AName) as TInstantFieldMetadata;
-end;
-
-function TInstantFieldMetadatas.GetItems(Index: Integer): TInstantFieldMetadata;
-begin
- Result := TInstantFieldMetadata(inherited Items[Index]);
-end;
-
-function TInstantFieldMetadatas.Owner: TInstantTableMetadata;
-begin
- Result := inherited Owner as TInstantTableMetadata;
-end;
-
-procedure TInstantFieldMetadatas.SetItems(Index: Integer;
- Value: TInstantFieldMetadata);
-begin
- inherited Items[Index] := Value;
-end;
-
-constructor TInstantIndexMetadatas.Create(AOwner: TInstantTableMetadata);
-begin
- inherited Create(AOwner, TInstantIndexMetadata);
-end;
-
-{ TInstantIndexMetadatas }
-
-function TInstantIndexMetadatas.Add: TInstantIndexMetadata;
-begin
- Result := TInstantIndexMetadata(inherited Add);
-end;
-
-procedure TInstantIndexMetadatas.AddIndexMetadata(const AName, AFields: string;
- AOptions: TIndexOptions);
-begin
- with Add do
- begin
- Name := AName;
- Fields := AFields;
- Options := AOptions;
- end;
-end;
-
-function TInstantIndexMetadatas.Find(
- const AName: string): TInstantIndexMetadata;
-begin
- Result := inherited Find(AName) as TInstantIndexMetadata;
-end;
-
-function TInstantIndexMetadatas.GetItems(Index: Integer): TInstantIndexMetadata;
-begin
- Result := TInstantIndexMetadata(inherited Items[Index]);
-end;
-
-function TInstantIndexMetadatas.IsFieldIndexed(
- const AFieldMetadata: TInstantFieldMetadata): Boolean;
-var
- I: Integer;
-begin
- Result := False;
- for I := 0 to Pred(Count) do
- begin
- Result := Items[I].IsFieldIndexed(AFieldMetadata);
- if Result then
- Break;
- end;
-end;
-
-function TInstantIndexMetadatas.Owner: TInstantTableMetadata;
-begin
- Result := inherited Owner as TInstantTableMetadata;
-end;
-
-procedure TInstantIndexMetadatas.SetItems(Index: Integer;
- Value: TInstantIndexMetadata);
-begin
- inherited Items[Index] := Value
-end;
-
-constructor TInstantTableMetadatas.Create(AOwner: TPersistent);
-begin
- inherited Create(AOwner, TInstantTableMetadata);
-end;
-
-{ TInstantTableMetadatas }
-
-function TInstantTableMetadatas.Add: TInstantTableMetadata;
-begin
- Result := inherited Add as TInstantTableMetadata;
-end;
-
-function TInstantTableMetadatas.Find(
- const AName: string): TInstantTableMetadata;
-begin
- Result := inherited Find(AName) as TInstantTableMetadata;
-end;
-
-function TInstantTableMetadatas.GetItems(Index: Integer): TInstantTableMetadata;
-begin
- Result := inherited Items[Index] as TInstantTableMetadata;
-end;
-
-{ TInstantCatalog }
-
-constructor TInstantCatalog.Create(const AScheme: TInstantScheme);
-begin
- inherited Create;
- FScheme := AScheme;
-end;
-
-procedure TInstantCatalog.DoWarning(const WarningText: string);
-begin
- if Assigned(FOnWarning) then
- FOnWarning(Self, WarningText);
-end;
-
-function TInstantCatalog.GetFeatures: TInstantCatalogFeatures;
-begin
- Result := [cfReadTableInfo, cfReadColumnInfo, cfReadIndexInfo];
-end;
-
-{ TInstantModelCatalog }
-
-constructor TInstantModelCatalog.Create(const AScheme: TInstantScheme;
- const AModel: TInstantModel);
-begin
- inherited Create(AScheme);
- FModel := AModel;
-end;
-
-procedure TInstantModelCatalog.InitTableMetadatas(ATableMetadatas:
- TInstantTableMetadatas);
-var
- Maps: TInstantAttributeMaps;
- I: Integer;
-
- procedure AddMap(Map: TInstantAttributeMap);
- var
- I: Integer;
- TableMetadata: TInstantTableMetadata;
- AttributeMetadata: TInstantAttributeMetadata;
- Options: TInstantFieldOptions;
-
- // Adds a table metadata definition matching AttributeMetadata, which
- // must have StorageKind = skExternal.
- procedure AddExternalTableMetadata;
- var
- TableMetadata: TInstantTableMetadata;
- begin
- TableMetadata := ATableMetadatas.Add;
- with TableMetadata do
- begin
- Name := AttributeMetadata.ExternalStorageName;
- // The structure of an external table is fixed.
- FieldMetadatas.AddFieldMetadata(InstantIdFieldName, Scheme.IdDataType,
- Scheme.IdSize, [foRequired, foIndexed]);
- FieldMetadatas.AddFieldMetadata(InstantParentClassFieldName, dtString,
- InstantDefaultFieldSize);
- FieldMetadatas.AddFieldMetadata(InstantParentIdFieldName,
- Scheme.IdDataType, Scheme.IdSize);
- FieldMetadatas.AddFieldMetadata(InstantChildClassFieldName, dtString,
- InstantDefaultFieldSize);
- FieldMetadatas.AddFieldMetadata(InstantChildIdFieldName,
- Scheme.IdDataType, Scheme.IdSize);
- FieldMetadatas.AddFieldMetadata(InstantSequenceNoFieldName, dtInteger,
- InstantDefaultFieldSize);
- IndexMetadatas.AddIndexMetadata('', InstantIdFieldName,
- [ixPrimary, ixUnique]);
- // ToDo: Temporary linking table indices
- IndexMetadatas.AddIndexMetadata(Name + '_PL',
- InstantParentClassFieldName + ';' + InstantParentIdFieldName, []);
-// IndexMetadatas.AddIndexMetadata(Name + '_CL',
-// InstantChildClassFieldName + ';' + InstantChildIdFieldName, []);
- end;
- end;
-
- begin
- TableMetadata := ATableMetadatas.Add;
- with TableMetadata do
- begin
- Name := Map.Name;
-
- // Class + Id + UpdateCount.
- FieldMetadatas.AddFieldMetadata(InstantClassFieldName, dtString,
- InstantDefaultFieldSize, [foRequired, foIndexed]);
- FieldMetadatas.AddFieldMetadata(InstantIdFieldName, Scheme.IdDataType,
- Scheme.IdSize, [foRequired, foIndexed]);
- FieldMetadatas.AddFieldMetadata(InstantUpdateCountFieldName, dtInteger,
- 0);
- IndexMetadatas.AddIndexMetadata('', InstantIndexFieldNames,
- [ixPrimary, ixUnique]);
-
- // Other.
- for I := 0 to Pred(Map.Count) do
- begin
- Options := [];
- AttributeMetadata := Map[I];
- if AttributeMetadata.AttributeType = atReference then
- begin
- FieldMetadatas.AddFieldMetadata(
- AttributeMetadata.FieldName + InstantClassFieldName,
- Scheme.AttributeTypeToDataType(atString), InstantDefaultFieldSize);
- FieldMetadatas.AddFieldMetadata(
- AttributeMetadata.FieldName + InstantIdFieldName,
- Scheme.IdDataType, Scheme.IdSize);
- end
- else if AttributeMetadata.AttributeType = atPart then
- begin
- if AttributeMetadata.StorageKind = skEmbedded then
- FieldMetadatas.AddFieldMetadata(AttributeMetadata.FieldName,
- Scheme.AttributeTypeToDataType(AttributeMetadata.AttributeType),
- AttributeMetadata.Size)
- else if AttributeMetadata.StorageKind = skExternal then
- begin
- FieldMetadatas.AddFieldMetadata(
- AttributeMetadata.FieldName + InstantClassFieldName,
- Scheme.AttributeTypeToDataType(atString),
- InstantDefaultFieldSize);
- FieldMetadatas.AddFieldMetadata(
- AttributeMetadata.FieldName + InstantIdFieldName,
- Scheme.IdDataType, Scheme.IdSize);
- end;
- end
- else if AttributeMetadata.AttributeType in [atParts, atReferences] then
- begin
- if AttributeMetadata.StorageKind = skEmbedded then
- FieldMetadatas.AddFieldMetadata(AttributeMetadata.FieldName,
- Scheme.AttributeTypeToDataType(AttributeMetadata.AttributeType),
- AttributeMetadata.Size)
- else if AttributeMetadata.StorageKind = skExternal then
- AddExternalTableMetadata;
- end
- else
- begin
- if AttributeMetadata.IsIndexed then
- begin
- IndexMetadatas.AddIndexMetadata(Map.Name +
- AttributeMetadata.FieldName, AttributeMetadata.FieldName, []);
- Options := Options + [foIndexed];
- end
- else if AttributeMetadata.IsRequired then
- begin
- Options := Options + [foRequired];
- end;
- FieldMetadatas.AddFieldMetadata(AttributeMetadata.FieldName,
- Scheme.AttributeTypeToDataType(AttributeMetadata.AttributeType),
- AttributeMetadata.Size, Options);
- end;
- end;
- end;
- end;
-
-begin
- Maps := InstantCreateStorageMaps(Model.ClassMetadatas);
- try
- if Assigned(Maps) then
- begin
- for I := 0 to Pred(Maps.Count) do
- AddMap(Maps[I]);
- end;
- finally
- Maps.Free;
- end;
-end;
-
-{ TInstantModel }
-
-destructor TInstantModel.Destroy;
-begin
- DestroyClassMetadatas;
- inherited;
-end;
-
-procedure TInstantModel.DestroyClassMetadatas;
-begin
- FreeAndNil(FClassMetadatas);
-end;
-
-function TInstantModel.GetClassMetadatas: TInstantClassMetadatas;
-begin
- if not Assigned(FClassMetadatas) then
- FClassMetadatas := TInstantClassMetadatas.Create(nil);
- Result := FClassMetadatas;
-end;
-
-procedure TInstantModel.LoadFromFile(const FileName: string);
-var
- Stream: TInstantFileStream;
-begin
- Stream := TInstantFileStream.Create(FileName, fmOpenRead);
- try
- InstantReadObject(Stream, sfXML, ClassMetadatas);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TInstantModel.LoadFromResFile(const FileName: string);
-var
- Stream: TInstantFileStream;
-begin
- Stream := TInstantFileStream.Create(FileName, fmOpenRead);
- try
- Stream.ReadResourceFileHeader;
- Stream.ReadObjectRes(ClassMetadatas);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TInstantModel.SaveToFile(const FileName: string);
-var
- Stream: TInstantFileStream;
-begin
- Stream := TInstantFileStream.Create(FileName, fmCreate);
- try
- InstantWriteObject(Stream, sfXML, ClassMetadatas);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TInstantModel.SaveToResFile(const FileName: string);
-var
- Stream: TInstantFileStream;
-begin
- Stream := TInstantFileStream.Create(FileName, fmCreate);
- try
- Stream.WriteResourceFileHeader;
- Stream.WriteObjectRes(InstantModelResourceName, ClassMetadatas);
- Stream.AlignStream;
- finally
- Stream.Free;
- end;
-end;
-
-constructor TInstantScheme.Create;
-begin
- inherited Create;
- FBlobStreamFormat := sfBinary;
- FIdDataType := dtString;
- FIdSize := InstantDefaultFieldSize;
-end;
-
-destructor TInstantScheme.Destroy;
-begin
- FCatalog.Free;
- FTableMetadataCollection.Free;
- inherited;
-end;
-
-{ TInstantScheme }
-
-function TInstantScheme.AttributeTypeToDataType(
- AttributeType: TInstantAttributeType): TInstantDataType;
-begin
- Result := InstantAttributeTypeToDataType(AttributeType, BlobStreamFormat);
-end;
-
-procedure TInstantScheme.CatalogWarningEventHandler(const Sender: TObject;
- const AWarningText: string);
-begin
- DoWarning(AWarningText);
-end;
-
-procedure TInstantScheme.DoWarning(const AWarningText: string);
-begin
- if Assigned(FOnWarning) then
- FOnWarning(Self, AWarningText);
-end;
-
-function TInstantScheme.FindTableMetadata(
- const AName: string): TInstantTableMetadata;
-begin
- Result := TableMetadataCollection.Find(AName);
-end;
-
-function TInstantScheme.GetTableMetadataCollection: TInstantTableMetadatas;
-begin
- if not Assigned(FTableMetadataCollection) then
- FTableMetadataCollection := TInstantTableMetadatas.Create(Self);
- Result := FTableMetadataCollection;
-end;
-
-function TInstantScheme.GetTableMetadataCount: Integer;
-begin
- Result := TableMetadataCollection.Count;
-end;
-
-function TInstantScheme.GetTableMetadatas(
- Index: Integer): TInstantTableMetadata;
-begin
- Result := TableMetadataCollection[Index];
-end;
-
-procedure TInstantScheme.SetCatalog(const Value: TInstantCatalog);
-begin
- FreeAndNil(FCatalog);
- FCatalog := Value;
- if Assigned(FCatalog) then
- begin
- FCatalog.OnWarning := CatalogWarningEventHandler;
- FCatalog.InitTableMetadatas(TableMetadataCollection);
- end;
-end;
-
-constructor TInstantAttributeMap.Create(
- AClassMetadata: TInstantClassMetadata);
-begin
- inherited Create;
- FClassMetadata := AClassMetadata;
-end;
-
-{ TInstantAttributeMap }
-
-function TInstantAttributeMap.Add(Item: TInstantAttributeMetadata): Integer;
-begin
- Result := inherited Add(Item);
-end;
-
-function TInstantAttributeMap.AddUnique(
- Item: TInstantAttributeMetadata): Integer;
-begin
- if not Assigned(Find(Item.Name)) then
- Result := Add(Item)
- else
- Result := -1;
-end;
-
-function TInstantAttributeMap.Find(
- const AName: string): TInstantAttributeMetadata;
-var
- I: Integer;
-begin
- for I := 0 to Pred(Count) do
- begin
- Result := Items[I];
- if SameText(Result.Name, AName) then
- Exit;
- end;
- Result := nil;
-end;
-
-function TInstantAttributeMap.GetIsRootMap: Boolean;
-begin
- Result := Assigned(ClassMetadata) and (Name = ClassMetadata.TableName);
-end;
-
-function TInstantAttributeMap.GetItems(
- Index: Integer): TInstantAttributeMetadata;
-begin
- Result := inherited Items[Index];
-end;
-
-function TInstantAttributeMap.GetName: string;
-begin
- Result := FName;
-end;
-
-function TInstantAttributeMap.IndexOf(Item: TInstantAttributeMetadata): Integer;
-begin
- Result := inherited IndexOf(Item);
-end;
-
-procedure TInstantAttributeMap.Insert(Index: Integer;
- Item: TInstantAttributeMetadata);
-begin
- inherited Insert(Index, Item);
-end;
-
-function TInstantAttributeMap.Remove(Item: TInstantAttributeMetadata): Integer;
-begin
- Result := inherited Remove(Item);
-end;
-
-procedure TInstantAttributeMap.SetItems(Index: Integer;
- Value: TInstantAttributeMetadata);
-begin
- inherited Items[Index] := Value;
-end;
-
-procedure TInstantAttributeMap.SetName(const Value: string);
-begin
- FName := Value;
-end;
-
-constructor TInstantAttributeMaps.Create(
- AClassMetadata: TInstantClassMetadata);
-begin
- inherited Create;
- FClassMetadata := AClassMetadata;
-end;
-
-{ TInstantAttributeMaps }
-
-function TInstantAttributeMaps.Add: TInstantAttributeMap;
-begin
- Result := TInstantAttributeMap.Create(ClassMetadata);
- try
- Add(Result);
- except
- Result.Free;
- raise;
- end;
-end;
-
-function TInstantAttributeMaps.Add(Item: TInstantAttributeMap): Integer;
-begin
- Result := inherited Add(Item)
-end;
-
-function TInstantAttributeMaps.EnsureMap(
- const AName: string): TInstantAttributeMap;
-begin
- Result := Find(AName);
- if not Assigned(Result) then
- begin
- Result := Add;
- Result.Name := AName;
- end
-end;
-
-function TInstantAttributeMaps.Find(const AName: string): TInstantAttributeMap;
-var
- I: Integer;
-begin
- for I := 0 to Pred(Count) do
- begin
- Result := Items[I];
- if SameText(Result.Name, AName) then
- Exit;
- end;
- Result := nil;
-end;
-
-function TInstantAttributeMaps.FindMap(
- const AttributeName: string): TInstantAttributeMap;
-var
- I: Integer;
-begin
- for I := 0 to Pred(Count) do
- begin
- Result := Items[I];
- if Assigned(Result.Find(AttributeName)) then
- Exit;
- end;
- Result := nil;
-end;
-
-function TInstantAttributeMaps.GetItems(Index: Integer): TInstantAttributeMap;
-begin
- Result := inherited Items[Index] as TInstantAttributeMap;
-end;
-
-function TInstantAttributeMaps.GetRootMap: TInstantAttributeMap;
-var
- I: Integer;
-begin
- if Assigned(ClassMetadata) then
- for I := 0 to Pred(Count) do
- begin
- Result := Items[I];
- if Result.Name = ClassMetadata.TableName then
- Exit;
- end;
- Result := nil
-end;
-
-function TInstantAttributeMaps.IndexOf(Item: TInstantAttributeMap): Integer;
-begin
- Result := inherited IndexOf(Item);
-end;
-
-procedure TInstantAttributeMaps.Insert(Index: Integer;
- Item: TInstantAttributeMap);
-begin
- inherited Insert(Index, Item);
-end;
-
-function TInstantAttributeMaps.Remove(Item: TInstantAttributeMap): Integer;
-begin
- Result := inherited Remove(Item);
-end;
-
-procedure TInstantAttributeMaps.SetItems(Index: Integer;
- Value: TInstantAttributeMap);
-begin
- inherited Items[Index] := Value;
-end;
-
-{ TInstantAttributeMetadata }
-
-procedure TInstantAttributeMetadata.Assign(Source: TPersistent);
-begin
- inherited;
- if Source is TInstantAttributeMetadata then
- with TInstantAttributeMetadata(Source) do
- begin
- Self.FAttributeType := FAttributeType;
- Self.FDefaultValue := FDefaultValue;
- Self.FDisplayWidth := FDisplayWidth;
- Self.FEditMask := FEditMask;
- Self.FIsIndexed := FIsIndexed;
- Self.FIsRequired := FIsRequired;
- Self.FObjectClassName := FObjectClassName;
- Self.FSize := FSize;
- Self.FStorageName := FStorageName;
- Self.FStorageKind := FStorageKind;
- Self.FExternalStorageName := FExternalStorageName;
- Self.FValidChars := FValidChars;
- end;
-end;
-
-procedure TInstantAttributeMetadata.CheckAttributeClass(AClass:
- TInstantAbstractAttributeClass);
-begin
- if Assigned(AClass) and not IsAttributeClass(AClass) then
- raise EInstantError.CreateFmt(SUnexpectedAttributeClass,
- [AttributeClassName, Name, ClassMetadataName, AClass.ClassName]);
-end;
-
-procedure TInstantAttributeMetadata.CheckCategory(
- ACategory: TInstantAttributeCategory);
-
- function CategoryName(Cat: TInstantAttributeCategory): string;
- begin
- Result := GetEnumName(TypeInfo(TInstantAttributeCategory), Ord(Cat));
- end;
-
-begin
- if Category <> ACategory then
- raise EInstantError.CreateFmt(SUnexpectedAttributeCategory,
- [CategoryName(Category), AttributeClassName, Name,
- ClassMetadataName, CategoryName(ACategory)]);
-end;
-
-procedure TInstantAttributeMetadata.CheckIsIndexed;
-begin
- if not IsIndexed then
- raise EInstantError.CreateFmt(SAttributeNotIndexed,
- [AttributeClassName, Name, ClassMetadataName]);
-end;
-
-function TInstantAttributeMetadata.CreateAttribute(AObject:
- TInstantAbstractObject): TInstantAbstractAttribute;
-var
- AClass: TInstantAbstractAttributeClass;
-begin
- AClass := AttributeClass;
- if not Assigned(AClass) then
- raise EInstantError.CreateFmt(SUnsupportedType, [AttributeTypeName]);
- Result := AClass.Create(TInstantObject(AObject), Self);
-end;
-
-function TInstantAttributeMetadata.GetAttributeClass:
- TInstantAbstractAttributeClass;
-begin
- Result := AttributeClasses[AttributeType];
-end;
-
-function TInstantAttributeMetadata.GetAttributeClassName: string;
-begin
- if Assigned(AttributeClass) then
- Result := AttributeClass.ClassName
- else
- Result := '';
-end;
-
-function TInstantAttributeMetadata.GetAttributeTypeName: string;
-begin
- Result := GetEnumName(TypeInfo(TInstantAttributeType),
- Ord(AttributeType));
- Result := Copy(Result, 3, Length(Result) - 2);
-end;
-
-function TInstantAttributeMetadata.GetCategory: TInstantAttributeCategory;
-begin
- if Assigned(AttributeClass) then
- begin
- if AttributeClass.InheritsFrom(TInstantElement) then
- Result := acElement
- else if AttributeClass.InheritsFrom(TInstantContainer) then
- Result := acContainer
- else
- Result := acSimple;
- end else
- Result := acUnknown;
-end;
-
-function TInstantAttributeMetadata.GetClassMetadata: TInstantClassMetadata;
-begin
- if Assigned(Collection) then
- Result := Collection.Owner
- else
- Result := nil;
-end;
-
-function TInstantAttributeMetadata.GetClassMetadataName: string;
-begin
- if Assigned(ClassMetadata) then
- Result := ClassMetadata.Name
- else
- Result := SUnassigned;
-end;
-
-function TInstantAttributeMetadata.GetCollection: TInstantAttributeMetadatas;
-begin
- Result := inherited Collection as TInstantAttributeMetadatas;
-end;
-
-function TInstantAttributeMetadata.GetFieldName: string;
-begin
- if FStorageName = '' then
- Result := Name
- else
- Result := FStorageName;
-end;
-
-function TInstantAttributeMetadata.GetHasValidChars: Boolean;
-begin
- Result := FValidChars <> [];
-end;
-
-function TInstantAttributeMetadata.GetIsDefault: Boolean;
-begin
- Result := Assigned(ClassMetadata) and
- (ClassMetadata.DefaultContainerName <> '') and
- (ClassMetadata.DefaultContainerName = Name);
-end;
-
-function TInstantAttributeMetadata.GetObjectClass: TInstantAbstractObjectClass;
-begin
- if ObjectClassName = '' then
- Result := TInstantObject
- else
- Result := InstantFindClass(ObjectClassName);
-end;
-
-function TInstantAttributeMetadata.GetObjectClassMetadata:
- TInstantClassMetadata;
-begin
- Result := InstantGetClassMetadata(ObjectClassName);
-end;
-
-function TInstantAttributeMetadata.GetTableName: string;
-begin
- if Assigned(ClassMetadata) then
- Result := ClassMetadata.TableName
- else
- Result := '';
-end;
-
-function TInstantAttributeMetadata.GetValidChars: TChars;
-begin
- if FValidChars = [] then
- Result := [#0..#255]
- else
- Result := FValidChars;
-end;
-
-function TInstantAttributeMetadata.GetValidCharsString: string;
-begin
- Result := InstantCharSetToStr(FValidChars);
-end;
-
-function TInstantAttributeMetadata.IsAttributeClass(AClass:
- TInstantAbstractAttributeClass): Boolean;
-begin
- Result := Assigned(AttributeClass) and AttributeClass.InheritsFrom(AClass);
-end;
-
-procedure TInstantAttributeMetadata.SetAttributeClass(const AClass:
- TInstantAbstractAttributeClass);
-var
- AttribType: TInstantAttributeType;
-begin
- for AttribType := Low(AttribType) to High(AttribType) do
- if AttributeClasses[AttribType] = AClass then
- begin
- AttributeType := AttribType;
- Exit;
- end;
- AttributeType := atUnknown;
-end;
-
-procedure TInstantAttributeMetadata.SetAttributeClassName(const Value: string);
-var
- AttribType: TInstantAttributeType;
- AClass: TInstantAttributeClass;
-begin
- for AttribType := Low(AttribType) to High(AttribType) do
- begin
- AClass := AttributeClasses[AttribType];
- if Assigned(AClass) and SameText(AClass.ClassName, Value) then
- begin
- AttributeType := AttribType;
- Exit;
- end;
- end;
- AttributeType := atUnknown;
-end;
-
-procedure TInstantAttributeMetadata.SetAttributeTypeName(const Value: string);
-var
- I: Integer;
-begin
- if Value = '' then
- Exit;
- I := GetEnumValue(TypeInfo(TInstantAttributeType), 'at' + Value);
- if I <> -1 then
- AttributeType := TInstantAttributeType(I)
- else
- raise EInstantError.CreateFmt(SUnsupportedType, [Value]);
-end;
-
-procedure TInstantAttributeMetadata.SetCollection(
- Value: TInstantAttributeMetadatas);
-begin
- inherited Collection := Value;
-end;
-
-procedure TInstantAttributeMetadata.SetFieldName(const Value: string);
-begin
- if Value = Name then
- FStorageName := ''
- else
- FStorageName := Value;
-end;
-
-procedure TInstantAttributeMetadata.SetIsDefault(const Value: Boolean);
-begin
- if (Value <> IsDefault) and Assigned(ClassMetadata) then
- begin
- if Value then
- ClassMetadata.DefaultContainerName := Name
- else
- ClassMetadata.DefaultContainerName := '';
- end;
-end;
-
-procedure TInstantAttributeMetadata.SetValidCharsString(const Value: string);
-begin
- FValidChars := InstantStrToCharSet(Value);
-end;
-
-constructor TInstantAttributeMetadatas.Create(AOwner: TInstantClassMetadata);
-begin
- inherited Create(AOwner,...
[truncated message content] |
|
From: <jcm...@us...> - 2007-02-24 20:07:28
|
Revision: 763
http://svn.sourceforge.net/instantobjects/revision/?rev=763&view=rev
Author: jcmoraisjr
Date: 2007-02-24 12:07:25 -0800 (Sat, 24 Feb 2007)
Log Message:
-----------
Included svn eol-style and mime-type properties.
Modified Paths:
--------------
trunk/Source/Core/InstantTypes.pas
Property Changed:
----------------
trunk/Source/Core/InstantTypes.pas
Modified: trunk/Source/Core/InstantTypes.pas
===================================================================
--- trunk/Source/Core/InstantTypes.pas 2007-02-24 19:41:55 UTC (rev 762)
+++ trunk/Source/Core/InstantTypes.pas 2007-02-24 20:07:25 UTC (rev 763)
@@ -1,94 +1,94 @@
-(*
- * InstantObjects
- * Types
- *)
-
-(* ***** BEGIN LICENSE BLOCK *****
- * Version: MPL 1.1
- *
- * The contents of this file are subject to the Mozilla Public License Version
- * 1.1 (the "License"); you may not use this file except in compliance with
- * the License. You may obtain a copy of the License at
- * http://www.mozilla.org/MPL/
- *
- * Software distributed under the License is distributed on an "AS IS" basis,
- * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
- * for the specific language governing rights and limitations under the
- * License.
- *
- * The Original Code is: Seleqt InstantObjects
- *
- * The Initial Developer of the Original Code is: Seleqt
- *
- * Portions created by the Initial Developer are Copyright (C) 2001-2003
- * the Initial Developer. All Rights Reserved.
- *
- * Contributor(s):
- * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
- * Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas,
- * Riceball Lee, David Moorhouse
- *
- * ***** END LICENSE BLOCK ***** *)
-
-unit InstantTypes;
-
-{$IFDEF LINUX}
-{$I '../InstantDefines.inc'}
-{$ELSE}
-{$I '..\InstantDefines.inc'}
-{$ENDIF}
-
-interface
-
-type
- {$IFNDEF D6+}
- IInterface = interface (IUnknown)
- end;
- {$ENDIF}
-
- TInstantStorageKind = (skEmbedded, skExternal);
- TInstantAttributeType = (atUnknown, atInteger, atFloat, atCurrency, atBoolean,
- atString, atDateTime, atBlob, atMemo, atGraphic,
- atPart, atReference, atParts, atReferences, atDate, atTime);
- TInstantAttributeCategory = (acUnknown, acSimple, acElement, acContainer);
-
- TInstantGraphicFileFormat = (gffUnknown, gffBmp, gffTiff, gffJpeg, gffPng,
- gffDcx, gffPcx, gffEmf, gffGif, gffIco);
-
- TInstantPersistence = (peEmbedded, peStored);
-
- TInstantDataType = (dtInteger, dtFloat, dtCurrency, dtBoolean, dtString,
- dtMemo, dtDateTime, dtBlob, dtDate, dtTime);
- TInstantDataTypes = set of TInstantDataType;
- TInstantFieldOption = (foRequired, foIndexed);
- TInstantFieldOptions = set of TInstantFieldOption;
-
- TInstantCatalogFeature = (cfReadTableInfo, cfReadColumnInfo, cfReadIndexInfo);
- TInstantCatalogFeatures = set of TInstantCatalogFeature;
-
- // ToDo: Add ctAddRef to help file.
- TInstantContentChangeType = (ctAdd, ctAddRef, ctRemove, ctReplace, ctClear);
-
- TInstantOperationType = (otNone, otCreate, otStore, otRetrieve, otRefresh,
- otDispose);
- TInstantErrorAction = (eaRetry, eaIgnore, eaError, eaRevert, eaCancel);
- TInstantVerificationResult = (vrOk, vrCancel, vrAbort, vrError);
- TInstantConflictAction = (caIgnore, caFail);
-
- TInstantCacheNodeColor = (ncRed, ncBlack);
-
- TInstantDBBuildCommandType = (ctAddTable, ctDropTable, ctAddField,
- ctAlterField, ctDropField, ctAddIndex, ctAlterIndex, ctDropIndex);
-
- TInstantObjectNotification = (onChanged, onCreated, onDisposed, onRefreshed,
- onRetrieved, onStored);
-
- TInstantWarningEvent = procedure (const Sender: TObject;
- const AWarningText: string) of object;
-
- TTime = type TDateTime;
- TDate = type TDateTime;
-
-implementation
-
-end.
+(*
+ * InstantObjects
+ * Types
+ *)
+
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is: Seleqt InstantObjects
+ *
+ * The Initial Developer of the Original Code is: Seleqt
+ *
+ * Portions created by the Initial Developer are Copyright (C) 2001-2003
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
+ * Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas,
+ * Riceball Lee, David Moorhouse
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit InstantTypes;
+
+{$IFDEF LINUX}
+{$I '../InstantDefines.inc'}
+{$ELSE}
+{$I '..\InstantDefines.inc'}
+{$ENDIF}
+
+interface
+
+type
+ {$IFNDEF D6+}
+ IInterface = interface (IUnknown)
+ end;
+ {$ENDIF}
+
+ TInstantStorageKind = (skEmbedded, skExternal);
+ TInstantAttributeType = (atUnknown, atInteger, atFloat, atCurrency, atBoolean,
+ atString, atDateTime, atBlob, atMemo, atGraphic,
+ atPart, atReference, atParts, atReferences, atDate, atTime);
+ TInstantAttributeCategory = (acUnknown, acSimple, acElement, acContainer);
+
+ TInstantGraphicFileFormat = (gffUnknown, gffBmp, gffTiff, gffJpeg, gffPng,
+ gffDcx, gffPcx, gffEmf, gffGif, gffIco);
+
+ TInstantPersistence = (peEmbedded, peStored);
+
+ TInstantDataType = (dtInteger, dtFloat, dtCurrency, dtBoolean, dtString,
+ dtMemo, dtDateTime, dtBlob, dtDate, dtTime);
+ TInstantDataTypes = set of TInstantDataType;
+ TInstantFieldOption = (foRequired, foIndexed);
+ TInstantFieldOptions = set of TInstantFieldOption;
+
+ TInstantCatalogFeature = (cfReadTableInfo, cfReadColumnInfo, cfReadIndexInfo);
+ TInstantCatalogFeatures = set of TInstantCatalogFeature;
+
+ // ToDo: Add ctAddRef to help file.
+ TInstantContentChangeType = (ctAdd, ctAddRef, ctRemove, ctReplace, ctClear);
+
+ TInstantOperationType = (otNone, otCreate, otStore, otRetrieve, otRefresh,
+ otDispose);
+ TInstantErrorAction = (eaRetry, eaIgnore, eaError, eaRevert, eaCancel);
+ TInstantVerificationResult = (vrOk, vrCancel, vrAbort, vrError);
+ TInstantConflictAction = (caIgnore, caFail);
+
+ TInstantCacheNodeColor = (ncRed, ncBlack);
+
+ TInstantDBBuildCommandType = (ctAddTable, ctDropTable, ctAddField,
+ ctAlterField, ctDropField, ctAddIndex, ctAlterIndex, ctDropIndex);
+
+ TInstantObjectNotification = (onChanged, onCreated, onDisposed, onRefreshed,
+ onRetrieved, onStored);
+
+ TInstantWarningEvent = procedure (const Sender: TObject;
+ const AWarningText: string) of object;
+
+ TTime = type TDateTime;
+ TDate = type TDateTime;
+
+implementation
+
+end.
Property changes on: trunk/Source/Core/InstantTypes.pas
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
|
|
From: <jcm...@us...> - 2007-02-24 19:41:55
|
Revision: 762
http://svn.sourceforge.net/instantobjects/revision/?rev=762&view=rev
Author: jcmoraisjr
Date: 2007-02-24 11:41:55 -0800 (Sat, 24 Feb 2007)
Log Message:
-----------
Moved the LogStatement call to the AcquireDataSet method in order to log all db statements.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2007-02-24 19:37:18 UTC (rev 761)
+++ trunk/Source/Core/InstantBrokers.pas 2007-02-24 19:41:55 UTC (rev 762)
@@ -1294,6 +1294,9 @@
var
CachedStatement: TInstantStatement;
begin
+ {$IFDEF IO_STATEMENT_LOGGING}
+ InstantLogStatement('Before: ', AStatement, AParams);
+ {$ENDIF}
Result := nil;
if FStatementCacheCapacity <> 0 then
begin
@@ -2855,9 +2858,6 @@
var
TransError: Exception;
begin
- {$IFDEF IO_STATEMENT_LOGGING}
- InstantLogStatement('Before: ', AStatement, AParams);
- {$ENDIF}
try
Result := Broker.Execute(AStatement, AParams);
Info.Success := Result >= 1;
|
|
From: <jcm...@us...> - 2007-02-24 19:37:20
|
Revision: 761
http://svn.sourceforge.net/instantobjects/revision/?rev=761&view=rev
Author: jcmoraisjr
Date: 2007-02-24 11:37:18 -0800 (Sat, 24 Feb 2007)
Log Message:
-----------
Included svn eol-style and mime-type properties.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
Property Changed:
----------------
trunk/Source/Core/InstantBrokers.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2007-02-24 19:35:00 UTC (rev 760)
+++ trunk/Source/Core/InstantBrokers.pas 2007-02-24 19:37:18 UTC (rev 761)
@@ -1,6067 +1,6067 @@
-(*
- * InstantObjects
- * Broker and Connector Classes
- *)
-
-(* ***** BEGIN LICENSE BLOCK *****
- * Version: MPL 1.1
- *
- * The contents of this file are subject to the Mozilla Public License Version
- * 1.1 (the "License"); you may not use this file except in compliance with
- * the License. You may obtain a copy of the License at
- * http://www.mozilla.org/MPL/
- *
- * Software distributed under the License is distributed on an "AS IS" basis,
- * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
- * for the specific language governing rights and limitations under the
- * License.
- *
- * The Original Code is: Seleqt InstantObjects
- *
- * The Initial Developer of the Original Code is: Seleqt
- *
- * Portions created by the Initial Developer are Copyright (C) 2001-2003
- * the Initial Developer. All Rights Reserved.
- *
- * Contributor(s):
- * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
- * Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas,
- * Riceball Lee, David Moorhouse
- *
- * ***** END LICENSE BLOCK ***** *)
-
-unit InstantBrokers;
-
-{$IFDEF LINUX}
-{$I '../InstantDefines.inc'}
-{$ELSE}
-{$I '..\InstantDefines.inc'}
-{$ENDIF}
-
-interface
-
-uses
- SysUtils, Classes, Db, InstantPersistence, InstantTypes, InstantMetadata,
- InstantConsts, InstantClasses, Contnrs, InstantCommand;
-
-type
- TInstantBrokerCatalog = class;
- TInstantConnectionBasedConnector = class;
- TInstantCustomRelationalBroker = class;
- TInstantCustomRelationalQuery = class;
- TInstantCustomRelationalQueryClass = class of TInstantCustomRelationalQuery;
- TInstantCustomResolver = class;
- TInstantLinkResolver = class;
- TInstantNavigationalBroker = class;
- TInstantNavigationalLinkResolver = class;
- TInstantNavigationalResolver = class;
- TInstantNavigationalResolverClass = class of TInstantNavigationalResolver;
- TInstantRelationalConnector = class;
- TInstantRelationalTranslator = class;
- TInstantRelationalTranslatorClass = class of TInstantRelationalTranslator;
- TInstantSQLBroker = class;
- TInstantSQLBrokerCatalog = class;
- TInstantSQLGenerator = class;
- TInstantSQLGeneratorClass = class of TInstantSQLGenerator;
- TInstantSQLLinkResolver = class;
- TInstantSQLResolver = class;
- TInstantStatementCache = class;
-
- PObjectRow = ^TObjectRow;
- TObjectRow = record
- Row: Integer;
- Instance: TObject;
- end;
-
- PInstantOperationInfo = ^TInstantOperationInfo;
- TInstantOperationInfo = record
- Success: Boolean;
- Conflict: Boolean;
- end;
-
- TInstantBrokerOperation = procedure(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction = caFail;
- Info: PInstantOperationInfo = nil) of object;
- TInstantGetDataSetEvent = procedure(Sender: TObject;
- const CommandText: string; var DataSet: TDataset) of object;
- TInstantInitDataSetEvent = procedure(Sender: TObject;
- const CommandText: string; DataSet: TDataSet) of object;
- TInstantNavigationalResolverOperation = procedure(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata) of object;
-
-
- TInstantCustomRelationalBroker = class(TInstantBroker)
- private
- FStatementCache: TInstantStatementCache;
- FStatementCacheCapacity: Integer;
- procedure DisposeMap(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
- function GetConnector: TInstantRelationalConnector;
- function PerformOperation(AObject: TInstantObject; const AObjectId: string;
- OperationType: TInstantOperationType; Operation: TInstantBrokerOperation;
- ConflictAction: TInstantConflictAction): Boolean;
- procedure RetrieveMap(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
- procedure StoreMap(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
- function GetStatementCache: TInstantStatementCache;
- procedure SetStatementCacheCapacity(const Value: Integer);
- protected
- property StatementCache: TInstantStatementCache read GetStatementCache;
- function EnsureResolver(Map: TInstantAttributeMap): TInstantCustomResolver;
- virtual; abstract;
- function GetDBMSName: string; virtual;
- function GetSQLDelimiters: string; virtual;
- function GetSQLQuote: Char; virtual;
- function GetSQLWildcard: string; virtual;
- function InternalDisposeObject(AObject: TInstantObject;
- ConflictAction: TInstantConflictAction): Boolean; override;
- function InternalRetrieveObject(AObject: TInstantObject;
- const AObjectId: string; ConflictAction: TInstantConflictAction): Boolean;
- override;
- function InternalStoreObject(AObject: TInstantObject;
- ConflictAction: TInstantConflictAction): Boolean; override;
- public
- constructor Create(AConnector: TInstantConnector); override;
- destructor Destroy; override;
- function Execute(const AStatement: string; AParams: TParams = nil): Integer;
- virtual;
- property Connector: TInstantRelationalConnector read GetConnector;
- property DBMSName: string read GetDBMSName;
- property SQLDelimiters: string read GetSQLDelimiters;
- property SQLQuote: Char read GetSQLQuote;
- property SQLWildcard: string read GetSQLWildCard;
- property StatementCacheCapacity: Integer read FStatementCacheCapacity
- write SetStatementCacheCapacity;
- end;
-
- TInstantNavigationalBroker = class(TInstantCustomRelationalBroker)
- private
- FResolverList: TObjectList;
- function GetResolverCount: Integer;
- function GetResolverList: TObjectList;
- function GetResolvers(Index: Integer): TInstantnavigationalResolver;
- property ResolverList: TObjectList read GetResolverList;
- protected
- function CreateResolver(const TableName: string):
- TInstantNavigationalResolver; virtual; abstract;
- function EnsureResolver(Map: TInstantAttributeMap): TInstantCustomResolver;
- override;
- function FindResolver(const TableName: string):
- TInstantNavigationalResolver;
- property ResolverCount: Integer read GetResolverCount;
- property Resolvers[Index: Integer]: TInstantNavigationalResolver
- read GetResolvers;
- public
- destructor Destroy; override;
- end;
-
- //Backwards compatibility
- TInstantRelationalBroker = TInstantNavigationalBroker;
-
- TInstantSQLBroker = class(TInstantCustomRelationalBroker)
- private
- FGenerator: TInstantSQLGenerator;
- FResolverList: TObjectList;
- function GetResolverList: TObjectList;
- function GetResolverCount: Integer;
- function GetResolvers(Index: Integer): TInstantSQLResolver;
- function GetGenerator: TInstantSQLGenerator;
- protected
- function CreateResolver(Map: TInstantAttributeMap): TInstantSQLResolver;
- virtual; abstract;
- function EnsureResolver(AMap: TInstantAttributeMap): TInstantCustomResolver;
- override;
- procedure InternalBuildDatabase(Scheme: TInstantScheme); override;
- property ResolverList: TObjectList read GetResolverList;
- procedure AssignDataSetParams(DataSet : TDataSet; AParams: TParams);
- virtual;
- function CreateDataSet(const AStatement: string; AParams: TParams = nil):
- TDataSet; virtual; abstract;
- public
- destructor Destroy; override;
- function AcquireDataSet(const AStatement: string; AParams: TParams = nil):
- TDataSet; virtual;
- procedure ReleaseDataSet(const ADataSet: TDataSet); virtual;
- function DataTypeToColumnType(DataType: TInstantDataType;
- Size: Integer): string; virtual; abstract;
- function FindResolver(AMap: TInstantAttributeMap): TInstantSQLResolver;
- class function GeneratorClass: TInstantSQLGeneratorClass; virtual;
- property Generator: TInstantSQLGenerator read GetGenerator;
- property ResolverCount: Integer read GetResolverCount;
- property Resolvers[Index: Integer]: TInstantSQLResolver read GetResolvers;
- end;
-
- TInstantRelationalConnector = class(TInstantConnector)
- private
- FOnGetDataSet: TInstantGetDataSetEvent;
- FOnInitDataSet: TInstantInitDataSetEvent;
- protected
- procedure DoGetDataSet(const CommandText: string; var DataSet: TDataSet);
- procedure DoInitDataSet(const CommandText: string; DataSet: TDataSet);
- function GetBroker: TInstantCustomRelationalBroker;
- procedure GetDataSet(const CommandText: string; var DataSet: TDataSet);
- virtual;
- function GetDBMSName: string; virtual;
- procedure InitDataSet(const CommandText: string; DataSet: TDataSet);
- virtual;
- function InternalCreateScheme(Model: TInstantModel): TInstantScheme;
- override;
- public
- property Broker: TInstantCustomRelationalBroker read GetBroker;
- property DBMSName: string read GetDBMSName;
- published
- property OnGetDataSet: TInstantGetDataSetEvent read FOnGetDataSet
- write FOnGetDataSet;
- property OnInitDataSet: TInstantInitDataSetEvent read FOnInitDataSet
- write FOnInitDataSet;
- end;
-
- TInstantConnectionBasedConnector = class(TInstantRelationalConnector)
- private
- FConnection: TCustomConnection;
- FLoginPrompt: Boolean;
- procedure DoAfterConnectionChange;
- procedure DoBeforeConnectionChange;
- function GetConnection: TCustomConnection;
- function GetLoginPrompt: Boolean;
- procedure SetConnection(Value: TCustomConnection);
- procedure SetLoginPrompt(const Value: Boolean);
- protected
- procedure AssignLoginOptions; virtual;
- procedure AfterConnectionChange; virtual;
- procedure BeforeConnectionChange; virtual;
- procedure CheckConnection;
- function GetConnected: Boolean; override;
- procedure InternalConnect; override;
- procedure InternalDisconnect; override;
- procedure Notification(AComponent: TComponent; Operation: TOperation);
- override;
- public
- property Connection: TCustomConnection read GetConnection
- write SetConnection;
- function HasConnection: Boolean;
- constructor Create(AOwner: TComponent); override;
- published
- property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt
- default True;
- end;
-
- TInstantCustomResolver = class(TInstantStreamable)
- private
- FBroker: TInstantCustomRelationalBroker;
- protected
- function KeyViolation(AObject: TInstantObject; const AObjectId: string;
- E: Exception): EInstantKeyViolation;
- procedure InternalDisposeMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); virtual;
- procedure InternalRetrieveMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- virtual;
- procedure InternalStoreMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); virtual;
- public
- constructor Create(ABroker: TInstantCustomRelationalBroker);
- procedure DisposeMap(AObject: TInstantObject; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- procedure DisposeObject(AObject: TInstantObject; Conflict:
- TInstantConflictAction);
- procedure RetrieveMap(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo);
- procedure StoreMap(AObject: TInstantObject; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- procedure StoreObject(AObject: TInstantObject; Conflict:
- TInstantConflictAction);
- property Broker: TInstantCustomRelationalBroker read FBroker;
- end;
-
- TInstantNavigationalResolver = class(TInstantCustomResolver)
- private
- FDataSet: TDataSet;
- FFreeDataSet: Boolean;
- FNavigationalLinkResolvers: TObjectList;
- FTableName: string;
- function CheckConflict(AObject: TInstantObject; const AObjectId: string;
- ConflictAction: TInstantConflictAction): Boolean;
- procedure ClearAttribute(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata);
- function FieldByName(const FieldName: string): TField;
- procedure FreeDataSet;
- function GetBroker: TInstantNavigationalBroker;
- function GetDataSet: TDataSet;
- function GetNavigationalLinkResolvers: TObjectList;
- function GetObjectClassName: string;
- function GetObjectId: string;
- procedure PerformOperation(AObject: TInstantObject;
- Map: TInstantAttributeMap; Operation:
- TInstantNavigationalResolverOperation);
- procedure ReadAttribute(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata);
- procedure ResetAttribute(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata);
- procedure SetDataSet(Value: TDataset);
- procedure WriteAttribute(AObject: TInstantObject;
- AttributeMetadata: TInstantAttributeMetadata);
- protected
- procedure Append; virtual;
- procedure Cancel; virtual;
- procedure ClearBlob(Attribute: TInstantBlob); virtual;
- procedure ClearBoolean(Attribute: TInstantBoolean); virtual;
- procedure ClearDateTime(Attribute: TInstantDateTime); virtual;
- procedure ClearDate(Attribute: TInstantDate); virtual;
- procedure ClearTime(Attribute: TInstantTime); virtual;
- procedure ClearInteger(Attribute: TInstantInteger); virtual;
- procedure ClearFloat(Attribute: TInstantFloat); virtual;
- procedure ClearCurrency(Attribute: TInstantCurrency); virtual;
- procedure ClearMemo(Attribute: TInstantMemo); virtual;
- procedure ClearPart(Attribute: TInstantPart); virtual;
- procedure ClearParts(Attribute: TInstantParts); virtual;
- procedure ClearReference(Attribute: TInstantReference); virtual;
- procedure ClearReferences(Attribute: TInstantReferences); virtual;
- procedure ClearString(Attribute: TInstantString); virtual;
- procedure Close; virtual;
- function CreateDataSet: TDataSet; virtual; abstract;
- function CreateNavigationalLinkResolver(const ATableName: string):
- TInstantNavigationalLinkResolver; virtual; abstract;
- function CreateLocateVarArray(const AObjectClassName, AObjectId: string):
- Variant;
- procedure Delete; virtual;
- procedure Edit; virtual;
- function GetLinkDatasetResolver(const ATableName: string):
- TInstantNavigationalLinkResolver;
- function FieldHasObjects(Field: TField): Boolean; virtual;
- function FindLinkDatasetResolver(const ATableName: string):
- TInstantNavigationalLinkResolver;
- procedure InternalDisposeMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); override;
- procedure InternalRetrieveMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); override;
- procedure InternalStoreMap(AObject: TInstantObject;
- Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- override;
- function Locate(const AObjectClassName, AObjectId: string): Boolean;
- virtual; abstract;
- procedure Open; virtual;
- procedure Post; virtual;
- procedure ReadBlob(Attribute: TInstantBlob); virtual;
- procedure ReadBoolean(Attribute: TInstantBoolean); virtual;
- procedure ReadDateTime(Attribute: TInstantDateTime); virtual;
- procedure ReadDate(Attribute: TInstantDate); virtual;
- procedure ReadTime(Attribute: TInstantTime); virtual;
- procedure ReadInteger(Attribute: TInstantInteger); virtual;
- procedure ReadFloat(Attribute: TInstantFloat); virtual;
- procedure ReadCurrency(Attribute: TInstantCurrency); virtual;
- procedure ReadMemo(Attribute: TInstantMemo); virtual;
- procedure ReadPart(Attribute: TInstantPart); virtual;
- procedure ReadParts(Attribute: TInstantParts); virtual;
- procedure ReadReference(Attribute: TInstantReference); virtual;
- procedure ReadReferences(Attribute: TInstantReferences); virtual;
- procedure ReadString(Attribute: TInstantString); virtual;
- procedure ResetAttributes(AObject: TInstantObject;
- Map: TInstantAttributeMap);
- procedure SetObjectUpdateCount(AObject: TInstantObject; Value: Integer);
- function TranslateError(AObject: TInstantObject; E: Exception): Exception;
- virtual;
- procedure WriteBlob(Attribute: TInstantBlob); virtual;
- procedure WriteBoolean(Attribute: TInstantBoolean); virtual;
- procedure WriteDateTime(Attribute: TInstantDateTime); virtual;
- procedure WriteDate(Attribute: TInstantDate); virtual;
- procedure WriteTime(Attribute: TInstantTime); virtual;
- procedure WriteFloat(Attribute: TInstantFloat); virtual;
- procedure WriteCurrency(Attribute: TInstantCurrency); virtual;
- procedure WriteInteger(Attribute: TInstantInteger); virtual;
- procedure WriteMemo(Attribute: TInstantMemo); virtual;
- procedure WritePart(Attribute: TInstantPart); virtual;
- procedure WriteParts(Attribute: TInstantParts); virtual;
- procedure WriteReference(Attribute: TInstantReference); virtual;
- procedure WriteReferences(Attribute: TInstantReferences); virtual;
- procedure WriteString(Attribute: TInstantString); virtual;
- property DataSet: TDataset read GetDataSet write SetDataSet;
- property NavigationalLinkResolvers: TObjectList read
- GetNavigationalLinkResolvers;
- public
- constructor Create(ABroker: TInstantNavigationalBroker;
- const ATableName: string);
- destructor Destroy; override;
- property Broker: TInstantNavigationalBroker read GetBroker;
- property ObjectClassName: string read GetObjectClassName;
- property ObjectId: string read GetObjectId;
- property TableName: string read FTableName;
- end;
-
- //Backwards compatibility
- TInstantResolver = TInstantNavigationalResolver;
-
- TInstantSQLResolver = class(TInstantCustomResolver)
- private
- FMap: TInstantAttributeMap;
- FDeleteSQL: string;
- FDeleteConcurrentSQL: string;
- FInsertSQL: string;
- FSelectSQL: string;
- FUpdateSQL: string;
- FUpdateConcurrentSQL: string;
- FSelectExternalSQL: string;
- FSelectExternalPartSQL: string;
- FDeleteExternalSQL: string;
- FInsertExternalSQL: string;
- procedure AddIntegerParam(Params: TParams; const ParamName: string;
- Value: Integer);
- procedure AddStringParam(Params: TParams; const ParamName, Value: string);
- // Adds an "Id" param, whose data type and size depends on connector
- // settings.
- procedure AddIdParam(Params: TParams; const ParamName, Value: string);
- procedure CheckConflict(Info: PInstantOperationInfo;
- AObject: TInstantObject);
- function ExecuteStatement(const AStatement: string; AParams: TParams;
- Info: PInstantOperationInfo; ConflictAction: TInstantConflictAction;
- AObject: TInstantObject): Integer;
- function GetDeleteConcurrentSQL: string;
- function GetDeleteSQL: string;
- function GetInsertSQL: string;
- function GetSelectSQL: string;
- function GetUpdateConcurrentSQL: string;
- function GetUpdateSQL: string;
- function GetBroker: TInstantSQLBroker;
- function GetSelectExternalSQL: string;
- function GetSelectExternalPartSQL: string;
- function GetDeleteExternalSQL: string;
- function GetInsertExternalSQL: string;
- protected
- procedure AddAttributeParam(Attribute: TInstantAttribute;
- Params: TParams); virtual;
- procedure AddAttributeParams(Params: TParams; AObject: TInstantObject;
- Map: TInstantAttributeMap);
- procedure AddBaseParams(Params: TParams; AClassName, AObjectId: string;
- AUpdateCount: Integer = -1);
- procedure AddConcurrencyParam(Params: TParams; AUpdateCount: Integer);
- function AddParam(Params: TParams; const ParamName: string;
- ADataType: TFieldType): TParam;
- procedure AddPersistentIdParam(Params: TParams; APersistentId: string);
- procedure InternalDisposeMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); override;
- procedure InternalRetrieveMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
- override;
- procedure InternalStoreMap(AObject: TInstantObject;
- Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
- Info: PInstantOperationInfo); override;
- procedure ReadAttribute(AObject: TInstantObject; const AObjectId: string;
- AttributeMetadata: TInstantAttributeMetadata; DataSet: TDataSet); virtual;
- procedure ReadAttributes(AObject: TInstantObject; const AObjectId: string;
- Map: TInstantAttributeMap; DataSet: TDataSet);
- function ReadBlobField(DataSet: TDataSet; const FieldName: string): string;
- virtual;
- function ReadBooleanField(DataSet: TDataSet; const FieldName: string):
- Boolean; virtual;
- function ReadDateTimeField(DataSet: TDataSet; const FieldName: string):
- TDateTime; virtual;
- function ReadDateField(DataSet: TDataSet; const FieldName: string):
- TDateTime; virtual;
- function ReadTimeField(DataSet: TDataSet; const FieldName: string):
- TDateTime; virtual;
- function ReadFloatField(DataSet: TDataSet; const FieldName: string): Double;
- virtual;
- function ReadCurrencyField(DataSet: TDataSet; const FieldName: string):
- Currency; virtual;
- function ReadIntegerField(DataSet: TDataSet; const FieldName: string):
- Integer; virtual;
- function ReadMemoField(DataSet: TDataSet; const FieldName: string): string;
- virtual;
- function ReadStringField(DataSet: TDataSet; const FieldName: string):
- string; virtual;
- procedure RemoveConcurrencyParam(Params: TParams);
- procedure RemovePersistentIdParam(Params: TParams);
- function TranslateError(AObject: TInstantObject;
- E: Exception): Exception; virtual;
- public
- constructor Create(ABroker: TInstantSQLBroker; AMap: TInstantAttributeMap);
- property Broker: TInstantSQLBroker read GetBroker;
- property DeleteConcurrentSQL: string read GetDeleteConcurrentSQL write FDeleteConcurrentSQL;
- property DeleteSQL: string read GetDeleteSQL write FDeleteSQL;
- property DeleteExternalSQL: string read GetDeleteExternalSQL write FDeleteExternalSQL;
- property InsertSQL: string read GetInsertSQL write FInsertSQL;
- property InsertExternalSQL: string read GetInsertExternalSQL
- write FInsertExternalSQL;
- property Map: TInstantAttributeMap read FMap;
- property SelectSQL: string read GetSelectSQL write FSelectSQL;
- property SelectExternalSQL: string read GetSelectExternalSQL
- write FSelectExternalSQL;
- property SelectExternalPartSQL: string read GetSelectExternalPartSQL
- write FSelectExternalPartSQL;
- property UpdateConcurrentSQL: string read GetUpdateConcurrentSQL
- write FUpdateConcurrentSQL;
- property UpdateSQL: string read GetUpdateSQL write FUpdateSQL;
- end;
-
- // TInstantLinkResolver class defines common interface for handling
- // access to container attributes with external storage
- TInstantLinkResolver = class(TInstantStreamable)
- private
- FResolver: TInstantCustomResolver;
- function GetBroker: TInstantCustomRelationalBroker;
- function GetResolver: TInstantCustomResolver;
- protected
- procedure InternalStoreAttributeObjects(Attribute: TInstantContainer);
- virtual;
- procedure InternalClearAttributeLinkRecords; virtual;
- procedure InternalDisposeDeletedAttributeObjects(
- Attribute: TInstantContainer); virtual;
- procedure InternalReadAttributeObjects(Attribute: TInstantContainer;
- const AObjectId: string); virtual;
- public
- constructor Create(AResolver: TInstantCustomResolver);
- procedure StoreAttributeObjects(Attribute: TInstantContainer);
- procedure ClearAttributeLinkRecords;
- procedure DisposeDeletedAttributeObjects(Attribute: TInstantContainer);
- procedure ReadAttributeObjects(Attribute: TInstantContainer;
- const AObjectId: string);
- property Broker: TInstantCustomRelationalBroker read GetBroker;
- property Resolver: TInstantCustomResolver read GetResolver;
- end;
-
- // TInstantNavigationalLinkResolver is an abstract class that
- // defines the interface for handling access to container attributes
- // with external storage for navigational brokers.
- // Each navigational broker needs to provide a concrete class descendent.
- // See the BDE broker as an example.
- TInstantNavigationalLinkResolver = class(TInstantLinkResolver)
- private
- FDataSet: TDataSet;
- FFreeDataSet: Boolean;
- FTableName: string;
- function FieldByName(const FieldName: string): TField;
- procedure FreeDataSet;
- function GetBroker: TInstantNavigationalBroker;
- function GetDataSet: TDataSet;
- function GetResolver: TInstantNavigationalResolver;
- procedure SetDataSet(Value: TDataset);
- protected
- procedure Append; virtual;
- procedure Cancel; virtual;
- procedure Close; virtual;
- function CreateDataSet: TDataSet; virtual; abstract;
- procedure Delete; virtual;
- procedure Edit; virtual;
- function Eof: Boolean; virtual;
- procedure First; virtual;
- procedure InternalStoreAttributeObjects(Attribute: TInstantContainer); override;
- procedure InternalClearAttributeLinkRecords; override;
- procedure InternalDisposeDeletedAttributeObjects(
- Attribute: TInstantContainer); override;
- procedure InternalReadAttributeObjects(Attribute: TInstantContainer;
- const AObjectId: string); override;
- procedure Next; virtual;
- procedure Open; virtual;
- procedure Post; virtual;
- procedure SetDatasetParentRange(const AParentClass, AParentId: string);
- virtual; abstract;
- property DataSet: TDataset read GetDataSet write SetDataSet;
- public
- constructor Create(AResolver: TInstantNavigationalResolver;
- const ATableName: string);
- destructor Destroy; override;
- property Broker: TInstantNavigationalBroker read GetBroker;
- property Resolver: TInstantNavigationalResolver read GetResolver;
- property TableName: string read FTableName;
- end;
-
- // TInstantSQLLinkResolver class defines interface for handling
- // access to container attributes with external storage for
- // SQL brokers. Due to the generic nature of SQL this class is used
- // directly and no descendant classes are needed for SQL brokers.
- TInstantSQLLinkResolver = class(TInstantLinkResolver)
- private
- FAttributeOwner: TInstantObject;
- FTableName: string;
- function GetBroker: TInstantSQLBroker;
- function GetResolver: TInstantSQLResolver;
- property TableName: string read FTableName;
- protected
- procedure InternalStoreAttributeObjects(Attribute: TInstantContainer);
- override;
- procedure InternalClearAttributeLinkRecords; override;
- procedure InternalDisposeDeletedAttributeObjects(
- Attribute: TInstantContainer); override;
- procedure InternalReadAttributeObjects(Attribute: TInstantContainer; const
- AObjectId: string); override;
- public
- constructor Create(AResolver: TInstantSQLResolver; const ATableName: string;
- AObject: TInstantObject);
- property AttributeOwner: TInstantObject read FAttributeOwner;
- property Broker: TInstantSQLBroker read GetBroker;
- property Resolver: TInstantSQLResolver read GetResolver;
- end;
-
- TInstantStatement = class
- private
- FStatementImplementation: TComponent;
- public
- constructor Create(const AStatementImplementation: TComponent);
- destructor Destroy; override;
- property StatementImplementation: TComponent read FStatementImplementation;
- end;
-
- TInstantStatementCache = class(TComponent)
- private
- FStatements: TStringList;
- FCapacity: Integer;
- procedure DeleteStatement(const Index: Integer);
- procedure DeleteAllStatements;
- procedure Shrink;
- procedure SetCapacity(const Value: Integer);
- protected
- procedure Notification(AComponent: TComponent; Operation: TOperation);
- override;
- public
- constructor Create(AOwner: TComponent); override;
- property Capacity: Integer read FCapacity write SetCapacity;
- destructor Destroy; override;
- function GetStatement(const StatementText: string): TInstantStatement;
- function AddStatement(const StatementText: string;
- const StatementImplementation: TComponent): Integer;
- function RemoveStatement(const StatementText: string): Boolean;
- end;
-
- // A TInstantCatalog that gathers its info from an existing database (through
- // a TInstantBroker). The broker knows how to read the metadata information
- // depending on which particular database is used as back-end. This is an
- // abstract class. A concrete derived class for each supported back-end
- // must be developed.
- TInstantBrokerCatalog = class(TInstantCatalog)
- private
- FBroker: TInstantBroker;
- function GetBroker: TInstantBroker;
- public
- // Creates an instance and binds it to the specified TInstantScheme object.
- // ABroker is written to the Broker property.
- constructor Create(const AScheme: TInstantScheme;
- const ABroker: TInstantBroker); virtual;
- // A reference to the broker through which the metadata info is read.
- property Broker: TInstantBroker read GetBroker;
- end;
-
- // A TInstantBrokerCatalog that works with a SQL broker only.
- TInstantSQLBrokerCatalog = class(TInstantBrokerCatalog)
- private
- function GetBroker: TInstantSQLBroker;
- public
- property Broker: TInstantSQLBroker read GetBroker;
- end;
-
- TInstantSQLGenerator = class(TObject)
- private
- FBroker: TInstantSQLBroker;
- protected
- function BuildList(Map: TInstantAttributeMap; Additional: array of string;
- StringFunc: TInstantStringFunc = nil; const Delimiter: string = ','):
- string;
- function BuildAssignment(const AName: string): string;
- function BuildAssignmentList(Map: TInstantAttributeMap;
- Additional: array of string): string;
- function BuildConcurrencyCriteria: string;
- function BuildPersistentIdCriteria: string;
- function BuildFieldList(Map: TInstantAttributeMap;
- Additional: array of string): string; overload;
- function BuildFieldList(const S: string): string; overload;
- function BuildParam(const AName: string): string; virtual;
- function BuildParamList(Map: TInstantAttributeMap;
- Additional: array of string): string;
- function BuildWhereStr(Fields: array of string): string;
- function EmbraceField(const FieldName: string): string; virtual;
- function EmbraceTable(const TableName: string): string; virtual;
- function GetDelimiters: string; virtual;
- function InternalGenerateAddFieldSQL(Metadata: TInstantFieldMetadata):
- string; virtual;
- function InternalGenerateAlterFieldSQL(OldMetadata,
- NewMetadata: TInstantFieldMetadata): string; virtual;
- function InternalGenerateCreateIndexSQL(Metadata: TInstantIndexMetadata):
- string; virtual;
- function InternalGenerateCreateTableSQL(Metadata: TInstantTableMetadata):
- string; virtual;
- function InternalGenerateDeleteConcurrentSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateDeleteSQL(Map: TInstantAttributeMap): string;
- virtual;
- function InternalGenerateDeleteExternalSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateDropFieldSQL(Metadata: TInstantFieldMetadata):
- string; virtual;
- function InternalGenerateDropIndexSQL(Metadata: TInstantIndexMetadata):
- string; virtual;
- function InternalGenerateDropTableSQL(Metadata: TInstantTableMetadata):
- string; virtual;
- function InternalGenerateInsertSQL(Map: TInstantAttributeMap): string;
- virtual;
- function InternalGenerateInsertExternalSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateSelectSQL(Map: TInstantAttributeMap): string;
- virtual;
- function InternalGenerateSelectExternalSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateSelectExternalPartSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateSelectTablesSQL: string; virtual;
- function InternalGenerateUpdateConcurrentSQL(Map: TInstantAttributeMap):
- string; virtual;
- function InternalGenerateUpdateFieldCopySQL(OldMetadata, NewMetadata:
- TInstantFieldMetadata): string; virtual;
- function InternalGenerateUpdateSQL(Map: TInstantAttributeMap): string;
- virtual;
- property Delimiters: string read GetDelimiters;
- property Broker: TInstantSQLBroker read FBroker;
- public
- constructor Create(ABroker: TInstantSQLBroker);
- function GenerateAddFieldSQL(Metadata: TInstantFieldMetadata): string;
- function GenerateAlterFieldSQL(OldMetadata,
- NewMetadata: TInstantFieldMetadata): string;
- function GenerateCreateIndexSQL(Metadata: TInstantIndexMetadata): string;
- function GenerateCreateTableSQL(Metadata: TInstantTableMetadata): string;
- function GenerateDeleteConcurrentSQL(Map: TInstantAttributeMap): string;
- function GenerateDeleteSQL(Map: TInstantAttributeMap): string;
- function GenerateDeleteExternalSQL(Map: TInstantAttributeMap): string;
- function GenerateDropFieldSQL(Metadata: TInstantFieldMetadata): string;
- function GenerateDropIndexSQL(Metadata: TInstantIndexMetadata): string;
- function GenerateDropTableSQL(Metadata: TInstantTableMetadata): string;
- function GenerateInsertSQL(Map: TInstantAttributeMap): string;
- function GenerateInsertExternalSQL(Map: TInstantAttributeMap): string;
- function GenerateSelectSQL(Map: TInstantAttributeMap): string;
- function GenerateSelectExternalSQL(Map: TInstantAttributeMap): string;
- function GenerateSelectExternalPartSQL(Map: TInstantAttributeMap): string;
- function GenerateSelectTablesSQL: string;
- function GenerateUpdateConcurrentSQL(Map: TInstantAttributeMap): string;
- function GenerateUpdateFieldCopySQL(OldMetadata, NewMetadata:
- TInstantFieldMetadata): string;
- function GenerateUpdateSQL(Map: TInstantAttributeMap): string;
- end;
-
- TInstantCustomRelationalQuery = class(TInstantQuery)
- private
- function GetConnector: TInstantRelationalConnector;
- protected
- function GetStatement: string; virtual;
- procedure InternalGetInstantObjectRefs(List: TInstantObjectReferenceList);
- virtual;
- procedure InternalRefreshObjects; override;
- procedure SetStatement(const Value: string); virtual;
- procedure TranslateCommand; override;
- class function TranslatorClass: TInstantRelationalTranslatorClass; virtual;
- public
- function CreateTranslator: TInstantRelationalTranslator;
- property Statement: string read GetStatement write SetStatement;
- property Connector: TInstantRelationalConnector read GetConnector;
- end;
-
- TInstantQueryTranslator = class(TInstantIQLTranslator)
- private
- FQuery: TInstantQuery;
- function GetQuery: TInstantQuery;
- protected
- function CreateCommand: TInstantIQLCommand; override;
- function GetResultClassName: string; override;
- public
- constructor Create(AQuery: TInstantQuery);
- property Query: TInstantQuery read GetQuery;
- end;
-
- TInstantRelationalTranslator = class(TInstantQueryTranslator)
- private
- FCriteriaList: TStringList;
- FTablePathList: TStringList;
- procedure AddJoin(const FromPath, FromField, ToPath, ToField: string);
- function ConcatPath(const APathText, AttribName: string): string;
- procedure DestroyCriteriaList;
- procedure DestroyTablePathList;
- function ExtractTarget(const PathStr: string): string;
- function RootAttribToFieldName(const AttribName: string): string;
- function GetClassTablePath: string;
- function GetCriteriaCount: Integer;
- function GetCriteriaList: TStringList;
- function GetCriterias(Index: Integer): string;
- function GetObjectClassMetadata: TInstantClassMetadata;
- function GetQuery: TInstantCustomRelationalQuery;
- function GetTablePathAliases(Index: Integer): string;
- function GetTablePathCount: Integer;
- function GetTablePathList: TStringList;
- function GetTablePaths(Index: Integer): string;
- function PathToTablePath(const PathText: string): string;
- function PathToTarget(const PathText: string;
- out TablePath, FieldName: string): TInstantAttributeMetadata;
- function Qualify(const TablePath, FieldName: string): string;
- function QualifyPath(const PathText: string): string;
- function ReplaceWildcard(const Str: string): string;
- function TablePathToAlias(const TablePath: string): string;
- procedure WriteAnd(Writer: TInstantIQLWriter);
- function WriteCriterias(Writer: TInstantIQLWriter; IncludeWhere: Boolean):
- Boolean;
- procedure WriteTables(Writer: TInstantIQLWriter);
- property CriteriaList: TStringList read GetCriteriaList;
- property TablePathList: TStringList read GetTablePathList;
- function GetConnector: TInstantRelationalConnector;
- protected
- function AddCriteria(const Criteria: string): Integer;
- function AddTablePath(const TablePath: string): Integer;
- procedure BeforeTranslate; override;
- procedure Clear; override;
- procedure CollectObjects(AObject: TInstantIQLObject;
- AClassType: TInstantIQLObjectClass; AList: TList);
- procedure CollectPaths(AObject: TInstantIQLObject; APathList: TList);
- function GetDelimiters: string; virtual;
- function GetQuote: Char; virtual;
- function GetWildcard: string; virtual;
- function HasConnector: Boolean;
- function IncludeOrderFields: Boolean; virtual;
- function IndexOfCriteria(const Criteria: string): Integer;
- function IndexOfTablePath(const TablePath: string): Integer;
- function InternalGetObjectClassMetadata: TInstantClassMetadata; virtual;
- function IsRootAttribute(const AttributeName: string): Boolean;
- function IsPrimary(AObject: TInstantIQLObject): Boolean;
- procedure MakeJoins(Path: TInstantIQLPath);
- procedure MakeTablePaths(Path: TInstantIQLPath);
- function TranslateClassRef(ClassRef: TInstantIQLClassRef;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateClause(Clause: TInstantIQLClause;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateConstant(Constant: TInstantIQLConstant;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateFunction(AFunction: TInstantIQLFunction;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateFunctionName(const FunctionName: string;
- Writer: TInstantIQLWriter): Boolean; virtual;
- function TranslateKeyword(const Keyword: string; Writer: TInstantIQLWriter):
- Boolean; override;
- function TranslateObject(AObject: TInstantIQLObject;
- Writer: TInstantIQLWriter): Boolean; override;
- function TranslatePath(Path: TInstantIQLPath; Writer: TInstantIQLWriter):
- Boolean; virtual;
- function TranslateSpecifier(Specifier: TInstantIQLSpecifier;
- Writer: TInstantIQLWriter): Boolean; virtual;
- property ClassTablePath: string read GetClassTablePath;
- property Connector: TInstantRelationalConnector read GetConnector;
- property CriteriaCount: Integer read GetCriteriaCount;
- property Criterias[Index: Integer]: string read GetCriterias;
- property Delimiters: string read GetDelimiters;
- property ObjectClassMetadata: TInstantClassMetadata
- read GetObjectClassMetadata;
- property Quote: Char read GetQuote;
- property TablePathAliases[Index: Integer]: string read GetTablePathAliases;
- property TablePathCount: Integer read GetTablePathCount;
- property TablePaths[Index: Integer]: string read GetTablePaths;
- property Wildcard: string read GetWildcard;
- public
- destructor Destroy; override;
- function QuoteString(const Str: string): string;
- property Query: TInstantCustomRelationalQuery read GetQuery;
- end;
-
- TInstantNavigationalQuery = class(TInstantCustomRelationalQuery)
- private
- FObjectRowList: TList;
- function CreateObject(Row: Integer): TObject;
- procedure DestroyObjectRowList;
- function GetObjectRowList: TList;
- function GetObjectRowCount: Integer;
- function GetObjectRows(Index: Integer): PObjectRow;
- procedure InitObjectRows(List: TList; FromIndex, ToIndex: Integer);
- property ObjectRowList: TList read GetObjectRowList;
- protected
- function GetActive: Boolean; override;
- function GetDataSet: TDataSet; virtual;
- function GetRowCount: Integer; virtual;
- function GetRowNumber: Integer; virtual;
- function InternalAddObject(AObject: TObject): Integer; override;
- procedure InternalClose; override;
- procedure InternalGetInstantObjectRefs(List: TInstantObjectReferenceList);
- override;
- function InternalGetObjectCount: Integer; override;
- function InternalGetObjects(Index: Integer): TObject; override;
- function InternalIndexOfObject(AObject: TObject): Integer; override;
- procedure InternalInsertObject(Index: Integer; AObject: TObject); override;
- procedure InternalOpen; override;
- procedure InternalRefreshObjects; override;
- procedure InternalReleaseObject(AObject: TObject); override;
- function InternalRemoveObject(AObject: TObject): Integer; override;
- function IsSequenced: Boolean; virtual;
- function ObjectFetched(Index: Integer): Boolean; override;
- function RecNoOfObject(AObject: TInstantObject): Integer; virtual;
- procedure SetRowNumber(Value: Integer); virtual;
- property DataSet: TDataSet read GetDataSet;
- property ObjectRowCount: Integer read GetObjectRowCount;
- property ObjectRows[Index: Integer]: PObjectRow read GetObjectRows;
- public
- destructor Destroy; override;
- property RowCount: Integer read GetRowCount;
- property RowNumber: Integer read GetRowNumber write SetRowNumber;
- end;
-
- //Backwards compatibility
- TInstantRelationalQuery = TInstantNavigationalQuery;
-
- TInstantSQLQuery = class(TInstantCustomRelationalQuery)
- private
- FObjectReferenceList: TInstantObjectReferenceList;
- FParamsObject: TParams;
- FStatement: string;
- procedure DestroyObjectReferenceList;
- function GetObjectReferenceCount: Integer;
- function GetObjectReferenceList: TInstantObjectReferenceList;
- function GetParamsObject: TParams;
- procedure InitObjectReferences(DataSet: TDataSet);
- protected
- function GetActive: Boolean; override;
- function AcquireDataSet(const AStatement: string; AParams: TParams):
- TDataSet; virtual;
- procedure ReleaseDataSet(const DataSet: TDataSet);
- function GetParams: TParams; override;
- function GetStatement: string; override;
- function InternalAddObject(AObject: TObject): Integer; override;
- procedure InternalClose; override;
- procedure InternalGetInstantObjectRefs(List: TInstantObjectReferenceList);
- override;
- function InternalGetObjectCount: Integer; override;
- function InternalGetObjects(Index: Integer): TObject; override;
- function InternalIndexOfObject(AObject: TObject): Integer; override;
- procedure InternalInsertObject(Index: Integer; AObject: TObject); override;
- procedure InternalOpen; override;
- procedure InternalReleaseObject(AObject: TObject); override;
- function InternalRemoveObject(AObject: TObject): Integer; override;
- procedure SetParams(Value: TParams); override;
- function ObjectFetched(Index: Integer): Boolean; override;
- procedure SetStatement(const Value: string); override;
- property ObjectReferenceCount: Integer read GetObjectReferenceCount;
- property ObjectReferenceList: TInstantObjectReferenceList read
- GetObjectReferenceList;
- property ParamsObject: TParams read GetParamsObject;
- public
- destructor Destroy; override;
- end;
-
- TInstantRelationalConnectionDef = class(TInstantConnectionDef)
- end;
-
- TInstantConnectionBasedConnectionDef = class(TInstantRelationalConnectionDef)
- private
- FLoginPrompt: Boolean;
- protected
- function CreateConnection(AOwner: TComponent): TCustomConnection; virtual;
- abstract;
- procedure InitConnector(Connector: TInstantConnector); override;
- public
- constructor Create(Collection: TCollection); override;
- published
- property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt
- default True;
- end;
-
-var
- InstantLogProc: procedure (const AString: string) of object;
-
-implementation
-
-uses
-{$IFDEF MSWINDOWS}
- Windows,
-{$ENDIF}
-{$IFDEF LINUX}
- Types,
-{$ENDIF}
-{$IFDEF D6+}
- Variants,
- DateUtils,
-{$ENDIF}
- TypInfo, InstantUtils, InstantRtti;
-
-const
- ConcurrencyParamName = 'IO_Concur';
- PersistentIdParamName = 'IO_PersId';
-
-{$IFDEF IO_STATEMENT_LOGGING}
-procedure InstantLogStatement(const Caption, AStatement: string;
- AParams: TParams = nil);
-var
- S: string;
- g: Integer;
-begin
- S := Caption + AStatement;
- if Assigned(AParams) then
- begin
- for g := 0 to AParams.Count - 1 do begin
- S := S + sLineBreak + ' ' +
- AParams[g].Name + ': ' + GetEnumName(TypeInfo(TFieldType),
- Ord(AParams[g].DataType)) +
- ' = ' + AParams[g].AsString;
- end;
- end;
-{$IFDEF MSWINDOWS}
- OutputDebugString(PChar(S));
-{$ENDIF}
- if Assigned(InstantLogProc) then
- InstantLogProc(S);
-end;
-{$ENDIF}
-
-function CreateObjectFromDataSet(AClass: TClass; DataSet: TDataSet): TObject;
-var
- I: Integer;
- FieldName: string;
-begin
- if AClass = nil then
- raise Exception.Create(SUnassignedClass)
- else if AClass.InheritsFrom(TInstantObject) then
- Result := TInstantObjectClass(AClass).Create
- else
- Result := AClass.Create;
- for I := 0 to Pred(DataSet.FieldCount) do
- begin
- FieldName := StringReplace(
- DataSet.Fields[I].FieldName, '_', '.', [rfReplaceAll]);
- InstantSetProperty(Result, FieldName, DataSet.Fields[I].Value);
- end;
-end;
-
-{ TInstantCustomRelationalBroker }
-
-constructor TInstantCustomRelationalBroker.Create(AConnector: TInstantConnector);
-begin
- inherited;
- FStatementCacheCapacity := 0;
-end;
-
-destructor TInstantCustomRelationalBroker.Destroy;
-begin
- FreeAndNil(FStatementCache);
- inherited;
-end;
-
-procedure TInstantCustomRelationalBroker.DisposeMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
-begin
- EnsureResolver(Map).DisposeMap(AObject, Map, ConflictAction, Info);
-end;
-
-function TInstantCustomRelationalBroker.Execute(const AStatement: string;
- AParams: TParams): Integer;
-begin
- Result := 0;
-end;
-
-function TInstantCustomRelationalBroker.GetConnector: TInstantRelationalConnector;
-begin
- Result := inherited Connector as TInstantRelationalConnector;
-end;
-
-function TInstantCustomRelationalBroker.GetDBMSName: string;
-begin
- Result := '';
-end;
-
-function TInstantCustomRelationalBroker.GetSQLDelimiters: string;
-begin
- Result := '';
-end;
-
-function TInstantCustomRelationalBroker.GetSQLQuote: Char;
-begin
- Result := '"';
-end;
-
-function TInstantCustomRelationalBroker.GetSQLWildcard: string;
-begin
- Result := '%';
-end;
-
-function TInstantCustomRelationalBroker.GetStatementCache: TInstantStatementCache;
-begin
- if not Assigned(FStatementCache) then
- begin
- FStatementCache := TInstantStatementCache.Create(nil);
- FStatementCache.Capacity := FStatementCacheCapacity;
- end;
- Result := FStatementCache;
-end;
-
-function TInstantCustomRelationalBroker.InternalDisposeObject(
- AObject: TInstantObject; ConflictAction: TInstantConflictAction): Boolean;
-begin
- Result := PerformOperation(AObject, AObject.Id, otDispose, DisposeMap,
- ConflictAction);
-end;
-
-function TInstantCustomRelationalBroker.InternalRetrieveObject(
- AObject: TInstantObject; const AObjectId: string;
- ConflictAction: TInstantConflictAction): Boolean;
-begin
- Result := PerformOperation(AObject, AObjectId, otRetrieve, RetrieveMap,
- ConflictAction);
-end;
-
-function TInstantCustomRelationalBroker.InternalStoreObject(
- AObject: TInstantObject; ConflictAction: TInstantConflictAction): Boolean;
-begin
- Result := PerformOperation(AObject, AObject.Id, otStore, StoreMap,
- ConflictAction);
-end;
-
-function TInstantCustomRelationalBroker.PerformOperation(
- AObject: TInstantObject; const AObjectId: string;
- OperationType: TInstantOperationType; Operation: TInstantBrokerOperation;
- ConflictAction: TInstantConflictAction): Boolean;
-
- function OperationRequired(Map: TInstantAttributeMap): Boolean;
- var
- I: Integer;
- Attrib: TInstantAttribute;
- begin
- case OperationType of
- otStore:
- begin
- Result := not AObject.IsPersistent;
- if not Result then
- for I := 0 to Pred(Map.Count) do
- begin
- Attrib := AObject.AttributeByName(Map[I].Name);
- Result := Attrib.IsMandatory or Attrib.IsChanged;
- if Result then
- Exit;
- end;
- end;
- otRetrieve, otDispose:
- Result := True;
- else
- Result := False;
- end;
- end;
-
-var
- I: Integer;
- RootMap, Map: TInstantAttributeMap;
- Info: TInstantOperationInfo;
-begin
- with Info do
- begin
- Success := False;
- Conflict := False;
- end;
- with AObject.Metadata do
- begin
- RootMap := StorageMaps.RootMap;
- Operation(AObject, AObjectId, RootMap, ConflictAction, @Info);
- Result := Info.Success;
- if Result then
- for I := 0 to Pred(StorageMaps.Count) do
- begin
- Map := StorageMaps[I];
- if (Map <> RootMap) and (Info.Conflict or OperationRequired(Map)) then
- Operation(AObject, AObjectId, Map);
- end;
- end;
-end;
-
-procedure TInstantCustomRelationalBroker.RetrieveMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
-begin
- EnsureResolver(Map).RetrieveMap(AObject, AObjectId, Map, ConflictAction, Info);
-end;
-
-procedure TInstantCustomRelationalBroker.SetStatementCacheCapacity(const Value: Integer);
-begin
- FStatementCacheCapacity := Value;
- if FStatementCacheCapacity = 0 then
- FreeAndNil(FStatementCache)
- else if Assigned(FStatementCache) then
- FStatementCache.Capacity := FStatementCacheCapacity;
-end;
-
-procedure TInstantCustomRelationalBroker.StoreMap(AObject: TInstantObject;
- const AObjectId: string; Map: TInstantAttributeMap;
- ConflictAction: TInstantConflictAction; Info: PInstantOperationInfo);
-
- // Always storing fixes #880713
- {function MustStoreMap: Boolean;
- var
- I: Integer;
- Attrib: TInstantAttribute;
- begin
- Result := Map.IsRootMap;
- if Result then
- Exit;
- for I := 0 to Pred(Map.Count) do
- begin
- Attrib := AObject.AttributeByName(Map[I].Name);
- Result := Attrib.IsMandatory or not Attrib.IsDefault;
- if Result then
- Exit;
- end;
- Result := False;
- end;}
-
-var
- Resolver: TInstantCustomResolver;
- {MustStore: Boolean;}
-begin
- {MustStore := MustStoreMap;}
- {if MustStore or AObject.IsPersistent then
- begin}
- Resolver := EnsureResolver(Map);
- {if MustStore then}
- Resolver.StoreMap(AObject, Map, ConflictAction, Info)
- {else if AObject.IsPersistent then
- Resolver.DisposeMap(AObject, Map, ConflictAction, Info);
- end;}
-end;
-
-{ TInstantNavigationalBroker }
-
-destructor TInstantNavigationalBroker.Destroy;
-begin
- FResolverList.Free;
- inherited;
-end;
-
-function TInstantNavigationalBroker.EnsureResolver(
- Map: TInstantAttributeMap): TInstantCustomResolver;
-var
- TableName: string;
-begin
- TableName := Map.Name;
- Result := FindResolver(TableName);
- if not Assigned(Result) then
- begin
- Result := CreateResolver(TableName);
- ResolverList.Add(Result);
- end;
-end;
-
-function TInstantNavigationalBroker.FindResolver(
- const TableName: string): TInstantNavigationalResolver;
-var
- I: Integer;
-begin
- for I := 0 to Pred(ResolverCount) do
- begin
- Result := Resolvers[I];
- if SameText(TableName, Result.TableName) then
- Exit;
- end;
- Result := nil;
-end;
-
-function TInstantNavigationalBroker.GetResolverCount: Integer;
-begin
- Result := ResolverList.Count;
-end;
-
-function TInstantNavigationalBroker.GetResolverList: TObjectList;
-begin
- if not Assigned(FResolverList) then
- FResolverList := TObjectList.Create;
- Result := FResolverList;
-end;
-
-function TInstantNavigationalBroker.GetResolvers(
- Index: Integer): TInstantNavigationalResolver;
-begin
- Result := ResolverList[Index] as TInstantNavigationalResolver;
-end;
-
-destructor TInstantSQLBroker.Destroy;
-begin
- FGenerator.Free;
- FResolverList.Free;
- inherited;
-end;
-
-{ TInstantSQLBroker }
-
-function TInstantSQLBroker.AcquireDataSet(const AStatement: string;
- AParams: TParams): TDataSet;
-var
- CachedStatement: TInstantStatement;
-begin
- Result := nil;
- if FStatementCacheCapacity <> 0 then
- begin
- CachedStatement := StatementCache.GetStatement(AStatement);
- if Assigned(CachedStatement) then
- begin
- Result := TDataSet(CachedStatement.StatementImplementation);
- AssignDataSetParams(Result, AParams);
- end;
- end;
- if not Assigned(Result) then
- begin
- Result := CreateDataSet(AStatement, AParams);
- try
- if Assigned(AParams) and (FStatementCacheCapacity <> 0) then
- StatementCache.AddStatement(AStatement, Result);
- except
- if FStatementCacheCapacity <> 0 then
- StatementCache.RemoveStatement(AStatement);
- Result.Free;
- raise;
- end;
- end;
-end;
-
-procedure TInstantSQLBroker.AssignDataSetParams(DataSet: TDataSet; AParams: TParams);
-begin
- raise EInstantError.CreateFmt(SMissingImplementation, ['AssignDataSetParams', ClassName]);
-end;
-
-function TInstantSQLBroker.EnsureResolver(
- AMap: TInstantAttributeMap): TInstantCustomResolver;
-begin
- Result := FindResolver(AMap);
- if not Assigned(Result) then
- begin
- Result := CreateResolver(AMap);
- ResolverList.Add(Result)
- end;
-end;
-
-function TInstantSQLBroker.FindResolver(
- AMap: TInstantAttributeMap): TInstantSQLResolver;
-var
- I: Integer;
-begin
- for I := 0 to Pred(ResolverCount) do
- begin
- Result := Resolvers[I];
- if Result.Map = AMap then
- Exit;
- end;
- Result := nil;
-end;
-
-class function TInstantSQLBroker.GeneratorClass: TInstantSQLGeneratorClass;
-begin
- Result := TInstantSQLGenerator;
-end;
-
-function TInstantSQLBroker.GetGenerator: TInstantSQLGenerator;
-begin
- if not Assigned(FGenerator) then
- FGenerator := GeneratorClass.Create(Self);
- Result := FGenerator;
-end;
-
-function TInstantSQLBroker.GetResolverCount: Integer;
-begin
- Result := ResolverList.Count;
-end;
-
-function TInstantSQLBroker.GetResolverList: TObjectList;
-begin
- if not Assigned(FResolverList) then
- FResolverList := TObjectList.Create;
- Result := FResolverList;
-end;
-
-function TInstantSQLBroker.GetResolvers(
- Index: Integer): TInstantSQLResolver;
-begin
- Result := ResolverList[Index] as TInstantSQLResolver;
-end;
-
-procedure TInstantSQLBroker.InternalBuildDatabase(Scheme: TInstantScheme);
-var
- I, J: Integer;
- TableMetadata: TInstantTableMetadata;
- IndexMetadata: TInstantIndexMetadata;
-begin
- if not Assigned(Scheme) then
- Exit;
- with Scheme do
- begin
- for I := 0 to Pred(TableMetadataCount) do
- begin
- TableMetadata := TableMetadatas[I];
- try
- Execute(Generator.GenerateDropTableSQL(TableMetadata));
- except
- end;
- Execute(Generator.GenerateCreateTableSQL(TableMetadata));
- with TableMetadata do
- begin
- for J := 0 to Pred(IndexMetadatas.Count) do
- begin
- IndexMetadata := IndexMetadatas[J];
- if not (ixPrimary in IndexMetadata.Options) then
- Execute(Generator.GenerateCreateIndexSQL(IndexMetadata));
- end;
- end;
- end;
- end;
-end;
-
-procedure TInstantSQLBroker.ReleaseDataSet(const ADataSet: TDataSet);
-begin
- if FStatementCacheCapacity <> 0 then
- ADataSet.Close
- else
- ADataSet.Free;
-end;
-
-{ TInstantRelationalConnector }
-
-procedure TInstantRelationalConnector.DoGetDataSet(const CommandText: string;
- var DataSet: TDataSet);
-begin
- if Assigned(FOnGetDataSet) then
- FOnGetDataSet(Self, CommandText, DataSet)
- else
- GetDataSet(CommandText, DataSet);
-end;
-
-procedure TInstantRelationalConnector.DoInitDataSet(
- const CommandText: string; DataSet: TDataSet);
-begin
- if Assigned(FOnInitDataSet) then
- FOnInitDataSet(Self, CommandText, DataSet)
- else
- InitDataSet(CommandText, DataSet);
-end;
-
-function TInstantRelationalConnector.GetBroker: TInstantCustomRelationalBroker;
-begin
- Result := inherited Broker as TInstantCustomRelationalBroker;
-end;
-
-procedure TInstantRelationalConnector.GetDataSet(const CommandText: string;
- var DataSet: TDataSet);
-begin
-end;
-
-function TInstantRelationalConnector.GetDBMSName: string;
-begin
- Result := Broker.DBMSName;
-end;
-
-procedure TInstantRelationalConnector.InitDataSet(const CommandText: string;
- DataSet: TDataSet);
-begin
-end;
-
-function TInstantRelationalConnector.InternalCreateScheme(
- Model: TInstantModel): TInstantScheme;
-begin
- Result := TInstantScheme.Create;
- try
- Result.IdDataType := IdDataType;
- Result.IdSize := IdSize;
- Result.BlobStreamFormat := BlobStreamFormat;
- Result.Catalog := TInstantModelCatalog.Create(Result, Model);
- except
- FreeAndNil(Result);
- raise;
- end;
-end;
-
-constructor TInstantConnectionBasedConnector.Create(AOwner: TComponent);
-begin
- inherited;
- FLoginPrompt := True;
-end;
-
-{ TInstantConnectionBasedConnector }
-
-procedure TInstantConnectionBasedConnector.AfterConnectionChange;
-begin
-end;
-
-procedure TInstantConnectionBasedConnector.AssignLoginOptions;
-begin
- if HasConnection then
- begin
- FConnection.LoginPrompt := FLoginPrompt;
- end;
-end;
-
-procedure TInstantConnectionBasedConnector.BeforeConnectionChange;
-begin
-end;
-
-procedure TInstantConnectionBasedConnector.CheckConnection;
-begin
- InstantCheckConnection(FConnection);
-end;
-
-procedure TInstantConnectionBasedConnector.DoAfterConnectionChange;
-begin
- if Assigned(FConnection) then
- FConnection.FreeNotification(Self);
- AfterConnectionChange;
-end;
-
-procedure TInstantConnectionBasedConnector.DoBeforeConnectionChange;
-begin
- try
- BeforeConnectionChange;
- finally
- if Assigned(FConnection) then
- FConnection.RemoveFreeNotification(Self);
- end;
-end;
-
-function TInstantConnectionBasedConnector.GetConnected: Boolean;
-begin
- if HasConnection then
- Result := Connection.Connected
- else
- Result := inherited GetConnected;
-end;
-
-function TInstantConnectionBasedConnector.GetConnection: TCustomConnection;
-begin
- if not (csDesigning in ComponentSt...
[truncated message content] |
|
From: <jcm...@us...> - 2007-02-24 19:35:00
|
Revision: 760
http://svn.sourceforge.net/instantobjects/revision/?rev=760&view=rev
Author: jcmoraisjr
Date: 2007-02-24 11:35:00 -0800 (Sat, 24 Feb 2007)
Log Message:
-----------
Small fpc-compatibility optimization.
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2007-02-24 19:31:26 UTC (rev 759)
+++ trunk/Source/Core/InstantPersistence.pas 2007-02-24 19:35:00 UTC (rev 760)
@@ -901,11 +901,7 @@
procedure Changed; virtual;
function ChangesDisabled: Boolean;
procedure CheckId;
-{$IFDEF FPC}
- class function ClassType: TInstantObjectClass;
-{$ELSE}
- function ClassType: TInstantObjectClass;
-{$ENDIF}
+ {$IFDEF FPC}class{$ENDIF} function ClassType: TInstantObjectClass;
procedure ClearObjects;
function Clone(AConnector: TInstantConnector = nil): TInstantObject; overload;
function ContainerByName(const ContainerName: string): TInstantContainer;
@@ -5412,11 +5408,7 @@
end;
end;
-{$IFDEF FPC}
-class function TInstantObject.ClassType: TInstantObjectClass;
-{$ELSE}
-function TInstantObject.ClassType: TInstantObjectClass;
-{$ENDIF}
+{$IFDEF FPC}class{$ENDIF} function TInstantObject.ClassType: TInstantObjectClass;
begin
Result := TInstantObjectClass(inherited ClassType);
end;
|
|
From: <jcm...@us...> - 2007-02-24 19:31:50
|
Revision: 759
http://svn.sourceforge.net/instantobjects/revision/?rev=759&view=rev
Author: jcmoraisjr
Date: 2007-02-24 11:31:26 -0800 (Sat, 24 Feb 2007)
Log Message:
-----------
Moving TInstantPart.ObjectReferences property to the protected area to allow optimizations.
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2007-02-20 21:44:49 UTC (rev 758)
+++ trunk/Source/Core/InstantPersistence.pas 2007-02-24 19:31:26 UTC (rev 759)
@@ -660,7 +660,6 @@
function GetObjectReferences(Index: Integer): TInstantObjectReference;
procedure SetObjectReferences(Index: Integer; Value: TInstantObjectReference);
property ObjectReferenceList: TObjectList read GetObjectReferenceList;
- property ObjectReferences[Index: Integer]: TInstantObjectReference read GetObjectReferences write SetObjectReferences;
protected
class function AttributeType: TInstantAttributeType; override;
function GetAllowOwned: Boolean; override;
@@ -683,6 +682,7 @@
procedure SetAllowOwned(Value: Boolean); virtual;
procedure ValidateObject(AObject: TInstantObject); override;
procedure WriteObject(Writer: TInstantWriter); override;
+ property ObjectReferences[Index: Integer]: TInstantObjectReference read GetObjectReferences write SetObjectReferences;
public
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
|
|
From: <fas...@us...> - 2007-02-20 21:45:04
|
Revision: 758
http://svn.sourceforge.net/instantobjects/revision/?rev=758&view=rev
Author: fastbike2
Date: 2007-02-20 13:44:49 -0800 (Tue, 20 Feb 2007)
Log Message:
-----------
[ 1651153] TInstantCustomExposer.Filter bugfix
Modified Paths:
--------------
trunk/Source/Core/InstantPresentation.pas
Modified: trunk/Source/Core/InstantPresentation.pas
===================================================================
--- trunk/Source/Core/InstantPresentation.pas 2007-02-01 04:27:01 UTC (rev 757)
+++ trunk/Source/Core/InstantPresentation.pas 2007-02-20 21:44:49 UTC (rev 758)
@@ -4077,14 +4077,20 @@
procedure TInstantCustomExposer.SetFiltered(Value: Boolean);
begin
- if Value <> Filtered then
+ if Active then
begin
- inherited;
- if Filtered then
- First
- else
- Refresh;
- end;
+ CheckBrowseMode;
+ if Filtered <> Value then
+ begin
+ inherited SetFiltered(Value);
+ if Value then
+ First
+ else
+ Refresh;
+ end;
+ end
+ else
+ inherited SetFiltered(Value);
end;
procedure TInstantCustomExposer.SetLimited(Value: Boolean);
|
|
From: <sr...@us...> - 2007-02-01 04:27:01
|
Revision: 757
http://svn.sourceforge.net/instantobjects/revision/?rev=757&view=rev
Author: srmitch
Date: 2007-01-31 20:27:01 -0800 (Wed, 31 Jan 2007)
Log Message:
-----------
Update to allow the InstantObjects Model Explorer Expert (IMEE) to use the newer Delphi ToolsAPI for D7+. Changes include the following:
- Copy the current 'InstantModelExpert.pas' and 'InstantOTA.pas' units to 'InstantModelExpertOld.pas' and 'InstantOTAOld.pas' respectively and continue to use these for D5 and D6 IDEs by modifying their package files;
- Update the current 'InstantModelExpert.pas' and 'InstantOTA.pas' units for the newer Delphi ToolsAPI (no '*Inf.pas' dependencies) and use these for D7 and later IDEs;
- Adjust any other unit uses clauses as required to implement these changes.
Modified Paths:
--------------
trunk/Source/Design/D5/DclIOCore_D5.dpk
trunk/Source/Design/D6/DclIOCore.dpk
trunk/Source/Design/InstantModelExpert.pas
trunk/Source/Design/InstantModelExplorer.pas
trunk/Source/Design/InstantOTA.pas
Added Paths:
-----------
trunk/Source/Design/InstantModelExpertOld.pas
trunk/Source/Design/InstantOTAOld.pas
Modified: trunk/Source/Design/D5/DclIOCore_D5.dpk
===================================================================
--- trunk/Source/Design/D5/DclIOCore_D5.dpk 2007-02-01 03:39:40 UTC (rev 756)
+++ trunk/Source/Design/D5/DclIOCore_D5.dpk 2007-02-01 04:27:01 UTC (rev 757)
@@ -47,9 +47,9 @@
InstantDialog in '..\InstantDialog.pas' {InstantDialogForm},
InstantDualList in '..\InstantDualList.pas' {InstantDualListForm},
InstantEdit in '..\InstantEdit.pas' {InstantEditForm},
- InstantModelExpert in '..\InstantModelExpert.pas',
+ InstantModelExpertOld in '..\InstantModelExpertOld.pas',
InstantModelExplorer in '..\InstantModelExplorer.pas' {InstantModelExplorerForm},
- InstantOTA in '..\InstantOTA.pas',
+ InstantOTAOld in '..\InstantOTAOld.pas',
InstantReg in '..\InstantReg.pas',
InstantUnitSelect in '..\InstantUnitSelect.pas' {InstantUnitSelectForm},
InstantAttributeEditor in '..\InstantAttributeEditor.pas' {InstantAttributeEditorForm},
Modified: trunk/Source/Design/D6/DclIOCore.dpk
===================================================================
--- trunk/Source/Design/D6/DclIOCore.dpk 2007-02-01 03:39:40 UTC (rev 756)
+++ trunk/Source/Design/D6/DclIOCore.dpk 2007-02-01 04:27:01 UTC (rev 757)
@@ -52,9 +52,9 @@
InstantDialog in '..\InstantDialog.pas' {InstantDialogForm},
InstantDualList in '..\InstantDualList.pas' {InstantDualListForm},
InstantEdit in '..\InstantEdit.pas' {InstantEditForm},
- InstantModelExpert in '..\InstantModelExpert.pas',
+ InstantModelExpertOld in '..\InstantModelExpertOld.pas',
InstantModelExplorer in '..\InstantModelExplorer.pas' {InstantModelExplorerForm},
- InstantOTA in '..\InstantOTA.pas',
+ InstantOTAOld in '..\InstantOTAOld.pas',
InstantReg in '..\InstantReg.pas',
InstantUnitSelect in '..\InstantUnitSelect.pas' {InstantUnitSelectForm},
InstantAttributeEditor in '..\InstantAttributeEditor.pas' {InstantAttributeEditorForm},
Modified: trunk/Source/Design/InstantModelExpert.pas
===================================================================
--- trunk/Source/Design/InstantModelExpert.pas 2007-02-01 03:39:40 UTC (rev 756)
+++ trunk/Source/Design/InstantModelExpert.pas 2007-02-01 04:27:01 UTC (rev 757)
@@ -1,6 +1,6 @@
(*
* InstantObjects
- * IDE Model Expert
+ * IDE Model Expert for D7+
*)
(* ***** BEGIN LICENSE BLOCK *****
@@ -36,15 +36,11 @@
{$I '..\InstantDefines.inc'}
{$ENDIF}
-{$IFDEF D7+}
-{$WARN UNIT_DEPRECATED OFF}
-{$ENDIF}
-
interface
uses
- Classes, ToolsAPI, ToolIntf, EditIntf, InstantOTA, Menus, ImgList,
- InstantDesignResources, InstantModelExplorer, InstantCode, ExtCtrls, Forms,
+ Classes, ToolsAPI, InstantOTA, Menus, ImgList, ExtCtrls, Forms,
+ InstantDesignResources, InstantModelExplorer, InstantCode,
InstantConsts;
type
@@ -122,15 +118,14 @@
procedure CheckIOMetadataKeyword(const FileName, Source: string);
procedure ExplorerItemClick(Sender: TObject);
procedure GetModelModules(Modules: TInterfaceList);
- procedure IDEAfterCompilation(Sender: TObject; Succeeded: Boolean);
+ procedure IDEAfterCompilation(Sender: TObject; const Project: IOTAProject;
+ Succeeded: Boolean; IsCodeInsight: Boolean);
procedure IDEBeforeCompilation(Sender: TObject; Project: IOTAProject;
IsCodeInsight: Boolean; var Cancel: Boolean);
- procedure IDEEventNotification(Sender: TObject;
- NotifyCode: TEventNotification; var Cancel: Boolean);
procedure IDEFileNotification(Sender: TObject;
- NotifyCode: TFileNotification; const FileName: string;
+ NotifyCode: TOTAFileNotification; const FileName: string;
var Cancel: Boolean);
- procedure IDEModuleNotification(Sender: TObject; NotifyCode: TNotifyCode;
+ procedure IDEModuleNotification(Sender: TObject; NotifyCode: TModuleNotifyCode;
const FileName: string);
function IsProjectUnit(FileName: string): Boolean;
function IsModelUnit(FileName: string): Boolean;
@@ -666,9 +661,8 @@
Result := TInstantOTAIDEInterface.Create;
with Result do
begin
- AfterCompilation := IDEAfterCompilation;
- BeforeCompilation := IDEBeforeCompilation;
- OnEventNotification := IDEEventNotification;
+ OnAfterCompilation := IDEAfterCompilation;
+ OnBeforeCompilation := IDEBeforeCompilation;
OnFileNotification := IDEFileNotification;
OnModuleNotification := IDEModuleNotification;
end;
@@ -857,8 +851,11 @@
Result := [];
end;
-procedure TInstantModelExpert.IDEAfterCompilation(Sender: TObject; Succeeded: Boolean);
+procedure TInstantModelExpert.IDEAfterCompilation(Sender: TObject; const
+ Project: IOTAProject; Succeeded: Boolean; IsCodeInsight: Boolean);
begin
+ if IsCodeInsight then
+ Exit;
if FMustUpdateAfterCompile then
begin
FMustUpdateAfterCompile := False;
@@ -888,34 +885,28 @@
end;
end;
-procedure TInstantModelExpert.IDEEventNotification(Sender: TObject;
- NotifyCode: TEventNotification; var Cancel: Boolean);
-begin
-end;
-
procedure TInstantModelExpert.IDEFileNotification(Sender: TObject;
- NotifyCode: TFileNotification; const FileName: string; var Cancel: Boolean);
+ NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
begin
case NotifyCode of
- fnFileOpened:
+ ofnFileOpened:
if IsProjectUnit(FileName) then
MetaDataCheckState := mcNeverChecked;
- fnFileClosing:
+ ofnFileClosing:
if IsModelUnit(FileName) then
IsDirty := True;
end;
end;
procedure TInstantModelExpert.IDEModuleNotification(Sender: TObject;
- NotifyCode: TNotifyCode; const FileName: string);
+ NotifyCode: TModuleNotifyCode; const FileName: string);
begin
case NotifyCode of
- ncAfterSave,
- ncEditorModified:
+ mncAfterSave,
+ mncEditorModified:
if IsModelUnit(FileName) then
IsDirty := True;
- ncEditorSelected:
- Exit;
+ mncEditorSelected: ;
end;
end;
Added: trunk/Source/Design/InstantModelExpertOld.pas
===================================================================
--- trunk/Source/Design/InstantModelExpertOld.pas (rev 0)
+++ trunk/Source/Design/InstantModelExpertOld.pas 2007-02-01 04:27:01 UTC (rev 757)
@@ -0,0 +1,1205 @@
+(*
+ * InstantObjects
+ * IDE Model Expert for D5 and D6
+ *)
+
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is: Seleqt InstantObjects
+ *
+ * The Initial Developer of the Original Code is: Seleqt
+ *
+ * Portions created by the Initial Developer are Copyright (C) 2001-2003
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ * Nando Dessena, Steven Mitchell
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit InstantModelExpertOld;
+
+{$IFDEF LINUX}
+{$I '../InstantDefines.inc'}
+{$ELSE}
+{$I '..\InstantDefines.inc'}
+{$ENDIF}
+
+interface
+
+uses
+ Classes, ToolsAPI, ToolIntf, EditIntf, InstantOTAOld, Menus, ImgList,
+ InstantDesignResources, InstantModelExplorer, InstantCode, ExtCtrls, Forms,
+ InstantConsts;
+
+type
+ TIOMetaDataCheckState = (mcNeverChecked, mcCheckError, mcCheckCorrect);
+
+ { When the IDE is being shut down, items in the Database-menu are
+ destroyed even if they don't belong to the menu. Since we want to
+ detach our items in the Database-menu when the expert is removed,
+ we need to know if they have already been destroyed by the IDE
+ before doing so. TReferencedMenuItem knows about our reference to
+ the item and will clear this reference when it is destroyed.
+ This ensures that we do not try to free items that are already
+ destroyed by the IDE. }
+
+ PReferencedMenuItem = ^TReferencedMenuItem;
+ TReferencedMenuItem = class(TMenuItem)
+ private
+ FReferee: PReferencedMenuItem;
+ public
+ constructor Create(AOwner: TComponent;
+ var AReferee: TReferencedMenuItem); reintroduce;
+ destructor Destroy; override;
+ end;
+
+ TSourceEnumerator = procedure(const FileName, Source: string) of object;
+
+ TInstantModelExpert = class(TNotifierObject, IOTAWizard)
+ private
+ FActiveProjectName: string;
+ FBuilderItem: TReferencedMenuItem;
+ FExplorerItem: TMenuItem;
+ FIDEInterface: TInstantOTAIDEInterface;
+ FIsChanged: Boolean;
+ FMustUpdateAfterCompile: Boolean;
+ FResourceModule: TInstantDesignResourceModule;
+ FSaveApplicationIdle: TIdleEvent;
+ FToolImageCount: Integer;
+ FToolImageOffset: Integer;
+ FUpdateDisableCount: Integer;
+ FUpdateTimer: TTimer;
+ MetaDataCheckState : TIOMetaDataCheckState;
+ MetaDataCheckUnits : string;
+ procedure ExplorerApplyClass(Sender: TObject; AClass: TInstantCodeClass;
+ ChangeInfo: TInstantCodeClassChangeInfo);
+ procedure ExplorerGotoSource(Sender: TObject; const FileName: string;
+ Pos: TInstantCodePos);
+ procedure ExplorerLoadModel(Sender: TObject; Model: TInstantCodeModel);
+ function GetActiveProject: IOTAProject;
+ function GetAllowContinue: Boolean;
+ function GetCurrentSource: string;
+ function GetExplorer: TInstantModelExplorerForm;
+ function GetIDString: string;
+ function GetIsDirty: Boolean;
+ function GetName: string;
+ function GetState: TWizardState;
+ procedure SetIsDirty(const Value: Boolean);
+ protected
+ procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
+ procedure AccessModelUnits(Project: IOTAProject; Units: TStrings;
+ Write: Boolean);
+ procedure AddToolError(const FileName, Msg: string; Line, Column: Integer);
+ procedure AddToolMessage(const FileName, Msg, Prefix: string; Line, Column: Integer);
+ procedure AddToolText(const Text: string);
+ procedure AttachMenus;
+ procedure BuilderItemClick(Sender: TObject);
+ procedure CheckProjectChanged;
+ procedure CompileProject(Project: IOTAProject);
+ procedure CollectModules(Project: IOTAProject; Modules: TInterfaceList;
+ Names: TStrings);
+ function CreateIDEInterface: TInstantOTAIDEInterface;
+ function CreateUpdateTimer: TTimer;
+ procedure DetachMenus;
+ procedure EnumSources(Modules: TInterfaceList;
+ Enumerator: TSourceEnumerator);
+ procedure CheckIOMetadataKeyword(const FileName, Source: string);
+ procedure ExplorerItemClick(Sender: TObject);
+ procedure GetModelModules(Modules: TInterfaceList);
+ procedure IDEAfterCompilation(Sender: TObject; Succeeded: Boolean);
+ procedure IDEBeforeCompilation(Sender: TObject; Project: IOTAProject;
+ IsCodeInsight: Boolean; var Cancel: Boolean);
+ procedure IDEEventNotification(Sender: TObject;
+ NotifyCode: TEventNotification; var Cancel: Boolean);
+ procedure IDEFileNotification(Sender: TObject;
+ NotifyCode: TFileNotification; const FileName: string;
+ var Cancel: Boolean);
+ procedure IDEModuleNotification(Sender: TObject; NotifyCode: TNotifyCode;
+ const FileName: string);
+ function IsProjectUnit(FileName: string): Boolean;
+ function IsModelUnit(FileName: string): Boolean;
+ procedure ShowExplorer;
+ procedure UpdateModel;
+ procedure UpdateTimerTick(Sender: TObject);
+ property CurrentSource: string read GetCurrentSource;
+ property Explorer: TInstantModelExplorerForm read GetExplorer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure DisableUpdate;
+ procedure EnableUpdate;
+ procedure ApplyClass(AClass: TInstantCodeClass;
+ ChangeInfo: TInstantCodeClassChangeInfo);
+ procedure BuildDatabase(CodeModel: TInstantCodeModel);
+ procedure Execute;
+ function LoadModel(Model: TInstantCodeModel; Project: IOTAProject = nil;
+ CheckTime: TDateTime = 0): Boolean;
+ procedure SelectUnits;
+ function UpdateEnabled: Boolean;
+ procedure UpdateModelUnits;
+ property ActiveProject: IOTAProject read GetActiveProject;
+ property AllowContinue: Boolean read GetAllowContinue;
+ property IsDirty: Boolean read GetIsDirty write SetIsDirty;
+ end;
+
+var
+ ModelExpert: TInstantModelExpert;
+
+procedure Register;
+
+implementation
+
+uses
+ SysUtils, TypInfo, InstantDesignUtils, InstantUtils, InstantUnitSelect,
+ InstantConnectionManager, Dialogs;
+
+const
+ SBuilderItemCaption = 'InstantObjects Database &Builder...';
+ SBuilderItemName = 'InstantBuilderItem';
+ SExplorerItemCaption = 'InstantObjects &Model Explorer';
+ SExplorerItemName = 'InstantExplorerItem';
+ SModelCompiler = 'Model Compiler';
+ SResFileExt = '.mdr';
+ UpdateInterval = 500;
+
+procedure ReaderIdle(Reader: TInstantCodeReader; var Continue: Boolean);
+begin
+ Application.ProcessMessages;
+ Continue := ModelExpert.AllowContinue;
+end;
+
+procedure Register;
+begin
+ ModelExpert := TInstantModelExpert.Create;
+ RegisterPackageWizard(ModelExpert);
+ InstantCodeReaderIdle := ReaderIdle;
+end;
+
+function FindText(const SubStr, Str: string;
+ var Pos, Line, Column: Integer): Boolean;
+var
+ I, J: Integer;
+begin
+ J := 1;
+ if Pos = 0 then
+ Inc(Pos);
+ if Pos = 1 then
+ begin
+ Line := 1;
+ Column := 1;
+ end;
+ I := Pos;
+ while I <= Length(Str) do
+ begin
+ case Str[I] of
+ #10:begin
+ Inc(Line);
+ Column := 1;
+ end;
+ else
+ Inc(Column);
+ end;
+ if UpperCase(Str[I]) = UpperCase(SubStr[J]) then
+ begin
+ if J = Length(SubStr) then
+ begin
+ Pos := I - J + 1;
+ Result := True;
+ Exit;
+ end;
+ Inc(J);
+ Inc(I);
+ end else if J = 1 then
+ Inc(I)
+ else
+ J := 1;
+ end;
+ Result := False;
+end;
+
+{ TReferencedMenuItem }
+
+constructor TReferencedMenuItem.Create(AOwner: TComponent;
+ var AReferee: TReferencedMenuItem);
+begin
+ inherited Create(AOwner);
+ FReferee := @AReferee;
+end;
+
+destructor TReferencedMenuItem.Destroy;
+begin
+ inherited;
+ FReferee^ := nil;
+end;
+
+{ TInstantModelExpert}
+
+procedure TInstantModelExpert.AccessModelUnits(Project: IOTAProject;
+ Units: TStrings; Write: Boolean);
+const
+
+ ModelTag = #10'{$R *' + SResFileExt + '}';
+ ResourceTag = #10'{$R *.res}';
+
+ function ListToStr(List: TStrings): string;
+ var
+ I: Integer;
+ S: string;
+ begin
+ S := '';
+ for I := 0 to Pred(List.Count) do
+ begin
+ Result := Result + S + List[I];
+ S := ', ' + sLineBreak + ' ';
+ end;
+ end;
+
+ function FindModelDef(const Source: string; out ModelDef: string;
+ var Line, Column: Integer): Integer;
+ var
+ I: Integer;
+ begin
+ Result := 1;
+ if FindText(ModelTag, Source, Result, Line, Column) then
+ begin
+ I := Result + Length(ModelTag);
+ while I <= Length(Source) do
+ begin
+ case Source[I] of
+ ' ': Inc(I);
+ '{':
+ while I < Length(Source) do
+ begin
+ Inc(I);
+ if Source[I] = '}' then
+ begin
+ ModelDef := Copy(Source, Result, I - Result + 1);
+ Exit;
+ end;
+ end;
+ else
+ Break;
+ end;
+ end;
+ ModelDef := Copy(Source, Result, Length(ModelTag));
+ end else
+ Result := 0;
+ end;
+
+ function RemoveBrackets(const Str: string): string;
+ begin
+ Result := Trim(Str);
+ if (Length(Result) > 0) and (Result[1] = '{') then
+ Delete(Result, 1, 1);
+ if (Length(Result) > 0) and (Result[Length(Result)] = '}') then
+ Delete(Result, Length(Result), 1);
+ Result := Trim(Result);
+ end;
+
+ procedure WriteUses(var Source: string; UnitNames: array of string;
+ Include: Boolean);
+ var
+ UsesClause: TInstantCodeUsesClause;
+ UsesItem: TInstantCodeUses;
+ Found: Boolean;
+ I: Integer;
+ S: string;
+ begin
+ with TInstantCodeModifier.Create(Source, nil) do
+ try
+ if Module.ModuleType = mtProgram then
+ begin
+ UsesClause := Module.ProgramSection.FindUsesClause;
+ if Assigned(UsesClause) and (UsesClause.Count > 0) then
+ begin
+ Found := False;
+ for I := Low(UnitNames) to High(UnitNames) do
+ begin
+ UsesItem := UsesClause.Find(UnitNames[I]);
+ Found := Assigned(UsesItem);
+ if Found then
+ begin
+ if not Include then
+ begin
+ EraseObject(UsesItem);
+ if NextChar = ',' then
+ DeleteText(1);
+ CloseGap;
+ end else
+ Break;
+ end;
+ end;
+ if Include and not Found then
+ begin
+ CursorPos := UsesClause[0].StartPos;
+ InsertMode := imBefore;
+ S := '';
+ for I := Low(UnitNames) to High(UnitNames) do
+ S := S + UnitNames[I] + ','#10' ';
+ InsertText(S);
+ end;
+ end;
+ end;
+ finally
+ Free;
+ end;
+ end;
+
+var
+ Editor: IOTASourceEditor;
+ Source: string;
+ Pos, Line, Column, SourceLen: Integer;
+ CurModelDef, NewModelDef: string;
+begin
+ Editor := FIDEInterface.SourceEditor(Project);
+ Source := FIDEInterface.ReadEditorSource(Editor);
+ Pos := FindModelDef(Source, CurModelDef, Line, Column);
+ if Write then
+ begin
+ SourceLen := Length(Source);
+ if Units.Count > 0 then
+ NewModelDef := Format('%s {%s}', [ModelTag, ListToStr(Units)])
+ else
+ NewModelDef := '';
+ if CurModelDef = NewModelDef then
+ Exit
+ else if Pos > 0 then
+ Delete(Source, Pos, Length(CurModelDef))
+ else if not FindText(ResourceTag, Source, Pos, Line, Column) then
+ Exit
+ else
+ Inc(Pos, Length(ResourceTag));
+ Insert(NewModelDef, Source, Pos);
+ FIDEInterface.WriteEditorSource(Editor, Source, SourceLen);
+ end else if Pos > 0 then
+ begin
+ Delete(CurModelDef, 1, Length(ModelTag));
+ CurModelDef := RemoveBrackets(CurModelDef);
+ if CurModelDef = '' then
+ AddToolError(Editor.FileName, 'No model units specified', Line, Column);
+ InstantStrToList(CurModelDef, Units, [',']);
+ end;
+end;
+
+procedure TInstantModelExpert.AddToolError(const FileName, Msg: string; Line,
+ Column: Integer);
+begin
+ AddToolMessage(FileName, Msg, 'Error', Line, Column);
+end;
+
+procedure TInstantModelExpert.AddToolMessage(const FileName, Msg, Prefix: string;
+ Line, Column: Integer);
+begin
+ FIDEInterface.MessageServices.AddToolMessage(FileName, Msg, Prefix,
+ Line, Column);
+end;
+
+procedure TInstantModelExpert.AddToolText(const Text: string);
+begin
+ AddToolMessage('', Text, '', 0, 0);
+end;
+
+procedure TInstantModelExpert.ApplicationIdle(Sender: TObject;
+ var Done: Boolean);
+begin
+ CheckProjectChanged;
+ if Assigned(FSaveApplicationIdle) then
+ FSaveApplicationIdle(Sender, Done);
+end;
+
+procedure TInstantModelExpert.ApplyClass(AClass: TInstantCodeClass;
+ ChangeInfo: TInstantCodeClassChangeInfo);
+var
+ Source: string;
+ Module: IOTAModule;
+ Editor: IOTASourceEditor;
+ OldLen: Integer;
+begin
+ Module := FIDEInterface.FindModule(AClass.Module.UnitName);
+ if not Assigned(Module) then
+ Exit;
+ Editor := FIDEInterface.SourceEditor(Module);
+ if not Assigned(Editor) then
+ Exit;
+ Source := FIDEInterface.ReadEditorSource(Editor);
+ OldLen := Length(Source);
+ AClass.ApplyToSource(Source, ChangeInfo);
+ DisableUpdate;
+ try
+ FIDEInterface.WriteEditorSource(Editor, Source, OldLen);
+ finally
+ EnableUpdate;
+ end;
+end;
+
+procedure TInstantModelExpert.AttachMenus;
+
+ function ItemByName(Items: TMenuItem; Name: string): TMenuItem;
+ var
+ I: Integer;
+ begin
+ Result := nil;
+ if Assigned(Items) then
+ for I := 0 to Pred(Items.Count) do
+ begin
+ if Items[I].Name = Name then
+ begin
+ Result := Items[I];
+ Break;
+ end;
+ end;
+ end;
+
+ procedure CreateBuilderMenuItem;
+ begin
+ FBuilderItem := TReferencedMenuItem.Create(nil, FBuilderItem);
+ with FBuilderItem do
+ begin
+ Name := SBuilderItemName;
+ Caption := SBuilderItemCaption;
+ Action := Explorer.BuildDatabaseAction;
+ ImageIndex := FToolImageOffset + 1;
+ end;
+ end;
+
+var
+ MainMenu: TMainMenu;
+ Menu, Item: TMenuItem;
+begin
+ if not Assigned(BorlandIDEServices) then
+ Exit;
+ MainMenu := (BorlandIDEServices as INTAServices40).MainMenu;
+ if not Assigned(MainMenu) then
+ Exit;
+
+ { Add images }
+ with MainMenu.Images do
+ begin
+ FToolImageOffset := Count;
+ FToolImageCount := FResourceModule.ToolImages.Count;
+ AddImages(TCustomImageList(FResourceModule.ToolImages));
+ end;
+
+ { Add 'Model Explorer' to View-menu }
+ Menu := ItemByName(MainMenu.Items, 'ViewsMenu');
+ if Assigned(Menu) then
+ begin
+ FExplorerItem := TMenuItem.Create(nil);
+ with FExplorerItem do
+ begin
+ Name := SExplorerItemName;
+ Caption := SExplorerItemCaption;
+ ShortCut := Menus.ShortCut(Word('M'), [ssCtrl, ssShift]);
+ ImageIndex := FToolImageOffset;
+ OnClick := ExplorerItemClick;
+ end;
+{$IFDEF D9+}
+ Item := ItemByName(Menu, 'ViewStructureItem');
+{$ELSE}
+ Item := ItemByName(Menu, 'CodeExplorer');
+{$ENDIF}
+ if Assigned(Item) then
+ Menu.Insert(Item.MenuIndex + 1, FExplorerItem)
+ else
+ Menu.Add(FExplorerItem);
+
+{$IFDEF D9+}
+ { Add Database InstantObjects Builder to View-menu }
+ CreateBuilderMenuItem;
+ Item := ItemByName(Menu, 'mnuViewDataExplorer');
+ if Assigned(Item) then
+ Menu.Insert(Item.MenuIndex + 1, FBuilderItem)
+ else
+ Menu.Add(FBuilderItem);
+{$ENDIF}
+ end;
+
+{$IFNDEF D9+}
+ { Add Database InstantObjects Builder to Database-menu }
+ Menu := ItemByName(MainMenu.Items, 'DatabaseMenu');
+ if Assigned(Menu) then
+ begin
+ CreateBuilderMenuItem;
+ Menu.Add(FBuilderItem);
+ end;
+{$ENDIF}
+
+end;
+
+procedure TInstantModelExpert.BuildDatabase(CodeModel: TInstantCodeModel);
+var
+ Project: IOTAProject;
+begin
+ Project := ActiveProject;
+ if not Assigned(Project) then
+ Exit;
+ with TInstantConnectionManager.Create(nil) do
+ try
+ Caption := 'Database Builder';
+ Model := CodeModel.Model;
+ FileName := ChangeFileExt(Project.FileName, '.con');
+ VisibleActions := [atNew, atEdit, atDelete, atRename, atBuild, atEvolve, atOpen];
+ Execute;
+ finally
+ Free;
+ end;
+end;
+
+procedure TInstantModelExpert.BuilderItemClick(Sender: TObject);
+begin
+ BuildDatabase(Explorer.Model);
+end;
+
+procedure TInstantModelExpert.CheckProjectChanged;
+var
+ Project: IOTAProject;
+begin
+ with FIDEInterface do
+ if Assigned(ProjectGroup) then
+ begin
+ Project := ProjectGroup.ActiveProject;
+ if Assigned(Project) and not SameText(Project.FileName,
+ FActiveProjectName) then
+ begin
+ FActiveProjectName := Project.FileName;
+ UpdateModel;
+ end;
+ end else if FActiveProjectName <> '' then
+ begin
+ UpdateModel;
+ FActiveProjectName := '';
+ end;
+end;
+
+procedure TInstantModelExpert.CollectModules(Project: IOTAProject;
+ Modules: TInterfaceList; Names: TStrings);
+
+ function NameInNames(Name: string): Boolean;
+ var
+ I: Integer;
+ begin
+ for I := 0 to Pred(Names.Count) do
+ if SameText(Name, Names[I]) then
+ begin
+ Result := True;
+ Exit;
+ end;
+ Result := False;
+ end;
+
+var
+ I: Integer;
+ ModuleInfo: IOTAModuleInfo;
+begin
+ for I := 0 to Pred(Project.GetModuleCount) do
+ begin
+ ModuleInfo := Project.GetModule(I);
+ if NameInNames(ModuleInfo.Name) then
+ Modules.Add(ModuleInfo.OpenModule);
+ end;
+end;
+
+procedure TInstantModelExpert.CompileProject(Project: IOTAProject);
+var
+ Model: TInstantCodeModel;
+ ResFileName: string;
+ ResFileAge: Integer;
+ ResFileTime: TDateTime;
+begin
+ DisableUpdate;
+ Model := TInstantCodeModel.Create;
+ try
+ ResFileName := ChangeFileExt(Project.FileName, SResFileExt);
+ ResFileAge := FileAge(ResFileName);
+ if ResFileAge = -1 then
+ ResFileTime := 0 else
+ ResFileTime := FileDateToDateTime(ResFileAge);
+ try
+ if LoadModel(Model, Project, ResFileTime) then
+ Model.SaveToResFile(ResFileName);
+ except
+ on E: EInstantCodeError do
+ begin
+ AddToolError(E.FileName, E.Message, E.Position.Line,
+ E.Position.Column);
+ Abort;
+ end
+ else
+ raise;
+ end;
+ finally
+ Model.Free;
+ EnableUpdate;
+ end;
+end;
+
+constructor TInstantModelExpert.Create;
+begin
+ //CheckExpiration;
+ FResourceModule := TInstantDesignResourceModule.Create(nil);
+ FIDEInterface := CreateIDEInterface;
+ FUpdateTimer := CreateUpdateTimer;
+ AttachMenus;
+ FSaveApplicationIdle := Application.OnIdle;
+ Application.OnIdle := ApplicationIdle;
+ ModelExplorer := Explorer;
+end;
+
+function TInstantModelExpert.CreateIDEInterface: TInstantOTAIDEInterface;
+begin
+ Result := TInstantOTAIDEInterface.Create;
+ with Result do
+ begin
+ AfterCompilation := IDEAfterCompilation;
+ BeforeCompilation := IDEBeforeCompilation;
+ OnEventNotification := IDEEventNotification;
+ OnFileNotification := IDEFileNotification;
+ OnModuleNotification := IDEModuleNotification;
+ end;
+end;
+
+function TInstantModelExpert.CreateUpdateTimer: TTimer;
+begin
+ Result := TTimer.Create(nil);
+ with Result do
+ begin
+ Enabled := False;
+ Interval := UpdateInterval;
+ OnTimer := UpdateTimerTick;
+ end;
+end;
+
+destructor TInstantModelExpert.Destroy;
+begin
+ Application.OnIdle := FSaveApplicationIdle;
+ DetachMenus;
+ FUpdateTimer.Free;
+ ModelExplorer.Free;
+ FIDEInterface.Free;
+ FResourceModule.Free;
+ inherited;
+end;
+
+procedure TInstantModelExpert.DetachMenus;
+var
+ MainMenu: TMainMenu;
+ I: Integer;
+begin
+ if not Application.Terminated then
+ begin
+ { Remove images }
+ MainMenu := (BorlandIDEServices as INTAServices40).MainMenu;
+ if Assigned(MainMenu) and Assigned(MainMenu.Images) then
+ with MainMenu.Images do
+ for I := 0 to Pred(FToolImageCount) do
+ Delete(FToolImageOffset);
+ end;
+
+ { Remove items }
+ FBuilderItem.Free;
+ FExplorerItem.Free;
+end;
+
+procedure TInstantModelExpert.DisableUpdate;
+begin
+ Inc(FUpdateDisableCount);
+end;
+
+procedure TInstantModelExpert.EnableUpdate;
+begin
+ if FUpdateDisableCount > 0 then
+ Dec(FUpdateDisableCount);
+end;
+
+procedure TInstantModelExpert.EnumSources(Modules: TInterfaceList;
+ Enumerator: TSourceEnumerator);
+var
+ I: Integer;
+ Module: IOTAModule;
+ Editor: IOTASourceEditor;
+ Source: string;
+begin
+ if not Assigned(Enumerator) then
+ Exit;
+ Busy(True);
+ try
+ for I := 0 to Pred(Modules.Count) do
+ begin
+ Module := Modules[I] as IOTAModule;
+ if Module.GetModuleFileCount = 1 then
+ begin
+ Editor := FIDEInterface.SourceEditor(Module);
+ Source := FIDEInterface.ReadEditorSource(Editor);
+ Enumerator(Editor.FileName, Source);
+ end;
+ end;
+ finally
+ Busy(False);
+ end;
+end;
+
+procedure TInstantModelExpert.Execute;
+begin
+ ShowExplorer;
+end;
+
+procedure TInstantModelExpert.ExplorerApplyClass(Sender: TObject;
+ AClass: TInstantCodeClass; ChangeInfo: TInstantCodeClassChangeInfo);
+begin
+ ApplyClass(AClass, ChangeInfo);
+end;
+
+procedure TInstantModelExpert.ExplorerGotoSource(Sender: TObject;
+ const FileName: string; Pos: TInstantCodePos);
+begin
+ FIDEInterface.GotoFilePos(FileName, Pos.Line, Pos.Column);
+end;
+
+procedure TInstantModelExpert.ExplorerItemClick(Sender: TObject);
+begin
+ ShowExplorer;
+end;
+
+procedure TInstantModelExpert.ExplorerLoadModel(Sender: TObject;
+ Model: TInstantCodeModel);
+begin
+ LoadModel(Model);
+end;
+
+function TInstantModelExpert.GetActiveProject: IOTAProject;
+begin
+ with FIDEInterface do
+ if Assigned(ProjectGroup) then
+ Result := ProjectGroup.ActiveProject
+ else
+ Result := nil;
+end;
+
+function TInstantModelExpert.GetAllowContinue: Boolean;
+begin
+ Result := not FIsChanged;
+end;
+
+function TInstantModelExpert.GetCurrentSource: string;
+var
+ Editor: IOTASourceEditor;
+begin
+ with FIDEInterface do
+ begin
+ Editor := SourceEditor(CurrentModule);
+ Result := ReadEditorSource(Editor);
+ end;
+end;
+
+function TInstantModelExpert.GetExplorer: TInstantModelExplorerForm;
+begin
+ if not Assigned(ModelExplorer) then
+ begin
+ ModelExplorer := TInstantModelExplorerForm.Create(nil);
+ with ModelExplorer do
+ begin
+ OnApplyClass := ExplorerApplyClass;
+ OnGotoSource := ExplorerGotoSource;
+ OnLoadModel := ExplorerLoadModel;
+ end;
+ end;
+ Result := ModelExplorer;
+end;
+
+function TInstantModelExpert.GetIDString: string;
+begin
+ Result := 'Instant.Model.Expert';
+end;
+
+function TInstantModelExpert.GetIsDirty: Boolean;
+begin
+ Result := FUpdateTimer.Enabled;
+end;
+
+procedure TInstantModelExpert.GetModelModules(Modules: TInterfaceList);
+var
+ Project: IOTAProject;
+ UnitNames: TStringList;
+begin
+ Project := ActiveProject;
+ UnitNames := TStringList.Create;
+ try
+ AccessModelUnits(Project, UnitNames, False);
+ CollectModules(Project, Modules, UnitNames);
+ finally
+ UnitNames.Free;
+ end;
+end;
+
+function TInstantModelExpert.GetName: string;
+begin
+ Result := 'Instant Model Expert';
+end;
+
+function TInstantModelExpert.GetState: TWizardState;
+begin
+ Result := [];
+end;
+
+procedure TInstantModelExpert.IDEAfterCompilation(Sender: TObject; Succeeded: Boolean);
+begin
+ if FMustUpdateAfterCompile then
+ begin
+ FMustUpdateAfterCompile := False;
+ UpdateModel;
+ end;
+end;
+
+procedure TInstantModelExpert.IDEBeforeCompilation(Sender: TObject;
+ Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean);
+begin
+ if IsCodeInsight then
+ Exit;
+ FMustUpdateAfterCompile := IsDirty;
+ IsDirty := False;
+ FIDEInterface.MessageServices.ClearAllMessages;
+ try
+ CompileProject(Project);
+ except
+ on E: EAbort do
+ begin
+ Cancel := True;
+ FIDEInterface.ShowMessages;
+ FMustUpdateAfterCompile := False;
+ end;
+ else
+ raise;
+ end;
+end;
+
+procedure TInstantModelExpert.IDEEventNotification(Sender: TObject;
+ NotifyCode: TEventNotification; var Cancel: Boolean);
+begin
+end;
+
+procedure TInstantModelExpert.IDEFileNotification(Sender: TObject;
+ NotifyCode: TFileNotification; const FileName: string; var Cancel: Boolean);
+begin
+ case NotifyCode of
+ fnFileOpened:
+ if IsProjectUnit(FileName) then
+ MetaDataCheckState := mcNeverChecked;
+ fnFileClosing:
+ if IsModelUnit(FileName) then
+ IsDirty := True;
+ end;
+end;
+
+procedure TInstantModelExpert.IDEModuleNotification(Sender: TObject;
+ NotifyCode: TNotifyCode; const FileName: string);
+begin
+ case NotifyCode of
+ ncAfterSave,
+ ncEditorModified:
+ if IsModelUnit(FileName) then
+ IsDirty := True;
+ ncEditorSelected:
+ Exit;
+ end;
+end;
+
+function TInstantModelExpert.IsProjectUnit(FileName: string): Boolean;
+begin
+ Result := Assigned(ActiveProject) and SameText(ActiveProject.FileName, FileName);
+end;
+
+function TInstantModelExpert.IsModelUnit(FileName: string): Boolean;
+var
+ Project: IOTAProject;
+ Units: TStringList;
+ I: Integer;
+begin
+ Result := False;
+ Project := ActiveProject;
+ if not Assigned(Project) then
+ Exit;
+ if SameText(Project.FileName, FileName) then
+ begin
+ Result := True;
+ Exit;
+ end;
+ Units := TStringList.Create;
+ try
+ AccessModelUnits(Project, Units, False);
+ for I := 0 to Pred(Units.Count) do
+ if SameText(Units[I], ChangeFileExt(ExtractFileName(FileName), '')) then
+ begin
+ Result := True;
+ Break;
+ end;
+ finally
+ Units.Free;
+ end;
+end;
+
+function TInstantModelExpert.LoadModel(Model: TInstantCodeModel;
+ Project: IOTAProject; CheckTime: TDateTime): Boolean;
+
+ function EditorModified(Module: IOTAModule): Boolean;
+ var
+ Editor: IOTASourceEditor;
+ begin
+ Editor := FIDEInterface.SourceEditor(Module);
+ Result := Editor.Modified;
+ end;
+
+ function FileModified(const FileName: string; Since: TDateTime): Boolean;
+ var
+ Age: Integer;
+ begin
+ Age := FileAge(FileName);
+ if Age = -1 then
+ Result := False
+ else
+ Result := FileDateToDateTime(Age) > Since;
+ end;
+
+ function ModuleModified(Module: IOTAModule; Since: TDateTime): Boolean;
+ begin
+ Result := EditorModified(Module) or FileModified(Module.FileName, Since);
+ end;
+
+ function ModulesModified(Modules: TInterfaceList; Since: TDateTime): Boolean;
+ var
+ I: Integer;
+ Module: IOTAModule;
+ begin
+ for I := 0 to Pred(Modules.Count) do
+ begin
+ Module := Modules[I] as IOTAModule;
+ Result := ModuleModified(Module, Since);
+ if Result then
+ Exit;
+ end;
+ Result := False;
+ end;
+
+ procedure ReadModel(Modules: TInterfaceList);
+ var
+ I: Integer;
+ Module: IOTAModule;
+ Editor: IOTASourceEditor;
+ Source: string;
+ Stream: TStringStream;
+ begin
+ for I := 0 to Pred(Modules.Count) do
+ begin
+ Module := Modules[I] as IOTAModule;
+ Editor := FIDEInterface.SourceEditor(Module);
+ Source := FIDEInterface.ReadEditorSource(Editor);
+ Stream := TStringStream.Create(Source);
+ try
+ Model.LoadModule(Stream, Editor.FileName);
+ finally
+ Stream.Free;
+ end;
+ end;
+ end;
+
+var
+ Units: TStringList;
+ Modules: TInterfaceList;
+begin
+ if not Assigned(Project) then
+ Project := ActiveProject;
+ Units := TStringList.Create;
+ try
+ AccessModelUnits(Project, Units, False);
+ if Units.Count > 0 then
+ begin
+ Modules := TInterfaceList.Create;
+ try
+ CollectModules(Project, Modules, Units);
+ if MetaDataCheckState = mcNeverChecked then
+ begin
+ MetadataCheckUnits := '';
+ MetaDataCheckState := mcCheckCorrect;
+ EnumSources(Modules, CheckIOMetadataKeyword);
+ if MetaDataCheckState = mcCheckError then
+ MessageDlg(Format('WARNING: Project %s contains some class metadata without IOMETADATA keyword:'+
+ '%s'+sLineBreak+'Please refer to IOMETADATA_keyword.txt in instantobjects\doc folder.',
+ [FActiveProjectName, MetadataCheckUnits]), mtWarning, [mbOK], 0);
+ end;
+ Result := (CheckTime = 0) or
+ ModuleModified(Project, CheckTime) or
+ ModulesModified(Modules, CheckTime);
+ if Result then
+ ReadModel(Modules);
+ finally
+ Modules.Free;
+ end;
+ end else
+ Result := False;
+ finally
+ Units.Free;
+ end;
+end;
+
+procedure TInstantModelExpert.SelectUnits;
+
+ procedure GetUnitNames(Project: IOTAProject; Names: TStrings);
+ var
+ I: Integer;
+ Module: IOTAModuleInfo;
+ begin
+ for I := 0 to Pred(Project.GetModuleCount) do
+ begin
+ Module := Project.GetModule(I);
+ if (Module.FileName <> '') and (Module.ModuleType = 0) then
+ Names.Add(Module.Name);
+ end;
+ end;
+
+ procedure SubtractList(List, Subtract: TStrings);
+ var
+ I, Index: Integer;
+ begin
+ for I := 0 to Pred(Subtract.Count) do
+ begin
+ Index := List.IndexOf(Subtract[I]);
+ if Index <> -1 then
+ List.Delete(Index);
+ end;
+ end;
+
+var
+ Project: IOTAProject;
+ ModelUnits, OtherUnits: TStringList;
+begin
+ if not Assigned(FIDEInterface.ProjectGroup) then
+ Exit;
+ ModelUnits := TStringList.Create;
+ OtherUnits := TStringList.Create;
+ try
+ Project := ActiveProject;
+ AccessModelUnits(Project, ModelUnits, False);
+ GetUnitNames(Project, OtherUnits);
+ SubtractList(OtherUnits, ModelUnits);
+ with TInstantUnitSelectForm.Create(nil) do
+ try
+ if Execute(ModelUnits, OtherUnits) then
+ begin
+ AccessModelUnits(Project, ModelUnits, True);
+ UpdateModel;
+ end;
+ finally
+ Free;
+ end;
+ finally
+ ModelUnits.Free;
+ OtherUnits.Free;
+ end;
+end;
+
+procedure TInstantModelExpert.SetIsDirty(const Value: Boolean);
+begin
+ if not UpdateEnabled then
+ Exit;
+ FIsChanged := Value;
+ with FUpdateTimer do
+ begin
+ Enabled := False;
+ Enabled := Value;
+ end;
+end;
+
+procedure TInstantModelExpert.ShowExplorer;
+begin
+ with Explorer do
+ begin
+ Refresh;
+ Show;
+ ModelView.SetFocus;
+ end;
+end;
+
+function TInstantModelExpert.UpdateEnabled: Boolean;
+begin
+ Result := FUpdateDisableCount = 0;
+end;
+
+procedure TInstantModelExpert.UpdateModel;
+begin
+ IsDirty := False;
+ DisableUpdate;
+ try
+ Explorer.Refresh;
+ finally
+ EnableUpdate;
+ end;
+end;
+
+procedure TInstantModelExpert.UpdateModelUnits;
+
+ procedure UpdateModelUnit(Module: IOTAModule);
+ var
+ Editor: IOTASourceEditor;
+ Source, OldSource: string;
+ begin
+ Editor := FIDEInterface.SourceEditor(Module);
+ Source := FIDEInterface.ReadEditorSource(Editor);
+ OldSource := Source;
+ with TInstantCodeModifier.Create(Source, nil) do
+ try
+ UpdateUnit;
+ finally
+ Free;
+ end;
+ if Source <> OldSource then
+ begin
+ DisableUpdate;
+ try
+ FIDEInterface.WriteEditorSource(Editor, Source, Length(Source));
+ finally
+ EnableUpdate;
+ end;
+ end;
+ end;
+
+var
+ Modules: TInterfaceList;
+ I: Integer;
+begin
+ Modules := TInterfaceList.Create;
+ try
+ GetModelModules(Modules);
+ for I := 0 to Pred(Modules.Count) do
+ UpdateModelUnit(Modules[I] as IOTAModule);
+ finally
+ Modules.Free;
+ end;
+end;
+
+procedure TInstantModelExpert.UpdateTimerTick(Sender: TObject);
+begin
+ if UpdateEnabled then
+ UpdateModel;
+end;
+
+procedure TInstantModelExpert.CheckIOMetadataKeyword(const FileName, Source: string);
+begin
+ if pos('{ stored', Source) > 0 then
+ begin
+ MetaDataCheckUnits := MetaDataCheckUnits + sLineBreak+FileName+';';
+ MetaDataCheckState := mcCheckError;
+ end;
+end;
+
+end.
Modified: trunk/Source/Design/InstantModelExplorer.pas
===================================================================
--- trunk/Source/Design/InstantModelExplorer.pas 2007-02-01 03:39:40 UTC (rev 756)
+++ trunk/Source/Design/InstantModelExplorer.pas 2007-02-01 04:27:01 UTC (rev 757)
@@ -188,7 +188,12 @@
{$IFDEF LINUX}
QDialogs,
{$ENDIF}
- TypInfo, InstantClassEditor, InstantClasses, DeskUtil, InstantModelExpert,
+ TypInfo, InstantClassEditor, InstantClasses, DeskUtil,
+{$IFNDEF D7+}
+ InstantModelExpertOld,
+{$ELSE}
+ InstantModelExpert,
+{$ENDIF}
InstantDesignUtils, InstantPersistence, InstantDesignHook, InstantAbout,
InstantImageUtils;
Modified: trunk/Source/Design/InstantOTA.pas
===================================================================
--- trunk/Source/Design/InstantOTA.pas 2007-02-01 03:39:40 UTC (rev 756)
+++ trunk/Source/Design/InstantOTA.pas 2007-02-01 04:27:01 UTC (rev 757)
@@ -1,6 +1,6 @@
(*
* InstantObjects
- * Borland OTA Interface (Open Tools API)
+ * Borland OTA Interface (Open Tools API) for D7+
*)
(* ***** BEGIN LICENSE BLOCK *****
@@ -24,7 +24,7 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Nando Dessena
+ * Nando Dessena, Steven Mitchell
*
* ***** END LICENSE BLOCK ***** *)
@@ -38,60 +38,68 @@
{$I '..\InstantDefines.inc'}
{$ENDIF}
-{$IFDEF D7+}
-{$WARN UNIT_DEPRECATED OFF}
-{$ENDIF}
-
uses
- Classes, ToolsAPI, ExptIntf, ToolIntf, EditIntf, Forms;
+ Classes, ToolsAPI, InstantTypes, Forms;
type
TInstantOTAIDEInterface = class;
+{$IFDEF D9+}
+ TInstantOTAIDENotifier8 = class;
+{$ENDIF}
TInstantOTAIDENotifier5 = class;
- TInstantOTAIDENotifier3 = class;
TInstantOTAModuleNotifier = class;
+ TInstantOTAEditorNotifier = class;
+ TInstantOTAFormNotifier = class;
+ TModuleNotifyCode = (mncModuleDeleted, mncModuleRenamed, mncEditorModified,
+ mncFormModified, mncEditorSelected, mncFormSelected, mncBeforeSave,
+ mncAfterSave, mncFormSaving, mncProjResModified);
+
TInstantOTAAfterCompilationEvent = procedure(Sender: TObject;
- Succeeded: Boolean) of object;
+ const Project: IOTAProject; Succeeded: Boolean;
+ IsCodeInsight: Boolean) of object;
TInstantOTABeforeCompilationEvent = procedure(Sender: TObject;
Project: IOTAProject; IsCodeInsight: Boolean;
var Cancel: Boolean) of object;
- TInstantOTAEventNotificationEvent = procedure(Sender: TObject;
- NotifyCode: TEventNotification; var Cancel: Boolean) of object;
+ TInstantOTAModuleNotificationEvent = procedure(Sender: TObject;
+ NotifyCode: TModuleNotifyCode; const FileName: string) of object;
TInstantOTAFileNotificationEvent = procedure(Sender: TObject;
- NotifyCode: TFileNotification; const FileName: string;
+ NotifyCode: TOTAFileNotification; const FileName: string;
var Cancel: Boolean) of object;
- TInstantOTAModuleNotificationEvent = procedure(Sender: TObject;
- NotifyCode: TNotifyCode; const FileName: string) of object;
+ TInstantOTAModuleRenamedNotificationEvent = procedure(Sender: TObject;
+ const OldName, NewName: string) of object;
+ IInstantOTANotifierUninstallation = interface(IInterface)
+ ['{D5690321-5365-4BD1-B149-AE1B3A4AE371}']
+ procedure UninstallNotifier;
+ end;
+
TInstantOTAIDEInterface = class(TObject)
private
- FIDENotifier3: TInstantOTAIDENotifier3;
FIDENotifier5: TInstantOTAIDENotifier5;
- function GetAfterCompilation: TInstantOTAAfterCompilationEvent;
- function GetBeforeCompilation: TInstantOTABeforeCompilationEvent;
- function GetEditActions: IOTAEditActions;
- function GetIDENotifier3: TInstantOTAIDENotifier3;
- function GetIDENotifier5: TInstantOTAIDENotifier5;
- function GetMessageServices: IOTAMessageServices;
- function GetModuleServices: IOTAModuleServices;
- function GetOnEventNotification: TInstantOTAEventNotificationEvent;
+ function GetOnModuleRenamedNotification:
+ TInstantOTAModuleRenamedNotificationEvent;
+ procedure SetOnModuleRenamedNotification(const Value:
+ TInstantOTAModuleRenamedNotificationEvent);
function GetOnFileNotification: TInstantOTAFileNotificationEvent;
function GetOnModuleNotification: TInstantOTAModuleNotificationEvent;
- function GetProjectGroup: IOTAProjectGroup;
- function GetServices3: TIToolServices;
- function GetServices5: IOTAServices;
- procedure SetAfterCompilation(const Value: TInstantOTAAfterCompilationEvent);
- procedure SetBeforeCompilation(const Value: TInstantOTABeforeCompilationEvent);
- procedure SetOnEventNotification(
- const Value: TInstantOTAEventNotificationEvent);
procedure SetOnFileNotification(
const Value: TInstantOTAFileNotificationEvent);
procedure SetOnModuleNotification(
const Value: TInstantOTAModuleNotificationEvent);
+ function GetOnAfterCompilation: TInstantOTAAfterCompilationEvent;
+ function GetOnBeforeCompilation: TInstantOTABeforeCompilationEvent;
+ function GetEditActions: IOTAEditActions;
+ function GetIDENotifier5: TInstantOTAIDENotifier5;
+ function GetMessageServices: IOTAMessageServices;
+ function GetModuleServices: IOTAModuleServices;
+ function GetProjectGroup: IOTAProjectGroup;
+ function GetServices: IOTAServices;
+ procedure SetOnAfterCompilation(const Value: TInstantOTAAfterCompilationEvent);
+ procedure SetOnBeforeCompilation(const Value:
+ TInstantOTABeforeCompilationEvent);
protected
function FindForm(Name, ClassName: string): TForm;
- property IDENotifier3: TInstantOTAIDENotifier3 read GetIDENotifier3;
property IDENotifier5: TInstantOTAIDENotifier5 read GetIDENotifier5;
public
destructor Destroy; override;
@@ -104,98 +112,131 @@
function SourceEditor(Module: IOTAModule): IOTASourceEditor;
procedure WriteEditorSource(Editor: IOTASourceEditor; const Source: string;
ReplaceLen: Integer; Undoable: Boolean = False);
- property AfterCompilation: TInstantOTAAfterCompilationEvent read GetAfterCompilation write SetAfterCompilation;
- property BeforeCompilation: TInstantOTABeforeCompilationEvent read GetBeforeCompilation write SetBeforeCompilation;
property EditActions: IOTAEditActions read GetEditActions;
property MessageServices: IOTAMessageServices read GetMessageServices;
property ModuleServices: IOTAModuleServices read GetModuleServices;
property ProjectGroup: IOTAProjectGroup read GetProjectGroup;
- property Services3: TIToolServices read GetServices3;
- property Services5: IOTAServices read GetServices5;
- property OnEventNotification: TInstantOTAEventNotificationEvent
- read GetOnEventNotification write SetOnEventNotification;
+ property Services: IOTAServices read GetServices;
+ property OnAfterCompilation: TInstantOTAAfterCompilationEvent read
+ GetOnAfterCompilation write SetOnAfterCompilation;
+ property OnBeforeCompilation: TInstantOTABeforeCompilationEvent read
+ GetOnBeforeCompilation write SetOnBeforeCompilation;
property OnFileNotification: TInstantOTAFileNotificationEvent
read GetOnFileNotification write SetOnFileNotification;
property OnModuleNotification: TInstantOTAModuleNotificationEvent
read GetOnModuleNotification write SetOnModuleNotification;
+ property OnModuleRenamedNotification: TInstantOTAModuleRenamedNotificationEvent
+ read GetOnModuleRenamedNotification write SetOnModuleRenamedNotification;
end;
TInstantOTAIDENotifier5 = class(TNotifierObject, IOTANotifier, IOTAIDENotifier50)
private
FNotifierIndex: Integer;
FOwner: TInstantOTAIDEInterface;
- FAfterCompilation: TInstantOTAAfterCompilationEvent;
- FBeforeCompilation: TInstantOTABeforeCompilationEvent;
+ FOnAfterCompilation: TInstantOTAAfterCompilationEvent;
+ FOnBeforeCompilation: TInstantOTABeforeCompilationEvent;
+ FModuleNotifierList: TList;
+ FOnFileNotification: TInstantOTAFileNotificationEvent;
+ FOnModuleNotification: TInstantOTAModuleNotificationEvent;
+ FOnModuleRenamedNotification: TInstantOTAModuleRenamedNotificationEvent;
+ procedure ClearModuleNotifiers;
+ function GetModuleNotifierCount: Integer;
+ function GetModuleNotifierList: TList;
+ function GetModuleNotifiers(Index: Integer): TInstantOTAModuleNotifier;
+ function HasNotifierBeenInstalled(const AFileName: string): Boolean;
+ procedure InstallModuleNotifier(Module: IOTAModule); overload;
+ procedure RemoveModuleNotifiers;
protected
- procedure DoAfterCompilation(Succeeded, IsCodeInsight: Boolean);
+ procedure DoAfterCompilation(Succeeded, IsCodeInsight: Boolean); overload;
+ procedure DoAfterCompilation(Succeeded: Boolean); overload;
procedure DoBeforeCompilation(const Project: IOTAProject;
IsCodeInsight: Boolean; var Cancel: Boolean);
+ function IsValidModuleFileName(const AFileName: string): Boolean;
+ procedure RegisterNotifier; virtual;
+ procedure UnregisterNotifier; virtual;
+ property ModuleNotifierList: TList read GetModuleNotifierList;
+ property NotifierIndex: Integer read FNotifierIndex write FNotifierIndex;
public
constructor Create(AOwner: TInstantOTAIDEInterface);
destructor Destroy; override;
+ // IOTAIDENotifier
procedure AfterCompile(Succeeded: Boolean); overload;
- procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload;
- procedure AfterConstruction; override;
procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
- procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload;
- procedure BeforeDestruction; override;
procedure FileNotification(NotifyCode: TOTAFileNotification;
const FileName: string; var Cancel: Boolean);
- property AfterCompilation: TInstantOTAAfterCompilationEvent read FAfterCompilation write FAfterCompilation;
- property BeforeCompilation: TInstantOTABeforeCompilationEvent read FBeforeCompilation write FBeforeCompilation;
+ // IOTAIDENotifier50
+ procedure AfterCompile(Succeeded, IsCodeInsight: Boolean); overload;
+ procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean;
+ var Cancel: Boolean); overload;
+
+ procedure AddModuleNotifier(Notifier: TInstantOTAModuleNotifier);
+ procedure AfterConstruction; override;
+ procedure BeforeDestruction; override;
+ procedure InstallModuleNotifier(const FileName: string); overload;
+ procedure ModuleNotification(const FileName: string; NotifyCode:
+ TModuleNotifyCode);
+ procedure ModuleRenamed(const OldName, NewName: string);
+ function RemoveModuleNotifier(Notifier: TInstantOTAModuleNotifier): Integer;
+ property ModuleNotifierCount: Integer read GetModuleNotifierCount;
+ property ModuleNotifiers[Index: Integer]: TInstantOTAModuleNotifier read
+ GetModuleNotifiers;
+ property OnAfterCompilation: TInstantOTAAfterCompilationEvent read
+ FOnAfterCompilation write FOnAfterCompilation;
+ property OnBeforeCompilation: TInstantOTABeforeCompilationEvent read
+ FOnBeforeCompilation write FOnBeforeCompilation;
+ property OnFileNotification: TInstantOTAFileNotificationEvent read
+ FOnFileNotification write FOnFileNotification;
+ property OnModuleNotification: TInstantOTAModuleNotificationEvent read
+ FOnModuleNotification write FOnModuleNotification;
+ property OnModuleRenamedNotification: TInstantOTAModuleRenamedNotificationEvent
+ read FOnModuleRenamedNotification write FOnModuleRenamedNotification;
end;
- TInstantOTAIDENotifier3 = class(TIAddInNotifier)
- private
- FModuleNotifierList: TList;
- FOwner: TInstantOTAIDEInterface;
- FOnEventNotification: TInstantOTAEventNotificationEvent;
- FOnFileNotification: TInstantOTAFileNotificationEvent;
- FOnModuleNotification: TInstantOTAModuleNotificationEvent;
- function GetModuleNotifierCount: Integer;
- function GetModuleNotifiers(Index: Integer): TInstantOTAModuleNotifier;
- function GetModuleNotifierList: TList;
+ {$IFDEF D9+}
+ TInstantOTAIDENotifier8 = class(TInstantOTAIDENotifier5, IOTANotifier,
+ IOTAIDENotifier50, IOTAIDENotifier80)
protected
- procedure ModuleNotification(FileName: string; NotifyCode: TNotifyCode);
- property ModuleNotifierList: TList read GetModuleNotifierList;
+ procedure DoAfterCompilation(const Project: IOTAProject; Succeeded,
+ IsCodeInsight: Boolean); overload;
public
- constructor Create(AOwner: TInstantOTAIDEInterface);
- destructor Destroy; override;
- procedure AddModuleNotifier(Notifier: TInstantOTAModuleNotifier);
- procedure EventNotification(NotifyCode: TEventNotification;
- var Cancel: Boolean); override;
- procedure FileNotification(NotifyCode: TFileNotification;
- const FileName: string; var Cancel: Boolean); override;
- function InstallModuleNotifier(FileName: string): TInstantOTAModuleNotifier;
- procedure RemoveModuleNotifier(Notifier: TInstantOTAModuleNotifier);
- property ModuleNotifiers[Index: Integer]: TInstantOTAModuleNotifier
- read GetModuleNotifiers;
- property ModuleNotifierCount: Integer read GetModuleNotifierCount;
- property OnEventNotification: TInstantOTAEventNotificationEvent
- read FOnEventNotification write FOnEventNotification;
- property OnFileNotification: TInstantOTAFileNotificationEvent
- read FOnFileNotification write FOnFileNotification;
- property OnModuleNotification: TInstantOTAModuleNotificationEvent
- read FOnModuleNotification write FOnModuleNotification;
+ // IOTAIDENotifier80
+ procedure AfterCompile(const Project: IOTAProject; Succeeded: Boolean;
+ IsCodeInsight: Boolean); overload;
end;
+ {$ENDIF}
- TInstantOTAModuleNotifier = class(TIModuleNotifier)
+ TInstantOTAModuleNotifier = class(TNotifierObject, IOTANotifier,
+ IOTAModuleNotifier, IInstantOTANotifierUninstallation)
private
FFileName: string;
- FModuleInterface: TIModuleInterface;
- FOwner: TInstantOTAIDENotifier3;
+ FEditorNotifierList: TInterfaceList;
+ FModuleInterface: IOTAModule;
+ FNotifierIndex: Integer;
+ FOwner: TInstantOTAIDENotifier5;
+ function GetEditorNotifierCount: Integer;
+ function GetEditorNotifierList: TInterfaceList;
+ procedure InstallEditorNotifiers;
+ procedure RemoveEditorNotifiers;
+ procedure RemoveSelfFromOwner;
+ procedure RemoveSelfNotifier;
+ protected
+ property EditorNotifierList: TInterfaceList read GetEditorNotifierList;
+ property EditorNotifierCount: Integer read GetEditorNotifierCount;
+ function GetModuleInterface: IOTAModule;
+ property ModuleInterface: IOTAModule read GetModuleInterface;
+ // IOTANotifier
+ procedure Destroyed;
+ // IOTAModuleNotifier
+ function CheckOverwrite: Boolean;
+ procedure ModuleNotification(const AFileName: string; NotifyCode:
+ TModuleNotifyCode);
+ procedure ModuleRenamed(const NewName: string);
+ // IInstantOTANotifierUninstallation
+ procedure UnInstallNotifier;
public
- constructor Create(AOwner: TInstantOTAIDENotifier3;
- AModuleInterface: TIModuleInterface; AFileName: string);
+ constructor Create(AOwner: TInstantOTAIDENotifier5; AModuleInterface:
+ IOTAModule);
destructor Destroy; override;
- procedure Notify(NotifyCode: TNotifyCode); override;
- {$IFDEF D6+}
- procedure ComponentRenamed(const AComponent: TComponent;
- const OldName, NewName: string); override;
- {$ELSE}
- procedure ComponentRenamed(ComponentHandle: Pointer;
- const OldName, NewName: string); override;
- {$ENDIF}
end;
TInstantOTAMessage = class(TInterfacedObject, IOTACustomMessage)
@@ -216,11 +257,74 @@
property ToolName: string read FToolName;
end;
+ TInstantOTABaseEditorNotifier = class(TNotifierObject, IOTANotifier,
+ IInstantOTANotifierUninstallation)
+ private
+ FNotifierIndex: Integer;
+ FOwner: TInstantOTAModuleNotifier;
+ protected
+ FFileName: string;
+ // IOTANotifier
+ procedure AfterSave;
+ procedure BeforeSave;
+ // IInstantOTANotifierUninstallation
+ procedure UnInstallNotifier;
+
+ procedure RemoveSelfFromOwner;
+ procedure RemoveSelfNotifier; virtual; abstract;
+ end;
+
+ TInstantOTAEditorNotifier = class(TInstantOTABaseEditorNotifier, IOTANotifier,
+ IOTAEditorNotifier, IInstantOTANotifierUninstallation)
+ private
+ FSourceInterface: IOTASourceEditor;
+ protected
+ procedure Destroyed;
+ procedure Modified;
+ // IOTAEditorNotifier
+ procedure ViewNotification(const View: IOTAEditView; Operation: TOperation);
+ procedure ViewActivated(const View: IOTAEditView);
+
+ procedure RemoveSelfNotifier; override;
+ public
+ constructor Create(AOwner: TInstantOTAModuleNotifier; ASourceEditorInterface:
+ IOTASourceEditor);
+ destructor Destroy; override;
+ end;
+
+ TInstantOTAFormNotifier = class(TInstantOTABaseEditorNotifier, IOTANotifier,
+ IOTAFormNotifier, IInstantOTANotifierUninstallation)
+ private
+ FFormInterface: IOTAFormEditor;
+ protected
+ procedure Destroyed;
+ procedure Modified;
+ // IOTAFormNotifier
+ procedure FormActivated;
+ procedure FormSaving;
+ procedure ComponentRenamed(ComponentHandle: TOTAHandle; const OldName, NewName:
+ string);
+
+ procedure RemoveSelfNotifier; override;
+ public
+ constructor Create(AOwner: TInstantOTAModuleNotifier; AFormEditorInterface:
+ IOTAFormEditor);
+ destructor Destroy; override;
+ end;
+
implementation
uses
Windows, SysUtils, Dialogs, Controls;
+type
+ // Use the PNoRefCnt type to assign interface instances without invoking
+ // reference counting. Only use this if you have a very good reason.
+ PNoRefCnt = Pointer;
+
+const
+ InvalidNotifierIndex = -1;
+
{ TInstantOTAIDEInterface }
function TInstantOTAIDEInterface.CurrentModule: IOTAModule;
@@ -231,7 +335,6 @@
destructor TInstantOTAIDEInterface.Destroy;
begin
MessageServices.ClearAllMessages;
- FIDENotifier3.Free;
FIDENotifier5.Free;
inherited;
end;
@@ -271,14 +374,16 @@
Result := nil;
end;
-function TInstantOTAIDEInterface.GetAfterCompilation: TInstantOTAAfterCompilationEvent;
+function TInstantOTAIDEInterface.GetOnAfterCompilation:
+ TInstantOTAAfterCompilationEvent;
begin
- Result := IDENotifier5.AfterCompilation;
+ Result := IDENotifier5.OnAfterCompilation;
end;
-function TInstantOTAIDEInterface.GetBeforeCompilation: TInstantOTABeforeCompilationEvent;
+function TInstantOTAIDEInterface.GetOnBeforeCompilation:
+ TInstantOTABeforeCompilationEvent;
begin
- Result := IDENotifier5.BeforeCompilation;
+ Result := IDENotifier5.OnBeforeCompilation;
end;
function TInstantOTAIDEInterface.GetEditActions: IOTAEditActions;
@@ -309,17 +414,14 @@
Result := nil;
end;
-function TInstantOTAIDEInterface.GetIDENotifier3: TInstantOTAIDENotifier3;
-begin
- if not Assigned(FIDENotifier3) then
- FIDENotifier3 := TInstantOTAIDENotifier3.Create(Self);
- Result := FIDENotifier3;
-end;
-
function TInstantOTAIDEInterface.GetIDENotifier5: TInstantOTAIDENotifier5;
begin
if not Assigned(FIDENotifier5) then
+ {$IFDEF D9+}
+ FIDENotifier5 := TInstantOTAIDENotifier8.Create(Self);
+ {$ELSE}
FIDENotifier5 := TInstantOTAIDENotifier5.Create(Self);
+ {$ENDIF}
Result := FIDENotifier5;
end;
@@ -330,22 +432,23 @@
function TInstantOTAIDEInterface.GetModuleServices: IOTAModuleServices;
begin
- Result := Services5 as IOTAModuleServices;
+ Result := Services as IOTAModuleServices;
end;
-function TInstantOTAIDEInterface.GetOnEventNotification: TInstantOTAEventNotificationEvent;
+function TInstantOTAIDEInterface.GetOnFileNotification: TInstantOTAFileNotificationEvent;
begin
- Result := IDENotifier3.OnEventNotification;
+ Result := IDENotifier5.OnFileNotification;
end;
-function TInstantOTAIDEInterface.GetOnFileNotification: TInstantOTAFileNotificationEvent;
+function TInstantOTAIDEInterface.GetOnModuleNotification: TInstantOTAModuleNotificationEvent;
begin
- Result := IDENotifier3.OnFileNotification;
+ Result := IDENotifier5.OnModuleNotification;
end;
-function TInstantOTAIDEInterface.GetOnModuleNotification: TInstantOTAModuleNotificationEvent;
+function TInstantOTAIDEInterface.GetOnModuleRenamedNotification:
+ TInstantOTAModuleRenamedNotificationEvent;
begin
- Result := IDENotifier3.OnModuleNotification;
+ Result := IDENotifier5.OnModuleRenamedNotification;
end;
function TInstantOTAIDEInterface.GetProjectGroup: IOTAProjectGroup;
@@ -359,18 +462,11 @@
Result := nil;
end;
-function TInstantOTAIDEInterface.GetServices3: TIToolServices;
+function TInstantOTAIDEInterface.GetServices: IOTAServices;
begin
- Result := ToolServices;
- if not Assigned(Result) then
-...
[truncated message content] |
|
From: <sr...@us...> - 2007-02-01 03:39:42
|
Revision: 756
http://svn.sourceforge.net/instantobjects/revision/?rev=756&view=rev
Author: srmitch
Date: 2007-01-31 19:39:40 -0800 (Wed, 31 Jan 2007)
Log Message:
-----------
D5 compatibility fixes:
- The recent additions for TInstantDate and TInstantTime have broken IO
for Delphi 5. The problem arises because the 'DateUtils.pas' unit was not introduced until D6 so we need alternative support for the 'DateOf' and 'TimeOf' functions used in the 'InstantPersistence.pas' and 'InstantBrokers.pas' units.
- The recent fix to prevent duplicate attribute names has broken IO for Delphi 5. The main problem is that there is no 'IInterface'. 'IInterface' was not introduced until D6.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantTypes.pas
trunk/Source/Core/InstantUtils.pas
trunk/Source/Design/InstantAttributeEditor.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2007-01-22 12:50:17 UTC (rev 755)
+++ trunk/Source/Core/InstantBrokers.pas 2007-02-01 03:39:40 UTC (rev 756)
@@ -981,8 +981,8 @@
{$ENDIF}
{$IFDEF D6+}
Variants,
+ DateUtils,
{$ENDIF}
- DateUtils,
TypInfo, InstantUtils, InstantRtti;
const
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2007-01-22 12:50:17 UTC (rev 755)
+++ trunk/Source/Core/InstantPersistence.pas 2007-02-01 03:39:40 UTC (rev 756)
@@ -1596,10 +1596,10 @@
{$IFDEF D6+}
MaskUtils,
Variants,
+ DateUtils,
{$ELSE}
Mask,
{$ENDIF}
- DateUtils,
InstantUtils, {InstantRtti, }InstantDesignHook, InstantCode;
var
Modified: trunk/Source/Core/InstantTypes.pas
===================================================================
--- trunk/Source/Core/InstantTypes.pas 2007-01-22 12:50:17 UTC (rev 755)
+++ trunk/Source/Core/InstantTypes.pas 2007-02-01 03:39:40 UTC (rev 756)
@@ -41,6 +41,11 @@
interface
type
+ {$IFNDEF D6+}
+ IInterface = interface (IUnknown)
+ end;
+ {$ENDIF}
+
TInstantStorageKind = (skEmbedded, skExternal);
TInstantAttributeType = (atUnknown, atInteger, atFloat, atCurrency, atBoolean,
atString, atDateTime, atBlob, atMemo, atGraphic,
Modified: trunk/Source/Core/InstantUtils.pas
===================================================================
--- trunk/Source/Core/InstantUtils.pas 2007-01-22 12:50:17 UTC (rev 755)
+++ trunk/Source/Core/InstantUtils.pas 2007-02-01 03:39:40 UTC (rev 756)
@@ -87,6 +87,11 @@
function InstantStrToTime(const Str: string): TDateTime;
function InstantUnquote(const Str: string; Quote: Char): string;
+{$IFDEF D5}
+function DateOf(const AValue: TDateTime): TDateTime;
+function TimeOf(const AValue: TDateTime): TDateTime;
+{$ENDIF}
+
implementation
uses
@@ -603,4 +608,16 @@
Result := AnsiExtractQuotedStr(S, Quote);
end;
+{$IFDEF D5}
+function DateOf(const AValue: TDateTime): TDateTime;
+begin
+ Result := Trunc(AValue);
+end;
+
+function TimeOf(const AValue: TDateTime): TDateTime;
+begin
+ Result := Frac(AValue);
+end;
+{$ENDIF}
+
end.
Modified: trunk/Source/Design/InstantAttributeEditor.pas
===================================================================
--- trunk/Source/Design/InstantAttributeEditor.pas 2007-01-22 12:50:17 UTC (rev 755)
+++ trunk/Source/Design/InstantAttributeEditor.pas 2007-02-01 03:39:40 UTC (rev 756)
@@ -48,7 +48,7 @@
{$IFDEF LINUX}
QImgList, QStdCtrls, QDBCtrls, QMask, QControls, QComCtrls, QExtCtrls,
{$ENDIF}
- InstantPresentation;
+ InstantPresentation, InstantTypes;
type
TInstantStringsEvent = procedure(Sender: TObject; Items: TStrings;
@@ -175,7 +175,7 @@
uses
InstantRtti, InstantPersistence, InstantDesignUtils, InstantImageUtils,
- InstantClasses, InstantMetadata, InstantTypes;
+ InstantClasses, InstantMetadata;
{$R *.dfm}
|
|
From: <na...@us...> - 2007-01-22 12:50:16
|
Revision: 755
http://svn.sourceforge.net/instantobjects/revision/?rev=755&view=rev
Author: nandod
Date: 2007-01-22 04:50:17 -0800 (Mon, 22 Jan 2007)
Log Message:
-----------
* restructured XML broker for easier customization.
Modified Paths:
--------------
trunk/Source/Brokers/XML/InstantXML.pas
Modified: trunk/Source/Brokers/XML/InstantXML.pas
===================================================================
--- trunk/Source/Brokers/XML/InstantXML.pas 2007-01-20 07:37:39 UTC (rev 754)
+++ trunk/Source/Brokers/XML/InstantXML.pas 2007-01-22 12:50:17 UTC (rev 755)
@@ -66,34 +66,54 @@
procedure CreateStorageDir(const AStorageName: string);
function GetRootFolder: string;
procedure SetRootFolder(const AValue: string);
- function SaveToFileXML_UTF8(AObject: TInstantObject;
- const AFileName: string): Boolean;
- function LoadFromFileXML_UTF8(AObject: TInstantObject; const FileName:
- string): boolean;
- function PlainObjectFileName(const StorageName, ClassName, Id: string):
- string;
function ObjectUpdateCountFromFileName(const AFileName: string): Integer;
protected
procedure DoConnect; override;
procedure DoDisconnect; override;
function GetConnected: Boolean; override;
+ // Override this method to redirect storage to different folders with a
+ // class-level or object-level granularity.
+ function GetObjectFileName(const AStorageName, AObjectClassName,
+ AObjectId: string): string; virtual;
+ function LoadInstantObjectFromXmlFile(const AObject: TInstantObject;
+ const AObjectId, AFileName: string): Boolean;
+ function SaveInstantObjectToXmlFile(const AObject: TInstantObject;
+ const AFileName: string): Boolean;
+ function LocateInstantObjectXmlFile(const AObjectClassName,
+ AObjectId, AFileName: string): Boolean;
+ function DeleteInstantObjectXmlFile(const AObject: TInstantObject;
+ const AFileName: string): Boolean;
+ // Override InternalReadInstantObject, InternalSaveInstantObject,
+ // InternalLocateInstantObject and InternalDeleteInstantObject to redirect
+ // storage to media other than the file system.
+ function InternalReadInstantObject(const AObject: TInstantObject;
+ const AStorageName, AObjectId: string;
+ out AObjectUpdateCount: Integer): Boolean; virtual;
+ function InternalWriteInstantObject(const AObject: TInstantObject;
+ const AStorageName: string; out AObjectUpdateCount: Integer): Boolean;
+ virtual;
+ function InternalLocateInstantObject(const AStorageName, AObjectClassName,
+ AObjectId: string): Boolean; virtual;
+ function InternalDeleteInstantObject(const AObject: TInstantObject;
+ const AStorageName: string): Boolean; virtual;
public
constructor Create(AOwner: TComponent); override;
- function ReadInstantObject(AObject: TInstantObject; const StorageName,
+ function LocateInstantObject(const AStorageName, AObjectClassName,
+ AObjectId: string): Boolean;
+ function ReadInstantObject(const AObject: TInstantObject; const AStorageName,
AObjectId: string; out AObjectUpdateCount: Integer): Boolean;
- function WriteInstantObject(AObject: TInstantObject;
+ function WriteInstantObject(const AObject: TInstantObject;
const AStorageName: string; out AObjectUpdateCount: Integer): Boolean;
- function DeleteInstantObject(AObject: TInstantObject;
+ function DeleteInstantObject(const AObject: TInstantObject;
const AStorageName: string): Boolean;
- function Locate(const AStorageName, AObjectClassName, AObjectId: string): Boolean;
function CheckConflict(AObject: TInstantObject;
const AStorageName, AObjectId: string): Boolean;
procedure LoadFileList(const AFileList: TStringList;
const AStorageNames: TStrings);
published
property RootFolder: string read GetRootFolder write SetRootFolder;
- property XMLFileFormat: TXMLFileFormat read FXMLFileFormat write
- FXMLFileFormat default xffUtf8;
+ property XMLFileFormat: TXMLFileFormat
+ read FXMLFileFormat write FXMLFileFormat default xffUtf8;
end;
TInstantXMLConnectionDef = class(TInstantConnectionBasedConnectionDef)
@@ -183,7 +203,7 @@
override;
procedure ResetAttributes(AObject: TInstantObject; Map:
TInstantAttributeMap);
- function Locate(AObject: TObject; const AObjectId: string): Boolean;
+ function Locate(AObject: TInstantObject; const AObjectId: string): Boolean;
virtual;
function ReadInstantObject(AObject: TInstantObject; const AObjectId: string;
out AObjectUpdateCount: Integer): Boolean;
@@ -570,18 +590,27 @@
end;
end;
-function TInstantXMLResolver.Locate(AObject: TObject; const AObjectId: string):
+function TInstantXMLResolver.Locate(AObject: TInstantObject; const AObjectId: string):
Boolean;
begin
- Result := Broker.Connector.Connection.Locate(
- FStorageName, AObject.ClassName, AObjectId);
+ if AObject.Metadata.TableName = FStorageName then
+ Result := Broker.Connector.Connection.LocateInstantObject(
+ FStorageName, AObject.ClassName, AObjectId)
+ else
+ Result := True;
end;
function TInstantXMLResolver.ReadInstantObject(AObject: TInstantObject;
const AObjectId: string; out AObjectUpdateCount: Integer): Boolean;
begin
- Result := Broker.Connector.Connection.ReadInstantObject(AObject, FStorageName,
- AObjectId, AObjectUpdateCount);
+ if AObject.Metadata.TableName = FStorageName then
+ Result := Broker.Connector.Connection.ReadInstantObject(AObject,
+ FStorageName, AObjectId, AObjectUpdateCount)
+ else
+ begin
+ Result := True;
+ AObjectUpdateCount := 1;
+ end;
end;
procedure TInstantXMLResolver.ResetAttributes(AObject: TInstantObject;
@@ -1000,8 +1029,8 @@
end;
end;
-function TXMLFilesAccessor.SaveToFileXML_UTF8(AObject: TInstantObject;
- const AFileName: string): Boolean;
+function TXMLFilesAccessor.SaveInstantObjectToXmlFile(
+ const AObject: TInstantObject; const AFileName: string): Boolean;
var
strstream: TStringStream;
fileStream: TFileStream;
@@ -1040,14 +1069,14 @@
Result := xmlString;
end;
-function TXMLFilesAccessor.LoadFromFileXML_UTF8(AObject: TInstantObject;
- const FileName: string): boolean;
+function TXMLFilesAccessor.LoadInstantObjectFromXmlFile(
+ const AObject: TInstantObject; const AObjectId, AFileName: string): Boolean;
var
fileStream: TFileStream;
strUtf8: string;
strstream: TStringStream;
begin
- fileStream := TFileStream.Create(FileName, fmOpenRead);
+ fileStream := TFileStream.Create(AFileName, fmOpenRead);
try
SetLength(strUtf8, fileStream.Size);
Result := fileStream.Read(strUtf8[1], fileStream.Size) <> 0;
@@ -1070,36 +1099,86 @@
end;
end;
-function TXMLFilesAccessor.ReadInstantObject(AObject: TInstantObject;
- const StorageName, AObjectId: string; out AObjectUpdateCount: Integer): Boolean;
+function TXMLFilesAccessor.LocateInstantObjectXmlFile(const AObjectClassName,
+ AObjectId, AFileName: string): Boolean;
+begin
+ Result := FileExists(AFileName);
+end;
+
+function TXMLFilesAccessor.DeleteInstantObjectXmlFile(
+ const AObject: TInstantObject; const AFileName: string): Boolean;
+begin
+ Result := SysUtils.DeleteFile(AFileName);
+end;
+
+function TXMLFilesAccessor.ReadInstantObject(const AObject: TInstantObject;
+ const AStorageName, AObjectId: string; out AObjectUpdateCount: Integer): Boolean;
+begin
+ Result := InternalReadInstantObject(AObject, AStorageName, AObjectId,
+ AObjectUpdateCount);
+end;
+
+function TXMLFilesAccessor.InternalReadInstantObject(
+ const AObject: TInstantObject; const AStorageName, AObjectId: string;
+ out AObjectUpdateCount: Integer): Boolean;
var
LFileName: string;
begin
- LFileName := PlainObjectFileName(StorageName, AObject.ClassName, AObjectId);
- Result := LoadFromFileXML_UTF8(AObject, LFileName);
+ LFileName := GetObjectFileName(AStorageName, AObject.ClassName, AObjectId);
+ Result := LoadInstantObjectFromXmlFile(AObject, AObjectId, LFileName);
AObjectUpdateCount := ObjectUpdateCountFromFileName(LFileName);
end;
-function TXMLFilesAccessor.WriteInstantObject(AObject: TInstantObject;
+function TXMLFilesAccessor.WriteInstantObject(const AObject: TInstantObject;
const AStorageName: string; out AObjectUpdateCount: Integer): Boolean;
+begin
+ Result := InternalWriteInstantObject(AObject, AStorageName,
+ AObjectUpdateCount);
+end;
+
+function TXMLFilesAccessor.InternalWriteInstantObject(
+ const AObject: TInstantObject; const AStorageName: string;
+ out AObjectUpdateCount: Integer): Boolean;
var
LFileName: string;
begin
+ LFileName := GetObjectFileName(AStorageName, AObject.ClassName, AObject.Id);
CreateStorageDir(AStorageName);
- LFileName := PlainObjectFileName(AStorageName, AObject.ClassName, AObject.Id);
- Result := SavetoFileXML_UTF8(AObject, LFileName);
+ Result := SaveInstantObjectToXmlFile(AObject, LFileName);
AObjectUpdateCount := ObjectUpdateCountFromFileName(LFileName);
end;
-function TXMLFilesAccessor.Locate(const AStorageName, AObjectClassName,
- AObjectId: string): Boolean;
+function TXMLFilesAccessor.LocateInstantObject(const AStorageName,
+ AObjectClassName, AObjectId: string): Boolean;
+begin
+ Result := InternalLocateInstantObject(AStorageName, AObjectClassName,
+ AObjectId);
+end;
+
+function TXMLFilesAccessor.InternalLocateInstantObject(const AStorageName,
+ AObjectClassName, AObjectId: string): Boolean;
var
- filename: string;
+ LFileName: string;
begin
- filename := PlainObjectFileName(AStorageName, AObjectClassName, AObjectId);
- Result := FileExists(filename);
+ LFileName := GetObjectFileName(AStorageName, AObjectClassName, AObjectId);
+ Result := LocateInstantObjectXmlFile(AObjectClassName, AObjectId, LFileName);
end;
+function TXMLFilesAccessor.DeleteInstantObject(const AObject: TInstantObject;
+ const AStorageName: string): Boolean;
+begin
+ Result := InternalDeleteInstantObject(AObject, AStorageName);
+end;
+
+function TXMLFilesAccessor.InternalDeleteInstantObject(
+ const AObject: TInstantObject; const AStorageName: string): Boolean;
+var
+ LFileName: string;
+begin
+ LFileName := GetObjectFileName(AStorageName, AObject.ClassName, AObject.Id);
+ Result := DeleteInstantObjectXmlFile(AObject, LFileName);
+end;
+
procedure TXMLFilesAccessor.CreateStorageDir(const AStorageName: string);
begin
if not DirectoryExists(RootFolder + AStorageName) then
@@ -1112,24 +1191,17 @@
Result := GetObjectUpdateCount(ExtractFileName(AFileName));
end;
-function TXMLFilesAccessor.DeleteInstantObject(AObject: TInstantObject;
- const AStorageName: string): Boolean;
-begin
- Result := SysUtils.DeleteFile(PlainObjectFileName(AStorageName,
- AObject.ClassName, AObject.Id));
-end;
-
constructor TXMLFilesAccessor.Create(AOwner: TComponent);
begin
inherited;
FXMLFileFormat := xffUtf8;
end;
-function TXMLFilesAccessor.PlainObjectFileName(const StorageName,
- ClassName, Id: string): string;
+function TXMLFilesAccessor.GetObjectFileName(const AStorageName,
+ AObjectClassName, AObjectId: string): string;
begin
- Result := RootFolder + StorageName + PathDelim + ClassName + '.' + Id + '.1' +
- DOT_XML_EXT;
+ Result := RootFolder + AStorageName + PathDelim + AObjectClassName + '.'
+ + AObjectId + '.1' + DOT_XML_EXT;
end;
function TXMLFilesAccessor.CheckConflict(AObject: TInstantObject;
|
|
From: <sr...@us...> - 2007-01-20 07:37:45
|
Revision: 754
http://svn.sourceforge.net/instantobjects/revision/?rev=754&view=rev
Author: srmitch
Date: 2007-01-19 23:37:39 -0800 (Fri, 19 Jan 2007)
Log Message:
-----------
- Updated Help file topics 'Associating Objects' and 'InstantObject.AddRef'.
Modified Paths:
--------------
trunk/Help/IOHelp.chm
trunk/Help/IOHelp.cnt
trunk/Help/IOHelp.hlp
trunk/Help/IOHelp.hpj
trunk/Help/IOHelp.hsc
trunk/Help/IOHelp.rtf
Modified: trunk/Help/IOHelp.chm
===================================================================
(Binary files differ)
Modified: trunk/Help/IOHelp.cnt
===================================================================
--- trunk/Help/IOHelp.cnt 2007-01-17 07:59:37 UTC (rev 753)
+++ trunk/Help/IOHelp.cnt 2007-01-20 07:37:39 UTC (rev 754)
@@ -1,4 +1,4 @@
-;This help file was created with HelpScribble 7.6.1
+;This help file was created with HelpScribble 7.7.0
;Licensed to: Steven Mitchell
:BASE IOHelp.hlp
Modified: trunk/Help/IOHelp.hlp
===================================================================
(Binary files differ)
Modified: trunk/Help/IOHelp.hpj
===================================================================
--- trunk/Help/IOHelp.hpj 2007-01-17 07:59:37 UTC (rev 753)
+++ trunk/Help/IOHelp.hpj 2007-01-20 07:37:39 UTC (rev 754)
@@ -1,20 +1,20 @@
; InstantObjects Help
;
-; This help file was created with HelpScribble 7.6.1
+; This help file was created with HelpScribble 7.7.0
; Licensed to: Steven Mitchell
-; HelpScribble is copyright (c) 1996-2005 Jan Goyvaerts
+; HelpScribble is copyright (c) 1996-2007 Jan Goyvaerts
; Visit http://www.helpscribble.com/ for more information
[OPTIONS]
REPORT=YES
-BMROOT=D:\L\INSTAN~1\Help\,D:\L\INSTAN~1\Help
+BMROOT=D:\L\IN121C~1\Help,D:\L\IN121C~1\Help
COMPRESS=True
LCID=0x0409
CNT=IOHelp.cnt
-ROOT=D:\L\INSTAN~1\Help
+ROOT=D:\L\IN121C~1\Help
TITLE=InstantObjects Help
[CONFIG]
@@ -26,7 +26,7 @@
nav="InstantObjects Guide",(200,410,220,503),0,(255,255,255),(255,255,255),0
[FILES]
-D:\L\INSTAN~1\Help\IOHelp.rtf
+D:\L\IN121C~1\Help\IOHelp.rtf
[MAP]
Scribble10 10
Modified: trunk/Help/IOHelp.hsc
===================================================================
--- trunk/Help/IOHelp.hsc 2007-01-17 07:59:37 UTC (rev 753)
+++ trunk/Help/IOHelp.hsc 2007-01-20 07:37:39 UTC (rev 754)
@@ -1273,15 +1273,19 @@
FALSE
-9
-{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fswiss Arial;}}
+13
+{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fswiss Arial;}{\f1\fswiss\fcharset0 Arial;}{\f2\fnil\fcharset2 Symbol;}}
{\colortbl ;\red0\green0\blue0;\red0\green128\blue0;\red128\green0\blue0;}
\viewkind4\uc1\pard\lang1040\b\f0\fs24 Associating Objects\cf1\b0\fs16
\par \pard\sb25\tx1435\cf2\strike Example 1\cf3\strike0\{linkID=430>example\}\cf1\tab\cf2\strike Programming with Persistent Objects\cf3\strike0\{linkID=340>main\}\{keepn\}\cf1
-\par \pard\sb25\sa25\tx1435\fs18 Persistent object relations defined by relational attributes in the business model can be accessed just as easy as any other attribute.
+\par \pard\sb25\sa25\tx1435\fs18 Persistent object relations \lang1033\f1 are \lang1040\f0 defined by relational attributes in the business model \lang1033\f1 and \lang1040\f0 can be accessed just as easy as any other attribute.
\par Single object relations defined by Part and Reference attributes are accessed through the corresponding object property of the class.
\par Multiple object references defined by Parts and References attributes are accessed through the corresponding array property and the container methods defined for the attribute.
\par
+\par \lang1033\b\f1 Assignment to \lang1040\f0 relational attributes
+\par \lang1033\b0\f1 (A close study of the code in \cf2\strike Example 1\cf3\strike0\{linkID=430>example\}\cf1 will help to clarify the points below.)\lang1040\f0
+\par \pard{\pntext\f2\'B7\tab}{\*\pn\pnlvlblt\pnf2\pnindent0{\pntxtb\'B7}}\fi-200\li200\sb25\sa25\tx200\lang1033\f1 O\lang1040\f0 bjects created \lang1033\f1 and\lang1040\f0 then assigned to \i part/parts attributes\i0 \lang1033\f1 SHOULD \lang1040\f0 NOT be freed after assignment. These attributes expect \lang1033\f1 the \lang1040\f0 transfer to them \lang1033\f1 of\lang1040\f0 ownership of the objects that they are assigned.\lang1033\f1 \lang1040\f0 The reference count\lang1033\f1 s\lang1040\f0 of these objects do not change during assignment.\lang1033\f1 \lang1040\f0 This means that\lang1033\f1 ,\lang1040\f0 when an object\lang1033\f1 is\lang1040\f0 create\lang1033\f1 d\lang1040\f0 and assign\lang1033\f1 ed\lang1040\f0 to a part/parts\lang1033\f1 \lang1040\f0 attribute\lang1033\f1 ,\lang1040\f0 the object that \lang1033\f1 was\lang1040\f0 created must \lang1033\f1 NOT be\lang1040\f0 free\lang1033\f1 d\lang1040\f0 unless an exception is raised during the\lang1033\f1 a\lang1040\f0 ssignment.\lang1033\f1 \lang1040\f0
+\par \lang1033\f1{\pntext\f2\'B7\tab}O\lang1040\f0 bjects created \lang1033\f1 and\lang1040\f0 then assigned to \i reference/references\lang1033\f1 \lang1040\f0 attributes\i0 DO need to be freed after assignment. These\lang1033\f1 \lang1040\f0 attributes DO NOT expect \lang1033\f1 the\lang1040\f0 transfer \lang1033\f1 of\lang1040\f0 ownership to them of the\lang1033\f1 \lang1040\f0 objects that they are assigned. The reference count of each of these\lang1033\f1 \lang1040\f0 objects is incremented during assignment. This means that\lang1033\f1 ,\lang1040\f0 when an object \lang1033\f1 is \lang1040\f0 create\lang1033\f1 d\lang1040\f0 and assign\lang1033\f1 ed\lang1040\f0 to a reference/references attribute\lang1033\f1 ,\lang1040\f0 the object that \lang1033\f1 was\lang1040\f0 created must \lang1033\f1 be \lang1040\f0 free\lang1033\f1 d\lang1040\f0 at some point after the\lang1033\f1 \lang1040\f0 assignment\lang1033\f1 to avoid a possible memory leak\lang1040\f0 .
\par }
430
Scribble430
@@ -1295,7 +1299,7 @@
FALSE
-123
+142
{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fswiss Arial;}{\f1\fmodern Courier New;}{\f2\fswiss\fcharset0 Arial;}{\f3\fnil Arial;}{\f4\fmodern\fcharset0 Courier New;}}
{\colortbl ;\red0\green0\blue0;\red0\green128\blue0;\red128\green0\blue0;}
\viewkind4\uc1\pard\lang1040\b\f0\fs24 Example 1 \cf1\b0\fs16
@@ -1355,16 +1359,35 @@
\par Result.Address.Street := 'Summer Street 1';
\par Result.Company := Company;
\par
-\par \{\- Add phones \}
+\par \{\f4\- Add phones \}
\par Phone := TPhone.Create;
-\par Phone.Name := 'Home';
-\par Phone.Number := '12345678';
-\par Result.AddPhone(Phone);
+\par try
+\par Phone.Name := 'Home';
+\par Phone.Number := '12345678';
+\par Result.AddPhone(Phone);
+\par except
+\par Phone.Free;
+\par raise;
+\par end;
\par Phone := TPhone.Create;
-\par Phone.Name := 'Office';
-\par Phone.Number := '32187654';
-\par Result.AddPhone(Phone);
-\par
+\par try
+\par Phone.Name := 'Office';
+\par Phone.Number := '32187654';
+\par Result.AddPhone(Phone);
+\par except
+\par Phone.Free;
+\par raise;
+\par end;
+\par \f1
+\par \f4 \f1\{\- Add \lang1033\f4 new Person as a Friend\lang1040\f1 \}\f4
+\par Person := TPerson.Create;
+\par try
+\par Person.Name := 'Fred Bloggs';
+\par Result.\f1 AddFriend\f4 (Person);
+\par finally
+\par Person.Free;
+\par end;
+\par \f1
\par \{\- Add colleagues\lang1033\f4 as Friends\lang1040\f1 \}
\par \b with \b0 TInstantSelector.Create(nil) \b do\b0
\par \b try\b0
@@ -1425,7 +1448,7 @@
Using an InstantQuery;InstantQuery,Using;
-
+programming:000050
Done
@@ -18223,17 +18246,20 @@
main
AddRef;AddRef_Method;TInstantObject_AddRef
-FALSE
-10
-{\rtf1\ansi\deff0{\fonttbl{\f0\fswiss Arial;}{\f1\fmodern Courier New;}}
+TRUE
+13
+{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fswiss Arial;}{\f1\fmodern Courier New;}{\f2\fswiss\fcharset0 Arial;}}
{\colortbl ;\red0\green0\blue0;}
\viewkind4\uc1\pard\lang1040\b\f0\fs24 TInstantObject.AddRef \cf1\b0\fs16
\par \pard\sb25\tx1435\strike TInstantObject\strike0\{linkID=7390>main\}\tab\ul See Also\ulnone\{linkID=7910\}\{keepn\}
\par \pard\sb25\sa85\tx1435\fs18 Increments the reference count for the number of references dependent on the instance.
\par \pard\sb25\sa25\tx1435\b\f1 function\b0 AddRef: Integer;
\par \pard\sb55\sa25\tx1435\b\f0 Description
-\par \pard\sb25\sa25\tx1435\b0 AddRef increments the reference count for the instance and returns the resulting value of the reference count. Although it should not normally be necessary to call AddRef directly, it can be called to safeguard an object before calling a method that could result in a premature destruction of the object, and after the method returns, call the \strike Release\strike0\{linkID=8920>main\} method to decrement the count.
-\par
+\par \pard\sb25\sa25\tx1435\b0 AddRef increments the reference count for the instance and returns the resulting value of the reference count.
+\par \fs10
+\par \fs18 Although it should not normally be necessary to call AddRef directly, it can be called\lang1033\f2 \lang1040\f0 to ensure the lifetime of an\lang1033\f2 \lang1040\f0 object\lang1033\f2 \lang1040\f0 before calling a method that could result in \lang1033\f2 the\lang1040\f0 premature destruction of the object, and after the method returns, call the \lang1033\f2 Free \lang1040\f0 method to decrement the \lang1033\f2 object's reference \lang1040\f0 count.\lang1033\f2 Note: It is generally not advisable to use the Release method in application development as this might result in memory leaks.\lang1040\f0
+\par \fs10
+\par \lang1033\f2\fs18 For practical examples of when to use the AddRef method study the PrimerCross demo application. One example is the TMainForm.CreateRandomContacts method in Main.pas. In that method a local Companies list is created. When an instance of TCompany is created its AddRef is called and it is added to the Companies list. However during the processing, instances of TCompany can be deleted from the list. As the list is a TObjectList, free will be called on its contained objects when items in the list are deleted or the list is destroyed. Calling AddRef when adding objects to the list ensures that the objects exist until they are deleted from the list or the list is destroyed thereby avoiding the possibility of an AV occurring.\lang1040\f0
\par }
7910
Scribble7910
@@ -20431,7 +20457,7 @@
main
Release;Release_Method;TInstantObject_Release
-FALSE
+TRUE
10
{\rtf1\ansi\deff0{\fonttbl{\f0\fswiss Arial;}{\f1\fmodern Courier New;}}
{\colortbl ;\red0\green0\blue0;}
Modified: trunk/Help/IOHelp.rtf
===================================================================
--- trunk/Help/IOHelp.rtf 2007-01-17 07:59:37 UTC (rev 753)
+++ trunk/Help/IOHelp.rtf 2007-01-20 07:37:39 UTC (rev 754)
@@ -970,10 +970,14 @@
}
\viewkind4\uc1\pard\keepn\lang1040\b\f0\fs24 Associating Objects\cf1\b0\fs16
\par \pard\keepn\sb25\tx1435\cf2\strike Example 1\cf3\strike0{\v Scribble430>example}\cf1\tab\cf2\strike Programming with Persistent Objects\cf3\strike0{\v Scribble340>main}\cf1
-\par \pard\sb25\sa25\tx1435\fs18 Persistent object relations defined by relational attributes in the business model can be accessed just as easy as any other attribute.
+\par \pard\sb25\sa25\tx1435\fs18 Persistent object relations \lang1033\f1 are \lang1040\f0 defined by relational attributes in the business model \lang1033\f1 and \lang1040\f0 can be accessed just as easy as any other attribute.
\par Single object relations defined by Part and Reference attributes are accessed through the corresponding object property of the class.
\par Multiple object references defined by Parts and References attributes are accessed through the corresponding array property and the container methods defined for the attribute.
\par
+\par \lang1033\b\f1 Assignment to \lang1040\f0 relational attributes
+\par \lang1033\b0\f1 (A close study of the code in \cf2\strike Example 1\cf3\strike0{\v Scribble430>example}\cf1 will help to clarify the points below.)\lang1040\f0
+\par \pard{\pntext\f6\'B7\tab}{\*\pn\pnlvlblt\pnf6\pnindent0{\pntxtb\'B7}}\fi-200\li200\sb25\sa25\tx200\lang1033\f1 O\lang1040\f0 bjects created \lang1033\f1 and\lang1040\f0 then assigned to \i part/parts attributes\i0 \lang1033\f1 SHOULD \lang1040\f0 NOT be freed after assignment. These attributes expect \lang1033\f1 the \lang1040\f0 transfer to them \lang1033\f1 of\lang1040\f0 ownership of the objects that they are assigned.\lang1033\f1 \lang1040\f0 The reference count\lang1033\f1 s\lang1040\f0 of these objects do not change during assignment.\lang1033\f1 \lang1040\f0 This means that\lang1033\f1 ,\lang1040\f0 when an object\lang1033\f1 is\lang1040\f0 create\lang1033\f1 d\lang1040\f0 and assign\lang1033\f1 ed\lang1040\f0 to a part/parts\lang1033\f1 \lang1040\f0 attribute\lang1033\f1 ,\lang1040\f0 the object that \lang1033\f1 was\lang1040\f0 created must \lang1033\f1 NOT be\lang1040\f0 free\lang1033\f1 d\lang1040\f0 unless an exception is raised during the\lang1033\f1 a\lang1040\f0 ssignment.\lang1033\f1 \lang1040\f0
+\par \lang1033\f1{\pntext\f6\'B7\tab}O\lang1040\f0 bjects created \lang1033\f1 and\lang1040\f0 then assigned to \i reference/references\lang1033\f1 \lang1040\f0 attributes\i0 DO need to be freed after assignment. These\lang1033\f1 \lang1040\f0 attributes DO NOT expect \lang1033\f1 the\lang1040\f0 transfer \lang1033\f1 of\lang1040\f0 ownership to them of the\lang1033\f1 \lang1040\f0 objects that they are assigned. The reference count of each of these\lang1033\f1 \lang1040\f0 objects is incremented during assignment. This means that\lang1033\f1 ,\lang1040\f0 when an object \lang1033\f1 is \lang1040\f0 create\lang1033\f1 d\lang1040\f0 and assign\lang1033\f1 ed\lang1040\f0 to a reference/references attribute\lang1033\f1 ,\lang1040\f0 the object that \lang1033\f1 was\lang1040\f0 created must \lang1033\f1 be \lang1040\f0 free\lang1033\f1 d\lang1040\f0 at some point after the\lang1033\f1 \lang1040\f0 assignment\lang1033\f1 to avoid a possible memory leak\lang1040\f0 .
\par \pard\plain\f0
{\page}
@@ -1040,16 +1044,35 @@
\par Result.Address.Street := 'Summer Street 1';
\par Result.Company := Company;
\par
-\par \{\- Add phones \}
+\par \{\f8\- Add phones \}
\par Phone := TPhone.Create;
-\par Phone.Name := 'Home';
-\par Phone.Number := '12345678';
-\par Result.AddPhone(Phone);
+\par try
+\par Phone.Name := 'Home';
+\par Phone.Number := '12345678';
+\par Result.AddPhone(Phone);
+\par except
+\par Phone.Free;
+\par raise;
+\par end;
\par Phone := TPhone.Create;
-\par Phone.Name := 'Office';
-\par Phone.Number := '32187654';
-\par Result.AddPhone(Phone);
-\par
+\par try
+\par Phone.Name := 'Office';
+\par Phone.Number := '32187654';
+\par Result.AddPhone(Phone);
+\par except
+\par Phone.Free;
+\par raise;
+\par end;
+\par \f7
+\par \f8 \f7\{\- Add \lang1033\f8 new Person as a Friend\lang1040\f7 \}\f8
+\par Person := TPerson.Create;
+\par try
+\par Person.Name := 'Fred Bloggs';
+\par Result.\f7 AddFriend\f8 (Person);
+\par finally
+\par Person.Free;
+\par end;
+\par \f7
\par \{\- Add colleagues\lang1033\f8 as Friends\lang1040\f7 \}
\par \b with \b0 TInstantSelector.Create(nil) \b do\b0
\par \b try\b0
@@ -1110,6 +1133,7 @@
{\pard\plain\f0\fs20
{\up #}{\footnote {\up #} Scribble440}
{\up $}{\footnote {\up $} Using an InstantQuery}
+{\up +}{\footnote {\up +} programming:000050}
{\up K}{\footnote {\up K} Using an InstantQuery;InstantQuery,Using;}
}
\viewkind4\uc1\pard\keepn\cf1\b\f0\fs24 Using an InstantQuery\b0\fs16
@@ -12729,8 +12753,11 @@
\par \pard\sb25\sa85\tx1435\fs18 Increments the reference count for the number of references dependent on the instance.
\par \pard\sb25\sa25\tx1435\b\f7 function\b0 AddRef: Integer;
\par \pard\sb55\sa25\tx1435\b\f0 Description
-\par \pard\sb25\sa25\tx1435\b0 AddRef increments the reference count for the instance and returns the resulting value of the reference count. Although it should not normally be necessary to call AddRef directly, it can be called to safeguard an object before calling a method that could result in a premature destruction of the object, and after the method returns, call the \strike Release\strike0{\v Scribble8920>main} method to decrement the count.
-\par
+\par \pard\sb25\sa25\tx1435\b0 AddRef increments the reference count for the instance and returns the resulting value of the reference count.
+\par \fs10
+\par \fs18 Although it should not normally be necessary to call AddRef directly, it can be called\lang1033\f1 \lang1040\f0 to ensure the lifetime of an\lang1033\f1 \lang1040\f0 object\lang1033\f1 \lang1040\f0 before calling a method that could result in \lang1033\f1 the\lang1040\f0 premature destruction of the object, and after the method returns, call the \lang1033\f1 Free \lang1040\f0 method to decrement the \lang1033\f1 object's reference \lang1040\f0 count.\lang1033\f1 Note: It is generally not advisable to use the Release method in application development as this might result in memory leaks.\lang1040\f0
+\par \fs10
+\par \lang1033\f1\fs18 For practical examples of when to use the AddRef method study the PrimerCross demo application. One example is the TMainForm.CreateRandomContacts method in Main.pas. In that method a local Companies list is created. When an instance of TCompany is created its AddRef is called and it is added to the Companies list. However during the processing, instances of TCompany can be deleted from the list. As the list is a TObjectList, free will be called on its contained objects when items in the list are deleted or the list is destroyed. Calling AddRef when adding objects to the list ensures that the objects exist until they are deleted from the list or the list is destroyed thereby avoiding the possibility of an AV occurring.\lang1040\f0
\par \pard\plain\f0
{\page}
|
|
From: <na...@us...> - 2007-01-17 07:59:36
|
Revision: 753
http://svn.sourceforge.net/instantobjects/revision/?rev=753&view=rev
Author: nandod
Date: 2007-01-16 23:59:37 -0800 (Tue, 16 Jan 2007)
Log Message:
-----------
+ warning note about undefining IO_CIRCULAR_REFERENCE_CHECK.
Modified Paths:
--------------
trunk/Source/InstantDefines.inc
Modified: trunk/Source/InstantDefines.inc
===================================================================
--- trunk/Source/InstantDefines.inc 2007-01-16 22:57:40 UTC (rev 752)
+++ trunk/Source/InstantDefines.inc 2007-01-17 07:59:37 UTC (rev 753)
@@ -128,6 +128,15 @@
references (as is the case with many object models, especially simple ones),
you can undefine this symbol to gain a little speed in programs that create
and destroy large quantities of objects.
+
+ WARNING: If you disable the check, then every time your program frees an
+ object with circular references, it will leak memory. You might not notice it
+ unless you are using memory leak detection tools such as FastMM.
+ So please make sure your model doesn't allow any circular reference
+ before turning this setting off.
+
+ Also, do it only if you actually need the speed gain, which is needed only
+ in special cases.
}
{$DEFINE IO_CIRCULAR_REFERENCE_CHECK}
|
|
From: <na...@us...> - 2007-01-16 23:13:24
|
Revision: 752
http://svn.sourceforge.net/instantobjects/revision/?rev=752&view=rev
Author: nandod
Date: 2007-01-16 14:57:40 -0800 (Tue, 16 Jan 2007)
Log Message:
-----------
* moved InstantLogProc from InstantPersistence to InstantBrokers, where it is used.
+ added ability to disable circular reference checking by undefining IO_CIRCULAR_REFERENCE_CHECK
* documented the available IO_* defines in InstantDefines.inc.
* FreeCircularReferences slightly optimized.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/InstantDefines.inc
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2007-01-16 17:09:37 UTC (rev 751)
+++ trunk/Source/Core/InstantBrokers.pas 2007-01-16 22:57:40 UTC (rev 752)
@@ -967,6 +967,9 @@
default True;
end;
+var
+ InstantLogProc: procedure (const AString: string) of object;
+
implementation
uses
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2007-01-16 17:09:37 UTC (rev 751)
+++ trunk/Source/Core/InstantPersistence.pas 2007-01-16 22:57:40 UTC (rev 752)
@@ -796,7 +796,9 @@
procedure DoStore(ConflictAction: TInstantConflictAction);
procedure DoUnchange;
function FindDefaultContainer: TInstantContainer;
+{$IFDEF IO_CIRCULAR_REFERENCE_CHECK}
procedure FreeCircularReferences;
+{$ENDIF}
function GetClassId: string;
function GetDefaultContainer: TInstantContainer;
function GetHasDefaultContainer: Boolean;
@@ -1581,9 +1583,6 @@
InstantClassPrefix: string = 'T';
InstantAttributePrefix: string = '_';
-var
- InstantLogProc: procedure (const AString: string) of object;
-
implementation
uses
@@ -6059,6 +6058,7 @@
DestroyInternalFields;
end;
+{$IFDEF IO_CIRCULAR_REFERENCE_CHECK}
procedure TInstantObject.FreeCircularReferences;
var
CheckedObjects: TObjectList;
@@ -6114,27 +6114,35 @@
I: Integer;
begin
if RefByCount = RefCount - 1 then
- for I := Pred(RefByCount) downto 0 do
- begin
- CheckedObjects := TObjectList.Create(False);
- try
+ begin
+ CheckedObjects := TObjectList.Create(False);
+ try
+ for I := Pred(RefByCount) downto 0 do
+ begin
if (FRefBy[I] is TInstantComplex) and
IsInsideCircularReference(TInstantComplex(FRefBy[I])) then
+ begin
case TInstantComplex(FRefBy[I]).AttributeType of
atReference:
TInstantReference(FRefBy[I]).ObjectReference.DestroyInstance;
atReferences:
TInstantReferences(FRefBy[I]).DestroyObject(Self);
end;
- finally
- CheckedObjects.Free;
+ end;
+ CheckedObjects.Clear;
end;
+ finally
+ CheckedObjects.Free;
end;
+ end;
end;
+{$ENDIF}
procedure TInstantObject.FreeInstance;
begin
+{$IFDEF IO_CIRCULAR_REFERENCE_CHECK}
FreeCircularReferences;
+{$ENDIF}
DoRelease;
if FRefCount = 0 then
try
@@ -6779,7 +6787,9 @@
function TInstantObject._Release: Integer;
begin
+{$IFDEF IO_CIRCULAR_REFERENCE_CHECK}
FreeCircularReferences;
+{$ENDIF}
Result := DoRelease;
if FRefCount = 0 then
try
Modified: trunk/Source/InstantDefines.inc
===================================================================
--- trunk/Source/InstantDefines.inc 2007-01-16 17:09:37 UTC (rev 751)
+++ trunk/Source/InstantDefines.inc 2007-01-16 22:57:40 UTC (rev 752)
@@ -114,3 +114,21 @@
{$WARN UNSAFE_CAST OFF}
{$ENDIF}
+{
+ Define this symbol to enable logging of all SQL statements to the debug
+ console (via OutputDebugString - only on Windows) and to the procedure
+ pointed by the InstantBrokers.InstantLogProc global variable.
+}
+{.$DEFINE IO_STATEMENT_LOGGING}
+
+{
+ Whenever a TInstantObject is destroyed, a check is performed to see if there
+ are any objects that circularly refer to it, which should be destroyed as
+ well. If you are sure that your object model doesn't allow circular
+ references (as is the case with many object models, especially simple ones),
+ you can undefine this symbol to gain a little speed in programs that create
+ and destroy large quantities of objects.
+}
+{$DEFINE IO_CIRCULAR_REFERENCE_CHECK}
+
+
|
|
From: <na...@us...> - 2007-01-16 17:09:36
|
Revision: 751
http://svn.sourceforge.net/instantobjects/revision/?rev=751&view=rev
Author: nandod
Date: 2007-01-16 09:09:37 -0800 (Tue, 16 Jan 2007)
Log Message:
-----------
* fix for test case 10 for circular references (on behalf of Joao Morais).
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2007-01-16 10:23:05 UTC (rev 750)
+++ trunk/Source/Core/InstantPersistence.pas 2007-01-16 17:09:37 UTC (rev 751)
@@ -6113,10 +6113,11 @@
var
I: Integer;
begin
- CheckedObjects := TObjectList.Create(False);
- try
- if RefByCount = RefCount - 1 then
- for I := Pred(RefByCount) downto 0 do
+ if RefByCount = RefCount - 1 then
+ for I := Pred(RefByCount) downto 0 do
+ begin
+ CheckedObjects := TObjectList.Create(False);
+ try
if (FRefBy[I] is TInstantComplex) and
IsInsideCircularReference(TInstantComplex(FRefBy[I])) then
case TInstantComplex(FRefBy[I]).AttributeType of
@@ -6125,9 +6126,10 @@
atReferences:
TInstantReferences(FRefBy[I]).DestroyObject(Self);
end;
- finally
- CheckedObjects.Free;
- end;
+ finally
+ CheckedObjects.Free;
+ end;
+ end;
end;
procedure TInstantObject.FreeInstance;
|
|
From: <na...@us...> - 2007-01-16 10:23:05
|
Revision: 750
http://svn.sourceforge.net/instantobjects/revision/?rev=750&view=rev
Author: nandod
Date: 2007-01-16 02:23:05 -0800 (Tue, 16 Jan 2007)
Log Message:
-----------
* test case 10 for circular references - it finally fails.
Modified Paths:
--------------
trunk/Tests/TestIO.mdr
trunk/Tests/TestIO.mdrt
trunk/Tests/TestIO.mdx
trunk/Tests/TestIO.mdxt
trunk/Tests/TestInstantCircularReferences.pas
trunk/Tests/TestModel.pas
Modified: trunk/Tests/TestIO.mdr
===================================================================
(Binary files differ)
Modified: trunk/Tests/TestIO.mdrt
===================================================================
(Binary files differ)
Modified: trunk/Tests/TestIO.mdx
===================================================================
--- trunk/Tests/TestIO.mdx 2007-01-16 09:21:00 UTC (rev 749)
+++ trunk/Tests/TestIO.mdx 2007-01-16 10:23:05 UTC (rev 750)
@@ -1 +1 @@
-<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCategory</Name><Persistence>peStored</Persistence><StorageName>Categories</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItems</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectBox</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Project</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItem</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Description</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItems</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItem</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
+<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCategory</Name><Persistence>peStored</Persistence><StorageName>Categories</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>EmploymentDate</Name><AttributeType>atDate</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>BirthTime</Name><AttributeType>atTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItems</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectBox</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Project</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>RelatedProjectBoxes</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectBox</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItem</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Description</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItems</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItem</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
Modified: trunk/Tests/TestIO.mdxt
===================================================================
--- trunk/Tests/TestIO.mdxt 2007-01-16 09:21:00 UTC (rev 749)
+++ trunk/Tests/TestIO.mdxt 2007-01-16 10:23:05 UTC (rev 750)
@@ -1 +1 @@
-<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItems</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectBox</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Project</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItem</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Description</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItems</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItem</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
+<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>EmploymentDate</Name><AttributeType>atDate</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>BirthTime</Name><AttributeType>atTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItems</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectBox</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Project</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>RelatedProjectBoxes</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectBox</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItem</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Description</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItems</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItem</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
Modified: trunk/Tests/TestInstantCircularReferences.pas
===================================================================
--- trunk/Tests/TestInstantCircularReferences.pas 2007-01-16 09:21:00 UTC (rev 749)
+++ trunk/Tests/TestInstantCircularReferences.pas 2007-01-16 10:23:05 UTC (rev 750)
@@ -92,8 +92,8 @@
// A -> A
procedure TestCircularReferences9;
- //
- //
+ // A {Refs}-> B {Parts}-> C {Parts}-> D {Parts}-> E {Ref}-> F
+ // {Parts}-> G {Parts}-> H {Ref}->F
procedure TestCircularReferences10;
end;
@@ -269,6 +269,7 @@
procedure TestCircularReferences.TestCircularReferences10;
var
vCountry: TCountry;
+ vMasterProjectBox: TProjectBox;
vProjectBox: TProjectBox;
begin
// Part I: create and store the object that is going to be referenced by
@@ -283,38 +284,47 @@
end;
// Part II: build the referencing structure.
- vProjectBox := TProjectBox.Create(FConn);
+ vMasterProjectBox := TProjectBox.Create(FConn); // create Category
try
- vProjectBox.Project := TProject.Create(FConn);
-
- vProjectBox.Project.Items.AddItem(TProjectItem.Create(FConn));
- vCountry := TCountry.Retrieve('SharedCountry', False, False, FConn);
+ vProjectBox := TProjectBox.Create(FConn); // create Element
try
- AssertEquals('vCountry.RefCount', 1, vCountry.RefCount);
- vProjectBox.Project.Items.Items[0].Country := vCountry;
- AssertEquals('vCountry.RefCount', 2, vCountry.RefCount);
- finally
- vCountry.Free;
- AssertEquals('vCountry.RefCount', 1, vCountry.RefCount);
- end;
+ vMasterProjectBox.AddRelatedProjectBox(vProjectBox); // add Element to Category
- vProjectBox.Project.AddSubProject(TProject.Create(FConn));
- vProjectBox.Project.SubProjects[0].Items.AddItem(TProjectItem.Create(FConn));
- vCountry := TCountry.Retrieve('SharedCountry', False, False, FConn);
- try
- AssertEquals('vCountry.RefCount', 2, vCountry.RefCount);
- vProjectBox.Project.SubProjects[0].Items.Items[0].Country := vCountry;
- AssertEquals('vCountry.RefCount', 3, vCountry.RefCount);
+ vProjectBox.Project := TProject.Create(FConn); // add master Form
+
+ vProjectBox.Project.AddSubProject(TProject.Create(FConn)); // add detail Form
+
+ vProjectBox.Project.SubProjects[0].Items.AddItem(TProjectItem.Create(FConn)); // add TriggerLink
+ vCountry := TCountry.Retrieve('SharedCountry', False, False, FConn);
+ try
+ AssertEquals('vCountry.RefCount', 1, vCountry.RefCount);
+ vProjectBox.Project.SubProjects[0].Items.Items[0].Country := vCountry; // add reference to Trigger
+ AssertEquals('vCountry.RefCount', 2, vCountry.RefCount);
+ finally
+ vCountry.Free;
+ AssertEquals('vCountry.RefCount', 1, vCountry.RefCount);
+ end;
+
+ vProjectBox.Project.SubProjects[0].AddSubProject(TProject.Create(FConn)); // add detail-detail Form.
+
+ vProjectBox.Project.SubProjects[0].SubProjects[0].Items.AddItem(TProjectItem.Create(FConn)); // add TriggerLink
+ vCountry := TCountry.Retrieve('SharedCountry', False, False, FConn);
+ try
+ AssertEquals('vCountry.RefCount', 2, vCountry.RefCount);
+ vProjectBox.Project.SubProjects[0].SubProjects[0].Items.Items[0].Country := vCountry; // add reference to Trigger
+ AssertEquals('vCountry.RefCount', 3, vCountry.RefCount);
+ finally
+ vCountry.Free;
+ AssertEquals('vCountry.RefCount', 2, vCountry.RefCount);
+ end;
+
+ vProjectBox.Store;
finally
- vCountry.Free;
- // The equivalent of vCountry.RefCount is 1 at this point
- // in the real project.
- AssertEquals('vCountry.RefCount', 2, vCountry.RefCount);
+ vProjectBox.Free;
end;
-
- vProjectBox.Store;
+ vMasterProjectBox.Store;
finally
- vProjectBox.Free;
+ vMasterProjectBox.Free;
end;
end;
Modified: trunk/Tests/TestModel.pas
===================================================================
--- trunk/Tests/TestModel.pas 2007-01-16 09:21:00 UTC (rev 749)
+++ trunk/Tests/TestModel.pas 2007-01-16 10:23:05 UTC (rev 750)
@@ -430,11 +430,25 @@
TProjectBox = class(TInstantObject)
{IOMETADATA stored;
- Project: Part(TProject); }
+ Project: Part(TProject);
+ RelatedProjectBoxes: References(TProjectBox); }
_Project: TInstantPart;
+ _RelatedProjectBoxes: TInstantReferences;
private
function GetProject: TProject;
+ function GetRelatedProjectBoxCount: Integer;
+ function GetRelatedProjectBoxes(Index: Integer): TProjectBox;
procedure SetProject(Value: TProject);
+ procedure SetRelatedProjectBoxes(Index: Integer; Value: TProjectBox);
+ public
+ function AddRelatedProjectBox(RelatedProjectBox: TProjectBox): Integer;
+ procedure ClearRelatedProjectBoxes;
+ procedure DeleteRelatedProjectBox(Index: Integer);
+ function IndexOfRelatedProjectBox(RelatedProjectBox: TProjectBox): Integer;
+ procedure InsertRelatedProjectBox(Index: Integer; RelatedProjectBox: TProjectBox);
+ function RemoveRelatedProjectBox(RelatedProjectBox: TProjectBox): Integer;
+ property RelatedProjectBoxCount: Integer read GetRelatedProjectBoxCount;
+ property RelatedProjectBoxes[Index: Integer]: TProjectBox read GetRelatedProjectBoxes write SetRelatedProjectBoxes;
published
property Project: TProject read GetProject write SetProject;
end;
@@ -477,7 +491,7 @@
implementation
uses
- SysUtils, InstantUtils;
+ SysUtils, InstantUtils, InstantMetadata;
{ TAddress }
@@ -1411,11 +1425,51 @@
{ TProjectBox }
+function TProjectBox.AddRelatedProjectBox(RelatedProjectBox: TProjectBox): Integer;
+begin
+ Result := _RelatedProjectBoxes.Add(RelatedProjectBox);
+end;
+
+procedure TProjectBox.ClearRelatedProjectBoxes;
+begin
+ _RelatedProjectBoxes.Clear;
+end;
+
+procedure TProjectBox.DeleteRelatedProjectBox(Index: Integer);
+begin
+ _RelatedProjectBoxes.Delete(Index);
+end;
+
function TProjectBox.GetProject: TProject;
begin
Result := _Project.Value as TProject;
end;
+function TProjectBox.GetRelatedProjectBoxCount: Integer;
+begin
+ Result := _RelatedProjectBoxes.Count;
+end;
+
+function TProjectBox.GetRelatedProjectBoxes(Index: Integer): TProjectBox;
+begin
+ Result := _RelatedProjectBoxes[Index] as TProjectBox;
+end;
+
+function TProjectBox.IndexOfRelatedProjectBox(RelatedProjectBox: TProjectBox): Integer;
+begin
+ Result := _RelatedProjectBoxes.IndexOf(RelatedProjectBox);
+end;
+
+procedure TProjectBox.InsertRelatedProjectBox(Index: Integer; RelatedProjectBox: TProjectBox);
+begin
+ _RelatedProjectBoxes.Insert(Index, RelatedProjectBox);
+end;
+
+function TProjectBox.RemoveRelatedProjectBox(RelatedProjectBox: TProjectBox): Integer;
+begin
+ Result := _RelatedProjectBoxes.Remove(RelatedProjectBox);
+end;
+
procedure TProjectBox.SetProject(Value: TProject);
begin
_Project.Value := Value;
@@ -1423,6 +1477,11 @@
{ TProjectItem }
+procedure TProjectBox.SetRelatedProjectBoxes(Index: Integer; Value: TProjectBox);
+begin
+ _RelatedProjectBoxes[Index] := Value;
+end;
+
function TProjectItem.GetCountry: TCountry;
begin
Result := _Country.Value as TCountry;
|
|
From: <na...@us...> - 2007-01-16 09:21:00
|
Revision: 749
http://svn.sourceforge.net/instantobjects/revision/?rev=749&view=rev
Author: nandod
Date: 2007-01-16 01:21:00 -0800 (Tue, 16 Jan 2007)
Log Message:
-----------
+ another test case for circular references (WIP).
- unused old test model classes.
Modified Paths:
--------------
trunk/Tests/TestIO.mdrt
trunk/Tests/TestIO.mdx
trunk/Tests/TestIO.mdxt
trunk/Tests/TestInstantCircularReferences.pas
trunk/Tests/TestModel.pas
Modified: trunk/Tests/TestIO.mdrt
===================================================================
(Binary files differ)
Modified: trunk/Tests/TestIO.mdx
===================================================================
--- trunk/Tests/TestIO.mdx 2007-01-15 06:18:23 UTC (rev 748)
+++ trunk/Tests/TestIO.mdx 2007-01-16 09:21:00 UTC (rev 749)
@@ -1 +1 @@
-<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCategory</Name><Persistence>peStored</Persistence><StorageName>Categories</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBTable</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>PrimaryKey</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBPrimaryKey</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ForeignKeys</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBForeignKey</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBField</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Table</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBTable</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBPrimaryKey</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Fields</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBField</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBFieldPair</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Field</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBField</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ForeignField</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBField</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBForeignKey</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>FieldPairs</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBFieldPair</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
+<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCategory</Name><Persistence>peStored</Persistence><StorageName>Categories</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItems</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectBox</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Project</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItem</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Description</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItems</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItem</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
Modified: trunk/Tests/TestIO.mdxt
===================================================================
--- trunk/Tests/TestIO.mdxt 2007-01-15 06:18:23 UTC (rev 748)
+++ trunk/Tests/TestIO.mdxt 2007-01-16 09:21:00 UTC (rev 749)
@@ -1 +1 @@
-<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBTable</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>PrimaryKey</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBPrimaryKey</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ForeignKeys</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBForeignKey</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBField</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Table</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBTable</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBPrimaryKey</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Fields</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBField</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBFieldPair</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Field</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBField</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ForeignField</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBField</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TDBForeignKey</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>FieldPairs</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TDBFieldPair</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
+<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItems</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectBox</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Project</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItem</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Description</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItems</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItem</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
Modified: trunk/Tests/TestInstantCircularReferences.pas
===================================================================
--- trunk/Tests/TestInstantCircularReferences.pas 2007-01-15 06:18:23 UTC (rev 748)
+++ trunk/Tests/TestInstantCircularReferences.pas 2007-01-16 09:21:00 UTC (rev 749)
@@ -92,8 +92,8 @@
// A -> A
procedure TestCircularReferences9;
- // This is intended to demonstrate a problem I am having in a project,
- // but doesn't leak as expected. More investigation needed.
+ //
+ //
procedure TestCircularReferences10;
end;
@@ -268,63 +268,54 @@
procedure TestCircularReferences.TestCircularReferences10;
var
- vMainTable, vLookupTable: TDBTable;
- vLookupTableIdField: TDBField;
- vLookupTableDescField: TDBField;
- vMainTableIdField: TDBField;
- vMainTableLookupIdField: TDBField;
- vFK: TDBForeignKey;
- vFieldPair: TDBFieldPair;
+ vCountry: TCountry;
+ vProjectBox: TProjectBox;
begin
- vLookupTable := TDBTable.Create(FConn);
- vLookupTable.Id := 'LookupTable';
- vLookupTable.Name := 'LookupTable';
- vLookupTable.Store;
+ // Part I: create and store the object that is going to be referenced by
+ // two other objects.
+ vCountry := TCountry.Create(FConn);
+ try
+ vCountry.Id := 'SharedCountry';
+ vCountry.Store;
+ finally
+ AssertEquals('vCountry.RefCount', 1, vCountry.RefCount);
+ vCountry.Free;
+ end;
- vLookupTableIdField := TDBField.Create(FConn);
- vLookupTableIdField.Name := 'ID';
- vLookupTableIdField.Table := vLookupTable;
- vLookupTableIdField.Store;
+ // Part II: build the referencing structure.
+ vProjectBox := TProjectBox.Create(FConn);
+ try
+ vProjectBox.Project := TProject.Create(FConn);
- vLookupTableDescField := TDBField.Create(FConn);
- vLookupTableDescField.Name := 'DESCRIPTION';
- vLookupTableDescField.Table := vLookupTable;
- vLookupTableDescField.Store;
+ vProjectBox.Project.Items.AddItem(TProjectItem.Create(FConn));
+ vCountry := TCountry.Retrieve('SharedCountry', False, False, FConn);
+ try
+ AssertEquals('vCountry.RefCount', 1, vCountry.RefCount);
+ vProjectBox.Project.Items.Items[0].Country := vCountry;
+ AssertEquals('vCountry.RefCount', 2, vCountry.RefCount);
+ finally
+ vCountry.Free;
+ AssertEquals('vCountry.RefCount', 1, vCountry.RefCount);
+ end;
- vLookupTable.Free;
+ vProjectBox.Project.AddSubProject(TProject.Create(FConn));
+ vProjectBox.Project.SubProjects[0].Items.AddItem(TProjectItem.Create(FConn));
+ vCountry := TCountry.Retrieve('SharedCountry', False, False, FConn);
+ try
+ AssertEquals('vCountry.RefCount', 2, vCountry.RefCount);
+ vProjectBox.Project.SubProjects[0].Items.Items[0].Country := vCountry;
+ AssertEquals('vCountry.RefCount', 3, vCountry.RefCount);
+ finally
+ vCountry.Free;
+ // The equivalent of vCountry.RefCount is 1 at this point
+ // in the real project.
+ AssertEquals('vCountry.RefCount', 2, vCountry.RefCount);
+ end;
- vMainTable := TDBTable.Create(FConn);
- vMainTable.Name := 'MainTable';
- vMainTable.Store;
-
- vMainTableIdField := TDBField.Create(FConn);
- vMainTableIdField.Name := 'ID';
- vMainTableIdField.Table := vMainTable;
- vMainTableIdField.Store;
-
- vMainTableLookupIdField := TDBField.Create(FConn);
- vMainTableLookupIdField.Name := 'LookupTable_ID';
- vMainTableLookupIdField.Table := vMainTable;
- vMainTableLookupIdField.Store;
-
- vFieldPair := TDBFieldPair.Create(FConn);
- vFieldPair.Field := vMainTableLookupIdField;
- vFieldPair.ForeignField := vLookupTableIdField;
-
- vFK := TDBForeignKey.Create(FConn);
- vFK.AddFieldPair(vFieldPair);
- vMainTable.AddForeignKey(vFK);
-
- vMainTable.Store;
-
- vMainTable.Free;
-
- vLookupTableIdField.Free;
- vLookupTableDescField.Free;
-
- vMainTableIdField.Free;
- vMainTableLookupIdField.Free;
-
+ vProjectBox.Store;
+ finally
+ vProjectBox.Free;
+ end;
end;
// A -> B {Parts}-> C {Parts}-> D -> A
Modified: trunk/Tests/TestModel.pas
===================================================================
--- trunk/Tests/TestModel.pas 2007-01-15 06:18:23 UTC (rev 748)
+++ trunk/Tests/TestModel.pas 2007-01-16 09:21:00 UTC (rev 749)
@@ -42,17 +42,15 @@
TContact = class;
TContactFilter = class;
TCountry = class;
- TDBField = class;
- TDBFieldPair = class;
- TDBForeignKey = class;
- TDBPrimaryKey = class;
- TDBTable = class;
TEmail = class;
TExternalAddress = class;
TExternalPhone = class;
TPerson = class;
TPhone = class;
TProject = class;
+ TProjectBox = class;
+ TProjectItem = class;
+ TProjectItems = class;
TAddress = class(TInstantObject)
{IOMETADATA City: String(30) index;
@@ -338,8 +336,10 @@
SubProjects: Parts(TProject) external 'Project_SubProjects';
Addresses: Parts(TExternalAddress) external 'Project_Addresses';
Manager: Reference(TContact);
- Participants: References(TContact) external 'Project_Participants'; }
+ Participants: References(TContact) external 'Project_Participants';
+ Items: Part(TProjectItems); }
_Addresses: TInstantParts;
+ _Items: TInstantPart;
_Manager: TInstantReference;
_Name: TInstantString;
_Participants: TInstantReferences;
@@ -347,6 +347,7 @@
private
function GetAddressCount: Integer;
function GetAddresses(Index: Integer): TExternalAddress;
+ function GetItems: TProjectItems;
function GetManager: TContact;
function GetName: string;
function GetParticipantCount: Integer;
@@ -354,6 +355,7 @@
function GetSubProjectCount: Integer;
function GetSubProjects(Index: Integer): TProject;
procedure SetAddresses(Index: Integer; Value: TExternalAddress);
+ procedure SetItems(Value: TProjectItems);
procedure SetManager(Value: TContact);
procedure SetName(const Value: string);
procedure SetParticipants(Index: Integer; Value: TContact);
@@ -384,6 +386,7 @@
property SubProjectCount: Integer read GetSubProjectCount;
property SubProjects[Index: Integer]: TProject read GetSubProjects write SetSubProjects;
published
+ property Items: TProjectItems read GetItems write SetItems;
property Manager: TContact read GetManager write SetManager;
property Name: string read GetName write SetName;
end;
@@ -425,116 +428,52 @@
property Number: string read GetNumber write SetNumber;
end;
- TDBTable = class(TInstantObject)
+ TProjectBox = class(TInstantObject)
{IOMETADATA stored;
- PrimaryKey: Part(TDBPri...
[truncated message content] |
|
From: <sr...@us...> - 2007-01-15 21:55:07
|
Revision: 748
http://svn.sourceforge.net/instantobjects/revision/?rev=748&view=rev
Author: srmitch
Date: 2007-01-14 22:18:23 -0800 (Sun, 14 Jan 2007)
Log Message:
-----------
- Added modifications to IO to produce metadata information in XML file format at design-time and use it at run-time instead of the current, less portable, resource file approach. This modification also allows the IO model to be contained in a statically linked package.
- Unit tests have been modified to work with the XML run-time metadata format.
Modified Paths:
--------------
branches/MetadataInXMLDev/Source/Core/InstantCode.pas
branches/MetadataInXMLDev/Source/Core/InstantConsts.pas
branches/MetadataInXMLDev/Source/Core/InstantMetadata.pas
branches/MetadataInXMLDev/Source/Core/InstantPersistence.pas
branches/MetadataInXMLDev/Source/Core/InstantPresentation.pas
branches/MetadataInXMLDev/Source/Design/InstantModelExpert.pas
branches/MetadataInXMLDev/Tests/TestIO.dpr
branches/MetadataInXMLDev/Tests/TestInstantAttribute.pas
branches/MetadataInXMLDev/Tests/TestInstantBlob.pas
branches/MetadataInXMLDev/Tests/TestInstantBoolean.pas
branches/MetadataInXMLDev/Tests/TestInstantCache.pas
branches/MetadataInXMLDev/Tests/TestInstantCircularReferences.pas
branches/MetadataInXMLDev/Tests/TestInstantClassMetadata.pas
branches/MetadataInXMLDev/Tests/TestInstantComplex.pas
branches/MetadataInXMLDev/Tests/TestInstantCurrency.pas
branches/MetadataInXMLDev/Tests/TestInstantDate.pas
branches/MetadataInXMLDev/Tests/TestInstantDateTime.pas
branches/MetadataInXMLDev/Tests/TestInstantFloat.pas
branches/MetadataInXMLDev/Tests/TestInstantInteger.pas
branches/MetadataInXMLDev/Tests/TestInstantNumeric.pas
branches/MetadataInXMLDev/Tests/TestInstantObject.pas
branches/MetadataInXMLDev/Tests/TestInstantObjectReference.pas
branches/MetadataInXMLDev/Tests/TestInstantObjectStore.pas
branches/MetadataInXMLDev/Tests/TestInstantPart.pas
branches/MetadataInXMLDev/Tests/TestInstantParts.pas
branches/MetadataInXMLDev/Tests/TestInstantReference.pas
branches/MetadataInXMLDev/Tests/TestInstantReferences.pas
branches/MetadataInXMLDev/Tests/TestInstantScheme.pas
branches/MetadataInXMLDev/Tests/TestInstantString.pas
branches/MetadataInXMLDev/Tests/TestInstantTableMetadata.pas
branches/MetadataInXMLDev/Tests/TestInstantTime.pas
branches/MetadataInXMLDev/Tests/TestMockBroker.pas
branches/MetadataInXMLDev/Tests/TestMockConnector.pas
branches/MetadataInXMLDev/Tests/TestModel.pas
Added Paths:
-----------
branches/MetadataInXMLDev/Docs/Runtime Model Metadata In XML Files.txt
branches/MetadataInXMLDev/Tests/TestModel.irs
Removed Paths:
-------------
branches/MetadataInXMLDev/Tests/TestIO.mdr
Added: branches/MetadataInXMLDev/Docs/Runtime Model Metadata In XML Files.txt
===================================================================
--- branches/MetadataInXMLDev/Docs/Runtime Model Metadata In XML Files.txt (rev 0)
+++ branches/MetadataInXMLDev/Docs/Runtime Model Metadata In XML Files.txt 2007-01-15 06:18:23 UTC (rev 748)
@@ -0,0 +1,35 @@
+Runtime Model Metadata In XML Files
+===================================================
+Author: Steven Mitchell, 01/2007.
+
+Abstract
+--------
+A modification to IO to produce metadata information in XML file format at design-time and use it at run-time instead of the current, less portable, resource file approach. This modification also allows the IO model to be contained in a statically linked package. The possibility to extend this approach to allow (a) a model in dynamically linked packages or (b) to include extra metadata information has not been investigated at this time.
+
+Conversion of IO projects
+-------------------------
+Use the following procedure to convert IO projects that use the previous IO Windows Resource metadata system.
+
+1. Build the modified IO Core and Design packages. Install IO Design package.
+2. Open IO Application Project in IDE.
+3. Launch IO Model Explorer (IOME). Explorer dialog will be empty.
+4. In IOME select Model code units. If all goes well IOME should now show the class model for the project. The '{$R *.mdr} {<ModelUnitNameList>}' entry in the project file should have been removed and each model code unit should have additions as indicated in the following example:
+
+unit Model2;
+{IOMODEL} <-------------
+...
+initialization
+
+ InstantRegisterClasses([
+ TCompany,
+ TPerson
+ ]);
+
+ LoadMetadatas('Model2.irs'); <-------------
+
+end.
+
+5. Build or compile the Application. There should be a '<ModelUnitName>.irs' file produced for each model unit. These files contain the metadata information, in XML format, for each model unit. Note: The old '<ApplicationName>.mdr' file is no longer needed and can be deleted.
+
+6. Before running the Application ensure that the '*.irs' files are in the same folder as the Application's executable.
+
Property changes on: branches/MetadataInXMLDev/Docs/Runtime Model Metadata In XML Files.txt
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: branches/MetadataInXMLDev/Source/Core/InstantCode.pas
===================================================================
--- branches/MetadataInXMLDev/Source/Core/InstantCode.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Source/Core/InstantCode.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -1305,6 +1305,7 @@
Scope: TInstantCodeScope = scInterface): TInstantCodeModule; overload;
function LoadModule(const Str: string; const FileName: string = '';
Scope: TInstantCodeScope = scInterface): TInstantCodeModule; overload;
+ procedure SaveToFile(const FileName: string);
procedure SaveToResFile(const FileName: string);
property ClassCount: Integer read GetClassCount;
property Classes[Index: Integer]: TInstantCodeClass read GetClasses;
@@ -1461,6 +1462,8 @@
procedure SkipText;
procedure UpdateClassForward(OldClass, NewClass: TInstantCodeClass);
procedure UpdateClassRegistration(OldClass, NewClass: TInstantCodeClass);
+ procedure UpdateLoadMetadatas(const FileName: string; Required: Boolean);
+ procedure UpdateModelUnitTag(const FileName: string; Required: Boolean);
procedure UpdateUnit;
property CursorPos: TInstantCodePos read GetCursorPos write SetCursorPos;
property InsertMode: TInstantCodeInsertMode read FInsertMode write FInsertMode;
@@ -7157,8 +7160,12 @@
begin
AClass := Classes[I];
with AClass do
+ begin
if (BaseClassName <> '') and not Assigned(BaseClass) then
BaseClass := FindClass(BaseClassName);
+ if Metadata.ParentName = '' then
+ Metadata.ParentName := BaseClassName;
+ end;
end;
end;
@@ -7251,6 +7258,11 @@
FTypes.Remove(AType);
end;
+procedure TInstantCodeProject.SaveToFile(const FileName: string);
+begin
+ Model.SaveToFile(FileName);
+end;
+
procedure TInstantCodeProject.SaveToResFile(const FileName: string);
begin
Model.SaveToResFile(FileName);
@@ -8818,6 +8830,92 @@
InsertText(RegistrationText);
end;
+procedure TInstantCodeModifier.UpdateLoadMetadatas(const FileName: string;
+ Required: Boolean);
+const
+ LoadMetadatasProcName = 'LoadMetadatas';
+
+ function LoadMetadatasText: string;
+ var
+ Stream: TInstantStringStream;
+ Writer: TInstantCodeWriter;
+ begin
+ Result := '';
+ Stream := TInstantStringStream.Create('');
+ Writer := TInstantCodeWriter.Create(Stream);
+ try
+ Writer.Indent;
+ Writer.Write(CRLF);
+ Writer.Write(LoadMetadatasProcName + '(''' + FileName + ''');' + CRLF);
+ Writer.Unindent;
+ Result := Stream.DataString;
+ finally
+ Writer.Free;
+ Stream.Free;
+ end;
+ end;
+
+var
+ Section: TInstantCodeInitializationSection;
+ Pos: TInstantCodePos;
+begin
+ Section := Module.InitializationSection;
+ if not Section.IsFiled then
+ begin
+ CursorPos := Module.ImplementationSection.EndPos;
+ InsertMode := imAfter;
+ InsertObjectText(Section);
+ end;
+ CursorPos := Section.StartPos;
+ SkipLine;
+ if FindText(LoadMetadatasProcName) then
+ begin
+ Pos := CursorPos;
+ Skip(';');
+ DeleteFrom(Pos);
+ CloseGap;
+ CloseGap;
+ end;
+ if Required then
+ begin
+ CursorPos := Section.EndPos;
+ MoveCursor(-Length(CRLF));
+ InsertText(LoadMetadatasText);
+ end;
+end;
+
+procedure TInstantCodeModifier.UpdateModelUnitTag(const FileName: string;
+ Required: Boolean);
+var
+ SavePos: TInstantCodePos;
+ SaveIgnoreComments: boolean;
+begin
+ if FindText(InstantUnitTag) then
+ begin
+ with FReader do
+ begin
+ SaveIgnoreComments := IgnoreComments;
+ IgnoreComments := False;
+ try
+ ReadNext(CRLF);
+ SavePos := Position;
+ if Readmatching(InstantModelUnitTag) then
+ begin
+ ReadNext(CRLF);
+ DeleteFrom(SavePos);
+ end
+ else
+ Position := SavePos;
+ finally
+ IgnoreComments := SaveIgnoreComments;
+ end;
+ end;
+
+ if Required then
+ InsertText(InstantModelUnitTag + CRLF);
+ end;
+end;
+
procedure TInstantCodeModifier.UpdateModule(Origin, Delta: TInstantCodePos;
Before: Boolean);
begin
Modified: branches/MetadataInXMLDev/Source/Core/InstantConsts.pas
===================================================================
--- branches/MetadataInXMLDev/Source/Core/InstantConsts.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Source/Core/InstantConsts.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -69,6 +69,9 @@
InstantSequenceNoFieldName = 'SequenceNo';
InstantChildClassFieldName = 'ChildClass';
+ InstantModelUnitTag = '{IOMODEL}';
+ InstantUnitTag = 'unit ';
+
{$IFNDEF D6+}
const
sLineBreak = #13#10;
Modified: branches/MetadataInXMLDev/Source/Core/InstantMetadata.pas
===================================================================
--- branches/MetadataInXMLDev/Source/Core/InstantMetadata.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Source/Core/InstantMetadata.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -576,14 +576,24 @@
{ TInstantClassMetadata }
procedure TInstantClassMetadata.Assign(Source: TPersistent);
+var
+ I: Integer;
+ AttributeMetadata: TInstantAttributeMetadata;
begin
inherited;
if Source is TInstantClassMetadata then
with TInstantClassMetadata(Source) do
begin
+ Self.FParentName := FParentName;
Self.FDefaultContainerName := FDefaultContainerName;
Self.FStorageName := FStorageName;
Self.FPersistence := FPersistence;
+ if Assigned(FAttributeMetadatas) then
+ for I := 0 to Pred(FAttributeMetadatas.Count) do
+ begin
+ AttributeMetadata := Self.AttributeMetadatas.Add;
+ AttributeMetadata.Assign(FAttributeMetadatas[I]);
+ end;
end;
end;
Modified: branches/MetadataInXMLDev/Source/Core/InstantPersistence.pas
===================================================================
--- branches/MetadataInXMLDev/Source/Core/InstantPersistence.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Source/Core/InstantPersistence.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -1577,6 +1577,9 @@
procedure AssignInstantDataTypeStrings(Strings: TStrings);
+procedure LoadMetadatas(const AFileName: string);
+procedure LoadModelFromFiles;
+
const
InstantClassPrefix: string = 'T';
InstantAttributePrefix: string = '_';
@@ -1606,6 +1609,7 @@
var
ConnectorClasses: TList;
ClassList: TList;
+ MetadataFileList: TStringList;
GraphicClassList: array[TInstantGraphicFileFormat] OF TGraphicClass;
RuntimeModel: TInstantModel;
ObjectNotifiers: TInstantObjectNotifiers;
@@ -8097,6 +8101,56 @@
end;
end;
+procedure LoadModelFromFiles;
+var
+ I: Integer;
+begin
+ if Assigned(MetadataFileList) and (MetadataFileList.Count > 0) then
+ begin
+ InstantModel.ClassMetadatas.Clear;
+ for I := 0 to Pred(MetadataFileList.Count) do
+ LoadMetadatas(MetadataFileList[I]);
+ end;
+end;
+
+procedure InstantRegisterMetadataFile(const AFileName: string);
+begin
+ if MetadataFileList.IndexOf(AFileName) = -1 then
+ MetadataFileList.Add(AFileName);
+end;
+
+procedure LoadMetadatas(const AFileName: string);
+var
+ Model: TInstantModel;
+ I: Integer;
+ ClassMetadata: TInstantClassMetadata;
+begin
+ if not FileExists(AFileName)then
+ raise EInstantError.CreateFmt('Model unit metadata file [%s] not found!',
+ [AFileName])
+ else
+ begin
+ Model := TInstantModel.Create;
+ try
+ Model.LoadFromFile(AFileName);
+ for I := 0 to Pred(Model.ClassMetadatas.Count) do
+ begin
+ if not Assigned(InstantModel.ClassMetadatas.Find(Model.ClassMetadatas[I].Name)) then
+ begin
+ ClassMetadata := InstantModel.ClassMetadatas.Add;
+ ClassMetadata.Assign(Model.ClassMetadatas[I]);
+ end
+ else
+ raise EInstantError.CreateFmt('Duplicate class [%s] in unit metadata file [%s]!',
+ [Model.ClassMetadatas[I].Name, AFileName]);
+ end;
+ InstantRegisterMetadataFile(AFileName);
+ finally
+ Model.Free;
+ end;
+ end;
+end;
+
{ TInstantGraphic }
class function TInstantGraphic.AttributeType: TInstantAttributeType;
@@ -8962,6 +9016,7 @@
TInstantAttributeMetadatas, TInstantAttributeMetadata,
TInstantObjectReference, TInstantConnectionDefs, TInstantConnectionDef]);
ClassList := TList.Create;
+ MetadataFileList := TStringList.Create;
{$IFDEF MSWINDOWS}
GraphicClassList[gffIco] := Graphics.TIcon;
GraphicClassList[gffBmp] := Graphics.TBitmap;
@@ -8976,11 +9031,11 @@
GraphicClassList[gffJpeg]:= QGraphics.TBitmap;
{$ENDIF}
ConnectorClasses := TList.Create;
- LoadClassMetadatas;
ObjectNotifiers := TInstantObjectNotifiers.Create;
finalization
ClassList.Free;
+ MetadataFileList.Free;
ConnectorClasses.Free;
RuntimeModel.Free;
ObjectNotifiers.Free;
Modified: branches/MetadataInXMLDev/Source/Core/InstantPresentation.pas
===================================================================
--- branches/MetadataInXMLDev/Source/Core/InstantPresentation.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Source/Core/InstantPresentation.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -367,7 +367,11 @@
protected
{ IProviderSupport }
procedure PSGetAttributes(List: TList); override;
+ {$IFNDEF D10+}
function PSGetTableName: string; override;
+ {$ELSE}
+ function PSGetTableNameW: WideString; override;
+ {$ENDIF}
procedure PSReset; override;
protected
procedure AddClassFieldDefs(const FieldName: string; AClass: TClass); overload;
@@ -3748,10 +3752,17 @@
begin
end;
+{$IFNDEF D10+}
function TInstantCustomExposer.PSGetTableName: string;
begin
Result := ObjectClassName;
end;
+{$ELSE}
+function TInstantCustomExposer.PSGetTableNameW: WideString;
+begin
+ Result := ObjectClassName;
+end;
+{$ENDIF}
procedure TInstantCustomExposer.PSReset;
begin
Modified: branches/MetadataInXMLDev/Source/Design/InstantModelExpert.pas
===================================================================
--- branches/MetadataInXMLDev/Source/Design/InstantModelExpert.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Source/Design/InstantModelExpert.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -87,6 +87,7 @@
FUpdateTimer: TTimer;
MetaDataCheckState : TIOMetaDataCheckState;
MetaDataCheckUnits : string;
+ function EditorModified(Module: IOTAModule): Boolean;
procedure ExplorerApplyClass(Sender: TObject; AClass: TInstantCodeClass;
ChangeInfo: TInstantCodeClassChangeInfo);
procedure ExplorerGotoSource(Sender: TObject; const FileName: string;
@@ -100,11 +101,13 @@
function GetIsDirty: Boolean;
function GetName: string;
function GetState: TWizardState;
+ function ModelFileModified(const FileName: string): Boolean;
+ function ModuleModified(Module: IOTAModule): Boolean;
procedure SetIsDirty(const Value: Boolean);
protected
procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
- procedure AccessModelUnits(Project: IOTAProject; Units: TStrings;
- Write: Boolean);
+ procedure AccessModelUnits(Project: IOTAProject; Units: TStrings; Write:
+ Boolean; RemovedUnits: TStrings = nil);
procedure AddToolError(const FileName, Msg: string; Line, Column: Integer);
procedure AddToolMessage(const FileName, Msg, Prefix: string; Line, Column: Integer);
procedure AddToolText(const Text: string);
@@ -122,6 +125,7 @@
procedure CheckIOMetadataKeyword(const FileName, Source: string);
procedure ExplorerItemClick(Sender: TObject);
procedure GetModelModules(Modules: TInterfaceList);
+ procedure GetModelUnits(Project: IOTAProject; Units: TStrings);
procedure IDEAfterCompilation(Sender: TObject; Succeeded: Boolean);
procedure IDEBeforeCompilation(Sender: TObject; Project: IOTAProject;
IsCodeInsight: Boolean; var Cancel: Boolean);
@@ -135,6 +139,8 @@
function IsProjectUnit(FileName: string): Boolean;
function IsModelUnit(FileName: string): Boolean;
procedure ShowExplorer;
+ procedure TagModelUnits(Project: IOTAProject; Units: TStrings; RemovedUnits:
+ TStrings);
procedure UpdateModel;
procedure UpdateTimerTick(Sender: TObject);
property CurrentSource: string read GetCurrentSource;
@@ -148,8 +154,8 @@
ChangeInfo: TInstantCodeClassChangeInfo);
procedure BuildDatabase(CodeModel: TInstantCodeModel);
procedure Execute;
- function LoadModel(Model: TInstantCodeModel; Project: IOTAProject = nil;
- CheckTime: TDateTime = 0): Boolean;
+ function LoadModel(Model: TInstantCodeModel; Project: IOTAProject = nil; Force:
+ Boolean = True): Boolean;
procedure SelectUnits;
function UpdateEnabled: Boolean;
procedure UpdateModelUnits;
@@ -175,7 +181,7 @@
SExplorerItemCaption = 'InstantObjects &Model Explorer';
SExplorerItemName = 'InstantExplorerItem';
SModelCompiler = 'Model Compiler';
- SResFileExt = '.mdr';
+ SResFileExt = '.irs';
UpdateInterval = 500;
procedure ReaderIdle(Reader: TInstantCodeReader; var Continue: Boolean);
@@ -250,150 +256,15 @@
{ TInstantModelExpert}
-procedure TInstantModelExpert.AccessModelUnits(Project: IOTAProject;
- Units: TStrings; Write: Boolean);
-const
-
- ModelTag = #10'{$R *' + SResFileExt + '}';
- ResourceTag = #10'{$R *.res}';
-
- function ListToStr(List: TStrings): string;
- var
- I: Integer;
- S: string;
- begin
- S := '';
- for I := 0 to Pred(List.Count) do
- begin
- Result := Result + S + List[I];
- S := ', ' + sLineBreak + ' ';
- end;
- end;
-
- function FindModelDef(const Source: string; out ModelDef: string;
- var Line, Column: Integer): Integer;
- var
- I: Integer;
- begin
- Result := 1;
- if FindText(ModelTag, Source, Result, Line, Column) then
- begin
- I := Result + Length(ModelTag);
- while I <= Length(Source) do
- begin
- case Source[I] of
- ' ': Inc(I);
- '{':
- while I < Length(Source) do
- begin
- Inc(I);
- if Source[I] = '}' then
- begin
- ModelDef := Copy(Source, Result, I - Result + 1);
- Exit;
- end;
- end;
- else
- Break;
- end;
- end;
- ModelDef := Copy(Source, Result, Length(ModelTag));
- end else
- Result := 0;
- end;
-
- function RemoveBrackets(const Str: string): string;
- begin
- Result := Trim(Str);
- if (Length(Result) > 0) and (Result[1] = '{') then
- Delete(Result, 1, 1);
- if (Length(Result) > 0) and (Result[Length(Result)] = '}') then
- Delete(Result, Length(Result), 1);
- Result := Trim(Result);
- end;
-
- procedure WriteUses(var Source: string; UnitNames: array of string;
- Include: Boolean);
- var
- UsesClause: TInstantCodeUsesClause;
- UsesItem: TInstantCodeUses;
- Found: Boolean;
- I: Integer;
- S: string;
- begin
- with TInstantCodeModifier.Create(Source, nil) do
- try
- if Module.ModuleType = mtProgram then
- begin
- UsesClause := Module.ProgramSection.FindUsesClause;
- if Assigned(UsesClause) and (UsesClause.Count > 0) then
- begin
- Found := False;
- for I := Low(UnitNames) to High(UnitNames) do
- begin
- UsesItem := UsesClause.Find(UnitNames[I]);
- Found := Assigned(UsesItem);
- if Found then
- begin
- if not Include then
- begin
- EraseObject(UsesItem);
- if NextChar = ',' then
- DeleteText(1);
- CloseGap;
- end else
- Break;
- end;
- end;
- if Include and not Found then
- begin
- CursorPos := UsesClause[0].StartPos;
- InsertMode := imBefore;
- S := '';
- for I := Low(UnitNames) to High(UnitNames) do
- S := S + UnitNames[I] + ','#10' ';
- InsertText(S);
- end;
- end;
- end;
- finally
- Free;
- end;
- end;
-
-var
- Editor: IOTASourceEditor;
- Source: string;
- Pos, Line, Column, SourceLen: Integer;
- CurModelDef, NewModelDef: string;
+procedure TInstantModelExpert.AccessModelUnits(Project: IOTAProject; Units:
+ TStrings; Write: Boolean; RemovedUnits: TStrings = nil);
begin
- Editor := FIDEInterface.SourceEditor(Project);
- Source := FIDEInterface.ReadEditorSource(Editor);
- Pos := FindModelDef(Source, CurModelDef, Line, Column);
- if Write then
+ if Assigned(Project) then
begin
- SourceLen := Length(Source);
- if Units.Count > 0 then
- NewModelDef := Format('%s {%s}', [ModelTag, ListToStr(Units)])
+ if Write then
+ TagModelUnits(Project, Units, RemovedUnits)
else
- NewModelDef := '';
- if CurModelDef = NewModelDef then
- Exit
- else if Pos > 0 then
- Delete(Source, Pos, Length(CurModelDef))
- else if not FindText(ResourceTag, Source, Pos, Line, Column) then
- Exit
- else
- Inc(Pos, Length(ResourceTag));
- Insert(NewModelDef, Source, Pos);
- FIDEInterface.WriteEditorSource(Editor, Source, SourceLen);
- end else if Pos > 0 then
- begin
- Delete(CurModelDef, 1, Length(ModelTag));
- CurModelDef := RemoveBrackets(CurModelDef);
- if CurModelDef = '' then
- AddToolError(Editor.FileName, 'No model units specified', Line, Column);
- InstantStrToList(CurModelDef, Units, [',']);
+ GetModelUnits(Project, Units);
end;
end;
@@ -616,35 +487,70 @@
end;
procedure TInstantModelExpert.CompileProject(Project: IOTAProject);
+
+ procedure ReadModel(AModel: TInstantCodeModel; AModule: IOTAModule);
+ var
+ Editor: IOTASourceEditor;
+ Source: string;
+ Stream: TStringStream;
+ begin
+ Editor := FIDEInterface.SourceEditor(AModule);
+ Source := FIDEInterface.ReadEditorSource(Editor);
+ Stream := TStringStream.Create(Source);
+ try
+ AModel.LoadModule(Stream, Editor.FileName);
+ finally
+ Stream.Free;
+ end;
+ end;
+
var
Model: TInstantCodeModel;
ResFileName: string;
+ {$IFNDEF D10+}
ResFileAge: Integer;
- ResFileTime: TDateTime;
+ {$ENDIF}
+ Modules: TInterfaceList;
+ I: Integer;
+ Module: IOTAModule;
+
begin
DisableUpdate;
- Model := TInstantCodeModel.Create;
+ Modules := TInterfaceList.Create;
try
- ResFileName := ChangeFileExt(Project.FileName, SResFileExt);
- ResFileAge := FileAge(ResFileName);
- if ResFileAge = -1 then
- ResFileTime := 0 else
- ResFileTime := FileDateToDateTime(ResFileAge);
+ GetModelModules(Modules);
+ if Modules.Count = 0 then
+ Exit;
+
+ Model := TInstantCodeModel.Create;
try
- if LoadModel(Model, Project, ResFileTime) then
- Model.SaveToResFile(ResFileName);
- except
- on E: EInstantCodeError do
+ try
+ for I := 0 to Pred(Modules.Count) do
begin
- AddToolError(E.FileName, E.Message, E.Position.Line,
- E.Position.Column);
- Abort;
- end
- else
- raise;
+ Module := Modules[I] as IOTAModule;
+ if ModuleModified(Module) then
+ begin
+ ReadModel(Model, Module);
+ ResFileName := ChangeFileExt(Module.FileName, SResFileExt);
+ Model.SaveToFile(ResFileName);
+ end;
+ Model.Clear;
+ end;
+ except
+ on E: EInstantCodeError do
+ begin
+ AddToolError(E.FileName, E.Message, E.Position.Line,
+ E.Position.Column);
+ Abort;
+ end
+ else
+ raise;
+ end;
+ finally
+ Model.Free;
end;
finally
- Model.Free;
+ Modules.Free;
EnableUpdate;
end;
end;
@@ -953,42 +859,18 @@
end;
end;
-function TInstantModelExpert.LoadModel(Model: TInstantCodeModel;
- Project: IOTAProject; CheckTime: TDateTime): Boolean;
+function TInstantModelExpert.LoadModel(Model: TInstantCodeModel; Project:
+ IOTAProject = nil; Force: Boolean = True): Boolean;
- function EditorModified(Module: IOTAModule): Boolean;
+ function ModulesModified(Modules: TInterfaceList): Boolean;
var
- Editor: IOTASourceEditor;
- begin
- Editor := FIDEInterface.SourceEditor(Module);
- Result := Editor.Modified;
- end;
-
- function FileModified(const FileName: string; Since: TDateTime): Boolean;
- var
- Age: Integer;
- begin
- Age := FileAge(FileName);
- if Age = -1 then
- Result := False
- else
- Result := FileDateToDateTime(Age) > Since;
- end;
-
- function ModuleModified(Module: IOTAModule; Since: TDateTime): Boolean;
- begin
- Result := EditorModified(Module) or FileModified(Module.FileName, Since);
- end;
-
- function ModulesModified(Modules: TInterfaceList; Since: TDateTime): Boolean;
- var
I: Integer;
Module: IOTAModule;
begin
for I := 0 to Pred(Modules.Count) do
begin
Module := Modules[I] as IOTAModule;
- Result := ModuleModified(Module, Since);
+ Result := ModuleModified(Module);
if Result then
Exit;
end;
@@ -1041,9 +923,9 @@
'%s'+sLineBreak+'Please refer to IOMETADATA_keyword.txt in instantobjects\doc folder.',
[FActiveProjectName, MetadataCheckUnits]), mtWarning, [mbOK], 0);
end;
- Result := (CheckTime = 0) or
- ModuleModified(Project, CheckTime) or
- ModulesModified(Modules, CheckTime);
+ Result := Force or
+ EditorModified(Project as IOTAModule) or
+ ModulesModified(Modules);
if Result then
ReadModel(Modules);
finally
@@ -1085,22 +967,25 @@
var
Project: IOTAProject;
- ModelUnits, OtherUnits: TStringList;
+ ModelUnits, OtherUnits, RemovedUnits: TStringList;
begin
if not Assigned(FIDEInterface.ProjectGroup) then
Exit;
ModelUnits := TStringList.Create;
OtherUnits := TStringList.Create;
+ RemovedUnits := TStringList.Create;
try
Project := ActiveProject;
AccessModelUnits(Project, ModelUnits, False);
+ RemovedUnits.AddStrings(ModelUnits);
GetUnitNames(Project, OtherUnits);
SubtractList(OtherUnits, ModelUnits);
with TInstantUnitSelectForm.Create(nil) do
try
if Execute(ModelUnits, OtherUnits) then
begin
- AccessModelUnits(Project, ModelUnits, True);
+ SubtractList(RemovedUnits, ModelUnits);
+ AccessModelUnits(Project, ModelUnits, True, RemovedUnits);
UpdateModel;
end;
finally
@@ -1109,6 +994,7 @@
finally
ModelUnits.Free;
OtherUnits.Free;
+ RemovedUnits.Free;
end;
end;
@@ -1206,4 +1092,264 @@
end;
end;
+function TInstantModelExpert.EditorModified(Module: IOTAModule): Boolean;
+var
+ Editor: IOTASourceEditor;
+begin
+ Editor := FIDEInterface.SourceEditor(Module);
+ Result := Editor.Modified;
+end;
+
+procedure TInstantModelExpert.GetModelUnits(Project: IOTAProject; Units:
+ TStrings);
+
+ function HasModelUnitTag(const ASource: string): Boolean;
+ var
+ Pos, Line, Column: Integer;
+ Str, SubStr: string;
+ begin
+ Result := False;
+ if ASource = '' then
+ Exit;
+
+ Pos := 1;
+ Str := ASource;
+ if FindText(InstantUnitTag, Str, Pos, Line, Column) and
+ (Column = Length(InstantUnitTag) + 1) then
+ begin
+ while not (Str[Pos] in [#10, #13]) do
+ Inc(Pos);
+ SubStr := Copy(Str, Pos + Length(sLineBreak), Length(InstantModelUnitTag));
+ Result := SameText(SubStr, InstantModelUnitTag);
+ end;
+ end;
+
+var
+ I: Integer;
+ ModuleInfo: IOTAModuleInfo;
+ Source: string;
+begin
+ for I := 0 to Pred(Project.GetModuleCount) do
+ begin
+ ModuleInfo := Project.GetModule(I);
+ if (ModuleInfo.ModuleType = omtForm) and
+ (ModuleInfo.FileName <> '') then
+ begin
+ Source := FIDEInterface.ReadModuleSource(ModuleInfo.OpenModule);
+ if HasModelUnitTag(Source) then
+ begin
+ Units.Add(ModuleInfo.Name);
+ end;
+ end;
+ end;
+end;
+
+// function FileModified(const FileName: string; Since: TDateTime): Boolean;
+// var
+// {$IFDEF D10+}
+// ResFileTime: TDateTime;
+// {$ELSE}
+// Age: Integer;
+// {$ENDIF}
+// begin
+// {$IFDEF D10+}
+// if not FileAge(FileName, ResFileTime) then
+// Result := False
+// else
+// Result := ResFileTime > Since;;
+// {$ELSE}
+// Age := FileAge(ResFileName);
+// if Age = -1 then
+// Result := False
+// else
+// Result := FileDateToDateTime(Age) > Since;
+// {$ENDIF}
+// end;
+//
+function TInstantModelExpert.ModelFileModified(const FileName: string): Boolean;
+var
+ ResFileName: string;
+{$IFDEF D10+}
+ ResFileTime: TDateTime;
+ ModuleFileTime: TDateTime;
+{$ELSE}
+ FileAge: Integer;
+{$ENDIF}
+begin
+ ResFileName := ChangeFileExt(FileName, SResFileExt);
+ {$IFDEF D10+}
+ if not FileAge(FileName, ModuleFileTime) then
+ Result := False
+ else if not FileAge(ResFileName, ResFileTime) then
+ Result := True
+ else
+ Result := ModuleFileTime > ResFileTime;
+ {$ELSE}
+ ResFileAge := FileAge(ResFileName);
+ if ResFileAge = -1 then
+ ResFileTime := 0
+ else
+ ResFileTime := FileDateToDateTime(ResFileAge);
+
+ FileAge := FileAge(FileName);
+ if FileAge = -1 then
+ Result := False
+ else
+ begin
+ ResFileAge := FileAge(ResFileName);
+ if ResFileAge = -1 then
+ Result := True
+ else
+ begin
+ ResFileTime := FileDateToDateTime(ResFileAge);
+ Result := FileDateToDateTime(FileAge) > ResFileTime;
+ end;
+ end;
+ {$ENDIF}
+end;
+
+function TInstantModelExpert.ModuleModified(Module: IOTAModule): Boolean;
+begin
+ Result := EditorModified(Module) or ModelFileModified(Module.FileName);
+end;
+
+procedure TInstantModelExpert.TagModelUnits(Project: IOTAProject; Units:
+ TStrings; RemovedUnits: TStrings);
+
+ function RemoveOldModelDef(Project: IOTAProject): Boolean;
+ const
+ OldModelTag = #10'{$R *.mdr}';
+ var
+ Editor: IOTASourceEditor;
+ Source: string;
+ Pos, Line, Column, SourceLen: Integer;
+ I: Integer;
+ begin
+ Result := False;
+ Editor := FIDEInterface.SourceEditor(Project);
+ Source := FIDEInterface.ReadEditorSource(Editor);
+ Pos := 1;
+ if FindText(OldModelTag, Source, Pos, Line, Column) then
+ begin
+ SourceLen := Length(Source);
+ I := Pos + Length(OldModelTag);
+ if Source[Pos-1] = #13 then
+ Dec(Pos);
+ while I <= Length(Source) do
+ begin
+ case Source[I] of
+ ' ': Inc(I);
+ '{':
+ while I < Length(Source) do
+ begin
+ Inc(I);
+ if Source[I] = '}' then
+ begin
+ Delete(Source, Pos, I - Pos + 1);
+ FIDEInterface.WriteEditorSource(Editor, Source, SourceLen);
+ Result := True;
+ Exit;
+ end;
+ end;
+ else
+ Break;
+ end;
+ end;
+ end;
+ end;
+
+ procedure CheckModelUnitTag(Editor: IOTASourceEditor; var ASource: string;
+ Required: Boolean);
+ begin
+ with TInstantCodeModifier.Create(ASource, nil) do
+ try
+ UpdateModelUnitTag(ChangeFileExt(ExtractFileName(Editor.Module.FileName),
+ SResFileExt), Required);
+ finally
+ Free;
+ end;
+ end;
+
+ procedure CheckLoadMetadatas(Editor: IOTASourceEditor; var ASource: string;
+ Required: Boolean);
+ begin
+ with TInstantCodeModifier.Create(ASource, nil) do
+ try
+ UpdateLoadMetadatas(ChangeFileExt(ExtractFileName(Editor.Module.FileName),
+ SResFileExt), Required);
+ finally
+ Free;
+ end;
+ end;
+
+ procedure UpdateEditorSource(Editor: IOTASourceEditor; const ASource: string;
+ ReplaceLen: Integer);
+ begin
+ DisableUpdate;
+ try
+ FIDEInterface.WriteEditorSource(Editor, ASource, ReplaceLen);
+ finally
+ EnableUpdate;
+ end;
+ end;
+
+ procedure CheckModelUnit(var ASource: string; Editor: IOTASourceEditor;
+ Required: Boolean);
+ var
+ Pos, Line, Column, SrcLen: Integer;
+ begin
+ if ASource = '' then
+ Exit;
+
+ Pos := 1;
+ SrcLen := Length(ASource);
+ if FindText(InstantUnitTag, ASource, Pos, Line, Column) and
+ (Column = Length(InstantUnitTag) + 1) then
+ begin
+ CheckModelUnitTag(Editor, ASource, Required);
+ CheckLoadMetadatas(Editor, ASource, Required);
+ UpdateEditorSource(Editor, ASource, SrcLen);
+ end;
+ end;
+
+var
+ I: Integer;
+ Editor: IOTASourceEditor;
+ Modules: TInterfaceList;
+ Module: IOTAModule;
+ Source: string;
+begin
+ if (Units.Count = 0) and (RemovedUnits.Count = 0) then
+ Exit;
+
+ RemoveOldModelDef(Project);
+
+ Modules := TInterfaceList.Create;
+ try
+ CollectModules(Project, Modules, Units);
+ for I := 0 to Pred(Modules.Count) do
+ begin
+ Module := Modules[I] as IOTAModule;
+ Editor := FIDEInterface.SourceEditor(Module);
+ Source := FIDEInterface.ReadEditorSource(Editor);
+ CheckModelUnit(Source, Editor, True);
+ end;
+
+ if RemovedUnits.Count > 0 then
+ begin
+ Modules.Clear;
+ CollectModules(Project, Modules, RemovedUnits);
+ for I := 0 to Pred(Modules.Count) do
+ begin
+ Module := Modules[I] as IOTAModule;
+ Editor := FIDEInterface.SourceEditor(Module);
+ Source := FIDEInterface.ReadEditorSource(Editor);
+ CheckModelUnit(Source, Editor, False);
+ end;
+ end;
+ finally
+ Modules.Free;
+ end;
+end;
+
end.
Modified: branches/MetadataInXMLDev/Tests/TestIO.dpr
===================================================================
--- branches/MetadataInXMLDev/Tests/TestIO.dpr 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestIO.dpr 2007-01-15 06:18:23 UTC (rev 748)
@@ -57,7 +57,6 @@
TestInstantObjectReference in 'TestInstantObjectReference.pas';
{$R *.res}
-{$R *.mdr} {TestModel}
begin
Application.Initialize;
Deleted: branches/MetadataInXMLDev/Tests/TestIO.mdr
===================================================================
(Binary files differ)
Modified: branches/MetadataInXMLDev/Tests/TestInstantAttribute.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantAttribute.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantAttribute.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -65,9 +65,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TContact.Create(FConn);
FInstantAttribute := FOwner._Name;
Modified: branches/MetadataInXMLDev/Tests/TestInstantBlob.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantBlob.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantBlob.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -66,9 +66,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TPerson.Create(FConn);
FInstantBlob := FOwner._Picture;
Modified: branches/MetadataInXMLDev/Tests/TestInstantBoolean.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantBoolean.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantBoolean.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -70,9 +70,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TPerson.Create(FConn);
FInstantBoolean := FOwner._Employed;
Modified: branches/MetadataInXMLDev/Tests/TestInstantCache.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantCache.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantCache.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -63,10 +63,8 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
+ LoadModelFromFiles;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
FInstantCache := TInstantCache.Create;
end;
Modified: branches/MetadataInXMLDev/Tests/TestInstantCircularReferences.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantCircularReferences.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantCircularReferences.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -106,9 +106,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FCompany := TCompany.Create(FConn);
end;
Modified: branches/MetadataInXMLDev/Tests/TestInstantClassMetadata.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantClassMetadata.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantClassMetadata.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -81,9 +81,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
// Load a default ClassMetadata
FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TContact');
end;
@@ -159,7 +157,7 @@
procedure TestTInstantClassMetadata.TestParentName;
begin
- AssertEquals('', FInstantClassMetadata.ParentName);
+ AssertEquals('TInstantObject', FInstantClassMetadata.ParentName);
FInstantClassMetadata := InstantModel.ClassMetadatas.Find('TPerson');
AssertEquals('TContact', FInstantClassMetadata.ParentName);
@@ -212,9 +210,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FInstantClassMetadatas := InstantModel.ClassMetadatas;
end;
Modified: branches/MetadataInXMLDev/Tests/TestInstantComplex.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantComplex.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantComplex.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -63,9 +63,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TContact.Create(FConn);
FInstantComplex := FOwner._Address;
Modified: branches/MetadataInXMLDev/Tests/TestInstantCurrency.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantCurrency.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantCurrency.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -67,9 +67,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TPerson.Create(FConn);
FInstantCurrency := FOwner._Salary;
Modified: branches/MetadataInXMLDev/Tests/TestInstantDate.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantDate.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantDate.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -72,9 +72,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TPerson.Create(FConn);
FInstantDate := FOwner._EmploymentDate;
Modified: branches/MetadataInXMLDev/Tests/TestInstantDateTime.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantDateTime.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantDateTime.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -72,9 +72,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TPerson.Create(FConn);
FInstantDateTime := FOwner._BirthDate;
Modified: branches/MetadataInXMLDev/Tests/TestInstantFloat.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantFloat.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantFloat.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -65,9 +65,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TPerson.Create(FConn);
FInstantFloat := FOwner._AL_hours;
Modified: branches/MetadataInXMLDev/Tests/TestInstantInteger.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantInteger.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantInteger.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -65,9 +65,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TCompany.Create(FConn);
FInstantInteger := FOwner._NoOfBranches;
Modified: branches/MetadataInXMLDev/Tests/TestInstantNumeric.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantNumeric.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantNumeric.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -62,9 +62,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TCompany.Create(FConn);
FInstantNumeric := FOwner._NoOfBranches;
Modified: branches/MetadataInXMLDev/Tests/TestInstantObject.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantObject.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantObject.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -94,10 +94,8 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
+ LoadModelFromFiles;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
vInstantClassMetadata := InstantModel.ClassMetadatas.Find('TPerson');
vInstantClassMetadata.DefaultContainerName := 'Emails';
FInstantObject := TPerson.Create(FConn);
Modified: branches/MetadataInXMLDev/Tests/TestInstantObjectReference.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantObjectReference.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantObjectReference.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -70,9 +70,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FInstantObject := TCompany.Create(FConn);
FInstantReferences := FInstantObject._Employees;
Modified: branches/MetadataInXMLDev/Tests/TestInstantObjectStore.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantObjectStore.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantObjectStore.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -71,9 +71,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockCRBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FInstantObjectStore := FConn.EnsureObjectStore(TPerson);
AssertNotNull(FInstantObjectStore);
@@ -189,9 +187,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FInstantObjectStores := FConn.ObjectStores;
FConn.EnsureObjectStore(TPerson);
Modified: branches/MetadataInXMLDev/Tests/TestInstantPart.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantPart.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantPart.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -87,9 +87,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TContact.Create(FConn);
FInstantPart := FOwner._Address;
@@ -281,9 +279,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TContact.Create(FConn);
FInstantPart := FOwner._ExternalAddress;
Modified: branches/MetadataInXMLDev/Tests/TestInstantParts.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantParts.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantParts.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -121,9 +121,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TContact.Create(FConn);
FInstantParts := FOwner._ExternalPhones;
@@ -387,9 +385,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TContact.Create(FConn);
FInstantParts := FOwner._Phones;
@@ -616,9 +612,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TContact.Create(FConn);
end;
Modified: branches/MetadataInXMLDev/Tests/TestInstantReference.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantReference.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantReference.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -68,9 +68,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TContact.Create(FConn);
FInstantReference := FOwner._Category;
Modified: branches/MetadataInXMLDev/Tests/TestInstantReferences.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantReferences.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantReferences.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -121,9 +121,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TCompany.Create(FConn);
FInstantReferences := FOwner._Employees;
@@ -432,9 +430,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TCompany.Create(FConn);
FInstantReferences := FOwner._Projects;
Modified: branches/MetadataInXMLDev/Tests/TestInstantScheme.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantScheme.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantScheme.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -58,9 +58,7 @@
procedure TestTInstantScheme.SetUp;
begin
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FInstantScheme := TInstantScheme.Create;
FInstantScheme.Catalog := TInstantModelCatalog.Create(FInstantScheme, InstantModel);
Modified: branches/MetadataInXMLDev/Tests/TestInstantString.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantString.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantString.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -70,9 +70,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TContact.Create(FConn);
FInstantString := FOwner._Name;
Modified: branches/MetadataInXMLDev/Tests/TestInstantTableMetadata.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantTableMetadata.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantTableMetadata.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -70,9 +70,7 @@
procedure TestTInstantTableMetadata.SetUp;
begin
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TInstantScheme.Create;
FOwner.Catalog := TInstantModelCatalog.Create(FOwner, InstantModel);
Modified: branches/MetadataInXMLDev/Tests/TestInstantTime.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestInstantTime.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestInstantTime.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -72,9 +72,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
FOwner := TPerson.Create(FConn);
FInstantTime := FOwner._BirthTime;
Modified: branches/MetadataInXMLDev/Tests/TestMockBroker.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestMockBroker.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestMockBroker.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -176,9 +176,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
end;
procedure TTestMockBroker.TearDown;
@@ -194,9 +192,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockCRBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
end;
procedure TTestMockRelationalBroker.TearDown;
Modified: branches/MetadataInXMLDev/Tests/TestMockConnector.pas
===================================================================
--- branches/MetadataInXMLDev/Tests/TestMockConnector.pas 2007-01-15 05:12:20 UTC (rev 747)
+++ branches/MetadataInXMLDev/Tests/TestMockConnector.pas 2007-01-15 06:18:23 UTC (rev 748)
@@ -60,9 +60,7 @@
FConn := TInstantMockConnector.Create(nil);
FConn.BrokerClass := TInstantMockBroker;
- if InstantModel.ClassMetadatas.Count > 0 then
- InstantModel.ClassMetadatas.Clear;
- InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+ LoadModelFromFiles;
end;
procedure TTestMockConnector.TearDown;
Added: branches/MetadataInXMLDev/Tests/TestModel.irs
===================================================================
--- branches/MetadataInXMLDev/Tests/TestModel.irs (rev 0)
+++ branches/MetadataInXMLDev/Tests/TestModel.irs 2007-01-15 06:18:23 UTC (rev 748)
@@ -0,0 +1 @@
+<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><ParentName>TInstantObject</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><ParentName>TInstantObject</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><ParentName>TInstantObject</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><ParentName>TInstantObject</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCategory</Name><ParentName>TInstantObject</ParentName><Persistence>peStored</Persistence><StorageName>Categories</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><ParentName>TInstantObject</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsInd...
[truncated message content] |
|
From: <sr...@us...> - 2007-01-15 05:12:29
|
Revision: 747
http://svn.sourceforge.net/instantobjects/revision/?rev=747&view=rev
Author: srmitch
Date: 2007-01-14 21:12:20 -0800 (Sun, 14 Jan 2007)
Log Message:
-----------
- Creating a development branch from instantobjects/trunk.
Added Paths:
-----------
branches/MetadataInXMLDev/
Copied: branches/MetadataInXMLDev (from rev 746, trunk)
|
|
From: <sr...@us...> - 2006-12-24 01:13:43
|
Revision: 746
http://svn.sourceforge.net/instantobjects/revision/?rev=746&view=rev
Author: srmitch
Date: 2006-12-23 17:13:39 -0800 (Sat, 23 Dec 2006)
Log Message:
-----------
- Fix for SF Bug #1620637 - TInstantReferences.HasItem(Index) incorrect implementation.
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2006-12-22 05:13:59 UTC (rev 745)
+++ trunk/Source/Core/InstantPersistence.pas 2006-12-24 01:13:39 UTC (rev 746)
@@ -4975,7 +4975,7 @@
function TInstantReferences.GetInstances(Index: Integer): TInstantObject;
begin
- Result := ObjectReferenceList[Index];
+ Result := RefItems[Index].Instance;
end;
function TInstantReferences.GetObjectReferenceList: TInstantObjectReferenceList;
|
|
From: <sr...@us...> - 2006-12-22 05:14:01
|
Revision: 745
http://svn.sourceforge.net/instantobjects/revision/?rev=745&view=rev
Author: srmitch
Date: 2006-12-21 21:13:59 -0800 (Thu, 21 Dec 2006)
Log Message:
-----------
Remove obsolete branch.
Removed Paths:
-------------
branches/Refactor_InstantPersistenceUnit/
|
|
From: <sr...@us...> - 2006-12-22 04:28:35
|
Revision: 744
http://svn.sourceforge.net/instantobjects/revision/?rev=744&view=rev
Author: srmitch
Date: 2006-12-21 20:28:30 -0800 (Thu, 21 Dec 2006)
Log Message:
-----------
- Update to trunk r743.
Modified Paths:
--------------
branches/EnsureObjectsDev/Demos/PrimerCross/DemoData.pas
branches/EnsureObjectsDev/Demos/PrimerCross/Model/Model.pas
branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas
branches/EnsureObjectsDev/Demos/PrimerCross/PersonEdit.dfm
branches/EnsureObjectsDev/Demos/PrimerCross/PersonEdit.pas
branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADO.pas
branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADOConnectionDefEdit.dfm
branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADOConnectionDefEdit.pas
branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDE.pas
branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDECatalog.pas
branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDEConnectionDefEdit.pas
branches/EnsureObjectsDev/Source/Brokers/DBX/InstantDBX.pas
branches/EnsureObjectsDev/Source/Brokers/IBX/InstantIBX.pas
branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDB.pas
branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDBCatalog.pas
branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.pas
branches/EnsureObjectsDev/Source/Brokers/UIB/InstantUIB.pas
branches/EnsureObjectsDev/Source/Brokers/XML/InstantXML.pas
branches/EnsureObjectsDev/Source/Catalogs/IBFb/InstantIBFbCatalog.pas
branches/EnsureObjectsDev/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas
branches/EnsureObjectsDev/Source/Core/InstantBrokers.pas
branches/EnsureObjectsDev/Source/Core/InstantCode.pas
branches/EnsureObjectsDev/Source/Core/InstantMetadata.pas
branches/EnsureObjectsDev/Source/Core/InstantPersistence.pas
branches/EnsureObjectsDev/Source/Core/InstantPresentation.pas
branches/EnsureObjectsDev/Source/Core/InstantTypes.pas
branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.pas
branches/EnsureObjectsDev/Source/Design/InstantModelExplorer.pas
branches/EnsureObjectsDev/Source/ObjectFoundry/OFClassRegWizard.pas
branches/EnsureObjectsDev/Source/ObjectFoundry/OFClasses.pas
branches/EnsureObjectsDev/Source/ObjectFoundry/OFCritic.pas
branches/EnsureObjectsDev/Source/ObjectFoundry/OFDefs.pas
branches/EnsureObjectsDev/Source/ObjectFoundry/OFExpert.pas
branches/EnsureObjectsDev/Source/ObjectFoundry/OFNotify.pas
branches/EnsureObjectsDev/Source/ObjectFoundry/OFOptions.pas
branches/EnsureObjectsDev/Source/ObjectFoundry/OFReg.pas
branches/EnsureObjectsDev/Source/ObjectFoundry/OFUtils.pas
branches/EnsureObjectsDev/Tests/TestIO.dpr
branches/EnsureObjectsDev/Tests/TestInstantDateTime.pas
branches/EnsureObjectsDev/Tests/TestModel.pas
Added Paths:
-----------
branches/EnsureObjectsDev/Docs/InstantDate-InstantTime Release Notes.txt
branches/EnsureObjectsDev/Docs/InterBase_DataTypes.html
branches/EnsureObjectsDev/Docs/ObjectFoundry_readme.txt
branches/EnsureObjectsDev/Source/ObjectFoundry/ObjectFoundry.inc
branches/EnsureObjectsDev/Tests/TestInstantDate.pas
branches/EnsureObjectsDev/Tests/TestInstantTime.pas
Removed Paths:
-------------
branches/EnsureObjectsDev/Source/ObjectFoundry/OF_readme.txt
Modified: branches/EnsureObjectsDev/Demos/PrimerCross/DemoData.pas
===================================================================
--- branches/EnsureObjectsDev/Demos/PrimerCross/DemoData.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Demos/PrimerCross/DemoData.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -184,6 +184,7 @@
Gender := TGender(Random(2));
Result.Name := RandomFullName(Gender);
Result.BirthDate := Date - (20 * 365 + Random(365 * 50)); // 20 - 70 years old
+ Result.BirthTime := Random;
Result.Address := CreateRandomAddress;
// Result.Salary := 922337203685470;
Result.Salary := 500 + Random(5000);
Modified: branches/EnsureObjectsDev/Demos/PrimerCross/Model/Model.pas
===================================================================
--- branches/EnsureObjectsDev/Demos/PrimerCross/Model/Model.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Demos/PrimerCross/Model/Model.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -8,7 +8,7 @@
interface
uses
- InstantPersistence;
+ InstantPersistence, InstantTypes;
type
TAddress = class;
@@ -21,6 +21,7 @@
TPerson = class;
TPhone = class;
+
TAddress = class(TInstantObject)
{IOMETADATA City: String(30) index;
Country: Reference(TCountry);
@@ -164,25 +165,29 @@
TPerson = class(TContact)
{IOMETADATA stored;
- BirthDate: DateTime;
Emails: Parts(TEmail);
Employer: Reference(TCompany);
Picture: Graphic;
- Salary: Currency; }
- _BirthDate: TInstantDateTime;
+ Salary: Currency;
+ BirthDate: Date;
+ BirthTime: Time; }
+ _BirthDate: TInstantDate;
+ _BirthTime: TInstantTime;
_Emails: TInstantParts;
_Employer: TInstantReference;
_Picture: TInstantGraphic;
_Salary: TInstantCurrency;
private
- function GetBirthDate: TDateTime;
+ function GetBirthDate: TDate;
+ function GetBirthTime: TTime;
function GetEmailCount: Integer;
function GetEmails(Index: Integer): TEmail;
function GetEmployer: TCompany;
function GetMainEmailAddress: string;
function GetPicture: string;
function GetSalary: Currency;
- procedure SetBirthDate(Value: TDateTime);
+ procedure SetBirthDate(Value: TDate);
+ procedure SetBirthTime(Value: TTime);
procedure SetEmails(Index: Integer; Value: TEmail);
procedure SetMainEmailAddress(const Value: string);
procedure SetPicture(const Value: string);
@@ -200,7 +205,8 @@
property EmailCount: Integer read GetEmailCount;
property Emails[Index: Integer]: TEmail read GetEmails write SetEmails;
published
- property BirthDate: TDateTime read GetBirthDate write SetBirthDate;
+ property BirthDate: TDate read GetBirthDate write SetBirthDate;
+ property BirthTime: TTime read GetBirthTime write SetBirthTime;
property Employer: TCompany read GetEmployer;
property MainEmailAddress: string read GetMainEmailAddress write SetMainEmailAddress;
property Picture: string read GetPicture write SetPicture;
@@ -390,11 +396,16 @@
end;
end;
-function TPerson.GetBirthDate: TDateTime;
+function TPerson.GetBirthDate: TDate;
begin
Result := _BirthDate.Value;
end;
+function TPerson.GetBirthTime: TTime;
+begin
+ Result := _BirthTime.Value;
+end;
+
function TPerson.GetEmailCount: Integer;
begin
Result := _Emails.Count
@@ -443,11 +454,16 @@
Result := _Emails.Remove(Email);
end;
-procedure TPerson.SetBirthDate(Value: TDateTime);
+procedure TPerson.SetBirthDate(Value: TDate);
begin
_BirthDate.Value := Value;
end;
+procedure TPerson.SetBirthTime(Value: TTime);
+begin
+ _BirthTime.Value := Value;
+end;
+
procedure TPerson.SetEmails(Index: Integer; Value: TEmail);
begin
_Emails[Index] := Value;
Modified: branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas
===================================================================
--- branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -8,7 +8,7 @@
interface
uses
- InstantPersistence;
+ InstantPersistence, InstantTypes;
type
TAddress = class;
@@ -167,25 +167,29 @@
TPerson = class(TContact)
{IOMETADATA stored ensureobjects;
- BirthDate: DateTime;
Emails: Parts(TEmail) external 'Person_Emails';
Employer: Reference(TCompany);
Picture: Graphic;
- Salary: Currency; }
- _BirthDate: TInstantDateTime;
+ Salary: Currency;
+ BirthDate: Date;
+ BirthTime: Time; }
+ _BirthDate: TInstantDate;
+ _BirthTime: TInstantTime;
_Emails: TInstantParts;
_Employer: TInstantReference;
_Picture: TInstantGraphic;
_Salary: TInstantCurrency;
private
- function GetBirthDate: TDateTime;
+ function GetBirthDate: TDate;
+ function GetBirthTime: TTime;
function GetEmailCount: Integer;
function GetEmails(Index: Integer): TEmail;
function GetEmployer: TCompany;
function GetMainEmailAddress: string;
function GetPicture: string;
function GetSalary: Currency;
- procedure SetBirthDate(Value: TDateTime);
+ procedure SetBirthDate(Value: TDate);
+ procedure SetBirthTime(Value: TTime);
procedure SetEmails(Index: Integer; Value: TEmail);
procedure SetMainEmailAddress(const Value: string);
procedure SetPicture(const Value: string);
@@ -203,7 +207,8 @@
property EmailCount: Integer read GetEmailCount;
property Emails[Index: Integer]: TEmail read GetEmails write SetEmails;
published
- property BirthDate: TDateTime read GetBirthDate write SetBirthDate;
+ property BirthDate: TDate read GetBirthDate write SetBirthDate;
+ property BirthTime: TTime read GetBirthTime write SetBirthTime;
property Employer: TCompany read GetEmployer;
property MainEmailAddress: string read GetMainEmailAddress write SetMainEmailAddress;
property Picture: string read GetPicture write SetPicture;
@@ -393,11 +398,16 @@
end;
end;
-function TPerson.GetBirthDate: TDateTime;
+function TPerson.GetBirthDate: TDate;
begin
Result := _BirthDate.Value;
end;
+function TPerson.GetBirthTime: TTime;
+begin
+ Result := _BirthTime.Value;
+end;
+
function TPerson.GetEmailCount: Integer;
begin
Result := _Emails.Count;
@@ -446,11 +456,16 @@
Result := _Emails.Remove(Email);
end;
-procedure TPerson.SetBirthDate(Value: TDateTime);
+procedure TPerson.SetBirthDate(Value: TDate);
begin
_BirthDate.Value := Value;
end;
+procedure TPerson.SetBirthTime(Value: TTime);
+begin
+ _BirthTime.Value := Value;
+end;
+
procedure TPerson.SetEmails(Index: Integer; Value: TEmail);
begin
_Emails[Index] := Value;
Modified: branches/EnsureObjectsDev/Demos/PrimerCross/PersonEdit.dfm
===================================================================
--- branches/EnsureObjectsDev/Demos/PrimerCross/PersonEdit.dfm 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Demos/PrimerCross/PersonEdit.dfm 2006-12-22 04:28:30 UTC (rev 744)
@@ -59,7 +59,15 @@
Height = 13
Caption = 'Sa&lary'
end
- object PicturePanel: TPanel [13]
+ object Label1: TLabel [13]
+ Left = 136
+ Top = 264
+ Width = 44
+ Height = 13
+ Caption = 'BirthTime'
+ FocusControl = BirthTimeEdit
+ end
+ object PicturePanel: TPanel [14]
Left = 332
Top = 203
Width = 76
@@ -95,7 +103,7 @@
Visible = True
end>
end
- object BirthDateEdit: TDBEdit [20]
+ object BirthDateEdit: TDBEdit [21]
Left = 136
Top = 200
Width = 73
@@ -104,7 +112,7 @@
DataSource = SubjectSource
TabOrder = 7
end
- object EmployerEdit: TDBEdit [21]
+ object EmployerEdit: TDBEdit [22]
Left = 8
Top = 240
Width = 129
@@ -114,7 +122,7 @@
ReadOnly = True
TabOrder = 8
end
- object EmailsGrid: TDBGrid [22]
+ object EmailsGrid: TDBGrid [23]
Left = 240
Top = 120
Width = 169
@@ -135,7 +143,7 @@
Visible = True
end>
end
- object EmployerToolBar: TToolBar [23]
+ object EmployerToolBar: TToolBar [24]
Left = 140
Top = 237
Width = 69
@@ -175,7 +183,7 @@
OnClick = EmployerClearButtonClick
end
end
- object PictureButton: TButton [24]
+ object PictureButton: TButton [25]
Left = 240
Top = 246
Width = 81
@@ -187,7 +195,7 @@
object SalaryEdit: TDBEdit
Left = 8
Top = 280
- Width = 153
+ Width = 121
Height = 21
DataField = 'Salary'
DataSource = SubjectSource
@@ -202,6 +210,15 @@
TabOrder = 15
OnClick = ClearButtonClick
end
+ object BirthTimeEdit: TDBEdit
+ Left = 136
+ Top = 280
+ Width = 81
+ Height = 21
+ DataField = 'BirthTime'
+ DataSource = SubjectSource
+ TabOrder = 16
+ end
end
end
end
Modified: branches/EnsureObjectsDev/Demos/PrimerCross/PersonEdit.pas
===================================================================
--- branches/EnsureObjectsDev/Demos/PrimerCross/PersonEdit.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Demos/PrimerCross/PersonEdit.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -41,6 +41,8 @@
PicturePanel: TPanel;
PictureImage: TImage;
ClearButton: TButton;
+ Label1: TLabel;
+ BirthTimeEdit: TDBEdit;
procedure EmployerClearButtonClick(Sender: TObject);
procedure EmployerEditButtonClick(Sender: TObject);
procedure EmployerLookupButtonClick(Sender: TObject);
Added: branches/EnsureObjectsDev/Docs/InstantDate-InstantTime Release Notes.txt
===================================================================
--- branches/EnsureObjectsDev/Docs/InstantDate-InstantTime Release Notes.txt (rev 0)
+++ branches/EnsureObjectsDev/Docs/InstantDate-InstantTime Release Notes.txt 2006-12-22 04:28:30 UTC (rev 744)
@@ -0,0 +1,122 @@
+---------- InstantDate InstantTime Release Notes -----------------
+Summary of Changes for Support of InstantDate and InstantTime Data types.
+
+Requirements
+---------------------------------
+1. Must completely rebuild IO.
+2. Must add InstantTypes to Interface Uses class of the model unit(s). if you want to use the new datatypes.
+
+InstantType.pas defines:
+TDate = class(TDateTime);
+TTime = class(TDateTime);
+The Model Explorer has been modified to automatically or (auto-magically) add the Interface uses clause of your model file(s) with InstantType and the Implementation uses clause with InstantMetadata when you edit your model.
+
+Files affected :
+Core Files modified:
+---------------------------------
+InstantBrokers.pas
+InstantClasses.pas
+InstantCode.pas
+InstantMetadata.pas
+InstantPersistence.pas
+InstantPresentation.pas
+InstantTypes.pas
+
+
+Tests Files Modified (* new files)
+---------------------------------
+* TestInstantDate.pas
+TestInstantDateTime.pas
+* TestInstantTime.pas
+TestIO.dpr
+TestIO.mdr
+TestModel.pas
+
+Document files (Docs Directory)
+--------------------------------
+* InstantDateInstantTime_Releasenotes.txt (this document)
+
+Demos - PrimerCross (Birthtime attribute added to TPerson and random Birthtimes are generated)
+---------------------------------
+DemoData.pas
+PersonEdit.dfm
+PersonEdit.pas
+Primer.mdr
+PrimerExternal.mdr
+Model/model.pas
+ModelExternal/model.pas
+
+Brokers (Note: I only modified the files for the standard set of Brokers which are build in RunTimePackages.bpg).
+---------------------------------
+InstantADO.pas
+InstantBDE.pas
+InstantDBX.pas
+InstantIBX.pas
+
+Note: The following brokers will also need to be modified.
+InstantADS.pas
+InstantDBISAM.pas
+InstantFlashFiler.pas
+InstantNexusDB.pas
+InstantUIB.pas
+InstantZeosDBO.pas
+
+Catalogs
+---------------------------------
+InstantBDECatalog.pas
+InstantIBFbCatalog.pas
+InstantMSSqlCatalog.pas
+
+Note: (AFIK InstantXML.pas does not need to be modified)
+
+Note:
+All brokers and catalogs must be modified to account for the two new data types. All standard brokers have been modified to map SQL datatypes for Date and Time. The default is to use DATETIME/TIMESTAMP for Date and Time Datatypes in SQL Brokers. The update has made this modification to all of the standard brokers and catalogs, but you should double check to be sure. If you have your own customized broker/catalog or you are using one of the brokers which is not part of the standard build, you will have to make similar changes as shown in the below mapping between SQL Datatypes and InstantDatatypes:
+
+function TInstantBDECatalog.ColumnTypeToDataType(const ColumnType: TFieldType;
+ out DataType: TInstantDataType): Boolean;
+begin
+ Result := True;
+ case ColumnType of
+ ftString: DataType := dtString;
+ ftSmallint,
+ ftInteger: DataType := dtInteger;
+ ftBoolean: DataType := dtBoolean;
+ ftFloat: DataType := dtFloat;
+ ftCurrency: DataType := dtCurrency;
+ ftDate: DataType := dtDate; // <- Map Date Fields
+ ftTime: DataType := dtTime; // <-- Map Time Fields
+ ftDateTime: DataType := dtDateTime;
+ ftAutoInc: DataType := dtInteger;
+ ftBlob,
+ ftGraphic: DataType := dtBlob;
+ ftMemo: DataType := dtMemo;
+ else
+ Result := False;
+ end;
+end;
+
+function TInstantADOMSSQLBroker.DataTypeToColumnType(
+ DataType: TInstantDataType; Size: Integer): string;
+const
+ Types: array[TInstantDataType] of string = (
+ 'INTEGER',
+ 'FLOAT',
+ 'MONEY',
+ 'BIT',
+ 'VARCHAR',
+ 'TEXT',
+ 'DATETIME',
+ 'IMAGE',
+ 'DATETIME', // <- Map Date Fields
+ 'DATETIME'); // <- Map Time Fields
+begin
+ Result := Types[DataType];
+ if (DataType = dtString) and (Size > 0) then
+ Result := Result + InstantEmbrace(IntToStr(Size), '()');
+end;
+
+I haved removed the following that were contained in my uploads to the repository ng.
+
+1. ACR - Accuracer
+2. DBX - Support for ASA-SqlAnyWhere (and it's Catalog 'InstantASACatalog.pas')
+3. SDAC - Corelab SQL Server Data Access Components
Property changes on: branches/EnsureObjectsDev/Docs/InstantDate-InstantTime Release Notes.txt
___________________________________________________________________
Name: svn:eol-style
+ native
Added: branches/EnsureObjectsDev/Docs/InterBase_DataTypes.html
===================================================================
--- branches/EnsureObjectsDev/Docs/InterBase_DataTypes.html (rev 0)
+++ branches/EnsureObjectsDev/Docs/InterBase_DataTypes.html 2006-12-22 04:28:30 UTC (rev 744)
@@ -0,0 +1,802 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+ <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=windows-1252">
+ <TITLE></TITLE>
+ <META NAME="GENERATOR" CONTENT="OpenOffice.org 2.0 (Win32)">
+ <META NAME="CREATED" CONTENT="20061127;22314800">
+ <META NAME="CHANGED" CONTENT="16010101;12000000">
+ <STYLE>
+ <!--
+ @page { size: 29.7cm 21cm; margin-left: 2cm; margin-right: 2cm; margin-top: 1.7cm; margin-bottom: 1.7cm }
+ P { margin-bottom: 0.21cm; direction: ltr; color: #000000; widows: 0; orphans: 0 }
+ P.western { font-family: "Times New Roman", serif; font-size: 12pt; so-language: en-US }
+ P.cjk { font-family: "Arial Unicode MS", sans-serif; font-size: 12pt; so-language: }
+ P.ctl { font-family: "Tahoma"; font-size: 12pt; so-language: }
+ TD P { margin-bottom: 0cm; direction: ltr; color: #000000; widows: 0; orphans: 0 }
+ TD P.western { font-family: "Times New Roman", serif; font-size: 12pt; so-language: en-US }
+ TD P.cjk { font-family: "Arial Unicode MS", sans-serif; font-size: 12pt; so-language: }
+ TD P.ctl { font-family: "Tahoma"; font-size: 12pt; so-language: }
+ -->
+ </STYLE>
+</HEAD>
+<BODY LANG="en-US" TEXT="#000000" DIR="LTR">
+<P CLASS="western"><FONT SIZE=4><B>InterBase / Firebird Data Types and Instant
+Objects</B></FONT></P>
+<TABLE WIDTH=960 BORDER=1 BORDERCOLOR="#000000" CELLPADDING=4 CELLSPACING=0>
+ <COL WIDTH=132>
+ <COL WIDTH=102>
+ <COL WIDTH=117>
+ <COL WIDTH=60>
+ <COL WIDTH=56>
+ <COL WIDTH=63>
+ <COL WIDTH=58>
+ <COL WIDTH=60>
+ <COL WIDTH=60>
+ <COL WIDTH=180>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western"><B>IB/Fb Data Type</B></P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western"><B>RDB$FIELDS definition (1)</B></P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT><B>RDB$TYPES description (2)</B></P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER><B>IB 4</B></P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER><B>IB 5.x</B></P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER><B>IB 6.0</B></P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER><B>IB6.5</B></P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER><B>IB7.x</B></P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER><B>Fb2.0</B></P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western"><B>Mapped to IO Data Type</B></P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">SMALLINT</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">7</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>SHORT</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">Boolean</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">INTEGER</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">8</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>LONG</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">Integer</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">QUAD</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">9</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>QUAD</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">n/a</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">FLOAT</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">10</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>FLOAT</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">Float</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">D_FLOAT</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">11</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>-</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">n/a</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">DATE (3)</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">12</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>DATE</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">Date</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">TIME</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">13</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>TIME</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">Time</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">CHAR</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">14</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>TEXT</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">String</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">INT64 (4)</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">16</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>-</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">Currency</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">BOOLEAN</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">17</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>-</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">n/a</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">DOUBLE</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">27</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>DOUBLE</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">Float</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">TIMESTAMP (3)</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">35</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>TIMESTAMP</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">DateTime</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">VARCHAR</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">37</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>VARYING</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">String</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">CSTRING</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">40</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>CSTRING</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">n/a</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">BLOB_ID</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">45</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>BLOB_ID</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>N</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">n/a</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=132>
+ <P CLASS="western">BLOB (4)</P>
+ </TD>
+ <TD WIDTH=102>
+ <P CLASS="western">261</P>
+ </TD>
+ <TD WIDTH=117>
+ <P CLASS="western" ALIGN=LEFT>BLOB</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=56>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=63>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=58>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=60>
+ <P CLASS="western" ALIGN=CENTER>Y</P>
+ </TD>
+ <TD WIDTH=180>
+ <P CLASS="western">Memo or Blob</P>
+ </TD>
+ </TR>
+</TABLE>
+<P CLASS="western" STYLE="margin-bottom: 0cm"><BR>
+</P>
+<P CLASS="western" STYLE="margin-bottom: 0cm"><B>Notes:</B></P>
+<OL>
+ <LI><P CLASS="western" STYLE="margin-bottom: 0cm">Data Types used in
+ RDB$FIELDS table to describe column data type</P>
+ <LI><P CLASS="western" STYLE="margin-bottom: 0cm">Some Data Types
+ described in RDB$TYPES table, Note there are no entries for data
+ types 11,16,17 !</P>
+ <LI><P CLASS="western" STYLE="margin-bottom: 0cm">Type 35 changed
+ from DATE to TIMESTAMP in version 6.0</P>
+ <LI><P CLASS="western" STYLE="margin-bottom: 0cm">Sub types defined
+ for BLOB, CHAR, SMALLINT, INTEGER and INT64.</P>
+</OL>
+<P CLASS="western" STYLE="margin-bottom: 0cm">See language reference
+guide (System Tables chapter) for more information.</P>
+<P CLASS="western" STYLE="margin-bottom: 0cm"><BR>
+</P>
+<P CLASS="western" STYLE="margin-bottom: 0cm"><BR>
+</P>
+<P CLASS="western" STYLE="margin-bottom: 0cm"><FONT SIZE=4><B>Mapping
+of Instant Attributes Types to IB/Fb Data Types (via the Instant Data
+Types)</B></FONT></P>
+<P CLASS="western" STYLE="margin-bottom: 0cm"><BR>
+</P>
+<TABLE WIDTH=971 BORDER=1 BORDERCOLOR="#000000" CELLPADDING=4 CELLSPACING=0>
+ <COL WIDTH=282>
+ <COL WIDTH=392>
+ <COL WIDTH=271>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western"><B>TInstantAttributeType</B></P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western"><B>TInstantDataType</B></P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western"><B>Mapping to IB/Fb Data Type</B></P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atUnknown</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtString</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">VARCHAR</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atInteger</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtInteger</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">INTEGER</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atFloat</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtFloat</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">DOUBLE PRECISION</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atCurrency</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtCurrency</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">DECIMAL(14,4)</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atBoolean</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtBoolean</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">SMALLINT'</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atString</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtString</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">VARCHAR</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atDateTime</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtDateTime</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">TIMESTAMP</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atBlob</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtBlob</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">BLOB</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atMemo</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtMemo</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">BLOB SUB_TYPE 1</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atGraphic</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtBlob</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">BLOB</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atPart (embedded only)</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtBlob</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">BLOB</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atReference</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">n/a</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">n/a</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atParts (embedded only)</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtBlob</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">BLOB</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atReferences (embedded only)</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtBlob</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">BLOB</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atDate</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtDate</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">DATE</P>
+ </TD>
+ </TR>
+ <TR VALIGN=TOP>
+ <TD WIDTH=282>
+ <P CLASS="western">atTime</P>
+ </TD>
+ <TD WIDTH=392>
+ <P CLASS="western">dtTime</P>
+ </TD>
+ <TD WIDTH=271>
+ <P CLASS="western">TIME'</P>
+ </TD>
+ </TR>
+</TABLE>
+<P CLASS="western" STYLE="margin-bottom: 0cm"><BR>
+</P>
+</BODY>
+</HTML>
\ No newline at end of file
Added: branches/EnsureObjectsDev/Docs/ObjectFoundry_readme.txt
===================================================================
--- branches/EnsureObjectsDev/Docs/ObjectFoundry_readme.txt (rev 0)
+++ branches/EnsureObjectsDev/Docs/ObjectFoundry_readme.txt 2006-12-22 04:28:30 UTC (rev 744)
@@ -0,0 +1,72 @@
+ObjectFoundry (for IO V2.x) Readme
+by Carlo Wolter/Steven Mitchell - 21 Mar 2005
+Revised by Steven Mitchell: 29 Nov 2006
+
+Introduction
+------------
+This file contains instructions and information for the
+Object Foundry (OF) integration between IO version 2 and
+ModelMaker(c)[http://www.modelmakertools.com].
+
+ModelMaker (MM) is an UML designer integrated with Delphi.
+It can be used also for InstantObject design, provided
+you place the
+ OFExpt.dll
+expert file in the
+ $(ProgramFiles)\ModelMakerTools\ModelMaker\x.x\Experts
+directory. MM detects and loads it during startup and
+"ObjectFoundry enabled" is included on the MM startup splash
+screen. It is also listed in the "Plug in expert manager"
+dialog launched from the Tools/Expert Manager menu option
+in MM.
+
+Currently MM versions 6 to 9 are supported with OF.
+
+Compiling
+---------
+This DLL can be compiled using the project in this directory.
+
+Please take note that the project needs to know where the
+MM Expert files are. Therefore make sure the subdir
+ $(ProgramFiles)\ModelMakerTools\ModelMaker\x.x\Experts
+is in the project options search path
+ (ie Project/Options/Directories-Conditionals/SearchPath).
+This is required because in the MM experts directory there is
+a single file that is needed:
+ MMToolsApi.PAS
+Also ensure that the appropriate compiler defines are entered
+in the project options Conditional defines (see table below).
+(ie Project/Options/Directories-Conditionals/Conditional defines)
+
+ MM Version Define
+ ---------- ------
+ 6.x [none]
+ 7.x or 8.x MM7+
+ 9.x MM9
+
+Note: The MMToolsApi.PAS file is protected by copyright of
+ModelMakerTools and cannot be put into CVS. Every legitimate
+owner of a MM licence, though, should have no problems in
+finding it.
+
+Notes on Usage
+--------------
+To operate correctly, this version of OF expects and
+generates the IO Metadata identifier tag in the class
+metadata info as follows:
+"{IOMETADATA " (without quotes but including trailing space).
+
+Conversion of IO MM projects that did not have the IO
+Metadata identifier tag:
+Make sure that the model is up to date then save and close
+Modelmaker. Backup the MM project file. Backup any previous
+'OFExpt.dll' file and copy the new 'OFExpt.dll' file to the
+{$Modelmaker}\Experts folder as indicated above. Re-open
+Modelmaker. Re-generating the Delphi code from ModelMaker
+should update the model code units to include the new class
+metadata identifier tag.
+
+Feedback
+--------
+Please report any problems to the IO news support group at
+"news.instantobjects.org/instantobjects.org.support".
Property changes on: branches/EnsureObjectsDev/Docs/ObjectFoundry_readme.txt
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADO.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADO.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADO.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -107,9 +107,12 @@
function GetDataSet: TCustomADODataSet;
protected
function CreateDataSet: TDataSet; override;
+ function CreateNavigationalLinkResolver(const ATableName: string):
+ TInstantNavigationalLinkResolver; override;
function Find(const AClassName, AObjectId: string): Boolean;
function Locate(const AClassName, AObjectId: string): Boolean; override;
public
+ function FormatTableName(const ATableName: string): string; virtual;
property Broker: TInstantADOBroker read GetBroker;
property DataSet: TCustomADODataSet read GetDataSet;
end;
@@ -148,6 +151,23 @@
property Connector: TInstantADOConnector read GetConnector;
end;
+ TInstantADOLinkResolver = class(TInstantNavigationalLinkResolver)
+ private
+ function GetBroker: TInstantADOBroker;
+ function GetDataSet: TADODataSet;
+ function GetResolver: TInstantADOResolver;
+ protected
+ function CreateDataSet: TDataSet; override;
+ procedure SetDatasetParentRange(const AParentClass, AParentId: string);
+ override;
+ public
+ constructor Create(AResolver: TInstantNavigationalResolver; const ATableName:
+ string);
+ property Broker: TInstantADOBroker read GetBroker;
+ property DataSet: TADODataSet read GetDataSet;
+ property Resolver: TInstantADOResolver read GetResolver;
+ end;
+
{ MS Jet }
TInstantADOMSJetBroker = class(TInstantADOBroker)
@@ -331,7 +351,9 @@
(adVarChar, adVarWChar, adVarChar, adVarChar, adVarChar, adVarChar), // dtString
(adLongVarChar, adLongVarWChar, adLongVarChar, adVarBinary, adLongVarChar, adLongVarChar), // dtMemo
(adDate, adDate, adDBTimeStamp, adDBTimeStamp, adDate, adDate), // dtDateTime
- (adLongVarBinary, adLongVarBinary, adLongVarBinary, adVarBinary, adLongVarBinary, adLongVarBinary) // dtBlob
+ (adLongVarBinary, adLongVarBinary, adLongVarBinary, adVarBinary, adLongVarBinary, adLongVarBinary), // dtBlob
+ (adDate, adDate, adDBTimeStamp, adDBTimeStamp, adDate, adDate), // dtDate
+ (adDate, adDate, adDBTimeStamp, adDBTimeStamp, adDate, adDate) // dtTime
);
var
Column: _Column;
@@ -447,7 +469,9 @@
'VARCHAR',
'MEMO',
'DATETIME',
- 'BLOB'
+ 'BLOB',
+ 'DATE',
+ 'TIME'
);
begin
Result := Types[DataType];
@@ -467,6 +491,8 @@
Result := 'TEXT';
dtBlob:
Result := 'IMAGE';
+ dtDate, dtDateTime:
+ Result := 'DATETIME';
end;
ptOracle:
case DataType of
@@ -474,7 +500,7 @@
Result := 'CHAR(1)';
dtCurrency:
Result := 'DECIMAL(14,4)';
- dtDateTime:
+ dtDateTime, dtDate, dtTime:
Result := 'DATE';
dtBlob:
Result := 'BLOB';
@@ -485,7 +511,7 @@
case DataType of
dtCurrency:
Result := 'DECIMAL(14,4)';
- dtDateTime:
+ dtDateTime, dtDate, dtTime:
Result := 'TIMESTAMP';
dtBlob:
Result := 'BLOB (1000 K)';
@@ -795,6 +821,12 @@
end;
end;
+function TInstantADOResolver.CreateNavigationalLinkResolver(
+ const ATableName: string): TInstantNavigationalLinkResolver;
+begin
+ Result := TInstantADOLinkResolver.Create(Self, ATableName);
+end;
+
function TInstantADOResolver.Find(const AClassName,
AObjectId: string): Boolean;
var
@@ -837,6 +869,12 @@
end;
end;
+function TInstantADOResolver.FormatTableName(
+ const ATableName: string): string;
+begin
+ Result := TableName;
+end;
+
function TInstantADOResolver.GetBroker: TInstantADOBroker;
begin
Result := inherited Broker as TInstantADOBroker;
@@ -1144,7 +1182,9 @@
'VARCHAR',
'TEXT',
'DATETIME',
- 'IMAGE');
+ 'IMAGE',
+ 'DATETIME',
+ 'DATETIME');
begin
Result := Types[DataType];
if (DataType = dtString) and (Size > 0) then
@@ -1176,6 +1216,50 @@
{ TInstantADOMSSQLQuery }
+{ TInstantADOLinkResolver }
+
+constructor TInstantADOLinkResolver.Create(
+ AResolver: TInstantNavigationalResolver; const ATableName: string);
+begin
+ inherited Create(AResolver, ATableName);
+end;
+
+function TInstantADOLinkResolver.CreateDataSet: TDataSet;
+begin
+ Result:= TADOTable.Create(nil);
+ with TADOTable(Result) do
+ try
+ Connection := Broker.Connector.Connection;
+ TableName := Self.TableName;
+ IndexFieldNames := InstantParentClassFieldName + ';' +
+ InstantParentIdFieldName;
+ except
+ Result.Free;
+ raise;
+ end;
+end;
+
+function TInstantADOLinkResolver.GetBroker: TInstantADOBroker;
+begin
+ Result := inherited Broker as TInstantADOBroker;
+end;
+
+function TInstantADOLinkResolver.GetDataSet: TADODataSet;
+begin
+ Result := inherited DataSet as TADODataSet;
+end;
+
+function TInstantADOLinkResolver.GetResolver: TInstantADOResolver;
+begin
+ Result := inherited Resolver as TInstantADOResolver;
+end;
+
+procedure TInstantADOLinkResolver.SetDatasetParentRange(const AParentClass,
+ AParentId: string);
+begin
+// Dataset.SetRange([AParentClass, AParentId], [AParentClass, AParentId]);
+end;
+
initialization
RegisterClass(TInstantADOConnectionDef);
TInstantADOConnector.RegisterClass;
Modified: branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADOConnectionDefEdit.dfm
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADOConnectionDefEdit.dfm 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADOConnectionDefEdit.dfm 2006-12-22 04:28:30 UTC (rev 744)
@@ -4,7 +4,7 @@
BorderStyle = bsDialog
Caption = 'ADO Connection'
ClientHeight = 242
- ClientWidth = 362
+ ClientWidth = 446
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@@ -19,7 +19,7 @@
object BottomBevel: TBevel
Left = 0
Top = 205
- Width = 362
+ Width = 446
Height = 2
Align = alBottom
Shape = bsBottomLine
@@ -27,7 +27,7 @@
object ClientPanel: TPanel
Left = 0
Top = 0
- Width = 362
+ Width = 446
Height = 205
Align = alClient
BevelOuter = bvNone
@@ -40,6 +40,22 @@
Caption = 'Blob &format'
FocusControl = StreamFormatComboBox
end
+ object Label1: TLabel
+ Left = 134
+ Top = 152
+ Width = 62
+ Height = 13
+ Caption = 'Id Data Type'
+ FocusControl = IdDataTypeComboBox
+ end
+ object Label2: TLabel
+ Left = 259
+ Top = 152
+ Width = 32
+ Height = 13
+ Caption = 'Id Size'
+ FocusControl = IdDataTypeComboBox
+ end
object DataLinkRadioButton: TRadioButton
Left = 16
Top = 16
@@ -97,7 +113,7 @@
object StreamFormatComboBox: TComboBox
Left = 32
Top = 168
- Width = 145
+ Width = 97
Height = 21
Style = csDropDownList
ItemHeight = 13
@@ -112,17 +128,33 @@
Caption = '&Login Prompt'
TabOrder = 6
end
+ object IdDataTypeComboBox: TComboBox
+ Left = 134
+ Top = 168
+ Width = 120
+ Height = 21
+ Style = csDropDownList
+ ItemHeight = 13
+ TabOrder = 8
+ end
+ object IdSizeEdit: TEdit
+ Left = 259
+ Top = 168
+ Width = 42
+ Height = 21
+ TabOrder = 9
+ end
end
object BottomPanel: TPanel
Left = 0
Top = 207
- Width = 362
+ Width = 446
Height = 35
Align = alBottom
BevelOuter = bvNone
TabOrder = 1
object OkButton: TButton
- Left = 204
+ Left = 288
Top = 6
Width = 75
Height = 25
@@ -133,7 +165,7 @@
TabOrder = 0
end
object CancelButton: TButton
- Left = 284
+ Left = 368
Top = 6
Width = 75
Height = 25
Modified: branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADOConnectionDefEdit.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADOConnectionDefEdit.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/ADO/InstantADOConnectionDefEdit.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -24,8 +24,8 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Carlo Barazzetta: blob streaming in XML format (Part, Parts, References)
- * Carlo Barazzetta: Currency and LoginPrompt support
+ * Carlo Barazzetta, Nando Dessena
+ *
* ***** END LICENSE BLOCK ***** *)
unit InstantADOConnectionDefEdit;
@@ -52,6 +52,10 @@
StreamFormatLabel: TLabel;
StreamFormatComboBox: TComboBox;
LoginPromptCheckBox: TCheckBox;
+ Label1: TLabel;
+ IdDataTypeComboBox: TComboBox;
+ Label2: TLabel;
+ IdSizeEdit: TEdit;
procedure ConnectionStringButtonClick(Sender: TObject);
procedure DataLinkButtonClick(Sender: TObject);
procedure DataChanged(Sender: TObject);
@@ -67,10 +71,10 @@
implementation
-{$R *.DFM}
+{$R *.dfm}
uses
- ADODB, InstantPersistence, InstantClasses;
+ ADODB, InstantPersistence, InstantClasses, InstantTypes, InstantConsts;
{ TInstantADOConnDefEditForm }
@@ -94,7 +98,10 @@
procedure TInstantADOConnectionDefEditForm.FormCreate(Sender: TObject);
begin
- AssignInstantStreamFormat(StreamFormatComboBox.Items); //CB
+ AssignInstantStreamFormat(StreamFormatComboBox.Items);
+ AssignInstantDataTypeStrings(IdDataTypeComboBox.Items);
+ IdDataTypeComboBox.ItemIndex := Ord(dtString);
+ IdSizeEdit.Text := IntToStr(InstantDefaultFieldSize);
UpdateControls;
end;
@@ -121,9 +128,10 @@
DataLinkRadioButton.Checked := True;
DataLinkEdit.Text := LinkFileName;
end;
- //CB
StreamFormatComboBox.ItemIndex := Ord(BlobStreamFormat);
LoginPromptCheckBox.Checked := LoginPrompt;
+ IdDataTypeComboBox.ItemIndex := Ord(IdDataType);
+ IdSizeEdit.Text := IntToStr(IdSize);
end;
end;
@@ -136,9 +144,10 @@
ConnectionString := 'FILE NAME=' + DataLinkEdit.Text
else
ConnectionString := ConnectionStringEdit.Text;
- //CB
BlobStreamFormat := TInstantStreamFormat(StreamFormatComboBox.ItemIndex);
LoginPrompt := LoginPromptCheckBox.Checked;
+ IdDataType := TInstantDataType(IdDataTypeComboBox.ItemIndex);
+ IdSize := StrToInt(IdSizeEdit.Text);
end;
end;
Modified: branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDE.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDE.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDE.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -405,7 +405,7 @@
procedure CreateTable(TableMetadata: TInstantTableMetadata);
const
FieldTypes: array[TInstantDataType] of TFieldType =
- (ftInteger, ftFloat, ftBCD, ftBoolean, ftString, ftMemo, ftDateTime, ftBlob);
+ (ftInteger, ftFloat, ftBCD, ftBoolean, ftString, ftMemo, ftDateTime, ftBlob, ftDate, ftTime);
var
I: Integer;
Table: TTable;
@@ -758,7 +758,7 @@
procedure TInstantDBBuildBDEAddTableCommand.InternalExecute;
const
FieldTypes: array[TInstantDataType] of TFieldType =
- (ftInteger, ftFloat, ftCurrency, ftBoolean, ftString, ftMemo, ftDateTime, ftBlob);
+ (ftInteger, ftFloat, ftCurrency, ftBoolean, ftString, ftMemo, ftDateTime, ftBlob, ftDate, ftTime);
var
I: Integer;
Table: TTable;
Modified: branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDECatalog.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDECatalog.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDECatalog.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -171,8 +171,8 @@
ftBoolean: DataType := dtBoolean;
ftFloat: DataType := dtFloat;
ftCurrency: DataType := dtCurrency;
- ftDate,
- ftTime,
+ ftDate: DataType := dtDate;
+ ftTime: DataType := dtTime;
ftDateTime: DataType := dtDateTime;
ftAutoInc: DataType := dtInteger;
ftBlob,
Modified: branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDEConnectionDefEdit.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDEConnectionDefEdit.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/BDE/InstantBDEConnectionDefEdit.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -181,9 +181,11 @@
with DriverComboBox do
ItemIndex := Items.IndexOf(DriverName);
end;
- //CB
StreamFormatComboBox.ItemIndex := Ord(BlobStreamFormat);
LoginPromptCheckBox.Checked := LoginPrompt;
+ IdDataTypeComboBox.ItemIndex := Ord(IdDataType);
+ IdSizeEdit.Text := IntToStr(IdSize);
+
UpdateControls;
ParametersEdit.Text := Parameters;
end;
Modified: branches/EnsureObjectsDev/Source/Brokers/DBX/InstantDBX.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/DBX/InstantDBX.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/DBX/InstantDBX.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -160,6 +160,14 @@
{ MS SQL Server }
+ TInstantDBXMSSQLSQLGenerator = class(TInstantSQLGenerator)
+ protected
+ function InternalGenerateAlterFieldSQL(OldMetadata, NewMetadata: TInstantFieldMetadata): string; override;
+ function InternalGenerateDropFieldSQL(Metadata: TInstantFieldMetadata): string; override;
+ function InternalGenerateDropIndexSQL(Metadata: TInstantIndexMetadata): string; override;
+ function EmbraceIndex(const IndexName: string): string; virtual;
+ end;
+
TInstantDBXMSSQLBroker = class(TInstantDBXBroker)
protected
function CreateCatalog(const AScheme: TInstantScheme): TInstantCatalog; override;
@@ -169,6 +177,8 @@
function GetDBMSName: string; override;
function GetSQLQuote: Char; override;
function InternalCreateQuery: TInstantQuery; override;
+ public
+ class function GeneratorClass: TInstantSQLGeneratorClass; override;
end;
TInstantDBXMSSQLResolver = class(TInstantSQLResolver)
@@ -522,7 +532,9 @@
'VARCHAR',
'BLOB SUB_TYPE 1',
'TIMESTAMP',
- 'BLOB');
+ 'BLOB',
+ 'TIMESTAMP',
+ 'TIMESTAMP');
begin
Result := Types[DataType];
end;
@@ -564,7 +576,9 @@
'VARCHAR',
'TEXT',
'DATETIME',
- 'IMAGE');
+ 'IMAGE',
+ 'DATETIME',
+ 'DATETIME');
begin
Result := Types[DataType];
end;
@@ -581,6 +595,11 @@
Result := TInstantDBXMSSQLResolver.Create(Self, Map);
end;
+class function TInstantDBXMSSQLBroker.GeneratorClass: TInstantSQLGeneratorClass;
+begin
+ Result := TInstantDBXMSSQLSQLGenerator;
+end;
+
function TInstantDBXMSSQLBroker.GetDBMSName: string;
begin
Result := 'MS SQL Server';
@@ -596,6 +615,39 @@
Result := TInstantDBXMSSQLQuery.Create(Connector);
end;
+{ TInstantDBXMSSQLSQLGenerator }
+
+function TInstantDBXMSSQLSQLGenerator.EmbraceIndex(
+ const IndexName: string): string;
+begin
+ Result := InstantEmbrace(IndexName, Delimiters);
+end;
+
+function TInstantDBXMSSQLSQLGenerator.InternalGenerateAlterFieldSQL(
+ OldMetadata, NewMetadata: TInstantFieldMetadata): string;
+begin
+ Result := Format('ALTER TABLE %s ALTER COLUMN %s %s',
+ [EmbraceTable(OldMetadata.TableMetadata.Name),
+ EmbraceField(OldMetadata.Name),
+ Broker.DataTypeToColumnType(NewMetadata.DataType, NewMetadata.Size)]);
+end;
+
+function TInstantDBXMSSQLSQLGenerator.InternalGenerateDropFieldSQL(
+ Metadata: TInstantFieldMetadata): string;
+begin
+ Result := Format('ALTER TABLE %s DROP COLUMN %s',
+ [EmbraceTable(Metadata.TableMetadata.Name),
+ EmbraceField(Metadata.Name)]);
+end;
+
+function TInstantDBXMSSQLSQLGenerator.InternalGenerateDropIndexSQL(
+ Metadata: TInstantIndexMetadata): string;
+begin
+ Result := Format('DROP INDEX %s.%s',
+ [EmbraceTable(Metadata.TableMetadata.Name),
+ EmbraceIndex(Metadata.Name)]);
+end;
+
{ TInstantDBXOracleBroker }
procedure TInstantDBXOracleBroker.AssignParam(SourceParam, TargetParam: TParam);
@@ -621,7 +673,9 @@
'VARCHAR',
'CLOB',
'DATE',
- 'BLOB');
+ 'BLOB',
+ 'DATE',
+ 'DATE');
begin
Result := Types[DataType];
end;
@@ -649,7 +703,9 @@
'VARCHAR',
'CLOB (1000 K)',
'TIMESTAMP',
- 'BLOB (1000 K)');
+ 'BLOB (1000 K)',
+ 'TIMESTAMP',
+ 'TIMESTAMP');
begin
Result := Types[DataType];
end;
@@ -690,7 +746,9 @@
'VARCHAR',
'TEXT',
'DATETIME',
- 'BLOB');
+ 'BLOB',
+ 'DATE',
+ 'TIME');
begin
Result := Types[DataType];
end;
Modified: branches/EnsureObjectsDev/Source/Brokers/IBX/InstantIBX.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/IBX/InstantIBX.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/IBX/InstantIBX.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -426,7 +426,9 @@
'VARCHAR',
'BLOB SUB_TYPE 1',
'TIMESTAMP',
- 'BLOB');
+ 'BLOB',
+ 'DATE',
+ 'TIME');
begin
Result := Types[DataType];
if (DataType = dtString) and (Size > 0) then
Modified: branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDB.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDB.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDB.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -793,7 +793,9 @@
'VARCHAR',
'TEXT',
'DATETIME',
- 'BLOB');
+ 'BLOB',
+ 'DATE',
+ 'TIME');
begin
Result := Types[DataType];
if (DataType = dtString) and (Size > 0) then
@@ -824,7 +826,7 @@
Result := TInstantNexusDBSQLGenerator;
end;
-{ TInstantNexusDBSQLTranslator }
+{ TInstantNexusDBTranslator }
function TInstantNexusDBTranslator.GetDelimiters: string;
begin
Modified: branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDBCatalog.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDBCatalog.pas 2006-12-18 02:19:20 UTC (rev 743)
+++ branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDBCatalog.pas 2006-12-22 04:28:30 UTC (rev 744)
@@ -239,10 +239,12 @@
DataType := dtCurrency
else if SameText(ColumnType, 'Boolean') then
DataType := dtBoolean
- else if SameText(ColumnType, 'DateTime')
- or SameText(ColumnType, 'Date')
- or SameText(ColumnType, 'Time')then
+ else if SameText(ColumnType, 'DateTime') then
DataType := dtDateTime
+ else if SameText(ColumnType, 'DATE') then
+ DataType := dtDate
+ else if SameText(ColumnType, 'TIME')then
+ DataType := dtTime
else if SameText(ColumnType, 'BLOB') then
DataType := dtBlob
else if SameText(ColumnType, 'BLOB Memo') then
@@ -264,10 +266,12 @@
DataType := dtCurrency
else if SameText(ColumnType, 'nxtBoolean') then
DataType := dtBoolean
- else if SameText(ColumnType, 'nxtDateTime')
- or SameText(ColumnType, 'nxtDate')
- or SameText(ColumnType, 'nxtTime')then
+ else if SameText(ColumnType, 'nxtDateTime') then
DataType := dtDateTime
+ else if SameText(ColumnType, 'nxtDate') then
+ DataType := dtDate
+ else if SameText(ColumnType, 'nxtTime')then
+ DataType := dtTime
else if SameText(ColumnType, 'nxtBlob') then
DataType := dtBlob
else if SameText(ColumnType, 'nxtBlobMemo') then
Modified: branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDBEmbeddedConnectionDefEdit.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Brokers/NexusDb/InstantNexusDBEmb...
[truncated message content] |
