Menu
▾
▴
instantobjects-cvscommit
|
From: <sr...@us...> - 2006-11-27 08:09:32
|
Revision: 720
http://svn.sourceforge.net/instantobjects/revision/?rev=720&view=rev
Author: srmitch
Date: 2006-11-27 00:09:29 -0800 (Mon, 27 Nov 2006)
Log Message:
-----------
1. Add an 'EnsureContainerObjects' property to the TInstantObject class. This property, when set to true, will cause all persistent objects referenced in container attributes of instances of this class to be retrieved and instantiated in one process for each container attribute. Container attributes, however, that have their 'EnsureContainerObjects' property (see below) set to true are ignored. The new property will be added to the class metadata so that it can be available at design-time and is persistent;
2. Add a 'Ensure Container Attribute Objects' check box option to the 'Class' page of the Class Editor in the InstantObjects Model Explorer. Add the supporting metadata processing;
3. Add an 'EnsureContainerObjects' property to the TInstantAttribute class. This property, when set to true, will cause all persistent objects referenced in a container attribute to be retrieved and instantiated in one process during the its creation. The new property will be added to the attribute metadata so that it can be available at design-time and is persistent;
4. Add an 'Ensure Container Objects' check box option to the 'Access' page of the Attribute Editor in the InstantObjects Model Explorer. Add the supporting metadata processing;
5. Add an 'EnsureObjects' property to TInstantCustomExposer and publish it in TInstantSelector. Add an 'EnsureObjects' property to TInstantQuery to support the new 'EnsureObjects' property in TInstantSelector;
6. Add several methods to the TInstantBroker and derived/supporting classes to provide the necessary processing for the retrieval and instantiation of multiple persistent objects and/or their container attribute objects. The TInstantBroker public methods are as follows:
- procedure TInstantBroker.RetrieveAllObjects(AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
[Used to instantiate all the objects of AObjectsClass in the persistent store. RetrieveAllObjects passes back the retrieved objects in AObjectIdList, which must be created before calling.]
- procedure TInstantBroker.RetrieveMixedObjects(AObjRefList: TInstantObjectReferenceList);
[Used to instantiate the objects referenced in AObjRefList from the persistent store. RetrieveMixedObjects passes back the retrieved objects in AObjRefList, which must be created and initialised before calling.]
- procedure TInstantBroker.RetrieveObjects(AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
[Used to instantiate the objects of AObjectsClass referenced by their Id in AObjectIdList from the persistent store. RetrieveObjects passes back the retrieved objects in AObjectIdList, which must be created and initialised before calling.]
Modified Paths:
--------------
branches/EnsureObjectsDev/Demos/PrimerCross/MainData.dfm
branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.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/Design/InstantAttributeEditor.dfm
branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.pas
branches/EnsureObjectsDev/Source/Design/InstantClassEditor.dfm
branches/EnsureObjectsDev/Source/Design/InstantClassEditor.pas
branches/EnsureObjectsDev/Tests/TestInstantAttribute.pas
branches/EnsureObjectsDev/Tests/TestInstantAttributeMetadata.pas
branches/EnsureObjectsDev/Tests/TestInstantClassMetadata.pas
branches/EnsureObjectsDev/Tests/TestInstantObject.pas
branches/EnsureObjectsDev/Tests/TestMinimalModel.pas
Added Paths:
-----------
branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt
Modified: branches/EnsureObjectsDev/Demos/PrimerCross/MainData.dfm
===================================================================
--- branches/EnsureObjectsDev/Demos/PrimerCross/MainData.dfm 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Demos/PrimerCross/MainData.dfm 2006-11-27 08:09:29 UTC (rev 720)
@@ -8,6 +8,7 @@
FieldOptions = [foObjects, foThorough]
Sorted = True
OnCompare = CountrySelectorCompare
+ EnsureObjects = True
Command.Strings = (
'SELECT * FROM TCountry')
Left = 40
@@ -22,6 +23,7 @@
FieldOptions = [foObjects, foThorough]
Sorted = True
OnCompare = CategorySelectorCompare
+ EnsureObjects = True
Command.Strings = (
'SELECT * FROM TCategory')
Left = 136
Modified: branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas
===================================================================
--- branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Demos/PrimerCross/ModelExternal/Model.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -166,7 +166,7 @@
end;
TPerson = class(TContact)
- {IOMETADATA stored;
+ {IOMETADATA stored ensureobjects;
BirthDate: DateTime;
Emails: Parts(TEmail) external 'Person_Emails';
Employer: Reference(TCompany);
@@ -211,7 +211,7 @@
end;
TCompany = class(TContact)
- {IOMETADATA stored;
+ {IOMETADATA stored ensureobjects;
Employees: References(TPerson) external 'Company_Employees'; }
_Employees: TInstantReferences;
private
Added: branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt
===================================================================
--- branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt (rev 0)
+++ branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt 2006-11-27 08:09:29 UTC (rev 720)
@@ -0,0 +1,42 @@
+RFC: IO-002
+Title: EnsureObjects Performance Enhancement Option
+Author: Steven Mitchell
+First Draft: 27 Nov 2006
+Current Revision: 0, 27 Nov 2006
+
+= Goal =
+
+Currently all object retrievals from the persistence store (eg database) in the IO framework is done individually for each persistent object and each of its container attribute objects. Employing such a 'lazy load' philosophy has both advantages and disadvantages. One of the disadvantages can be the numerous round trips to the persistence store to load a list of objects. This can cause noticeable delays and network traffic when connecting to remote persistence stores. Options in the IO framework to allow the retrieval and instantiation of multiple persistent objects would be helpful to reduce these problems.
+
+= Proposal =
+
+To provide run-time and design-time options within the IO framework to allow the retrieval and instantiation of multiple persistent objects and/or their container attribute objects as follows:
+
+1. Add an 'EnsureContainerObjects' property to the TInstantObject class. This property, when set to true, will cause all persistent objects referenced in container attributes of instances of this class to be retrieved and instantiated in one process for each container attribute. Container attributes, however, that have their 'EnsureContainerObjects' property (see below) set to true are ignored. The new property will be added to the class metadata so that it can be available at design-time and is persistent;
+
+2. Add a 'Ensure Container Attribute Objects' check box option to the 'Class' page of the Class Editor in the InstantObjects Model Explorer. Add the supporting metadata processing;
+
+3. Add an 'EnsureContainerObjects' property to the TInstantAttribute class. This property, when set to true, will cause all persistent objects referenced in a container attribute to be retrieved and instantiated in one process during the its creation. The new property will be added to the attribute metadata so that it can be available at design-time and is persistent;
+
+4. Add an 'Ensure Container Objects' check box option to the 'Access' page of the Attribute Editor in the InstantObjects Model Explorer. Add the supporting metadata processing;
+
+5. Add an 'EnsureObjects' property to TInstantCustomExposer and publish it in TInstantSelector. Add an 'EnsureObjects' property to TInstantQuery to support the new 'EnsureObjects' property in TInstantSelector;
+
+6. Add several methods to the TInstantBroker and derived/supporting classes to provide the necessary processing for the retrieval and instantiation of multiple persistent objects and/or their container attribute objects. The TInstantBroker public methods are as follows:
+
+- procedure TInstantBroker.RetrieveAllObjects(AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
+[Used to instantiate all the objects of AObjectsClass in the persistent store. RetrieveAllObjects passes back the retrieved objects in AObjectIdList, which must be created before calling.]
+
+- procedure TInstantBroker.RetrieveMixedObjects(AObjRefList: TInstantObjectReferenceList);
+[Used to instantiate the objects referenced in AObjRefList from the persistent store. RetrieveMixedObjects passes back the retrieved objects in AObjRefList, which must be created and initialised before calling.]
+
+- procedure TInstantBroker.RetrieveObjects(AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
+[Used to instantiate the objects of AObjectsClass referenced by their Id in AObjectIdList from the persistent store. RetrieveObjects passes back the retrieved objects in AObjectIdList, which must be created and initialised before calling.]
+
+= Use =
+
+NOTE: Initially only implemented when using SQL based brokers. Use with other brokers will raise exceptions.
+
+At design-time use InstantObjects Model Explorer to 'ensure the attributes' of the class or its individual container attributes as desired.
+
+At run-time use the broker methods passing in an appropriately created list. Use a TInstantQuery (TInstantSQLQuery only implemented initially) and set its 'EnsureObjects' property to true before opening it.
Property changes on: branches/EnsureObjectsDev/Docs/[RFC]_IO-002_EnsureObjects_Performance_Enhancement_Option.txt
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: branches/EnsureObjectsDev/Source/Core/InstantBrokers.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantBrokers.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantBrokers.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -120,9 +120,15 @@
function GetSQLWildcard: string; virtual;
function InternalDisposeObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; override;
+ procedure InternalRetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
+ procedure InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList); override;
function InternalRetrieveObject(AObject: TInstantObject;
const AObjectId: string; ConflictAction: TInstantConflictAction): Boolean;
override;
+ procedure InternalRetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
function InternalStoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; override;
public
@@ -153,6 +159,12 @@
override;
function FindResolver(const TableName: string):
TInstantNavigationalResolver;
+ procedure InternalRetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
+ procedure InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList); override;
+ procedure InternalRetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
property ResolverCount: Integer read GetResolverCount;
property Resolvers[Index: Integer]: TInstantNavigationalResolver
read GetResolvers;
@@ -182,10 +194,18 @@
virtual;
function CreateDataSet(const AStatement: string; AParams: TParams = nil):
TDataSet; virtual; abstract;
+ procedure InternalRetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
+ procedure InternalRetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); override;
+ procedure InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList); override;
public
destructor Destroy; override;
function AcquireDataSet(const AStatement: string; AParams: TParams = nil):
TDataSet; virtual;
+ procedure CreateObjectsFromDataset(AObjectsClass: TInstantObjectClass;
+ ADataSet: TDataSet; AObjectIdList: TStrings);
procedure ReleaseDataSet(const ADataSet: TDataSet); virtual;
function DataTypeToColumnType(DataType: TInstantDataType;
Size: Integer): string; virtual; abstract;
@@ -668,6 +688,7 @@
function BuildFieldList(Map: TInstantAttributeMap;
Additional: array of string): string; overload;
function BuildFieldList(const S: string): string; overload;
+ function BuildTableQualifiedFieldList(const S, ATableName: string): string;
function BuildParam(const AName: string): string; virtual;
function BuildParamList(Map: TInstantAttributeMap;
Additional: array of string): string;
@@ -705,6 +726,9 @@
string; virtual;
function InternalGenerateSelectExternalPartSQL(Map: TInstantAttributeMap):
string; virtual;
+ function InternalGenerateSelectMultipleQualifiedSQL(Maps:
+ TInstantAttributeMaps; const StatementInParameters: string = ''): string;
+ virtual;
function InternalGenerateSelectTablesSQL: string; virtual;
function InternalGenerateUpdateConcurrentSQL(Map: TInstantAttributeMap):
string; virtual;
@@ -732,6 +756,8 @@
function GenerateSelectSQL(Map: TInstantAttributeMap): string;
function GenerateSelectExternalSQL(Map: TInstantAttributeMap): string;
function GenerateSelectExternalPartSQL(Map: TInstantAttributeMap): string;
+ function GenerateSelectMultipleQualifiedSQL(Maps: TInstantAttributeMaps; const
+ StatementInParameters: string = ''): string;
function GenerateSelectTablesSQL: string;
function GenerateUpdateConcurrentSQL(Map: TInstantAttributeMap): string;
function GenerateUpdateFieldCopySQL(OldMetadata, NewMetadata:
@@ -1088,6 +1114,20 @@
ConflictAction);
end;
+procedure TInstantCustomRelationalBroker.InternalRetrieveAllObjects(
+ AObjectsClass: TInstantObjectClass; AObjectIdList: TStrings);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveAllObjects', ClassName]);
+end;
+
+procedure TInstantCustomRelationalBroker.InternalRetrieveMixedObjects(
+ AObjRefList: TInstantObjectReferenceList);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveMixedObjects', ClassName]);
+end;
+
function TInstantCustomRelationalBroker.InternalRetrieveObject(
AObject: TInstantObject; const AObjectId: string;
ConflictAction: TInstantConflictAction): Boolean;
@@ -1096,6 +1136,13 @@
ConflictAction);
end;
+procedure TInstantCustomRelationalBroker.InternalRetrieveObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveObjects', ClassName]);
+end;
+
function TInstantCustomRelationalBroker.InternalStoreObject(
AObject: TInstantObject; ConflictAction: TInstantConflictAction): Boolean;
begin
@@ -1266,6 +1313,27 @@
Result := ResolverList[Index] as TInstantNavigationalResolver;
end;
+procedure TInstantNavigationalBroker.InternalRetrieveAllObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveAllObjects', ClassName]);
+end;
+
+procedure TInstantNavigationalBroker.InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveMixedObjects', ClassName]);
+end;
+
+procedure TInstantNavigationalBroker.InternalRetrieveObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+begin
+ raise EInstantError.CreateFmt(
+ SMissingImplementation, ['InternalRetrieveObjects', ClassName]);
+end;
+
destructor TInstantSQLBroker.Destroy;
begin
FGenerator.Free;
@@ -1310,6 +1378,92 @@
raise EInstantError.CreateFmt(SMissingImplementation, ['AssignDataSetParams', ClassName]);
end;
+procedure TInstantSQLBroker.CreateObjectsFromDataset(AObjectsClass:
+ TInstantObjectClass; ADataSet: TDataSet; AObjectIdList: TStrings);
+
+ procedure UpdateListWithObject(AObject: TInstantObject;
+ const AObjectId: string);
+ var
+ Idx: Integer;
+ begin
+ Idx := AObjectIdList.IndexOf(AObjectId);
+ if Idx = -1 then
+ begin
+ Idx := AObjectIdList.Add(AObjectId);
+ AObjectIdList.Objects[Idx] := AObject;
+ end
+ else
+ AObjectIdList.Objects[Idx] := AObject;
+ end;
+
+ procedure ResolveAttributesFromDataset(AObject: TInstantObject;
+ const AObjectId: string);
+ var
+ I: Integer;
+ Map: TInstantAttributeMap;
+ begin
+ with AObject.Metadata do
+ begin
+ for I := 0 to Pred(StorageMaps.Count) do
+ begin
+ Map := StorageMaps[I];
+ if Map.IsRootMap then
+ SetObjectUpdateCount(AObject,
+ ADataSet.FieldByName(InstantUpdateCountFieldName).AsInteger);
+ TInstantSQLResolver(EnsureResolver(Map)).ReadAttributes(
+ AObject, AObjectId, Map, ADataset);
+ end;
+ end;
+ end;
+
+var
+ Obj: TInstantObject;
+ ObjStore: TInstantObjectStore;
+ DsId: string;
+ DsWasActive: Boolean;
+ Instance: TInstantObject;
+begin
+ if not Assigned(AObjectIdList) or not Assigned(ADataSet) then
+ Exit;
+
+ DsWasActive := ADataset.Active;
+ if not DsWasActive then
+ ADataset.Open;
+ try
+ ObjStore := Connector.EnsureObjectStore(AObjectsClass);
+ ADataset.First;
+ while not ADataset.Eof do
+ begin
+ DsId := ADataset.FindField(InstantIdFieldName).AsString;
+ Obj := AObjectsClass.Create(Connector);
+ Instance := ObjStore.Find(DsId);
+ if Assigned(Instance) then
+ begin
+ Obj.FreeInstance;
+ Obj := Instance;
+ Obj.AddRef;
+ end
+ else
+ begin
+ Obj.DisableChanges;
+ try
+ ResolveAttributesFromDataset(Obj, DsId);
+ finally
+ Obj.EnableChanges;
+ end;
+ ObjStore.EnsureObject(DsId, Obj);
+ end;
+
+ UpdateListWithObject(Obj, DsId);
+
+ ADataset.Next;
+ end;
+ finally
+ if not DsWasActive then
+ ADataset.Close;
+ end;
+end;
+
function TInstantSQLBroker.EnsureResolver(
AMap: TInstantAttributeMap): TInstantCustomResolver;
begin
@@ -1396,6 +1550,38 @@
end;
end;
+procedure TInstantSQLBroker.InternalRetrieveAllObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+var
+ Params: TParams;
+ Statement: string;
+ Resolver: TInstantSQLResolver;
+ ObjDataset: TDataset;
+ Maps: TInstantAttributeMaps;
+begin
+ if not AObjectsClass.Metadata.IsStored or not Assigned(AObjectIdList) then
+ Exit;
+
+ Maps := AObjectsClass.Metadata.StorageMaps;
+ Statement := Generator.GenerateSelectMultipleQualifiedSQL(Maps);
+ Resolver := TInstantSQLResolver(EnsureResolver(Maps.RootMap));
+
+ Params := TParams.Create;
+ try
+ Resolver.AddParam(Params, InstantClassFieldName, ftString).AsString :=
+ AObjectsClass.ClassName;
+
+ ObjDataset := AcquireDataSet(Statement, Params);
+ try
+ CreateObjectsFromDataset(AObjectsClass, ObjDataset, AObjectIdList);
+ finally
+ ReleaseDataSet(ObjDataset);
+ end;
+ finally
+ Params.Free;
+ end;
+end;
+
procedure TInstantSQLBroker.ReleaseDataSet(const ADataSet: TDataSet);
begin
if FStatementCacheCapacity <> 0 then
@@ -1404,6 +1590,123 @@
ADataSet.Free;
end;
+procedure TInstantSQLBroker.InternalRetrieveObjects(AObjectsClass:
+ TInstantObjectClass; AObjectIdList: TStrings);
+var
+ I: Integer;
+ Params: TParams;
+ ObjDataset: TDataset;
+ Resolver: TInstantSQLResolver;
+ Statement, StatementInParameters: String;
+
+begin
+ if not AObjectsClass.Metadata.IsStored or (AObjectIdList.Count = 0) then
+ Exit;
+
+ StatementInParameters := '';
+ for I:=0 to Pred(AObjectIdList.Count) do
+ begin
+ StatementInParameters := StatementInParameters + ':' +
+ InstantIdFieldName + IntToStr(I);
+ if I < Pred(AObjectIdList.Count) then
+ StatementInParameters := StatementInParameters + ', ';
+ end;
+
+ Statement := Generator.GenerateSelectMultipleQualifiedSQL(
+ AObjectsClass.Metadata.StorageMaps, StatementInParameters);
+
+ Resolver := TInstantSQLResolver(
+ EnsureResolver(AObjectsClass.Metadata.StorageMaps.RootMap));
+
+ Params := TParams.Create;
+ try
+ Resolver.AddParam(Params, InstantClassFieldName, ftString).AsString :=
+ AObjectsClass.ClassName;
+ for I := 0 to Pred(AObjectIdList.Count) do
+ begin
+ Resolver.AddIdParam(Params, InstantIdFieldName + IntToStr(I),
+ AObjectIdList[I]);
+ end;
+
+ ObjDataset := AcquireDataSet(Statement, Params);
+ try
+ CreateObjectsFromDataset(AObjectsClass, ObjDataset, AObjectIdList);
+ finally
+ ReleaseDataSet(ObjDataset);
+ end;
+ finally
+ Params.Free;
+ end;
+end;
+
+procedure TInstantSQLBroker.InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList);
+
+ function IsReferencedClassPersistent(AObjRef: TInstantObjectReference):
+ Boolean;
+ begin
+ Result := AObjRef.ObjectClass.Metadata.IsStored;
+ end;
+
+var
+ I: Integer;
+ ClassNameList: TStringList;
+ J: Integer;
+ Idx: Integer;
+ ObjIdList: TStringList;
+ K: Integer;
+ ObjClassName: string;
+ Ref: TInstantObjectReference;
+begin
+ if not Assigned(AObjRefList) or (AObjRefList.Count = 0) then
+ Exit;
+
+ ClassNameList := TStringList.Create;
+ try
+ for I := 0 to Pred(AObjRefList.Count) do
+ begin
+ Ref := AObjRefList.RefItems[I];
+ ObjClassName := Ref.ObjectClassName;
+ Idx := ClassNameList.IndexOf(ObjClassName);
+ if (Idx = -1) and IsReferencedClassPersistent(Ref) then
+ ClassNameList.Add(ObjClassName);
+ end;
+
+ for I := 0 to Pred(ClassNameList.Count) do
+ begin
+ ObjIdList := TStringList.Create;
+ try
+ for J := 0 to Pred(AObjRefList.Count) do
+ if AObjRefList.RefItems[J].ObjectClassName = ClassNameList[I] then
+ begin
+ Idx := ObjIdList.IndexOf(AObjRefList.RefItems[J].ObjectId);
+ if Idx = -1 then
+ ObjIdList.Add(AObjRefList.RefItems[J].ObjectId);
+ end;
+
+ RetrieveObjects(InstantFindClass(ClassNameList[I]), ObjIdList);
+
+ for J := 0 to Pred(ObjIdList.Count) do
+ for K := 0 to Pred(AObjRefList.Count) do
+ if AObjRefList.RefItems[K].Equals(
+ TInstantObject(ObjIdList.Objects[J])) then
+ begin
+ if not AObjRefList.RefItems[K].HasInstance then
+ AObjRefList[K] := TInstantObject(ObjIdList.Objects[J]);
+ if AObjRefList.RefItems[K].OwnsInstance then
+ ObjIdList.Objects[J].Free;
+ Break;
+ end;
+
+ finally
+ ObjIdList.Free;
+ end;
+ end;
+ finally
+ ClassNameList.Free;
+ end;
+end;
+
{ TInstantRelationalConnector }
procedure TInstantRelationalConnector.DoGetDataSet(const CommandText: string;
@@ -4178,6 +4481,29 @@
Result := BuildList(Map, Additional, EmbraceField);
end;
+function TInstantSQLGenerator.BuildTableQualifiedFieldList(const S, ATableName:
+ string): string;
+var
+ I: Integer;
+ List: TStringList;
+begin
+ List := TStringList.Create;
+ try
+ InstantStrToList(S, List, [' ', ',']);
+ Result := '';
+ for I := 0 to Pred(List.Count) do
+ begin
+ if Trim(List[I]) <> '' then
+ Result := Result + InstantEmbrace(ATableName, Broker.SQLDelimiters)
+ + '.' + List[I] + ' , ';
+ end;
+ if Length(Result) > 0 then
+ Delete(Result, Length(Result) - 2, 3);
+ finally
+ List.Free;
+ end;
+end;
+
function TInstantSQLGenerator.BuildList(Map: TInstantAttributeMap;
Additional: array of string; StringFunc: TInstantStringFunc;
const Delimiter: string): string;
@@ -4365,6 +4691,13 @@
Result := InternalGenerateSelectSQL(Map);
end;
+function TInstantSQLGenerator.GenerateSelectMultipleQualifiedSQL(Maps:
+ TInstantAttributeMaps; const StatementInParameters: string = ''): string;
+begin
+ Result := InternalGenerateSelectMultipleQualifiedSQL(Maps,
+ StatementInParameters);
+end;
+
function TInstantSQLGenerator.GenerateSelectTablesSQL: string;
begin
Result := InternalGenerateSelectTablesSQL;
@@ -4587,6 +4920,65 @@
[FieldStr, EmbraceTable(Map.Name), WhereStr]);
end;
+function TInstantSQLGenerator.InternalGenerateSelectMultipleQualifiedSQL(Maps:
+ TInstantAttributeMaps; const StatementInParameters: string = ''): string;
+var
+ FieldStr: string;
+ TableStr: String;
+ Map: TInstantAttributeMap;
+ WhereStr: string;
+ WhereStrA: string;
+ WhereStrB: string;
+ RootClassFldName: string;
+ RootIdFldName: string;
+ I: Integer;
+
+ function BuildTableQualifiedFieldStr(AMap: TInstantAttributeMap): string;
+ begin
+ if AMap.IsRootMap then
+ Result := BuildFieldList(AMap, [InstantClassFieldName,
+ InstantIdFieldName, InstantUpdateCountFieldName])
+ else
+ Result := BuildFieldList(AMap, []);
+ Result := BuildTableQualifiedFieldList(Result, AMap.Name);
+ end;
+
+begin
+ Map := Maps.RootMap;
+ RootClassFldName := EmbraceTable(Map.Name) + '.' +
+ EmbraceField(InstantClassFieldName);
+ RootIdFldName := EmbraceTable(Map.Name) + '.' +
+ EmbraceField(InstantIdFieldName);
+ WhereStrA := RootClassFldName + '=:' + InstantClassFieldName;
+ if StatementInParameters <> '' then
+ WhereStrB := RootIdFldName + ' IN (' + StatementInParameters + ')';
+ FieldStr := BuildTableQualifiedFieldStr(Map);
+ TableStr := EmbraceTable(Map.Name);
+
+ for I := 0 to Pred(Maps.Count) do
+ begin
+ Map := Maps[I];
+ if not Map.IsRootMap then
+ begin
+ FieldStr := FieldStr + ', ' + BuildTableQualifiedFieldStr(Map);
+ TableStr := TableStr + ', ' + EmbraceTable(Map.Name);
+ WhereStrA := WhereStrA + ' AND ' + EmbraceTable(Map.Name) + '.' +
+ EmbraceField(InstantClassFieldName) + '=' + RootClassFldName;
+ if StatementInParameters <> '' then
+ WhereStrB := WhereStrB + ' AND ' + EmbraceTable(Map.Name) + '.' +
+ EmbraceField(InstantIdFieldName) + '=' + RootIdFldName;
+ end;
+ end;
+
+ if StatementInParameters <> '' then
+ WhereStrB := ' AND ' + WhereStrB;
+
+ WhereStr := WhereStrA + WhereStrB;
+
+ Result := Format('SELECT %s FROM %s WHERE %s',
+ [FieldStr, TableStr, WhereStr]);
+end;
+
function TInstantSQLGenerator.InternalGenerateSelectTablesSQL: string;
begin
raise EInstantError.CreateFmt(SUnsupportedOperation,
@@ -5826,6 +6218,9 @@
if (MaxCount > 0) and (ObjectReferenceList.Count = MaxCount) then break;
DataSet.Next;
end;
+
+ if EnsureObjects and (ObjectReferenceList.Count > 0) then
+ Connector.Broker.RetrieveMixedObjects(ObjectReferenceList);
finally
DataSet.EnableControls;
end;
Modified: branches/EnsureObjectsDev/Source/Core/InstantCode.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantCode.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantCode.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -625,6 +625,8 @@
procedure SetStorageKind(const Value: TInstantStorageKind);
function GetCanHaveStorageName: boolean;
function GetCanBeExternal: boolean;
+ function GetEnsureContainerObjects: Boolean;
+ procedure SetEnsureContainerObjects(const Value: Boolean);
protected
function GetIsDefault: Boolean; virtual;
function GetMethodName(MethodType: TInstantCodeContainerMethodType): string;
@@ -677,6 +679,8 @@
property AttributeTypeName: string read GetAttributeTypeName
write SetAttributeTypeName;
property AttributeTypeText: string read GetAttributeTypeText;
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects write
+ SetEnsureContainerObjects;
property ExternalStorageName: string read GetExternalStorageName
write SetExternalStorageName;
property IncludeAddMethod: Boolean read GetIncludeAddMethod
@@ -759,11 +763,13 @@
function GetAttributeCount: Integer;
function GetAttributes(Index: Integer): TInstantCodeAttribute;
function GetClassStatement: string;
+ function GetEnsureContainerObjects: Boolean;
function GetIsStored: Boolean;
function GetMetadata: TInstantClassMetadata;
function GetOwner: TInstantCodeClass; reintroduce;
function GetPersistence: TInstantPersistence;
function GetStorageName: string;
+ procedure SetEnsureContainerObjects(const Value: Boolean);
procedure SetPersistence(Value: TInstantPersistence);
procedure SetStorageName(const Value: string);
protected
@@ -797,6 +803,8 @@
property Metadata: TInstantClassMetadata read GetMetadata;
property Owner: TInstantCodeClass read GetOwner;
published
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects write
+ SetEnsureContainerObjects;
property Persistence: TInstantPersistence read GetPersistence write SetPersistence;
property StorageName: string read GetStorageName write SetStorageName;
end;
@@ -851,6 +859,7 @@
function GetBaseClassName: string;
function GetDivisionCount: Integer;
function GetDivisions(Index: Integer): TInstantCodeDivision;
+ function GetEnsureContainerObjects: Boolean;
function GetFieldCount: Integer;
function GetFields(Index: Integer): TInstantCodeField;
function GetImplementationComment: string;
@@ -875,6 +884,7 @@
procedure SetStorageName(const Value: string);
procedure SetUnitName(const Value: string);
procedure RemoveDivision(Division: TInstantCodeDivision);
+ procedure SetEnsureContainerObjects(const Value: Boolean);
protected
function AddDivision(Visibility: TInstantCodeVisibility): TInstantCodeDivision;
procedure InsertDivision(Division: TInstantCodeDivision);
@@ -949,6 +959,8 @@
property SubClasses[Index: Integer]: TInstantCodeClass read GetSubClass;
published
property BaseClassName: string read GetBaseClassName write SetBaseClassName;
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects write
+ SetEnsureContainerObjects;
property Persistence: TInstantPersistence read GetPersistence write SetPersistence;
property StorageName: string read GetStorageName write SetStorageName;
property UnitName: string read GetUnitName write SetUnitName;
@@ -1548,6 +1560,7 @@
MetaKeyEmbedded = 'embedded';
MetaKeyValid = 'valid';
MetaKeyWidth = 'width';
+ MetaKeyEnsureObjects = 'ensureobjects';
ModuleTypeNames: array[TInstantCodeModuleType] of string =
('program', 'unit', 'library');
@@ -1794,6 +1807,8 @@
Token := ReadToken;
if SameText(Token, MetaKeyStored) then
FMetadata.StorageName := ReadStringValue;
+ if SameText(Token, MetaKeyEnsureObjects) then
+ FMetadata.EnsureContainerObjects := True;
if SameText(Token, MetaKeyDefault) then
FMetadata.IsDefault := True;
if SameText(Token, MetaKeyExternal) then
@@ -3623,6 +3638,7 @@
Self.IsIndexed := IsIndexed;
Self.IsRequired := IsRequired;
Self.ReadOnly := ReadOnly;
+ Self.EnsureContainerObjects := EnsureContainerObjects;
Self.SingularName := SingularName;
Self.Visibility := Visibility;
Self.Metadata.Assign(Metadata);
@@ -4041,6 +4057,8 @@
Writer.Write(' ' + MetaKeyRequired);
if IsDefault then
Writer.Write(' ' + MetaKeyDefault);
+ if EnsureContainerObjects then
+ Writer.Write(' ' + MetaKeyEnsureObjects);
Writer.Write(';');
end;
@@ -4211,6 +4229,16 @@
Result := AttributeType in [atPart, atParts, atReferences];
end;
+function TInstantCodeAttribute.GetEnsureContainerObjects: Boolean;
+begin
+ Result := Metadata.EnsureContainerObjects;
+end;
+
+procedure TInstantCodeAttribute.SetEnsureContainerObjects(const Value: Boolean);
+begin
+ Metadata.EnsureContainerObjects := Value;
+end;
+
{ TInstantCodeClassLink }
function TInstantCodeClassLink.FindInstance: TInstantCodeObject;
@@ -4320,6 +4348,7 @@
begin
Self.Persistence := Persistence;
Self.StorageName := StorageName;
+ Self.EnsureContainerObjects := EnsureContainerObjects;
Self.AssignAttributes(FAttributes);
end;
end;
@@ -4404,18 +4433,35 @@
function TInstantCodeMetadataInfo.GetClassStatement: string;
begin
+ if (AttributeCount = 0) and (Persistence = peEmbedded) then
+ begin
+ Result := MetaKeyEmbedded + ';';
+ Exit
+ end;
+
+ Result := '';
if Persistence = peStored then
begin
Result := MetaKeyStored;
if Metadata.StorageName <> '' then
Result := Result + ' ''' + StorageName + '''';
+ end;
+
+ if EnsureContainerObjects then
+ if Result <> '' then
+ Result := Result + ' ' + MetaKeyEnsureObjects
+ else
+ Result := MetaKeyEnsureObjects;
+
+ if Result <> '' then
Result := Result + ';';
- end else if AttributeCount = 0 then
- Result := MetaKeyEmbedded + ';'
- else
- Result := '';
end;
+function TInstantCodeMetadataInfo.GetEnsureContainerObjects: Boolean;
+begin
+ Result := Metadata.EnsureContainerObjects;
+end;
+
function TInstantCodeMetadataInfo.GetIsEmpty: Boolean;
begin
Result := False;
@@ -4532,6 +4578,11 @@
begin
Persistence := peStored;
StorageName := Reader.ReadStringValue;
+ Reader.ReadEndOfStatement(False);
+ end else if SameText(Token, MetaKeyEnsureObjects) then
+ begin
+ EnsureContainerObjects := True;
+ StorageName := Reader.ReadStringValue;
Reader.ReadEndOfStatement(True);
end else if Token = '}' then
Break
@@ -4600,6 +4651,12 @@
FAttributes.Remove(Attribute);
end;
+procedure TInstantCodeMetadataInfo.SetEnsureContainerObjects(const Value:
+ Boolean);
+begin
+ Metadata.EnsureContainerObjects := Value;
+end;
+
procedure TInstantCodeMetadataInfo.SetName(const Value: string);
begin
Metadata.Name := Value;
@@ -5065,6 +5122,11 @@
Result := FDivisions[Index];
end;
+function TInstantCodeClass.GetEnsureContainerObjects: Boolean;
+begin
+ Result := MetadataInfo.EnsureContainerObjects;
+end;
+
function TInstantCodeClass.GetFieldCount: Integer;
begin
Result := FFields.Count;
@@ -5336,6 +5398,11 @@
FBaseClassLink.Name := Value;
end;
+procedure TInstantCodeClass.SetEnsureContainerObjects(const Value: Boolean);
+begin
+ MetadataInfo.EnsureContainerObjects := Value;
+end;
+
procedure TInstantCodeClass.SetName(const Value: string);
var
I: Integer;
Modified: branches/EnsureObjectsDev/Source/Core/InstantMetadata.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantMetadata.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantMetadata.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -76,6 +76,7 @@
private
FAttributeMetadatas: TInstantAttributeMetadatas;
FDefaultContainerName: string;
+ FEnsureContainerObjects: Boolean;
FMemberMap: TInstantAttributeMap;
FParent: TInstantClassMetadata;
FParentName: string;
@@ -126,6 +127,8 @@
published
property DefaultContainerName: string read FDefaultContainerName
write FDefaultContainerName;
+ property EnsureContainerObjects: Boolean read FEnsureContainerObjects write
+ FEnsureContainerObjects;
property ParentName: string read GetParentName write SetParentName;
property Persistence: TInstantPersistence read FPersistence
write FPersistence;
@@ -436,6 +439,7 @@
FDefaultValue: string;
FDisplayWidth: Integer;
FEditMask: string;
+ FEnsureContainerObjects: Boolean;
FIsIndexed: Boolean;
FIsRequired: Boolean;
FObjectClassName: string;
@@ -500,6 +504,8 @@
property DisplayWidth: Integer read FDisplayWidth write FDisplayWidth
default 0;
property EditMask: string read FEditMask write FEditMask;
+ property EnsureContainerObjects: Boolean read FEnsureContainerObjects write
+ FEnsureContainerObjects;
property ExternalStorageName: string read FExternalStorageName
write FExternalStorageName;
property StorageKind: TInstantStorageKind read FStorageKind
@@ -584,6 +590,7 @@
Self.FDefaultContainerName := FDefaultContainerName;
Self.FStorageName := FStorageName;
Self.FPersistence := FPersistence;
+ Self.FEnsureContainerObjects := FEnsureContainerObjects;
end;
end;
@@ -1648,6 +1655,7 @@
Self.FEditMask := FEditMask;
Self.FIsIndexed := FIsIndexed;
Self.FIsRequired := FIsRequired;
+ Self.FEnsureContainerObjects := FEnsureContainerObjects;
Self.FObjectClassName := FObjectClassName;
Self.FSize := FSize;
Self.FStorageName := FStorageName;
Modified: branches/EnsureObjectsDev/Source/Core/InstantPersistence.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantPersistence.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantPersistence.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -156,6 +156,7 @@
private
FIsChanged: Boolean;
function GetIsIndexed: Boolean;
+ function GetEnsureContainerObjects: Boolean;
function GetIsRequired: Boolean;
function GetMetadata: TInstantAttributeMetadata;
function GetName: string;
@@ -212,6 +213,7 @@
property IsChanged: Boolean read GetIsChanged write SetIsChanged;
property IsDefault: Boolean read GetIsDefault;
property IsIndexed: Boolean read GetIsIndexed;
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects;
property IsMandatory: Boolean read GetIsMandatory;
property IsRequired: Boolean read GetIsRequired;
property Name: string read GetName;
@@ -566,8 +568,10 @@
private
function GetItems(Index: Integer): TInstantObject;
function GetChangeCount: Integer;
+ function GetObjectReferences(Index: Integer): TInstantObjectReference;
procedure SetItems(Index: Integer; AValue: TInstantObject);
procedure QuickSort(L, R: Integer; Compare: TInstantSortCompare);
+ procedure SetObjectReferences(Index: Integer; AValue: TInstantObjectReference);
protected
procedure AfterContentChange(ChangeType: TInstantContentChangeType;
Index: Integer; AObject: TInstantObject);
@@ -577,27 +581,37 @@
function GetCount: Integer; virtual; abstract;
function GetInstances(Index: Integer): TInstantObject; virtual;
function GetIsDefault: Boolean; override;
+ procedure InternalSetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference); virtual; abstract;
function InternalAdd(AObject: TInstantObject): Integer; virtual; abstract;
function InternalAddReference(const AObjectClassName, AObjectId: string):
Integer; virtual; abstract;
procedure InternalClear; virtual; abstract;
procedure InternalDelete(Index: Integer); virtual; abstract;
+ procedure InternalEnsureObjects; virtual;
function InternalGetItems(Index: Integer): TInstantObject; virtual; abstract;
function InternalIndexOf(AObject: TInstantObject): Integer; virtual; abstract;
function InternalIndexOfInstance(Instance: Pointer): Integer; virtual; abstract;
procedure InternalExchange(Index1, Index2: Integer); virtual; abstract;
+ function InternalGetObjectReferences(Index: Integer): TInstantObjectReference;
+ virtual; abstract;
procedure InternalInsert(Index: Integer; AObject: TInstantObject); virtual; abstract;
procedure InternalMove(CurIndex, NewIndex: Integer); virtual; abstract;
procedure InternalSetItems(Index: Integer; AValue: TInstantObject); virtual; abstract;
procedure ValidateObject(AObject: TInstantObject); override;
property Instances[Index: Integer]: TInstantObject read GetInstances;
+ property ObjectReferences[Index: Integer]: TInstantObjectReference read
+ GetObjectReferences write SetObjectReferences;
public
+ constructor Create(AOwner: TInstantAbstractObject = nil; AMetadata:
+ TInstantCollectionItem = nil); override;
function Add(AObject: TInstantObject): Integer;
function AddReference(const AObjectClassName, AObjectId: string): Integer;
function AttachObject(AObject: TInstantObject): Boolean; override;
procedure Clear;
procedure Delete(Index: Integer);
function DetachObject(AObject: TInstantObject): Boolean; override;
+ procedure EnsureObjects;
procedure Exchange(Index1, Index2: Integer);
function HasItem(Index: Integer): Boolean;
function IndexOf(AObject: TInstantObject): Integer;
@@ -625,10 +639,7 @@
property ObjectList: TObjectList read GetObjectList;
function CreateObjectReference(AObject: TInstantObject): TInstantObjectReference;
function GetObjectReferenceList: TObjectList;
- 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;
@@ -640,13 +651,18 @@
Integer; override;
procedure InternalClear; override;
procedure InternalDelete(Index: Integer); override;
+ procedure InternalEnsureObjects; override;
function InternalGetItems(Index: Integer): TInstantObject; override;
function InternalIndexOf(AObject: TInstantObject): Integer; override;
function InternalIndexOfInstance(Instance: Pointer): Integer; override;
procedure InternalExchange(Index1, Index2: Integer); override;
+ function InternalGetObjectReferences(Index: Integer): TInstantObjectReference;
+ override;
procedure InternalInsert(Index: Integer; AObject: TInstantObject); override;
procedure InternalMove(CurIndex, NewIndex: Integer); override;
procedure InternalSetItems(Index: Integer; AValue: TInstantObject); override;
+ procedure InternalSetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference); override;
procedure ReadObject(Reader: TInstantReader); override;
procedure SetAllowOwned(Value: Boolean); virtual;
procedure ValidateObject(AObject: TInstantObject); override;
@@ -682,9 +698,13 @@
function InternalIndexOf(AObject: TInstantObject): Integer; override;
function InternalIndexOfInstance(Instance: Pointer): Integer; override;
procedure InternalExchange(Index1, Index2: Integer); override;
+ function InternalGetObjectReferences(Index: Integer): TInstantObjectReference;
+ override;
procedure InternalInsert(Index: Integer; AObject: TInstantObject); override;
procedure InternalMove(CurIndex, NewIndex: Integer); override;
procedure InternalSetItems(Index: Integer; AValue: TInstantObject); override;
+ procedure InternalSetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference); override;
procedure ReadObject(Reader: TInstantReader); override;
procedure SetAllowOwned(Value: Boolean); virtual;
procedure ValidateObject(AObject: TInstantObject); override;
@@ -788,6 +808,7 @@
procedure Init;
procedure Finit;
function GetConnector: TInstantConnector;
+ function GetEnsureContainerObjects: Boolean;
procedure PerformUpdate(Operation: TInstantUpdateOperation; OperationType: TInstantOperationType;
ConflictAction: TInstantConflictAction);
procedure ReadAttributes(Reader: TInstantReader);
@@ -829,6 +850,7 @@
procedure Destruct; virtual;
procedure DisposeOwnedObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction);
+ procedure EnsureContainerAttributeObjects; virtual;
procedure Finalize; virtual;
function GenerateId: string; virtual;
function GetCaption: string; virtual;
@@ -845,6 +867,7 @@
procedure RestoreState; virtual;
procedure SaveState; virtual;
procedure SetConnector(AConnector: TInstantConnector); virtual;
+ procedure SetEnsureContainerObjects(const Value: Boolean); virtual;
procedure SetId(const Value: string); virtual;
function VerifyOperation(OperationType: TInstantOperationType): TInstantVerificationResult; virtual;
procedure WriteObject(Writer: TInstantWriter); override;
@@ -903,6 +926,8 @@
property Caption: string read GetCaption;
property ClassId: string read GetClassId;
property Connector: TInstantConnector read GetConnector;
+ property EnsureContainerObjects: Boolean read GetEnsureContainerObjects write
+ SetEnsureContainerObjects;
property HasDefaultContainer: Boolean read GetHasDefaultContainer;
property IsChanged: Boolean read GetIsChanged write SetIsChanged;
property IsDefault: Boolean read GetIsDefault;
@@ -1023,6 +1048,7 @@
procedure AbandonObjects;
procedure DisposeObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction);
+ procedure EnsureObject(const AObjectId: string; AObject: TInstantObject);
function Find(const AObjectId: string): TInstantObject;
procedure ObjectDestroyed(AObject: TInstantObject);
procedure RefreshObject(AObject: TInstantObject);
@@ -1098,6 +1124,7 @@
private
FCommand: string;
FConnector: TInstantConnector;
+ FEnsureObjects: Boolean;
FMaxCount: Integer;
function GetConnector: TInstantConnector;
function GetObjectCount: Integer;
@@ -1140,6 +1167,7 @@
property Active: Boolean read GetActive write SetActive;
property Command: string read FCommand write SetCommand;
property Connector: TInstantConnector read GetConnector;
+ property EnsureObjects: Boolean read FEnsureObjects write FEnsureObjects;
property MaxCount: Integer read FMaxCount write FMaxCount;
property ObjectClass: TClass read GetObjectClass;
property ObjectClassName: string read GetObjectClassName;
@@ -1293,6 +1321,7 @@
property Items[Index: Integer]: TInstantObject read GetItems write SetItems;
default;
property RefItems[Index: Integer]: TInstantObjectReference read GetRefItems;
+ property RefOwnsInstance: Boolean read FRefOwnsInstance;
end;
TInstantBroker = class(TInstantStreamable)
@@ -1316,6 +1345,12 @@
function InternalRetrieveObject(AObject: TInstantObject;
const AObjectId: string; ConflictAction: TInstantConflictAction):
Boolean; virtual; abstract;
+ procedure InternalRetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); virtual; abstract;
+ procedure InternalRetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList); virtual; abstract;
+ procedure InternalRetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings); virtual; abstract;
function InternalStoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean; virtual; abstract;
public
@@ -1349,6 +1384,11 @@
function IsCatalogSupported: Boolean;
function RetrieveObject(AObject: TInstantObject; const AObjectId: string;
ConflictAction: TInstantConflictAction): Boolean;
+ procedure RetrieveObjects(AObjectsClass: TInstantObjectClass; AObjectIdList:
+ TStrings);
+ procedure RetrieveMixedObjects(AObjRefList: TInstantObjectReferenceList);
+ procedure RetrieveAllObjects(AObjectsClass: TInstantObjectClass; AObjectIdList:
+ TStrings);
procedure SetObjectUpdateCount(AObject: TInstantObject; Value: Integer);
function StoreObject(AObject: TInstantObject;
ConflictAction: TInstantConflictAction): Boolean;
@@ -2352,6 +2392,11 @@
Result := Assigned(Metadata) and Metadata.IsIndexed;
end;
+function TInstantAttribute.GetEnsureContainerObjects: Boolean;
+begin
+ Result := Assigned(Metadata) and Metadata.EnsureContainerObjects;
+end;
+
function TInstantAttribute.GetIsMandatory: Boolean;
begin
Result := IsRequired or IsIndexed;
@@ -4124,6 +4169,14 @@
ObjectReference.WriteAsObject(Writer);
end;
+constructor TInstantContainer.Create(AOwner: TInstantAbstractObject = nil;
+ AMetadata: TInstantCollectionItem = nil);
+begin
+ inherited Create(AOwner, AMetadata);
+ if EnsureContainerObjects then
+ EnsureObjects;
+end;
+
{ TInstantContainer }
function TInstantContainer.Add(AObject: TInstantObject): Integer;
@@ -4206,6 +4259,56 @@
Result := Remove(AObject) <> -1;
end;
+procedure TInstantContainer.EnsureObjects;
+begin
+ InternalEnsureObjects;
+end;
+
+procedure TInstantContainer.InternalEnsureObjects;
+var
+ I: Integer;
+ Ref: TInstantObjectReference;
+ ObjRefList: TInstantObjectReferenceList;
+ J: Integer;
+begin
+ if (Metadata.StorageKind <> skExternal) and
+ (Metadata.AttributeType = atParts) then
+ Exit;
+
+ ObjRefList := TInstantObjectReferenceList.Create(False);
+ try
+ for I := 0 to Pred(Count) do
+ begin
+ if not HasItem(I) then
+ begin
+ Ref := ObjRefList.Add;
+ Ref.ReferenceObject(ObjectReferences[I].ObjectClassName,
+ ObjectReferences[I].ObjectId);
+ end;
+ end;
+
+ if ObjRefList.Count > 0 then
+ begin
+ Connector.Broker.RetrieveMixedObjects(ObjRefList);
+
+ for I := 0 to Pred(ObjRefList.Count) do
+ begin
+ for J := 0 to Pred(Count) do
+ begin
+ if ObjectReferences[J].Equals(ObjRefList[I]) then
+ begin
+ if not ObjectReferences[J].HasInstance then
+ Items[J] := ObjRefList[I];
+ Break;
+ end;
+ end;
+ end;
+ end;
+ finally
+ ObjRefList.Free;
+ end;
+end;
+
procedure TInstantContainer.Exchange(Index1, Index2: Integer);
begin
CheckRange(Index1);
@@ -4245,6 +4348,13 @@
Result := InternalGetItems(Index);
end;
+function TInstantContainer.GetObjectReferences(Index: Integer):
+ TInstantObjectReference;
+begin
+ CheckRange(Index);
+ Result := InternalGetObjectReferences(Index);
+end;
+
function TInstantContainer.HasItem(Index: Integer): Boolean;
begin
Result := Assigned(Instances[Index]);
@@ -4417,6 +4527,12 @@
end;
end;
+procedure TInstantContainer.SetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference);
+begin
+ InternalSetObjectReferences(Index, AValue);
+end;
+
procedure TInstantContainer.Sort(Compare: TInstantSortCompare);
begin
if Count > 1 then
@@ -4504,6 +4620,12 @@
Result := False;
end;
+procedure TInstantParts.InternalEnsureObjects;
+begin
+ if Metadata.StorageKind = skExternal then
+ inherited;
+end;
+
function TInstantParts.GetAllowOwned: Boolean;
begin
Result := FAllowOwned;
@@ -4553,12 +4675,6 @@
Result := FObjectReferenceList;
end;
-function TInstantParts.GetObjectReferences(
- Index: Integer): TInstantObjectReference;
-begin
- Result := TInstantObjectReference(ObjectReferenceList[Index]);
-end;
-
function TInstantParts.InternalAdd(AObject: TInstantObject): Integer;
var
Ref: TInstantObjectReference;
@@ -4664,6 +4780,15 @@
end;
end;
+function TInstantParts.InternalGetObjectReferences(Index: Integer):
+ TInstantObjectReference;
+begin
+ if Metadata.StorageKind = skEmbedded then
+ Result := nil
+ else
+ Result := TInstantObjectReference(ObjectReferenceList[Index]);
+end;
+
function TInstantParts.InternalIndexOf(AObject: TInstantObject): Integer;
var
Ref: TInstantObjectReference;
@@ -4744,6 +4869,15 @@
ObjectReferences[Index].Instance := AValue;
end;
+procedure TInstantParts.InternalSetObjectReferences(Index: Integer; AValue:
+ TInstantObjectReference);
+begin
+ if (Metadata.StorageKind = skExternal)
+ and not TInstantObjectReference(ObjectReferenceList[Index]).Equals(
+ AValue.ObjectClassName, AValue.ObjectId) then
+ TInstantObjectReference(ObjectReferenceList[Index]).Assign(AValue);
+end;
+
procedure TInstantParts.ReadObject(Reader: TInstantReader);
var
Obj: TPersistent;
@@ -4769,12 +4903,6 @@
FAllowOwned := Value;
end;
-procedure TInstantParts.SetObjectReferences(Index: Integer;
- Value: TInstantObjectReference);
-begin
- ObjectReferenceList[Index] := Value;
-end;
-
procedure TInstantParts.SetOwnerContext(AObject: TInstantObject);
begin
if Assigned(AObject) then
@@ -4883,7 +5011,7 @@
function TInstantReferences.GetInstances(Index: Integer): TInstantObject;
begin
- Result := ObjectReferenceList[Index];
+ Result := RefItems[Index].Instance;
end;
function TInstantReferences.GetObjectReferenceList: TInstantObjectReferenceList;
@@ -4943,6 +5071,12 @@
Result := ObjectReferenceList[Index];
end;
+function TInstantReferences.InternalGetObjectReferences(Index: Integer):
+ TInstantObjectReference;
+begin
+ Result := RefItems[Index];
+end;
+
function TInstantReferences.InternalIndexOf(
AObject: TInstantObject): Integer;
begin
@@ -4972,6 +5106,13 @@
ObjectReferenceList[Index] := AValue;
end;
+procedure TInstantReferences.InternalSetObjectReferences(Index: Integer;
+ AValue: TInstantObjectReference);
+begin
+ if not RefItems[Index].Equals(AValue.ObjectClassName, AValue.ObjectId) then
+ RefItems[Index].Assign(AValue);
+end;
+
procedure TInstantReferences.LoadObjectsFromStream(AStream: TStream);
var
I: Integer;
@@ -6226,6 +6367,8 @@
AfterCreateAttributes;
DisableChanges;
try
+ if EnsureContainerObjects then
+ EnsureContainerAttributeObjects;
try
Initialize;
except
@@ -6552,6 +6695,30 @@
end;
end;
end;
+
+procedure TInstantObject.EnsureContainerAttributeObjects;
+var
+ I: Integer;
+ AttrMetadata: TInstantAttributeMetadata;
+ Attr: TInstantContainer;
+ J: Integer;
+begin
+ CodeSite.EnterMethod(Self, 'TInstantObject.EnsureContainerAttributeObjects');
+ for I := 0 to Pred(Metadata.MemberMap.Count) do
+ begin
+ AttrMetadata := Metadata.MemberMap[I];
+ if (AttrMetadata.AttributeType in [atParts, atReferences]) and
+ (not AttrMetadata.EnsureContainerObjects) then
+ begin
+ Attr := TInstantContainer(AttributeByName(AttrMetadata.Name));
+ Attr.EnsureObjects;
+ for J := 0 to Pred(TInstantContainer(Attr).Count) do
+ Attr[J].EnsureContainerAttributeObjects;
+ end;
+ end;
+ CodeSite.ExitMethod(Self, 'TInstantObject.EnsureContainerAttributeObjects');
+end;
+
{$O+}
function TInstantObject.GetConnector: TInstantConnector;
@@ -6559,6 +6726,11 @@
Result := inherited GetConnector as TInstantConnector;
end;
+function TInstantObject.GetEnsureContainerObjects: Boolean;
+begin
+ Result := Metadata.EnsureContainerObjects;
+end;
+
procedure TInstantObject.SaveState;
begin
if State.PersistentId = '' then
@@ -6584,6 +6756,16 @@
FObjectStore := nil;
end;
+procedure TInstantObject.SetEnsureContainerObjects(const Value: Boolean);
+begin
+ if EnsureContainerObjects <> Value then
+ begin
+ Metadata.EnsureContainerObjects := Value;
+ if EnsureContainerObjects then
+ EnsureContainerAttributeObjects;
+ end;
+end;
+
procedure TInstantObject.SetId(const Value: string);
begin
if Value <> FId then
@@ -7225,6 +7407,13 @@
end;
end;
+procedure TInstantObjectStore.EnsureObject(const AObjectId: string; AObject:
+ TInstantObject);
+begin
+ AObject.SetPersistentId(AObjectId);
+ AddToCache(AObject);
+end;
+
function TInstantObjectStore.Find(const AObjectId: string): TInstantObject;
begin
Result := FCache.Find(AObjectId);
@@ -8335,6 +8524,24 @@
Result := InternalRetrieveObject(AObject, AObjectId, ConflictAction);
end;
+procedure TInstantBroker.RetrieveObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings);
+begin
+ InternalRetrieveObjects(AObjectsClass, AObjectIdList);
+end;
+
+procedure TInstantBroker.RetrieveMixedObjects(AObjRefList:
+ TInstantObjectReferenceList);
+begin
+ InternalRetrieveMixedObjects(AObjRefList);
+end;
+
+procedure TInstantBroker.RetrieveAllObjects(AObjectsClass: TInstantObjectClass;
+ AObjectIdList: TStrings);
+begin
+ InternalRetrieveAllObjects(AObjectsClass, AObjectIdList);
+end;
+
procedure TInstantBroker.SetObjectUpdateCount(AObject: TInstantObject;
Value: Integer);
begin
Modified: branches/EnsureObjectsDev/Source/Core/InstantPresentation.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Core/InstantPresentation.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Core/InstantPresentation.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -307,6 +307,7 @@
FSorted: Boolean;
FAfterPostField: TInstantFieldEvent;
FBeforePostField: TInstantFieldEvent;
+ FEnsureObjects: Boolean;
FOnCompare: TInstantCompareObjectsEvent;
FOnCreateObject: TInstantCreateObjectEvent;
FOnFieldError: TInstantFieldErrorEvent;
@@ -474,6 +475,8 @@
property ContentBuffer: TInstantContentBuffer read GetContentBuffer;
property CurrentBuffer: PChar read GetCurrentBuffer;
property DesignClass: TInstantCodeClass read GetDesignClass;
+ property EnsureObjects: Boolean read FEnsureObjects write FEnsureObjects
+ default False;
property HasCurrentBuffer: Boolean read GetHasCurrentBuffer;
property InContent: Boolean read GetInContent;
property Mode: TInstantAccessMode read GetMode write SetMode default amObject;
@@ -698,6 +701,7 @@
property AfterOpen;
property BeforeClose;
property BeforeOpen;
+ property EnsureObjects default False;
end;
TInstantBlobStream = class(TStream)
@@ -4671,6 +4675,7 @@
DestroyQuery;
end;
Query.Params := Params;
+ Query.EnsureObjects := EnsureObjects;
Query.Open;
inherited;
end;
Modified: branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.dfm
===================================================================
--- branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.dfm 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.dfm 2006-11-27 08:09:29 UTC (rev 720)
@@ -303,6 +303,22 @@
TabOrder = 1
end
end
+ object OtherOptionsGroupBox: TGroupBox
+ Left = 8
+ Top = 183
+ Width = 209
+ Height = 63
+ Caption = 'Other Options'
+ TabOrder = 4
+ object OtherOptionEnsureContainerObjectsCheckBox: TCheckBox
+ Left = 8
+ Top = 15
+ Width = 190
+ Height = 17
+ Caption = 'E&nsure Container Objects'
+ TabOrder = 0
+ end
+ end
end
object PresentationSheet: TTabSheet
Caption = 'Presentation'
Modified: branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.pas
===================================================================
--- branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.pas 2006-11-27 02:47:53 UTC (rev 719)
+++ branches/EnsureObjectsDev/Source/Design/InstantAttributeEditor.pas 2006-11-27 08:09:29 UTC (rev 720)
@@ -101,6 +101,8 @@
StorageKindEdit: TDBComboBox;
StorageKindLabel: TLabel;
AutoExternalStorageNameCheckBox: TCheckBox;
+ OtherOptionsGroupBox: TGroupBox;
+ OtherOptionEnsureContainerObjectsCheckBox: TCheckBox;
procedure NameEditKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure NameEditChange(Sender: TObject);
@@ -224,6 +226,8 @@
OptionRequired...
[truncated message content] |
|
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] |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X