Menu
▾
▴
instantobjects-cvscommit
|
From: <car...@us...> - 2008-09-03 10:42:57
|
Revision: 788
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=788&view=rev
Author: carlobar
Date: 2008-09-03 10:43:07 +0000 (Wed, 03 Sep 2008)
Log Message:
-----------
Fixed a bug for EXISTS/USING clause of IQL when a broker uses quoted identifiers.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantCommand.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2008-09-02 14:00:30 UTC (rev 787)
+++ trunk/Source/Core/InstantBrokers.pas 2008-09-03 10:43:07 UTC (rev 788)
@@ -847,6 +847,7 @@
function IndexOfChildContext(const AChildContext: TInstantTranslationContext): Integer;
function Qualify(const TablePath, FieldName: string): string;
function QualifyPath(const PathText: string): string;
+ function QualifyClassPath(const PathText: string): string;
function WriteCriterias(Writer: TInstantIQLWriter; IncludeWhere: Boolean): Boolean;
procedure WriteTables(Writer: TInstantIQLWriter);
@@ -6484,6 +6485,14 @@
Result := Qualify(TablePath, FieldName);
end;
+function TInstantTranslationContext.QualifyClassPath(const PathText: string): string;
+var
+ TablePath, FieldName: string;
+begin
+ PathToTarget(PathText, TablePath, FieldName);
+ Result := Qualify(TablePath, FieldName+InstantClassFieldName);
+end;
+
function TInstantTranslationContext.QuoteString(const Str: string): string;
begin
Result := InstantQuote(Str, Quote);
Modified: trunk/Source/Core/InstantCommand.pas
===================================================================
--- trunk/Source/Core/InstantCommand.pas 2008-09-02 14:00:30 UTC (rev 787)
+++ trunk/Source/Core/InstantCommand.pas 2008-09-03 10:43:07 UTC (rev 788)
@@ -1991,8 +1991,9 @@
WriteString('((');
- WriteString(LSubContext.QualifyPath(LAttributeMetadata.FieldName ) + InstantClassFieldName +
- ' = ' + InstantQuote(LParentContext.ClassRef.ObjectClassName, LParentContext.Quote));
+ WriteString( LSubContext.QualifyClassPath(LAttributeMetadata.FieldName));
+ WriteString(' = ');
+ WriteString(InstantQuote(LParentContext.ClassRef.ObjectClassName, LParentContext.Quote));
WriteString(') AND (');
|
|
From: <car...@us...> - 2008-09-05 09:11:28
|
Revision: 790
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=790&view=rev
Author: carlobar
Date: 2008-09-05 09:11:38 +0000 (Fri, 05 Sep 2008)
Log Message:
-----------
New Fix for the bug for EXISTS/USING clause of IQL when a broker uses quoted identifiers.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantCommand.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2008-09-03 10:46:34 UTC (rev 789)
+++ trunk/Source/Core/InstantBrokers.pas 2008-09-05 09:11:38 UTC (rev 790)
@@ -847,7 +847,6 @@
function IndexOfChildContext(const AChildContext: TInstantTranslationContext): Integer;
function Qualify(const TablePath, FieldName: string): string;
function QualifyPath(const PathText: string): string;
- function QualifyClassPath(const PathText: string): string;
function WriteCriterias(Writer: TInstantIQLWriter; IncludeWhere: Boolean): Boolean;
procedure WriteTables(Writer: TInstantIQLWriter);
@@ -6485,14 +6484,6 @@
Result := Qualify(TablePath, FieldName);
end;
-function TInstantTranslationContext.QualifyClassPath(const PathText: string): string;
-var
- TablePath, FieldName: string;
-begin
- PathToTarget(PathText, TablePath, FieldName);
- Result := Qualify(TablePath, FieldName+InstantClassFieldName);
-end;
-
function TInstantTranslationContext.QuoteString(const Str: string): string;
begin
Result := InstantQuote(Str, Quote);
Modified: trunk/Source/Core/InstantCommand.pas
===================================================================
--- trunk/Source/Core/InstantCommand.pas 2008-09-03 10:46:34 UTC (rev 789)
+++ trunk/Source/Core/InstantCommand.pas 2008-09-05 09:11:38 UTC (rev 790)
@@ -1991,9 +1991,8 @@
WriteString('((');
- WriteString( LSubContext.QualifyClassPath(LAttributeMetadata.FieldName));
- WriteString(' = ');
- WriteString(InstantQuote(LParentContext.ClassRef.ObjectClassName, LParentContext.Quote));
+ WriteString(LSubContext.Qualify(LSubContext.TableName, LAttributeMetadata.FieldName + InstantClassFieldName) +
+ ' = ' + InstantQuote(LParentContext.ClassRef.ObjectClassName, LParentContext.Quote));
WriteString(') AND (');
@@ -2003,7 +2002,7 @@
WriteString('))');
end;
-
+
end;
end;
|
|
From: <na...@us...> - 2009-08-14 07:16:13
|
Revision: 821
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=821&view=rev
Author: nandod
Date: 2009-08-14 07:15:58 +0000 (Fri, 14 Aug 2009)
Log Message:
-----------
* All XML output is now formatted and indented for better displaying, comparing, etc.
* D2009: Fixed transliteration problems with XML container blobs.
* Small optimization for InstantGetPropName.
Modified Paths:
--------------
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantConsts.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantRtti.pas
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantClasses.pas 2009-08-14 07:15:58 UTC (rev 821)
@@ -267,6 +267,7 @@
FStream: TStream;
FTagStack: TStringList;
FWriter: TAbstractWriter;
+ FCurrentIndentationSize: Integer;
function GetCurrentTag: string;
function GetEof: Boolean;
function GetPosition: Integer;
@@ -278,6 +279,10 @@
property TagStack: TStringList read GetTagStack;
property Writer: TAbstractWriter read GetWriter;
public
+ procedure Indent;
+ procedure Unindent;
+ procedure WriteIndentation;
+ procedure WriteLineBreak;
constructor Create(Stream: TStream);
destructor Destroy; override;
procedure WriteEscapedData(const Data: string);
@@ -452,7 +457,7 @@
implementation
uses
- TypInfo, InstantUtils, InstantRtti;
+ TypInfo, StrUtils, InstantUtils, InstantRtti;
const
ResourceHeader : packed array[0..31] of Byte = ($00,$00,$00,$00,$20,$00,$00,
@@ -1343,6 +1348,22 @@
{ TInstantXMLProducer }
+procedure TInstantXMLProducer.Indent;
+begin
+ Inc(FCurrentIndentationSize, InstantXMLIndentationSize);
+end;
+
+procedure TInstantXMLProducer.Unindent;
+begin
+ Dec(FCurrentIndentationSize, InstantXMLIndentationSize);
+ if InstantXMLIndentationSize >= 0 then
+ begin
+ WriteLineBreak;
+ WriteIndentation;
+ end;
+end;
+
+
constructor TInstantXMLProducer.Create(Stream: TStream);
begin
inherited Create;
@@ -1445,10 +1466,26 @@
procedure TInstantXMLProducer.WriteStartTag(const Tag: string);
begin
+ if InstantXMLIndentationSize >= 0 then
+ begin
+ WriteLineBreak;
+ WriteIndentation;
+ end;
WriteString(InstantBuildStartTag(Tag));
TagStack.Add(Tag);
end;
+procedure TInstantXMLProducer.WriteLineBreak;
+begin
+ WriteString(sLineBreak);
+end;
+
+procedure TInstantXMLProducer.WriteIndentation;
+begin
+ if FCurrentIndentationSize > 0 then
+ WriteString(DupeString(' ' , FCurrentIndentationSize));
+end;
+
procedure TInstantXMLProducer.WriteString(const S: string);
var
U: UTF8String;
@@ -1763,6 +1800,7 @@
PushObjectClass(FindClass(Reader.ReadStr));
try
Producer.WriteStartTag(ObjectClassName);
+ Producer.Indent;
if ObjectClass.InheritsFrom(TInstantStreamable) then
TInstantStreamableClass(ObjectClass).ConvertToText(Self)
else if ObjectClass.InheritsFrom(TInstantCollection) then
@@ -1770,6 +1808,7 @@
else if ObjectClass.InheritsFrom(TInstantCollectionItem) then
TInstantCollectionItemClass(ObjectClass).ConvertToText(Self);
Reader.ReadListEnd;
+ Producer.Unindent;
Producer.WriteEndTag;
finally
PopObjectClass;
@@ -1839,6 +1878,7 @@
end;
begin
+ Producer.Indent;
while not Reader.EndOfList do
begin
Producer.WriteStartTag(Reader.ReadStr);
@@ -1846,6 +1886,7 @@
Producer.WriteEndTag;
end;
Reader.ReadListEnd;
+ Producer.Unindent;
end;
{ TInstantToTextToBinaryConverter }
Modified: trunk/Source/Core/InstantConsts.pas
===================================================================
--- trunk/Source/Core/InstantConsts.pas 2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantConsts.pas 2009-08-14 07:15:58 UTC (rev 821)
@@ -70,12 +70,17 @@
InstantSequenceNoFieldName = 'SequenceNo';
InstantChildClassFieldName = 'ChildClass';
InstantLogStatementBefore = 'Before: ';
+ InstantLogStatementSelect = 'Select: ';
+ InstantLogStatementExecute = 'Execute: ';
{$IFNDEF D6+}
const
sLineBreak = #13#10;
{$ENDIF}
+var
+ InstantXMLIndentationSize: Integer = 2;
+
resourcestring
SAccessError = 'Cannot access attribute %s(''%s'') as type: %s';
SAccessorClassNotFoundFor = 'Accessor class not found for class %s ';
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantPersistence.pas 2009-08-14 07:15:58 UTC (rev 821)
@@ -3465,7 +3465,7 @@
function TInstantBlob.GetAsString: string;
begin
- Result := Value;
+ Result := string(Value);
end;
function TInstantBlob.GetAsVariant: Variant;
@@ -5226,7 +5226,7 @@
Try
XMLReferencesTag := Self.ClassName;
InstantXMLProducer.WriteStartTag(XMLReferencesTag);
- InstantXMLProducer.WriteEscapedData(sLineBreak);
+ InstantXMLProducer.WriteData(sLineBreak);
for I := 0 to Pred(Count) do
begin
InstantXMLProducer.WriteStartTag(
@@ -5235,6 +5235,7 @@
InstantXMLProducer.WriteEndTag;
end;
InstantXMLProducer.WriteEndTag;
+ InstantXMLProducer.WriteData(sLineBreak);
Finally
InstantXMLProducer.Free;
End;
@@ -5641,7 +5642,9 @@
vaIdent:
begin
Reader.ReadIdent;
+ Producer.Indent;
Convert;
+ Producer.Unindent;
end;
vaFalse:
begin
@@ -5666,8 +5669,10 @@
vaCollection:
begin
Reader.ReadValue;
+ Producer.Indent;
while not Reader.EndOfList do
Convert;
+ Producer.Unindent;
Reader.ReadListEnd;
end;
else
Modified: trunk/Source/Core/InstantRtti.pas
===================================================================
--- trunk/Source/Core/InstantRtti.pas 2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantRtti.pas 2009-08-14 07:15:58 UTC (rev 821)
@@ -78,7 +78,7 @@
procedure InstantSetProperty(AObject: TObject; PropPath: string; Value: Variant);
function InstantIsDefaultPropertyValue(Instance: TObject;
PropInfo: PPropInfo): Boolean;
-function InstantGetPropName(PropInfo: PPropInfo): string;
+function InstantGetPropName(PropInfo: PPropInfo): string; {$IFNDEF D12+}inline;{$ENDIF}
implementation
|
|
From: <na...@us...> - 2009-08-15 10:38:29
|
Revision: 827
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=827&view=rev
Author: nandod
Date: 2009-08-15 10:38:20 +0000 (Sat, 15 Aug 2009)
Log Message:
-----------
* D2009: fixed reading embedded objects in binary format. Retructured embedded object I/O in D2007 and D2009.
* Added SQL statement logging for write as well as read statements.
* Optimized XML output.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2009-08-14 19:28:40 UTC (rev 826)
+++ trunk/Source/Core/InstantBrokers.pas 2009-08-15 10:38:20 UTC (rev 827)
@@ -267,6 +267,11 @@
procedure InternalStoreMap(AObject: TInstantObject;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
Info: PInstantOperationInfo); virtual;
+ function CreateEmbeddedObjectInputStream(const AConnector: TInstantConnector;
+ const AField: TField): TStream;
+ function CreateEmbeddedObjectOutputStream(const AConnector: TInstantConnector): TStream;
+ procedure AssignEmbeddedObjectStreamToField(const AConnector: TInstantConnector;
+ const AStream: TStream; const AField: TField);
public
constructor Create(ABroker: TInstantCustomRelationalBroker);
procedure DisposeMap(AObject: TInstantObject; Map: TInstantAttributeMap;
@@ -389,8 +394,8 @@
procedure WriteReferences(Attribute: TInstantReferences); virtual;
procedure WriteString(Attribute: TInstantString); virtual;
property DataSet: TDataset read GetDataSet write SetDataSet;
- property NavigationalLinkResolvers: TObjectList read
- GetNavigationalLinkResolvers;
+ property NavigationalLinkResolvers: TObjectList
+ read GetNavigationalLinkResolvers;
public
constructor Create(ABroker: TInstantNavigationalBroker;
const ATableName: string);
@@ -488,6 +493,8 @@
procedure RemovePersistentIdParam(Params: TParams);
function TranslateError(AObject: TInstantObject;
E: Exception): Exception; virtual;
+ procedure AddEmbeddedObjectOutputParam(const AConnector: TInstantConnector;
+ const AParams: TParams; const AParamName: string; const AStream: TStream);
public
constructor Create(ABroker: TInstantSQLBroker; AMap: TInstantAttributeMap);
property Broker: TInstantSQLBroker read GetBroker;
@@ -1430,7 +1437,7 @@
CachedStatement: TInstantStatement;
begin
{$IFDEF IO_STATEMENT_LOGGING}
- InstantLogStatement(InstantLogStatementBefore, AStatement, AParams);
+ InstantLogStatement(InstantLogStatementSelect, AStatement, AParams);
{$ENDIF}
Result := nil;
if FStatementCacheCapacity <> 0 then
@@ -1739,6 +1746,58 @@
FBroker := ABroker;
end;
+function TInstantCustomResolver.CreateEmbeddedObjectInputStream(
+ const AConnector: TInstantConnector; const AField: TField): TStream;
+{$IFDEF D12+}
+var
+ LEncoding: TEncoding;
+{$ENDIF}
+begin
+ Assert(Assigned(AConnector));
+ Assert(Assigned(AField));
+
+ {$IFDEF D12+}
+ if AConnector.BlobStreamFormat = sfBinary then
+ Result := TBytesStream.Create(AField.AsBytes)
+ else
+ begin
+ TEncoding.GetBufferEncoding(AField.AsBytes, LEncoding);
+ Result := TInstantStringStream.Create(LEncoding.GetString(AField.AsBytes));
+ end;
+ {$ELSE}
+ Result := TInstantStringStream.Create(AField.AsString);
+ {$ENDIF}
+end;
+
+function TInstantCustomResolver.CreateEmbeddedObjectOutputStream(
+ const AConnector: TInstantConnector): TStream;
+begin
+ Assert(Assigned(AConnector));
+
+ {$IFDEF D12+}
+ if AConnector.BlobStreamFormat = sfBinary then
+ Result := TBytesStream.Create
+ else
+ Result := TStringStream.Create('', TEncoding.UTF8);
+ {$ELSE}
+ Result := TStringStream.Create('');
+ {$ENDIF}
+end;
+
+procedure TInstantCustomResolver.AssignEmbeddedObjectStreamToField(
+ const AConnector: TInstantConnector; const AStream: TStream; const AField: TField);
+begin
+ Assert(Assigned(AConnector));
+ Assert(Assigned(AStream));
+ Assert(Assigned(AField));
+ Assert(AField is TBlobField);
+
+ if AConnector.BlobStreamFormat = sfBinary then
+ TBlobField(AField).LoadFromStream(AStream)
+ else
+ AField.AsString := (AStream as TStringStream).DataString;
+end;
+
procedure TInstantCustomResolver.DisposeMap(AObject: TInstantObject;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
Info: PInstantOperationInfo);
@@ -2329,7 +2388,7 @@
procedure TInstantNavigationalResolver.ReadPart(Attribute: TInstantPart);
var
Field: TField;
- Stream: TInstantStringStream;
+ Stream: TStream;
PartClassName: string;
ObjID: string;
begin
@@ -2356,7 +2415,7 @@
Field := FieldByName(Metadata.FieldName);
if not FieldHasObjects(Field) then
Exit;
- Stream := TInstantStringStream.Create(Field.AsString);
+ Stream := CreateEmbeddedObjectInputStream(Connector, Field);
try
LoadObjectFromStream(Stream);
finally
@@ -2369,7 +2428,7 @@
procedure TInstantNavigationalResolver.ReadParts(Attribute: TInstantParts);
var
Field: TField;
- Stream: TInstantStringStream;
+ Stream: TStream;
LinkDatasetResolver: TInstantNavigationalLinkResolver;
begin
with Attribute do
@@ -2386,7 +2445,7 @@
Field := FieldByName(Metadata.FieldName);
if not FieldHasObjects(Field) then
Exit;
- Stream := TInstantStringStream.Create(Field.AsString);
+ Stream := CreateEmbeddedObjectInputStream(Connector, Field);
try
LoadObjectsFromStream(Stream);
finally
@@ -2413,7 +2472,7 @@
Attribute: TInstantReferences);
var
Field: TField;
- Stream: TInstantStringStream;
+ Stream: TStream;
LinkDatasetResolver: TInstantNavigationalLinkResolver;
begin
with Attribute do
@@ -2430,7 +2489,7 @@
Field := FieldByName(Metadata.FieldName);
if not FieldHasObjects(Field) then
Exit;
- Stream := TInstantStringStream.Create(Field.AsString);
+ Stream := CreateEmbeddedObjectInputStream(Connector, Field);
try
LoadReferencesFromStream(Stream);
finally
@@ -2611,7 +2670,7 @@
procedure TInstantNavigationalResolver.WritePart(Attribute: TInstantPart);
var
Field: TField;
- Stream: TStringStream;
+ Stream: TStream;
begin
with Attribute do
begin
@@ -2622,16 +2681,15 @@
Value.ClassName;
FieldByName(Metadata.FieldName + InstantIdFieldName).AsString :=
Value.Id;
-// Value.ObjectStore.StoreObject(Value, caIgnore);
StoreObject(Value, caIgnore);
end
else
begin
Field := FieldByName(Metadata.FieldName);
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Attribute.Connector);
try
SaveObjectToStream(Stream);
- Field.AsString := Stream.DataString;
+ AssignEmbeddedObjectStreamToField(Attribute.Connector, Stream, Field);
finally
Stream.Free;
end;
@@ -2642,7 +2700,7 @@
procedure TInstantNavigationalResolver.WriteParts(Attribute: TInstantParts);
var
Field: TField;
- Stream: TStringStream;
+ Stream: TStream;
LinkDatasetResolver: TInstantNavigationalLinkResolver;
begin
with Attribute do
@@ -2663,10 +2721,10 @@
else
begin
Field := FieldByName(Metadata.FieldName);
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Attribute.Connector);
try
SaveObjectsToStream(Stream);
- Field.AsString := Stream.DataString;
+ AssignEmbeddedObjectStreamToField(Attribute.Connector, Stream, Field);
finally
Stream.Free;
end;
@@ -2689,7 +2747,7 @@
Attribute: TInstantReferences);
var
Field: TField;
- Stream: TStringStream;
+ Stream: TStream;
LinkDatasetResolver: TInstantNavigationalLinkResolver;
begin
with Attribute do
@@ -2709,10 +2767,10 @@
else
begin
Field := FieldByName(Metadata.FieldName);
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Attribute.Connector);
try
SaveReferencesToStream(Stream);
- Field.AsString := Stream.DataString;
+ AssignEmbeddedObjectStreamToField(Attribute.Connector, Stream, Field);
finally
Stream.Free;
end;
@@ -2745,6 +2803,7 @@
var
FieldName: string;
+ (* No longer used. To be removed when things stabilize with D2009.
procedure AddBlobParam(const AFieldName, Value: string);
var
Param: TParam;
@@ -2762,6 +2821,7 @@
if Value <> '' then
Param.AsMemo := Value
end;
+ *)
procedure AddBlobAttributeParam;
var
@@ -2864,7 +2924,7 @@
procedure AddPartAttributeParam;
var
- Stream: TStringStream;
+ Stream: TStream;
Part: TInstantPart;
begin
if Attribute.Metadata.StorageKind = skExternal then
@@ -2876,13 +2936,10 @@
end
else
begin
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Broker.Connector);
try
(Attribute as TInstantPart).SaveObjectToStream(Stream);
- if Broker.Connector.BlobStreamFormat = sfBinary then
- AddBlobParam(FieldName, Stream.DataString)
- else
- AddMemoParam(FieldName, Stream.DataString);
+ AddEmbeddedObjectOutputParam(Broker.Connector, Params, FieldName, Stream);
finally
Stream.Free;
end;
@@ -2891,15 +2948,12 @@
procedure AddPartsAttributeParam;
var
- Stream: TStringStream;
+ Stream: TStream;
begin
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Broker.Connector);
try
(Attribute as TInstantParts).SaveObjectsToStream(Stream);
- if Broker.Connector.BlobStreamFormat = sfBinary then
- AddBlobParam(FieldName, Stream.DataString)
- else
- AddMemoParam(FieldName, Stream.DataString);
+ AddEmbeddedObjectOutputParam(Broker.Connector, Params, FieldName, Stream);
finally
Stream.Free;
end;
@@ -2917,15 +2971,12 @@
procedure AddReferencesAttributeParam;
var
- Stream: TStringStream;
+ Stream: TStream;
begin
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Broker.Connector);
try
(Attribute as TInstantReferences).SaveReferencesToStream(Stream);
- if Broker.Connector.BlobStreamFormat = sfBinary then
- AddBlobParam(FieldName, Stream.DataString)
- else
- AddMemoParam(FieldName, Stream.DataString);
+ AddEmbeddedObjectOutputParam(Broker.Connector, Params, FieldName, Stream);
finally
Stream.Free;
end;
@@ -3008,6 +3059,37 @@
AddIntegerParam(Params, ConcurrencyParamName, AUpdateCount);
end;
+procedure TInstantSQLResolver.AddEmbeddedObjectOutputParam(
+ const AConnector: TInstantConnector; const AParams: TParams;
+ const AParamName: string; const AStream: TStream);
+var
+ LParam: TParam;
+begin
+ Assert(Assigned(AConnector));
+ Assert(Assigned(AParams));
+ Assert(AParamName <> '');
+ Assert(Assigned(AStream));
+
+ // Look in TInstantCustomResolver.CreateEmbeddedObjectOutputStream
+ // to see the stream type. Change there need to be propagated here.
+ if AConnector.BlobStreamFormat = sfBinary then
+ begin
+ LParam := AddParam(AParams, AParamName, ftBlob);
+ if AStream.Size > 0 then
+ {$IFDEF D12+}
+ LParam.AsBytes := (AStream as TBytesStream).Bytes;
+ {$ELSE}
+ LParam.AsMemo := (AStream as TStringStream).DataString;
+ {$ENDIF}
+ end
+ else
+ begin
+ LParam := AddParam(AParams, AParamName, ftMemo);
+ if AStream.Size > 0 then
+ LParam.AsMemo := (AStream as TStringStream).DataString;
+ end;
+end;
+
procedure TInstantSQLResolver.AddIdParam(Params: TParams;
const ParamName, Value: string);
var
@@ -3062,6 +3144,9 @@
TransError: Exception;
begin
try
+ {$IFDEF IO_STATEMENT_LOGGING}
+ InstantLogStatement(InstantLogStatementExecute, AStatement, AParams);
+ {$ENDIF}
Result := Broker.Execute(AStatement, AParams);
Info.Success := Result >= 1;
Info.Conflict := not (Info.Success or (ConflictAction = caIgnore));
@@ -3557,7 +3642,7 @@
procedure ReadPartAttribute;
var
- Stream: TInstantStringStream;
+ Stream: TStream;
LPartClassName: string;
LPartId: string;
begin
@@ -3583,8 +3668,9 @@
end
else
begin
- Stream := TInstantStringStream.Create(ReadBlobField(DataSet,
- AFieldName));
+ Stream := CreateEmbeddedObjectInputStream(
+ (Attribute as TInstantPart).Connector,
+ DataSet.FieldByName(AFieldName));
try
if Stream.Size = 0 then
(Attribute as TInstantPart).Reset
@@ -3598,7 +3684,7 @@
procedure ReadPartsAttribute;
var
- Stream: TInstantStringStream;
+ Stream: TStream;
LinkResolver: TInstantSQLLinkResolver;
begin
if AttributeMetadata.StorageKind = skExternal then
@@ -3618,7 +3704,9 @@
end
else
begin
- Stream := TInstantStringStream.Create(ReadBlobField(DataSet, AFieldName));
+ Stream := CreateEmbeddedObjectInputStream(
+ (Attribute as TInstantParts).Connector,
+ DataSet.FieldByName(AFieldName));
try
if Stream.Size = 0 then
(Attribute as TInstantParts).Reset
@@ -3639,7 +3727,7 @@
procedure ReadReferencesAttribute;
var
- Stream: TInstantStringStream;
+ Stream: TStream;
LinkResolver: TInstantSQLLinkResolver;
begin
if AttributeMetadata.StorageKind = skExternal then
@@ -3659,7 +3747,9 @@
end
else
begin
- Stream := TInstantStringStream.Create(ReadBlobField(DataSet, AFieldName));
+ Stream := CreateEmbeddedObjectInputStream(
+ (Attribute as TInstantReferences).Connector,
+ DataSet.FieldByName(AFieldName));
try
if Stream.Size = 0 then
(Attribute as TInstantReferences).Reset
@@ -3728,7 +3818,7 @@
function TInstantSQLResolver.ReadBlobField(DataSet: TDataSet;
const FieldName: string): string;
begin
- Result := DataSet.FieldByName(FieldName).AsString
+ Result := DataSet.FieldByName(FieldName).AsString;
end;
function TInstantSQLResolver.ReadBooleanField(DataSet: TDataSet;
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2009-08-14 19:28:40 UTC (rev 826)
+++ trunk/Source/Core/InstantClasses.pas 2009-08-15 10:38:20 UTC (rev 827)
@@ -1465,7 +1465,9 @@
I: Integer;
Esc: string;
C: Char;
+ LString: string;
begin
+ LString := '';
for I := 1 to Length(Data) do
begin
C := Data[I];
@@ -1484,11 +1486,12 @@
Esc := 'gt';
end;
Esc := Format(EscStr, [Esc]);
- WriteString(Esc);
+ LString := LString + EscStr;
end
else
- WriteString(C);
+ LString := LString + C;
end;
+ WriteString(LString);
FLastToken := xtData;
end;
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-08-14 19:28:40 UTC (rev 826)
+++ trunk/Source/Core/InstantPersistence.pas 2009-08-15 10:38:20 UTC (rev 827)
@@ -446,8 +446,8 @@
function GetStream: TMemoryStream;
property Stream: TMemoryStream read GetStream;
protected
- function GetValue: AnsiString; virtual;
- procedure SetValue(const AValue: AnsiString); virtual;
+ function GetValue: string; virtual;
+ procedure SetValue(const AValue: string); virtual;
class function AttributeType: TInstantAttributeType; override;
function GetAsString: string; override;
function GetAsVariant: Variant; override;
@@ -472,7 +472,7 @@
function WriteBuffer(const Buffer; Position, Count: Integer): Integer;
property Size: Integer read GetSize;
published
- property Value: AnsiString read GetValue write SetValue;
+ property Value: string read GetValue write SetValue;
end;
TInstantMemo = class(TInstantBlob)
@@ -3485,12 +3485,15 @@
Result := FStream;
end;
-function TInstantBlob.GetValue: AnsiString;
+function TInstantBlob.GetValue: string;
+var
+ LValue: AnsiString;
begin
if Size > 0 then
begin
- SetLength(Result, Size div SizeOf(AnsiChar));
- Read(Result[1], 0, Size);
+ SetLength(LValue, Size div SizeOf(AnsiChar));
+ Read(LValue[1], 0, Size);
+ Result := string(LValue);
end
else
Result := '';
@@ -3568,15 +3571,17 @@
end;
end;
-procedure TInstantBlob.SetValue(const AValue: AnsiString);
+procedure TInstantBlob.SetValue(const AValue: string);
var
L: Integer;
+ LValue: AnsiString;
begin
- L := Length(AValue) * SizeOf(AnsiChar);
+ LValue := AnsiString(AValue);
+ L := Length(LValue) * SizeOf(AnsiChar);
if L > 0 then
begin
Stream.Clear;
- WriteBuffer(AValue[1], 0, L);
+ WriteBuffer(LValue[1], 0, L);
Stream.Size := L;
end
else
@@ -4433,9 +4438,11 @@
begin
MemoryStream := TMemoryStream.Create;
try
- //CB: I don't know why MS-SQL via ADO or via DBX returns a stream with wrong size (+1)
- //so I've changed this test adding -1 (for other brokers this is not a problem)
- while AStream.Position < AStream.Size -1 do
+ // After reading the last object, the XML stream may still contain a few
+ // bytes for the final line break (in case the XML cose is beautified),
+ // so we go ahead and read another object ony if there's more bytes in the
+ // buffer.
+ while AStream.Position < AStream.Size - (Length(sLineBreak) * SizeOf(Char)) do
begin
MemoryStream.Clear;
InstantObjectTextToBinary(AStream, MemoryStream);
|
|
From: <dav...@us...> - 2009-09-03 09:13:22
|
Revision: 870
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=870&view=rev
Author: davidvtaylor
Date: 2009-09-03 09:13:11 +0000 (Thu, 03 Sep 2009)
Log Message:
-----------
Fix for problem inserting and updating Blob attributes
+ Added new type TInstantBytes to mirror the new TBytes type in D12+
+ Added Bytes property to TInstantBlob to provide access to raw stream data as a byte array
* Modified AddBlobAttributeParam to properly handle data assignment for D12+
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantTypes.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2009-08-29 07:57:59 UTC (rev 869)
+++ trunk/Source/Core/InstantBrokers.pas 2009-09-03 09:13:11 UTC (rev 870)
@@ -2831,7 +2831,11 @@
if Attribute.IsNull then
LParam.Clear
else
- LParam.AsMemo := (Attribute as TInstantBlob).Value;
+ {$IFDEF D12+}
+ LParam.AsBytes := (Attribute as TInstantBlob).Bytes;
+ {$ELSE}
+ LParam.AsBlob := (Attribute as TInstantBlob).Value;
+ {$ENDIF}
end;
procedure AddBooleanAttributeParam;
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-08-29 07:57:59 UTC (rev 869)
+++ trunk/Source/Core/InstantPersistence.pas 2009-09-03 09:13:11 UTC (rev 870)
@@ -446,6 +446,8 @@
function GetStream: TMemoryStream;
property Stream: TMemoryStream read GetStream;
protected
+ function GetBytes: TInstantBytes;
+ procedure SetBytes(const AValue: TInstantBytes);
function GetValue: string; virtual;
procedure SetValue(const AValue: string); virtual;
class function AttributeType: TInstantAttributeType; override;
@@ -472,6 +474,7 @@
function WriteBuffer(const Buffer; Position, Count: Integer): Integer;
property Size: Integer read GetSize;
published
+ property Bytes: TInstantBytes read GetBytes write SetBytes;
property Value: string read GetValue write SetValue;
end;
@@ -3458,6 +3461,13 @@
Result := Value;
end;
+function TInstantBlob.GetBytes: TInstantBytes;
+begin
+ SetLength(Result, Size);
+ if Size > 0 then
+ Read(Result[0], 0, Size);
+end;
+
function TInstantBlob.GetSize: Integer;
begin
Result := Stream.Size;
@@ -3556,6 +3566,21 @@
end;
end;
+procedure TInstantBlob.SetBytes(const AValue: TInstantBytes);
+var
+ L: Integer;
+begin
+ L := length(AValue);
+ if L > 0 then
+ begin
+ Stream.Clear;
+ WriteBuffer(AValue[0], 0, L);
+ Stream.Size := L;
+ end
+ else
+ Clear;
+end;
+
procedure TInstantBlob.SetValue(const AValue: string);
var
L: Integer;
Modified: trunk/Source/Core/InstantTypes.pas
===================================================================
--- trunk/Source/Core/InstantTypes.pas 2009-08-29 07:57:59 UTC (rev 869)
+++ trunk/Source/Core/InstantTypes.pas 2009-09-03 09:13:11 UTC (rev 870)
@@ -40,6 +40,11 @@
interface
+{$IFDEF D12+}
+uses
+ Sysutils; // TBytes
+{$ENDIF}
+
type
{$IFNDEF D6+}
IInterface = interface (IUnknown)
@@ -89,6 +94,12 @@
TTime = type TDateTime;
TDate = type TDateTime;
+ {$IFDEF D12+}
+ TInstantBytes = TBytes;
+ {$ELSE}
+ TInstantBytes = array of Byte;
+ {$ENDIF}
+
implementation
end.
|
|
From: <dav...@us...> - 2009-12-21 04:52:22
|
Revision: 879
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=879&view=rev
Author: davidvtaylor
Date: 2009-12-21 04:52:06 +0000 (Mon, 21 Dec 2009)
Log Message:
-----------
* Fix memory leak with TInstantExposer that occurs if the exposer is destroyed with Subject changes pending. The exposer changes are now Undone and the Subject set to Nil in the exposer destructor.
* Small optimization in TInstantConnector.GetClientCount to prevent the underlying list from being unnecessarily created when checking if the list is empty.
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantPresentation.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-12-19 16:27:18 UTC (rev 878)
+++ trunk/Source/Core/InstantPersistence.pas 2009-12-21 04:52:06 UTC (rev 879)
@@ -8711,7 +8711,10 @@
function TInstantConnector.GetClientCount: Integer;
begin
- Result := ClientList.Count;
+ if (assigned(FClientList)) then
+ Result := FClientList.Count
+ else
+ Result := 0;
end;
function TInstantConnector.GetClientList: TList;
Modified: trunk/Source/Core/InstantPresentation.pas
===================================================================
--- trunk/Source/Core/InstantPresentation.pas 2009-12-19 16:27:18 UTC (rev 878)
+++ trunk/Source/Core/InstantPresentation.pas 2009-12-21 04:52:06 UTC (rev 879)
@@ -2545,6 +2545,11 @@
destructor TInstantCustomExposer.Destroy;
begin
+ // Ensure the Exposer is closed. Active will always be False
+ // for TInstantExposer since the Subject is already set to Nil
+ // (see TInstantExposer.Destroy for more details).
+ if Active then
+ Close;
FNotifier.Free;
DestroyAccessor;
if (csDesigning in ComponentState) and Assigned(DesignModel) then
@@ -4413,6 +4418,10 @@
destructor TInstantExposer.Destroy;
begin
+ // Clear the Subject to Undo any pending changes and deactivate the
+ // Exposer. This prevents TDataSet.Destroy from causing the Subject
+ // be unexpectedly accessed later in the destruction sequence.
+ SetSubject(nil);
FMasterLink.Free;
inherited;
end;
|
|
From: <wp...@us...> - 2009-12-21 09:14:00
|
Revision: 880
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=880&view=rev
Author: wp2udk
Date: 2009-12-21 09:13:48 +0000 (Mon, 21 Dec 2009)
Log Message:
-----------
Added support for Custom Attributes in InstantObjects. In the future this initiative (custom attributes) might replace Metadata comments (See post "info: Fix for Delphi 2010 Custom Attributes"). This is a fairly new implementation and it NEEDS a great amount of DESIGN and TEST. Below you'll see a code example on how things might be implemented in the future.
Model implementation:
TContact = class(TInstantObject)
{IOMETADATA stored;
Address: Part(TAddress);
Name: String(30);
Phones: Parts(TPhone); }
[IOATTRIBUTE(atPart, -1, TAddress)]
_Address: TInstantPart;
[IOATTRIBUTE(atString, 30, nil)]
_Name: TInstantString;
[IOATTRIBUTE(atParts, -1, TPhone)]
_Phones: TInstantParts;
private
function GetAddress: TAddress;
function GetName: string;
function GetPhoneCount: Integer;
function GetPhones(Index: Integer): TPhone;
procedure SetAddress(Value: TAddress);
procedure SetName(const Value: string);
procedure SetPhones(Index: Integer; Value: TPhone);
public
function AddPhone(Phone: TPhone): Integer;
procedure ClearPhones;
procedure DeletePhone(Index: Integer);
function IndexOfPhone(Phone: TPhone): Integer;
procedure InsertPhone(Index: Integer; Phone: TPhone);
function RemovePhone(Phone: TPhone): Integer;
property PhoneCount: Integer read GetPhoneCount;
property Phones[Index: Integer]: TPhone read GetPhones write SetPhones;
published
property Address: TAddress read GetAddress write SetAddress;
property Name: string read GetName write SetName;
end;
Custom Attribute implementation:
IOATTRIBUTE = class(TInstantRttiFieldAttribute)
private
FAttributeType: TInstantAttributeType;
FDataSize: Integer;
FRef: TInstantObjectClass;
protected
procedure InternalChange(AObject: TInstantObject; AField: TRttiField); override;
public
constructor Create(AAttributeType: TInstantAttributeType; ADataSize: Integer;
ARef: TInstantObjectClass = nil);
property AttributeType: TInstantAttributeType read FAttributeType write FAttributeType;
property DataSize: Integer read FDataSize write FDataSize;
property ARef: TInstantObjectClass read FRef write FRef;
end;
implementation
{ IOATTRIBUTE }
constructor IOATTRIBUTE.Create(AAttributeType: TInstantAttributeType;
ADataSize: Integer; ARef: TInstantObjectClass = nil);
begin
FAttributeType := AAttributeType;
FDataSize := ADataSize;
FRef := ARef;
end;
procedure IOATTRIBUTE.InternalChange(AObject: TInstantObject;
AField: TRttiField);
var
Attribute: TInstantAttribute;
begin
inherited;
Attribute := AField.GetValue(AObject).AsObject as TInstantAttribute;
with Attribute.Metadata do
begin
AttributeType := FAttributeType;
DataSize := FDataSize;
if FAttributeType in [atPart, atParts, atReference, atReferences] then
ObjectClassName := FRef.ClassName;
end;
end;
Modified Paths:
--------------
trunk/Source/Core/InstantPersistence.pas
Added Paths:
-----------
trunk/Source/Core/InstantRttiAttributes.pas
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-12-21 04:52:06 UTC (rev 879)
+++ trunk/Source/Core/InstantPersistence.pas 2009-12-21 09:13:48 UTC (rev 880)
@@ -1610,6 +1610,9 @@
{$ELSE}
Mask,
{$ENDIF}
+{$IFDEF D14+}
+ RTTI, InstantRttiAttributes,
+{$ENDIF}
InstantUtils, {InstantRtti, }InstantDesignHook, InstantCode;
var
@@ -2440,7 +2443,48 @@
end;
procedure TInstantAttribute.Initialize;
+
+{$IFDEF D14+}
+ procedure InitializeRttiAttributes;
+
+ procedure InvokeRttiAttribute(RttiMember: TRttiMember);
+ var
+ CustomAttribute: TCustomAttribute;
+ begin
+ for CustomAttribute in RttiMember.GetAttributes do
+ if CustomAttribute is TInstantRttiAttribute then
+ TInstantRttiAttribute(CustomAttribute).Change(Self, RttiMember);
+ end;
+
+ var
+ RttiContext: TRttiContext;
+ RttiType: TRttiType;
+ RttiField: TRttiField;
+ RttiMethod: TRttiMethod;
+ RttiProperty: TRttiProperty;
+ begin
+ RttiContext := TRttiContext.Create;
+ try
+ RttiType := RttiContext.GetType(Self.ClassType);
+
+ for RttiField in RttiType.GetFields do
+ InvokeRttiAttribute(RttiField);
+
+ for RttiMethod in RttiType.GetMethods do
+ InvokeRttiAttribute(RttiMethod);
+
+ for RttiProperty in RttiType.GetProperties do
+ InvokeRttiAttribute(RttiProperty);
+ finally
+ RttiContext.Free
+ end;
+ end;
+{$ENDIF}
+
begin
+{$IFDEF D14+}
+ InitializeRttiAttributes;
+{$ENDIF}
end;
procedure TInstantAttribute.ReadName(Reader: TInstantReader);
Added: trunk/Source/Core/InstantRttiAttributes.pas
===================================================================
--- trunk/Source/Core/InstantRttiAttributes.pas (rev 0)
+++ trunk/Source/Core/InstantRttiAttributes.pas 2009-12-21 09:13:48 UTC (rev 880)
@@ -0,0 +1,94 @@
+(*
+ * InstantObjects
+ * Delphi 2010 Custom Attributes framework
+ *)
+
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is: Brian Andersen
+ *
+ * The Initial Developer of the Original Code is: Seleqt
+ *
+ * Portions created by the Initial Developer are Copyright (C) 2001-2003
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ * Brian Andersen
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit InstantRttiAttributes;
+
+interface
+
+uses
+ InstantPersistence, Rtti;
+
+type
+ TInstantRttiAttribute = class(TCustomAttribute)
+ public
+ procedure Change(AObject: TInstantObject; AMember: TRttiMember); virtual; abstract;
+ end;
+
+ TInstantRttiAttributeClass = class of TInstantRttiAttribute;
+
+ TInstantRttiFieldAttribute = class(TInstantRttiAttribute)
+ protected
+ procedure InternalChange(AObject: TInstantObject; AField: TRttiField); virtual; abstract;
+ public
+ procedure Change(AObject: TInstantObject; AMember: TRttiMember); override;
+ end;
+
+ TInstantRttiMethodAttribute = class(TInstantRttiAttribute)
+ protected
+ procedure InternalChange(AObject: TInstantObject; AMethod: TRttiMethod); virtual; abstract;
+ public
+ procedure Change(AObject: TInstantObject; AMember: TRttiMember); override;
+ end;
+
+ TInstantRttiPropertyAttribute = class(TInstantRttiAttribute)
+ protected
+ procedure InternalChange(AObject: TInstantObject; AProperty: TRttiProperty); virtual; abstract;
+ public
+ procedure Change(AObject: TInstantObject; AMember: TRttiMember); override;
+ end;
+
+
+implementation
+
+{ TInstantRttiFieldAttribute }
+
+procedure TInstantRttiFieldAttribute.Change(AObject: TInstantObject;
+ AMember: TRttiMember);
+begin
+ InternalChange(AObject, AMember as TRttiField);
+end;
+
+{ TInstantRttiMethodAttribute }
+
+procedure TInstantRttiMethodAttribute.Change(AObject: TInstantObject;
+ AMember: TRttiMember);
+begin
+ InternalChange(AObject, AMember as TRttiMethod);
+end;
+
+{ TInstantRttiPropertyAttribute }
+
+procedure TInstantRttiPropertyAttribute.Change(AObject: TInstantObject;
+ AMember: TRttiMember);
+begin
+ InternalChange(AObject, AMember as TRttiProperty);
+end;
+
+end.
\ No newline at end of file
Property changes on: trunk/Source/Core/InstantRttiAttributes.pas
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
|
|
From: <dav...@us...> - 2010-04-18 05:35:46
|
Revision: 897
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=897&view=rev
Author: davidvtaylor
Date: 2010-04-18 05:35:40 +0000 (Sun, 18 Apr 2010)
Log Message:
-----------
* Revised Model Explorer code parser to support compound unit names in the uses clause of model units
Modified Paths:
--------------
trunk/Source/Core/InstantCode.pas
trunk/Source/Core/InstantTextFiler.pas
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2010-02-02 23:06:30 UTC (rev 896)
+++ trunk/Source/Core/InstantCode.pas 2010-04-18 05:35:40 UTC (rev 897)
@@ -5701,38 +5701,32 @@
procedure TInstantCodeUsesClause.InternalRead(Reader: TInstantCodeReader);
var
Token: string;
- GotName: Boolean;
+ Ident: string;
BeginPos: TInstantCodePos;
+ UsedUnit: TInstantCodeUses;
begin
inherited;
- GotName := False;
while not Reader.Finished and not Reader.ReadEndOfStatement do
begin
Reader.SkipSpace;
BeginPos := Reader.Position;
+ Ident := Reader.ReadIdent(True);
+ if (Ident = '') then
+ Reader.ErrorExpected('unit name', False);
+ UsedUnit := Add;
+ UsedUnit.Name := Ident;
+ UsedUnit.EndPos := Reader.Position;
+ UsedUnit.StartPos := BeginPos;
Token := Reader.ReadToken;
- if Token = ';' then
- Break;
- if Token = ',' then
+ if SameText(Token, 'in') then
begin
- if not GotName then
- Reader.ErrorExpected('unit name', False);
- GotName := False;
- end else if GotName then
- Reader.ErrorExpected(',')
- else begin
- with Add do
- begin
- StartPos := BeginPos;
- Name := Token;
- EndPos := Reader.Position;
- if SameText(Reader.ReadToken, 'in') then
- Reader.ReadString
- else
- Reader.Position := EndPos;
- end;
- GotName := True;
+ Reader.ReadString;
+ Token := Reader.ReadToken;
end;
+ if Token = ';' then
+ Break;
+ if Token <> ',' then
+ Reader.ErrorExpected(', or ; ' + Token);
end;
end;
Modified: trunk/Source/Core/InstantTextFiler.pas
===================================================================
--- trunk/Source/Core/InstantTextFiler.pas 2010-02-02 23:06:30 UTC (rev 896)
+++ trunk/Source/Core/InstantTextFiler.pas 2010-04-18 05:35:40 UTC (rev 897)
@@ -39,7 +39,8 @@
interface
uses
- Classes, InstantClasses;
+ Classes, InstantClasses
+ {$IFDEF D12+}, Character{$ENDIF};
type
PInstantTextPos = ^TInstantTextPos;
@@ -92,6 +93,8 @@
function GetBof: Boolean; override;
function GetEof: Boolean; override;
procedure Initialize; override;
+ function IsIdentPrefix(Ch: Char): Boolean;
+ function IsIdentChar(Ch: Char; AllowDots: boolean): Boolean;
function IsNumericPrefix(Ch: Char): Boolean;
function IsStringDelimiter(Ch: Char): Boolean;
public
@@ -106,6 +109,7 @@
function ReadNext(const Str: string; StopBefore: Boolean = False): string;
function ReadNumeric: string; virtual;
function ReadString: string; virtual;
+ function ReadIdent(AllowDots: boolean): string;
function ReadToken: string;
function SkipSpace: Boolean;
procedure UnreadToken;
@@ -317,6 +321,27 @@
ConstAware := True;
end;
+function TInstantTextReader.IsIdentPrefix(Ch: Char): Boolean;
+begin
+{$IFDEF D12+}
+ Result := TCharacter.IsLetter(Ch) or (Ch = '_');
+{$ELSE}
+ Result := Ch in ['A'..'Z','a'..'z','_'];
+{$ENDIF}
+end;
+
+function TInstantTextReader.IsIdentChar(Ch: Char; AllowDots: boolean): Boolean;
+begin
+{$IFDEF D12+}
+ Result := TCharacter.IsLetterOrDigit(Ch) or (Ch = '_') or (AllowDots and (Ch = '.'))
+{$ELSE}
+ if (AllowDots) then
+ Result := Ch in ['A'..'Z','a'..'z','_','.']
+ else
+ Result := Ch in ['A'..'Z','a'..'z','_'];
+{$ENDIF}
+end;
+
function TInstantTextReader.IsNumericPrefix(Ch: Char): Boolean;
begin
Result := ConstAware and
@@ -457,6 +482,38 @@
Position := SavePos;
end;
+function TInstantTextReader.ReadIdent(AllowDots: boolean): string;
+var
+ Ch: Char;
+ SavePos: TInstantTextPos;
+begin
+ Result := '';
+ if Eof then
+ Exit;
+ FTokenPos := Position;
+ Ch := ReadChar;
+ while IsSpace(Ch) do
+ begin
+ FTokenPos := Position;
+ if Eof then
+ Exit;
+ Ch := ReadChar;
+ end;
+ if (not IsIdentPrefix(Ch)) then
+ begin
+ Position := FTokenPos;
+ Exit;
+ end;
+ repeat
+ Result := Result + Ch;
+ if Eof then
+ Exit;
+ SavePos := Position;
+ Ch := ReadChar;
+ until not IsIdentChar(Ch,AllowDots);
+ Position := SavePos;
+end;
+
function TInstantTextReader.ReadToken: string;
var
Ch: Char;
|
|
From: <na...@us...> - 2010-09-11 16:51:06
|
Revision: 905
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=905&view=rev
Author: nandod
Date: 2010-09-11 16:51:00 +0000 (Sat, 11 Sep 2010)
Log Message:
-----------
* UseUnicode connector property. Enables unicode features not enabled by default in unicode versions of Delphi (D2009+), such as wide (unicode) memo fields. Tested only on D2009+.
* TInstantObject.DoAttributeChanged made virtual.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-09-11 16:47:56 UTC (rev 904)
+++ trunk/Source/Core/InstantBrokers.pas 2010-09-11 16:51:00 UTC (rev 905)
@@ -2899,6 +2899,19 @@
LParam.AsMemo := MemoAttrib.Value;
end;
+ procedure AddWideMemoAttributeParam;
+ var
+ LParam: TParam;
+ MemoAttrib: TInstantMemo;
+ begin
+ LParam := AddParam(Params, FieldName, ftWideMemo);
+ MemoAttrib := (Attribute as TInstantMemo);
+ if (MemoAttrib.Size = 0) or Attribute.IsNull then
+ LParam.Clear
+ else
+ LParam.Value := MemoAttrib.AsString;
+ end;
+
procedure AddPartAttributeParam;
var
Stream: TStream;
@@ -2988,6 +3001,9 @@
atInteger:
AddIntegerAttributeParam;
atMemo:
+ if Broker.Connector.UseUnicode then
+ AddWideMemoAttributeParam
+ else
AddMemoAttributeParam;
atPart:
AddPartAttributeParam;
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2010-09-11 16:47:56 UTC (rev 904)
+++ trunk/Source/Core/InstantPersistence.pas 2010-09-11 16:51:00 UTC (rev 905)
@@ -792,7 +792,6 @@
procedure DoAfterRefresh;
procedure DoAfterRetrieve;
procedure DoAfterStore;
- procedure DoAttributeChanged(Attribute: TInstantAttribute);
procedure DoBeforeContentChange(Container: TInstantContainer;
ChangeType: TInstantContentChangeType; Index: Integer; AObject: TInstantObject);
procedure DoBeforeDispose;
@@ -848,6 +847,7 @@
property SavedState: TInstantObjectState read GetSavedState;
property State: TInstantObjectState read GetState;
protected
+ procedure DoAttributeChanged(Attribute: TInstantAttribute); virtual;
procedure Abandon;
procedure AfterAddRef; virtual;
procedure AfterAssign; virtual;
@@ -1412,6 +1412,7 @@
FOnGenerateId: TInstantGenerateIdEvent;
FIdSize: Integer;
FIdDataType: TInstantDataType;
+ FUseUnicode: Boolean;
procedure AbandonObjects;
procedure ApplyTransactedObjectStates;
procedure ClearTransactedObjects;
@@ -1497,6 +1498,8 @@
default False;
property UseTransactions: Boolean read FUseTransactions
write FUseTransactions default True;
+ property UseUnicode: Boolean read FUseUnicode write FUseUnicode
+ default False;
property BeforeBuildDatabase: TInstantSchemeEvent read FBeforeBuildDatabase
write FBeforeBuildDatabase;
property BlobStreamFormat: TInstantStreamFormat read FBlobStreamFormat
@@ -1515,6 +1518,7 @@
FBlobStreamFormat: TInstantStreamFormat;
FIdSize: Integer;
FIdDataType: TInstantDataType;
+ FUseUnicode: Boolean;
protected
function GetCaption: string; virtual;
procedure InitConnector(Connector: TInstantConnector); virtual;
@@ -1533,6 +1537,8 @@
default dtString;
property IdSize: Integer read FIdSize write FIdSize
default InstantDefaultFieldSize;
+ property UseUnicode: Boolean read FUseUnicode write FUseUnicode
+ default False;
end;
TInstantConnectionDefs = class(TInstantCollection)
@@ -8580,6 +8586,7 @@
begin
inherited;
FUseTransactions := True;
+ FUseUnicode := False;
FIdDataType := dtString;
FIdSize := InstantDefaultFieldSize;
end;
@@ -8986,6 +8993,7 @@
FBlobStreamFormat := sfBinary;
FIdDataType := dtString;
FIdSize := InstantDefaultFieldSize;
+ FUseUnicode := False;
end;
function TInstantConnectionDef.CreateConnector(AOwner: TComponent): TInstantConnector;
@@ -9019,6 +9027,7 @@
Connector.BlobStreamFormat := BlobStreamFormat;
Connector.IdDataType := IdDataType;
Connector.IdSize := IdSize;
+ Connector.UseUnicode := UseUnicode;
end;
{ TInstantConnectionDefs }
|
|
From: <na...@us...> - 2010-09-18 08:36:18
|
Revision: 927
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=927&view=rev
Author: nandod
Date: 2010-09-18 08:36:12 +0000 (Sat, 18 Sep 2010)
Log Message:
-----------
+ Parser support for class-level custom RTTI attributes.
Modified Paths:
--------------
trunk/Source/Core/InstantCode.pas
Property Changed:
----------------
trunk/Source/Core/DXE/
Property changes on: trunk/Source/Core/DXE
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
*.identcache
+ *.dcu
*.local
*.identcache
__history
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2010-09-18 08:07:06 UTC (rev 926)
+++ trunk/Source/Core/InstantCode.pas 2010-09-18 08:36:12 UTC (rev 927)
@@ -3301,7 +3301,8 @@
begin
Result := Reader.ReadChar = '[';
if Result then
- Name := Reader.ReadToken else
+ Name := Reader.ReadToken
+ else
Name := '';
end;
@@ -3315,8 +3316,10 @@
BracketCount := 0;
repeat
C := Reader.ReadChar;
- if C = '[' then Inc(BracketCount) else
- if C = ']' then Dec(BracketCount);
+ if C = '[' then
+ Inc(BracketCount)
+ else if C = ']' then
+ Dec(BracketCount);
until BracketCount = 0;
end;
@@ -5792,7 +5795,8 @@
ReadObjects(Reader, [TInstantCodeRecord, TInstantCodeClassRef,
TInstantCodeClassForward, TInstantCodeClass, TInstantCodeInterface,
TInstantCodeDispInterface, TInstantCodeEnum, TInstantCodeSet,
- TInstantCodeTypeDef, TInstantCodeProcType, TInstantCodeUnknownType]);
+ TInstantCodeTypeDef, TInstantCodeProcType, TInstantCodeRttiAttribute,
+ TInstantCodeUnknownType]);
end;
{ TInstantCodeVars }
|
|
From: <na...@us...> - 2010-11-13 09:57:20
|
Revision: 935
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=935&view=rev
Author: nandod
Date: 2010-11-13 09:57:14 +0000 (Sat, 13 Nov 2010)
Log Message:
-----------
* Burst mode fixes. Bad interactions with the statement cache fixed.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-11-13 09:56:04 UTC (rev 934)
+++ trunk/Source/Core/InstantBrokers.pas 2010-11-13 09:57:14 UTC (rev 935)
@@ -1,4 +1,4 @@
-(*
+ (*
* InstantObjects
* Broker and Connector Classes
*)
@@ -624,11 +624,14 @@
// An item in the statement cache.
TInstantStatement = class
private
- FStatementImplementation: TComponent;
+ FStatementDataSet: TDataSet;
+ FDataSetRefCount: Integer;
public
- constructor Create(const AStatementImplementation: TComponent);
+ constructor Create(const AStatementDataSet: TDataSet);
destructor Destroy; override;
- property StatementImplementation: TComponent read FStatementImplementation;
+ property StatementDataSet: TDataSet read FStatementDataSet;
+ function AddDataSetRef: Integer;
+ function ReleaseDataSetRef: Integer;
end;
// Caches objects that implement command statements in releational brokers.
@@ -650,10 +653,11 @@
property Capacity: Integer read FCapacity write SetCapacity;
destructor Destroy; override;
function GetStatement(const StatementText: string): TInstantStatement;
+ function IndexOfStatementDataSet(const StatementDataSet: TDataSet): Integer;
+ function GetStatementByIndex(const AIndex: Integer): TInstantStatement;
function AddStatement(const StatementText: string;
- const StatementImplementation: TComponent): Integer;
+ const StatementDataSet: TDataSet): Integer;
function RemoveStatement(const StatementText: string): Boolean;
- function HasStatementImplementation(const StatementImplementation: TComponent): Boolean;
end;
// A TInstantCatalog that gathers its info from an existing database (through
@@ -1006,6 +1010,9 @@
FDataSet: TDataSet;
FRecNo: Integer;
FIdField: TField;
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation);
+ override;
public
constructor CreateAndInit(const ADataSet: TDataSet);
property DataSet: TDataSet read FDataSet;
@@ -1044,6 +1051,8 @@
procedure SetParams(Value: TParams); override;
function ObjectFetched(Index: Integer): Boolean; override;
procedure SetStatement(const Value: string); override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation);
+ override;
property ObjectReferenceCount: Integer read GetObjectReferenceCount;
property ObjectReferenceList: TInstantObjectReferenceList read
GetObjectReferenceList;
@@ -1454,8 +1463,25 @@
CachedStatement := StatementCache.GetStatement(AStatement);
if Assigned(CachedStatement) then
begin
- Result := TDataSet(CachedStatement.StatementImplementation);
- AssignDataSetParams(Result, AParams);
+ Result := TDataSet(CachedStatement.StatementDataSet);
+ // The dataset might be already open to serve a burst mode retrieval,
+ // in which case we can reuse it unless it's parametric.
+ if Result.Active then
+ begin
+ if AParams.Count = 0 then
+ Result.First
+ else
+ begin
+ Result.Close;
+ AssignDataSetParams(Result, AParams);
+ Result.Open;
+ end;
+ end
+ else
+ begin
+ AssignDataSetParams(Result, AParams);
+ Result.Open;
+ end;
end;
end;
if not Assigned(Result) then
@@ -1565,11 +1591,22 @@
end;
procedure TInstantSQLBroker.ReleaseDataSet(const ADataSet: TDataSet);
+var
+ I: Integer;
+ LStatement: TInstantStatement;
begin
- if Assigned(FStatementCache) and FStatementCache.HasStatementImplementation(ADataSet) then
- ADataSet.Close
- else
- ADataSet.Free;
+ if Assigned(FStatementCache) then
+ begin
+ I := FStatementCache.IndexOfStatementDataSet(ADataSet);
+ if I >= 0 then
+ begin
+ LStatement := FStatementCache.GetStatementByIndex(I);
+ if LStatement.ReleaseDataSetRef <= 0 then
+ ADataSet.Close;
+ Exit;
+ end;
+ end;
+ ADataSet.Free;
end;
{ TInstantRelationalConnector }
@@ -4378,18 +4415,31 @@
{ TInstantStatement }
-constructor TInstantStatement.Create(const AStatementImplementation: TComponent);
+function TInstantStatement.AddDataSetRef: Integer;
begin
+ Inc(FDataSetRefCount);
+ Result := FDataSetRefCount;
+end;
+
+constructor TInstantStatement.Create(const AStatementDataSet: TDataSet);
+begin
inherited Create;
- FStatementImplementation := AStatementImplementation;
+ FStatementDataSet := AStatementDataSet;
+ FDataSetRefCount := 1;
end;
destructor TInstantStatement.Destroy;
begin
- FStatementImplementation.Free;
+ FStatementDataSet.Free;
inherited;
end;
+function TInstantStatement.ReleaseDataSetRef: Integer;
+begin
+ Dec(FDataSetRefCount);
+ Result := FDataSetRefCount;
+end;
+
{ TInstantStatementCache }
constructor TInstantStatementCache.Create(AOwner: TComponent);
@@ -4409,16 +4459,16 @@
end;
function TInstantStatementCache.AddStatement(const StatementText: string;
- const StatementImplementation: TComponent): Integer;
+ const StatementDataSet: TDataSet): Integer;
var
StatementObject: TInstantStatement;
begin
- if Assigned(StatementImplementation) then
+ if Assigned(StatementDataSet) then
begin
Shrink;
- StatementObject := TInstantStatement.Create(StatementImplementation);
+ StatementObject := TInstantStatement.Create(StatementDataSet);
Result := FStatements.AddObject(StatementText, StatementObject);
- StatementImplementation.FreeNotification(Self);
+ StatementDataSet.FreeNotification(Self);
end
else
Result := -1;
@@ -4448,22 +4498,31 @@
begin
Index := FStatements.IndexOf(StatementText);
if Index >= 0 then
- Result := TInstantStatement(FStatements.Objects[Index])
+ begin
+ Result := TInstantStatement(FStatements.Objects[Index]);
+ Result.AddDataSetRef;
+ end
else
Result := nil;
end;
-function TInstantStatementCache.HasStatementImplementation(
- const StatementImplementation: TComponent): Boolean;
+function TInstantStatementCache.GetStatementByIndex(
+ const AIndex: Integer): TInstantStatement;
+begin
+ Result := TinstantStatement(FStatements.Objects[AIndex]);
+end;
+
+function TInstantStatementCache.IndexOfStatementDataSet(
+ const StatementDataSet: TDataSet): Integer;
var
I: Integer;
begin
- Result := False;
+ Result := -1;
for I := 0 to FStatements.Count - 1 do
begin
- if TinstantStatement(FStatements.Objects[I]).StatementImplementation = StatementImplementation then
+ if TinstantStatement(FStatements.Objects[I]).StatementDataSet = StatementDataSet then
begin
- Result := True;
+ Result := I;
Break;
end;
end;
@@ -4476,7 +4535,7 @@
inherited;
if Operation = opRemove then
for I := FStatements.Count - 1 downto 0 do
- if TInstantStatement(FStatements.Objects[I]).StatementImplementation = AComponent then
+ if TInstantStatement(FStatements.Objects[I]).StatementDataSet = AComponent then
DeleteStatement(I);
end;
@@ -6055,6 +6114,7 @@
FDataSet := AcquireDataSet(Statement, ParamsObject);
if Assigned(FDataSet) then
try
+ FDataSet.FreeNotification(Self);
if not FDataSet.Active then
FDataSet.Open;
InitObjectReferences;
@@ -6078,6 +6138,14 @@
Result := ObjectReferenceList.Remove(AObject as TInstantObject);
end;
+procedure TInstantSQLQuery.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDataSet) then
+ FDataSet := nil;
+end;
+
function TInstantSQLQuery.ObjectFetched(Index: Integer): Boolean;
begin
Result := ObjectReferenceList.RefItems[Index].HasInstance;
@@ -6772,7 +6840,8 @@
constructor TInstantDataSetObjectData.CreateAndInit(const ADataSet: TDataSet);
begin
Assert(Assigned(ADataSet));
- Create;
+ Create(nil);
+ ADataSet.FreeNotification(Self);
FDataSet := ADataSet;
FRecNo := ADataSet.RecNo;
FIdField := ADataSet.FieldByName(InstantIdFieldName);
@@ -6780,8 +6849,21 @@
function TInstantDataSetObjectData.Locate(const AObjectId: string): Boolean;
begin
- FDataSet.RecNo := FRecNo;
- Result := FIdField.AsString = AObjectId;
+ if not Assigned(FDataSet) or not FDataSet.Active then
+ Result := False
+ else
+ begin
+ FDataSet.RecNo := FRecNo;
+ Result := FIdField.AsString = AObjectId;
+ end;
end;
+procedure TInstantDataSetObjectData.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDataSet) then
+ FDataSet := nil;
+end;
+
end.
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2010-11-13 09:56:04 UTC (rev 934)
+++ trunk/Source/Core/InstantClasses.pas 2010-11-13 09:57:14 UTC (rev 935)
@@ -399,7 +399,7 @@
TInstantAbstractObjectClass = class of TInstantAbstractObject;
- TInstantAbstractObjectData = class(TInstantStreamable);
+ TInstantAbstractObjectData = class(TComponent);
TInstantAbstractObject = class(TInstantStreamable)
private
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2010-11-13 09:56:04 UTC (rev 934)
+++ trunk/Source/Core/InstantPersistence.pas 2010-11-13 09:57:14 UTC (rev 935)
@@ -1144,7 +1144,7 @@
procedure InternalExecute; override;
end;
- TInstantQuery = class(TPersistent)
+ TInstantQuery = class(TComponent)
private
FCommand: string;
FConnector: TInstantConnector;
@@ -7704,7 +7704,7 @@
constructor TInstantQuery.Create(AConnector: TInstantConnector);
begin
- inherited Create;
+ inherited Create(nil);
FConnector := AConnector;
end;
|
|
From: <na...@us...> - 2010-11-13 10:05:18
|
Revision: 936
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=936&view=rev
Author: nandod
Date: 2010-11-13 10:05:12 +0000 (Sat, 13 Nov 2010)
Log Message:
-----------
* Fixed "unassigned connector" error with full burst mode and no default connector.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2010-11-13 09:57:14 UTC (rev 935)
+++ trunk/Source/Core/InstantBrokers.pas 2010-11-13 10:05:12 UTC (rev 936)
@@ -6042,7 +6042,7 @@
else
LObjRef.ReferenceObject(LClassField.AsString, LIdField.AsString);
if ActualLoadMode = lmFullBurst then
- LObjRef.RetrieveObjectFromObjectData;
+ LObjRef.RetrieveObjectFromObjectData(Connector);
except
LObjRef.Free;
raise;
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2010-11-13 09:57:14 UTC (rev 935)
+++ trunk/Source/Core/InstantPersistence.pas 2010-11-13 10:05:12 UTC (rev 936)
@@ -141,8 +141,8 @@
const AObjectData: TInstantAbstractObjectData = nil); overload;
procedure ReferenceObject(const AObjectClass: TInstantObjectClass;
const AObjectId: string; const AObjectData: TInstantAbstractObjectData = nil); overload;
- // Retrieves the referenced object from internal data object, if available.
- procedure RetrieveObjectFromObjectData;
+ // Retrieves the referenced object from the internal data object, if available.
+ procedure RetrieveObjectFromObjectData(const AConnector: TInstantConnector);
procedure WriteAsObject(Writer: TInstantWriter); virtual;
property Instance: TInstantObject read GetInstance write SetInstance;
property ObjectClass: TInstantObjectClass read GetObjectClass;
@@ -1178,7 +1178,7 @@
function InternalGetObjectReferenceId(Index: Integer) : string; virtual;
procedure SetActualLoadMode(const AValue: TInstantLoadMode);
public
- constructor Create(AConnector: TInstantConnector); virtual;
+ constructor Create(AConnector: TInstantConnector); reintroduce; virtual;
function AddObject(AObject: TObject): Integer;
procedure ApplyChanges;
procedure Close;
@@ -2255,13 +2255,14 @@
ReferenceObject(AObjectClass.ClassName, AObjectId, AObjectData);
end;
-procedure TInstantObjectReference.RetrieveObjectFromObjectData;
+procedure TInstantObjectReference.RetrieveObjectFromObjectData(
+ const AConnector: TInstantConnector);
var
LObject: TInstantObject;
begin
Assert(Assigned(FObjectData));
- LObject := ObjectClass.Retrieve(ObjectId, False, False, nil, FObjectData);
+ LObject := ObjectClass.Retrieve(ObjectId, False, False, AConnector, FObjectData);
DoAssignInstance(LObject, True);
if Assigned(FInstance) then
FInstance.Release
|
×
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