1 {
2 This file is part of the Free Pascal Class Library SDO Implementation
3 Copyright (c) 2012 by Inoussa OUEDRAOGO
4 Free Pascal development team
5
6 This unit implements basic SDO definitions
7
8 See the file COPYING.FPC, included in this distribution,
9 for details about the copyright.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
15 **********************************************************************}
16 {$INCLUDE sdo_global.inc}
17 unit sdo;
18
19 interface
20 uses
21 SysUtils, Classes, Types,
22 sdo_types, sdo_linked_list, sdo_date_utils;
23
24 const
25 sdo_namespace = 'commonj.sdo';
26
27 type
28
29 TSDOTypeKind = (
30 //OtherTypes , // for 'unknown type; - all data objects'
31 BooleanType,
32 ByteType,
33 {$IFDEF HAS_SDO_BYTES}
34 BytesType,
35 {$ENDIF HAS_SDO_BYTES}
36 ChangeSummaryType,
37 {$IFDEF HAS_SDO_CHAR}
38 CharacterType,
39 {$ENDIF HAS_SDO_CHAR}
40 {$IFDEF HAS_SDO_CURRENCY}
41 CurrencyType,
42 {$ENDIF HAS_SDO_CURRENCY}
43 DateTimeType,
44 //DayType,
45 {$IFDEF HAS_SDO_DOUBLE}
46 DoubleType,
47 {$ENDIF HAS_SDO_DOUBLE}
48 //DurationType,
49 {$IFDEF HAS_SDO_FLOAT}
50 FloatType,
51 {$ENDIF HAS_SDO_FLOAT}
52 IntegerType,
53 {$IFDEF HAS_SDO_LONG}
54 LongType,
55 {$ENDIF HAS_SDO_LONG}
56 //MonthType,
57 //MonthDayType,
58 ObjectType,
59 {$IFDEF HAS_SDO_SHORT}
60 ShortType,
61 {$ENDIF HAS_SDO_SHORT}
62 StringType
63 //TimeType,
64 //UriType,
65 //YearType,
66 //YearMonthType,
67 //YearMonthDayType
68 );
69
70 const
71 DateType = DateTimeType;
72 IntType = IntegerType;
73 StringsType = StringType;
74
75 SDOTypeDefaultTypeNames : array[TSDOTypeKind] of string = (
76 //OtherTypes , // for 'unknown type; - all data objects'
77 'Boolean',
78 'Byte',
79 {$IFDEF HAS_SDO_BYTES}
80 'Bytes',
81 {$ENDIF HAS_SDO_BYTES}
82 'ChangeSummary',
83 {$IFDEF HAS_SDO_CHAR}
84 'Character',
85 {$ENDIF HAS_SDO_CHAR}
86 {$IFDEF HAS_SDO_CURRENCY}
87 'Currency',
88 {$ENDIF HAS_SDO_CURRENCY}
89 'DateTime',
90 {$IFDEF HAS_SDO_DOUBLE}
91 'Double',
92 {$ENDIF HAS_SDO_DOUBLE}
93 {$IFDEF HAS_SDO_FLOAT}
94 'Float',
95 {$ENDIF HAS_SDO_FLOAT}
96 'Integer',
97 {$IFDEF HAS_SDO_LONG}
98 'Long',
99 {$ENDIF HAS_SDO_LONG}
100 'Object',
101 {$IFDEF HAS_SDO_SHORT}
102 'Short',
103 {$ENDIF HAS_SDO_SHORT}
104 'String'
105 );
106 SDODataTypeKinds = [Low(TSDOTypeKind)..High(TSDOTypeKind)] - [ ChangeSummaryType, ObjectType ];
107
108 type
109
110 PSDOBoolean = ^TSDOBoolean;
111 {$IFDEF HAS_SDO_BYTES}
112 PSDOBytes = ^TSDOBytes;
113 PPSDOBytes = ^PSDOBytes;
114 {$ENDIF HAS_SDO_BYTES}
115 PPSDOChangeSummary = ^PSDOChangeSummary;
116 PSDOChangeSummary = ^ISDOChangeSummary;
117 {$IFDEF HAS_SDO_CHAR}
118 PSDOChar = ^TSDOChar;
119 {$ENDIF HAS_SDO_CHAR}
120 {$IFDEF HAS_SDO_CURRENCY}
121 PSDOCurrency = ^TSDOCurrency;
122 {$ENDIF HAS_SDO_CURRENCY}
123 PSDODate = ^TSDODate;
124 PSDODateTime = ^TSDODateTime;
125 {$IFDEF HAS_SDO_DOUBLE}
126 PSDODouble = ^TSDODouble;
127 {$ENDIF HAS_SDO_DOUBLE}
128 {$IFDEF HAS_SDO_FLOAT}
129 PSDOFloat = ^TSDOFloat;
130 {$ENDIF HAS_SDO_FLOAT}
131 PSDOInteger = ^TSDOInteger;
132 {$IFDEF HAS_SDO_LONG}
133 PSDOLong = ^TSDOLong;
134 {$ENDIF HAS_SDO_LONG}
135 {$IFDEF HAS_SDO_SHORT}
136 PSDOShort = ^TSDOShort;
137 {$ENDIF HAS_SDO_SHORT}
138 PPSDOString = ^PSDOString;
139 PSDOString = ^TSDOString;
140 PSDODataObject = ^ISDODataObject;
141 PPSDODataObject = ^PSDODataObject;
142 PPSDODataObjectList = ^PSDODataObjectList;
143 PSDODataObjectList = ^ISDODataObjectList;
144
145 TSDOFieldBuffer = Pointer;
146 TSDOBoolean = Boolean;
147 TSDOByte = Byte;
148 TSDOBytes = TByteDynArray;
149 {$IFDEF HAS_SDO_CHAR}
150 {$IFDEF USE_UNICODE}
151 TSDOChar = WideChar;
152 {$ELSE USE_UNICODE}
153 TSDOChar = Char;
154 {$ENDIF USE_UNICODE}
155 {$ENDIF HAS_SDO_CHAR}
156 {$IFDEF HAS_SDO_CURRENCY}
157 TSDOCurrency = Currency;
158 {$ENDIF HAS_SDO_CURRENCY}
159 TSDODateTime = TDateTimeRec;
160 TSDODate = TSDODateTime;
161 {$IFDEF HAS_SDO_DOUBLE}
162 TSDODouble = Double;
163 {$ENDIF HAS_SDO_DOUBLE}
164 {$IFDEF HAS_SDO_FLOAT}
165 TSDOFloat = Single;
166 {$ENDIF HAS_SDO_FLOAT}
167 TSDOInteger = Integer;
168 {$IFDEF HAS_SDO_LONG}
169 TSDOLong = Int64;
170 {$ENDIF HAS_SDO_LONG}
171 {$IFDEF HAS_SDO_SHORT}
172 TSDOShort = SmallInt;
173 {$ENDIF HAS_SDO_SHORT}
174 {$IFDEF USE_UNICODE}
175 TSDOString = UnicodeString;
176 {$ELSE USE_UNICODE}
177 TSDOString = AnsiString;
178 {$ENDIF USE_UNICODE}
179 TSDOVariant = Variant;
180
181 TChangeType = ( ctUndefined, ctCreate, ctChange, ctDelete );
182 TTypeFlag = ( tfIsSequenced, tfIsOpen, tfIsAbstract, tfIsDataType );
183 TTypeFlags = set of TTypeFlag;
184 TPropertyFlag = (
185 pfIsMany, pfIsReadOnly, pfIsContainment, pfIsNotNullable,
186 //This is an extension
187 pfIsAttribute
188 );
189 TPropertyFlags = set of TPropertyFlag;
190 TSerializerOption = (soExcludeSchema);
191 TSerializerOptions = set of TSerializerOption;
192
193 ESDOException = class(Exception)
194 end;
195
196 ESDONotImplementedException = class(ESDOException)
197 end;
198
199 ESDOUnsupportedOperationException = class(ESDOException)
200 private
201 FOperation: string;
202 public
203 constructor Create(const AOperation : string);
204 property Operation : string read FOperation write FOperation;
205 end;
206 ESDOInvalidStateOperationException = class(ESDOUnsupportedOperationException) end;
207
208 ESDOPropertyNotFoundException = class(ESDOException)
209 private
210 FPropertyName: string;
211 public
212 constructor Create(const APropName : string);
213 property PropertyName : string read FPropertyName write FPropertyName;
214 end;
215
216 ESDOIllegalArgumentException = class(ESDOException)
217 private
218 FArgumentName: string;
219 public
220 constructor Create(const AArgumentName : string);
221 property ArgumentName : string read FArgumentName write FArgumentName;
222 end;
223 ESDOCycleContainmentException = class(ESDOIllegalArgumentException) end;
224 //ESDOPropertyNotBelongToObjectException = class(ESDOIllegalArgumentException) end;
225
226 ESDOIndexOutOfRangeException = class(ESDOException)
227 private
228 FValue: Integer;
229 public
230 constructor Create(const AValue : Integer);
231 property Value : Integer read FValue write FValue;
232 end;
233
234 ESDOTypeNotFoundException = class(ESDOException)
235 private
236 FName: string;
237 public
238 constructor Create(const AName : string);
239 property Name : string read FName write FName;
240 end;
241
242 ESDOCircularDependencyTypeException = class(ESDOIllegalArgumentException)
243 private
244 FTypeName: string;
245 FPropertyType: string;
246 FPropertyName: string;
247 public
248 constructor Create(
249 const ATypeName,
250 APropertyName,
251 APropertyType : string
252 );
253 property TypeName : string read FTypeName write FTypeName;
254 property PropertyName : string read FPropertyName write FPropertyName;
255 property PropertyType : string read FPropertyType write FPropertyType;
256 end;
257
258 ESDOIncompleteTypeException = class(ESDOException)
259 private
260 FTypeName: string;
261 public
262 constructor Create(const ATypeName : string);
263 property TypeName : string read FTypeName write FTypeName;
264 end;
265 ESDOAbstractTypeException = class(ESDOIncompleteTypeException) end;
266
267 ESDODuplicatedItemException = class(ESDOException)
268 private
269 FName: string;
270 public
271 constructor Create(const AName : string);
272 property Name : string read FName write FName;
273 end;
274
275 ESDOInvalidConversionException = class(ESDOException)
276 private
277 FName: string;
278 public
279 constructor Create(const AName : string);
280 property Name : string read FName write FName;
281 end;
282
283 ESDOInvalidPathException = class(ESDOException)
284 private
285 FPath: string;
286 public
287 constructor Create(const APath : string);
288 property Path : string read FPath write FPath;
289 end;
290
291 ISDOType = interface;
292 ISDOProperty = interface;
293 ISDOPropertyList = interface;
294 ISDODataObject = interface;
295 ISDODataObjectList = interface;
296 ISDOChangeSummary = interface;
297 ISDODataFactory = interface;
298
299 ISDOType = interface
300 ['{76F00A3A-A6F8-4D78-8514-570207853453}']
301 { getName returns the name of the type
302 *
303 * This method returns a const char* name of the type.
304 }
getNamenull305 function getName() : string;
306
307 { getAlias returns the n'th alias
308 *
309 * This method returns a const char* corresponding to the
310 * alias at index n of the list of aliases. Use getAliasCount to
311 * discover the size of the list.
312 }
getAliasnull313 function getAlias(const AIndex : PtrInt) : string;
314
315 { getAliasCount returns the number of aliases
316 *
317 * This method returns the number of aliases for this type
318 }
getAliasCountnull319 function getAliasCount() : PtrInt;
320
321 { getBaseType returns the base if there is one
322 *
323 * This method returns a const Type* corresponding to the
324 * base Type for this type. The base type is the one which
325 * this type inherits from.
326 }
getBaseTypenull327 function getBaseType() : ISDOType;
328
329 { getURI returns the URI for this type
330 *
331 * This method returns the URI for this type. The URI may be
332 * null.
333 }
getURInull334 function getURI() : string;
335
336
337 { getProperties returns a list of properties for this type
338 *
339 * This method returns the list of properties for this type.
340 * Instances of open types may have more properties than appear
341 * in this list.
342 * See the propertylist API.
343 }
getPropertiesnull344 function getProperties() : ISDOPropertyList;
345
346 { getProperty returns a property for this type
347 *
348 * This method returns a property, by index or by name
349 }
getPropertynull350 function getProperty(const APropertyName : string) : ISDOProperty;overload;
getPropertynull351 function getProperty(const APropertyIndex : Integer) : ISDOProperty;overload;
352
353 { getPropertyIndex returns an index
354 *
355 * This method returns a property index for a named property
356 }
getPropertyIndexnull357 function getPropertyIndex(const APropertyName : string) : Integer;
358
359 { isDataObjectType true if not a DataType
360 *
361 * This method returns true if the type is not a DataType, and is therefore
362 * a DataObjectType with properties.
363 }
isDataObjectTypenull364 function isDataObjectType() : Boolean;
365
366
367 { isSequencedType true if the type is sequenced
368 *
369 * This method returns true if the type is sequenced, and is therefore
370 * objects of this type can be manipulate via their sequence interface.
371 }
isSequencedTypenull372 function isSequencedType() : Boolean;
373
374
375 { isOpenType true if the type is open
376 *
377 * Normal types have a predefined list of properties. Trying to set
378 * properties which do not exist will cause an exception to be thrown.
379 * Open types, on the other hand, may have properties added to their
380 * instances runtime. These properties get added silently when setting a
381 * property value for a property which does not exist.
382 * Different instances of these objects may have different lists of
383 * open properties.
384 }
isOpenTypenull385 function isOpenType() : Boolean;
386
387 { isAbstractType true if the type is not instantiable.
388 *
389 * An abstract type may not be instantiated. It is useful only as
390 * a base type to some other non-abstract type.
391 }
isAbstractTypenull392 function isAbstractType() : Boolean;
393
394 { isDataType true if the type is not an object.
395 *
396 * A DataType is anything which is not a DataObjectType. This method
397 * is the opposite of isDataObjectType().
398 }
isDataTypenull399 function isDataType() : Boolean;
400
401 { isChangeSummaryType true if the type is a change summary.
402 *
403 * There is only one type called ChangeSummary. This method serves
404 * no purpose in the C++ implementation.
405 }
isChangeSummaryTypenull406 function isChangeSummaryType() : Boolean;
407
408 { getTypeEnum gets the enum for this type.
409 *
410 * Each DataType has a defined value in the list of Types.
411 }
getTypeEnumnull412 function getTypeEnum() : TSDOTypeKind;
413
414 { equals compares uri and name.
415 *
416 * The types are equal if the URI and Name are equal.
417 }
equalsnull418 function equals(const AOther : ISDOType) : Boolean;
419
getFlagsnull420 function getFlags() : TTypeFlags;
421
422 //Implementation extension
getOwnernull423 function getOwner() : ISDODataFactory;
424 end;
425
426
427 ISDOProperty = interface
428 ['{F4649B56-366D-42CC-B818-46E2577E87FD}']
429 { getName gets the name of the property
430 *
431 * Returns the name of the property.
432 }
getNamenull433 function getName() : string;
434
435 { getAlias returns the n'th alias
436 *
437 * This method returns a const char* corresponding to the
438 * alias at index n of the list of aliases. Use getAliasCount to
439 * discover the size of the list.
440 }
getAliasnull441 function getAlias(const AIndex : Integer) : string;
442
443 { getAliasCount returns the number of aliases
444 *
445 * This method returns the number of aliases for this type
446 }
getAliasCountnull447 function getAliasCount() : Integer;
448
449 { getType returns the type of this property
450 *
451 * This method returns the type, which may be a DataType or a
452 * DataObjectType
453 }
getTypenull454 function getType() : ISDOType;
455
456 { getTypeEnum gets the enum for this type.
457 *
458 * Each DataType has a defined value in the list of Types.
459 }
getTypeEnumnull460 function getTypeEnum() : TSDOTypeKind;
461
462 { isMany is true if the property is a list
463 *
464 * IsMany returns true if this property represents a list of
465 * values, and should be accessed via the getList DataObjectAPI.
466 }
isManynull467 function isMany() : Boolean;
468
469 { isContainment is true if the property value is contained
470 *
471 * IsContainment returns true if this property represents a DataObjectType,
472 * and that DataObjectType is contained. I.E the property value is not a pointer
473 * to a DataObject somewhere else in the graph, it is an actual value.
474 }
isContainmentnull475 function isContainment() : Boolean;
476
477 { isReference is true if the property value is not contained
478 *
479 * IsReference returns true if this property represents a DataObjectType,
480 * and that DataObjectType is not contained. I.E the property value is a pointer
481 * to a DataObject somewhere else in the graph not an actual value.
482 }
isReferencenull483 function isReference() : Boolean;
484
485 { getContainingType give the type which holds this property.
486 *
487 * Although many types may have a property of the same name, any given
488 * instance of a property belongs to only one type.
489 * This method returns the type which holds this proeprty.
490 }
getContainingTypenull491 function getContainingType() : ISDOType;
492
493
494 { isReadOnly returns true if the property is unmodifiable.
495 *
496 * NOT IMPLEMENTED
497 * Returns true if values for this Property cannot be modified using the SDO APIs.
498 * When true, DataObject.set(Property property, Object value) throws an exception.
499 * Values may change due to other factors, such as services operating on DataObjects.
500 }
isReadOnlynull501 function isReadOnly() : Boolean;
502
503 { getOpposite returns the opposite property or zero.
504 *
505 * NOT IMPLEMENTED
506 }
getOppositenull507 function getOpposite() : ISDOProperty;
508
509 { isDefaulted is true if a default has been set.
510 *
511 * A property value may be set or unset. If unset, requests to the
512 * data object for the value will return a default if there is one.
513 * If the property is not defaulted, an un specified value will be
514 * returned. (Thism value will probably be zero).
515 }
516
isDefaultednull517 function isDefaulted() : Boolean ;
518
519 { setDefault sets the right sort of default.
520 *
521 * The many overrides of this method allow the setting
522 * of a default value for any DataType property.
523 *}
524 procedure setDefault(const AValue : TSDOBoolean);overload;
525 procedure setDefault(const AValue : TSDOByte);overload;
526 {$IFDEF HAS_SDO_BYTES}
527 procedure setDefault(AValue : TSDOBytes);overload;
528 {$ENDIF HAS_SDO_BYTES}
529 {$IFDEF HAS_SDO_CHAR}
530 procedure setDefault(const AValue : TSDOChar);overload;
531 {$ENDIF HAS_SDO_CHAR}
532 {$IFDEF HAS_SDO_CURRENCY}
533 procedure setDefaultCurrency(const AValue : TSDOCurrency);
534 {$ENDIF HAS_SDO_CURRENCY}
535 procedure setDefault(const AValue : TSDODate);overload;
536 {$IFDEF HAS_SDO_DOUBLE}
537 procedure setDefault(const AValue : TSDODouble);overload;
538 {$ENDIF HAS_SDO_DOUBLE}
539 {$IFDEF HAS_SDO_FLOAT}
540 procedure setDefault(const AValue : TSDOFloat);overload;
541 {$ENDIF HAS_SDO_FLOAT}
542 procedure setDefault(const AValue : TSDOInteger);overload;
543 {$IFDEF HAS_SDO_LONG}
544 procedure setDefault(const AValue : TSDOLong);overload;
545 {$ENDIF HAS_SDO_LONG}
546 {$IFDEF HAS_SDO_SHORT}
547 procedure setDefault(const AValue : TSDOShort);overload;
548 {$ENDIF HAS_SDO_SHORT}
549 procedure setDefault(const AValue : TSDOString);overload;
550 { getDefault gets the right sort of default.
551 *
552 * The many overrides of this method allow the getting
553 * of a default value for any DataType property.
554 }
getStringDefaultnull555 function getStringDefault() : TSDOString;
556 {$IFDEF HAS_SDO_BYTES}
getBytesDefaultnull557 function getBytesDefault() : TSDOBytes;
558 {$ENDIF HAS_SDO_BYTES}
getBooleanDefaultnull559 function getBooleanDefault() : TSDOBoolean;
getByteDefaultnull560 function getByteDefault() : TSDOByte;
561 {$IFDEF HAS_SDO_CHAR}
getCharacterDefaultnull562 function getCharacterDefault() : TSDOChar;
563 {$ENDIF HAS_SDO_CHAR}
564 {$IFDEF HAS_SDO_CURRENCY}
getCurrencyDefaultnull565 function getCurrencyDefault() : TSDOCurrency;
566 {$ENDIF HAS_SDO_CURRENCY}
getDateDefaultnull567 function getDateDefault() : TSDODate;
568 {$IFDEF HAS_SDO_DOUBLE}
getDoubleDefaultnull569 function getDoubleDefault() : TSDODouble;
570 {$ENDIF HAS_SDO_DOUBLE}
571 {$IFDEF HAS_SDO_FLOAT}
getFloatDefaultnull572 function getFloatDefault() : TSDOFloat;
573 {$ENDIF HAS_SDO_FLOAT}
getIntegerDefaultnull574 function getIntegerDefault() : TSDOInteger;
575 {$IFDEF HAS_SDO_LONG}
getLongDefaultnull576 function getLongDefault() : TSDOLong;
577 {$ENDIF HAS_SDO_LONG}
578 {$IFDEF HAS_SDO_SHORT}
getShortDefaultnull579 function getShortDefault() : TSDOShort;
580 {$ENDIF HAS_SDO_SHORT}
581
isNullablenull582 function isNullable() : Boolean;
583 //Extensions ...
isAttributenull584 function isAttribute() : Boolean;
585 end;
586
587 ISDOPropertyList = interface
588 ['{1253EA5C-D19C-434E-ADE5-A7639D582102}']
getCountnull589 function getCount() : Integer;
getItemnull590 function getItem(const AIndex : Integer) : ISDOProperty;
findnull591 function find(const APropertyName : string) : ISDOProperty;
getIndexnull592 function getIndex(const APropertyName : string) : Integer;
593 end;
594
595 ISDOTypeList = interface
596 ['{7A07FC8B-FA82-41AF-87F3-8BE3C2F228E1}']
getCountnull597 function getCount() : Integer;
getItemnull598 function getItem(const AIndex : Integer) : ISDOType;
findnull599 function find(const AUri, AName : string) : ISDOType;
getIndexnull600 function getIndex(const AUri, AName : string) : Integer;
601 end;
602
603 ISDODataFactory = interface
604 ['{8898CB64-1E83-464D-AE50-4DDB6D7770FE}']
605 {
606 * clone copies a data factory
607 *
608 * Copy the data factory, and return a new data factory which
609 * has the same properties and types, but is still able to have
610 * new types added to it.
611 }
612
613 //SDO_API virtual DataFactoryPtr clone();
614
615 {
616 * DataFactory::create creates a data object.
617 *
618 * Create a data object based on the type specified as a parameter
619 * Once a data object has been created by this factory, the metadata
620 * (types and properties) may no longer be altered.
621 }
CreateNewnull622 function CreateNew(const AType : ISDOType) : ISDODataObject;overload;
CreateNewnull623 function CreateNew(const AUri, ATypeName : string) : ISDODataObject;overload;
624
625 {
626 * DataFactory::getType gets a type back from the factory.
627 *
628 * Get a type as specified in the data factory. Useful for creating
629 * data objects or querying properties.
630 }
getTypenull631 function getType(const AUri, ATypeName : string) : ISDOType;
632
633 {
634 * DataFactory::getTypes gets a list of types back from the factory.
635 *
636 * Get all the types available within this data factory. Useful for
637 * validating whether a data object is of the correct type to be
638 * usable.
639 }
640
getTypesnull641 function getTypes() : ISDOTypeList;
642
643 {
644 * DataFactory::addType adds a type definition.
645 *
646 * Add a type defintion to the factory. (Properties may be added later).
647 * The type is defined by its uri and name.
648 * -# The type may be sequenced - and therefore work with a sequence API.
649 * -# The type may be open, indicating that it may have extra properties
650 * added at runtime.
651 * -# The type may be abstract, so the data factory will not permit creation
652 * of instances.
653 * -# The type may be a data type, indicating that is will not have properties.
654 * The Type may inherit from another type, but that is specified later with a
655 * call to setBaseType().
656 }
657 procedure AddType(
658 const AUri,
659 ATypeName : string;
660 const AFlags : TTypeFlags
661 );
662
663 {
664 * DataFactory::setBaseType allows inheritance
665 *
666 * The type specified second in the parameters becomes the basetype
667 * of the first parameter.
668 * The second type will have all the properties of its baser type, followed
669 * by any additional properties of its own. The property indices of the properties
670 * of the subclass will begin at one more than the total number of
671 * properties of the supertype
672 * This relationship is fixed when the first data object of any type is
673 * created by the factory. Up to that point the base type may be changed.
674 *
675 }
676 procedure setBaseType(const AType, ABase : ISDOType);overload;
677 procedure setBaseType(
678 const ATypeURI, ATypeName,
679 ABaseURI, ABaseName : string
680 );overload;
681
682 {
683 * DataFactory::setAlias sets an alternative name
684 *
685 * A Type may be known to the data factory by several different names.
686 * This method adds a new name for an existing property.
687 *
688 }
689 procedure setAlias(const ATypeURI, ATypeName, AAlias : string);overload;
690
691 {
692 * DataFactory::addPropertyToType adds properties
693 *
694 * The various addPropertyToType methods add a property to an
695 * existing type in the factory, specifying the name of the new property,
696 * and the type of the new property - which must also be an existing type
697 * in this factory.
698 * -# The new property may be many-valued - so it will be a list of values.
699 * -# The property may be read-only , and may not be altered by user code -
700 * However the value may be changed by data access service code.
701 * -# The property may be containment.
702 * The type of a property may be DataType, or DataObjectType (see Types).
703 * If the property is a DataType, then the actual value of the property is held
704 * within the data object containing the property.
705 * If the property is a DataObjectType, it may be containment, or reference.
706 * Containment indicates that the value of the property is contained in the
707 * data object, whilst reference indicates that the property is only a pointer to
708 * a value somewhere else in the data graph.
709 *
710 }
711 procedure addProperty(
712 const ATypeURI, ATypeName,
713 APropName, APropTypeUri, APropTypeName : string;
714 const AFlags : TPropertyFlags
715 );overload;
716 procedure addProperty(
717 const ATypeURI, ATypeName,
718 APropName : string;
719 const APropType : ISDOType;
720 const AFlags : TPropertyFlags
721 );overload;
722 procedure addProperty(
723 const AType : ISDOType;
724 const APropName : string;
725 const APropType : ISDOType;
726 const AFlags : TPropertyFlags
727 );overload;
728 procedure addProperty(
729 const AType : ISDOType;
730 const APropName, APropTypeUri, APropTypeName : string;
731 const AFlags : TPropertyFlags
732 );overload;
733
734
735 {
736 * DataFactory::setAlias sets a property alias name
737 *
738 * A property, like a type, may be known to the factory by several
739 * names.
740 }
741 procedure setAlias(const ATypeUri, ATypeName, APropName, AAlias : string);overload;
742
743 { for open Type support - this is an implementation extension!
744 the "ADataObject" parameter must be of open type
745 }
746 procedure addProperty(
747 ADataObject : ISDODataObject;
748 const APropName : string;
749 const APropType : ISDOType;
750 const AFlags : TPropertyFlags
751 );overload;
752
753 //Implementation extension
CreateListnull754 function CreateList(AType : ISDOType) : ISDODataObjectList;overload;
CreateListnull755 function CreateList(const AUri, ATypeName : string) : ISDODataObjectList;overload;
756 end;
757
758
759 ISDODataObject = interface
760 ['{74EFD05B-438F-4193-8AF0-3E28195A034B}']
761
762 { getPropertyIndex gets the unique index of a property
763 *
764 * A property of a data object has a unique index associated with it.
765 * This method gets a property index for this object from the property,
766 * or throw SDOPropertyNotFoundException if the property is not part
767 * of this data object.
768 }
getPropertyIndexnull769 function getPropertyIndex(const AProperty : ISDOProperty) : PtrInt;
770
771 { getInstanceProperties gets the props of the current object.
772 *
773 * Returns a read-only List of the Properties currently used in this DataObject.
774 * This list will contain all of the properties in getType().getProperties()
775 * and any properties where isSet(property) is true.
776 * For example, properties resulting from the use of
777 * open or mixed XML content are present if allowed by the Type.
778 * The list does not contain duplicates.
779 * The order of the properties in the list begins with getType().getProperties()
780 * and the order of the remaining properties is determined by the implementation.
781 * The same list will be returned unless the DataObject is updated so that
782 * the contents of the list change
783 * Returns the list of Properties currently used in this DataObject.
784 }
getInstancePropertiesnull785 function getInstanceProperties() : ISDOPropertyList;
786
787 {
788 * These are just like getType().getProperty(), but may return
789 * values other than the property list for open types.
790 }
getPropertynull791 function getProperty(const AIndex : PtrUInt) : ISDOProperty;overload;
getPropertynull792 function getProperty(const AProp : string) : ISDOProperty;overload;
793
794 { getContainer get the containing object
795 *
796 * Returns the containing data object
797 * or 0 if there is no container.
798 }
getContainernull799 function getContainer() : ISDODataObject;
800
801 { getContainmentProperty returns the property containing this object
802 *
803 * Return the Property of the data object containing this data object
804 * or throw an SDOPropertyNotFoundException if there is no container.
805 }
getContainmentPropertynull806 function getContainmentProperty() : ISDOProperty;
807
808 { getType returns the data object's type.
809 *
810 * getType returns the data object's type.
811 * The type defines the properties available for reflective access.
812 }
getTypenull813 function getType() : ISDOType;
814
815 { getTypeEnum returns an enumerator for the type
816 *
817 * Returns an enumerator for the type for easy switching on basic types.
818 * The enumerator is part of the Type class
819 }
getTypeEnumnull820 function getTypeEnum() : TSDOTypeKind;
821
822 { getDataObject returns a data object by path, index or property
823 *
824 * Returns the value of a property of either this object or an object
825 * reachable from it, as identified by the specified path.
826 }
getDataObjectnull827 function getDataObject(const APath : string) : ISDODataObject; overload;
getDataObjectnull828 function getDataObject(const APropertyIndex : PtrUInt) : ISDODataObject; overload;
getDataObjectnull829 function getDataObject(const AProperty : ISDOProperty) : ISDODataObject; overload;
830
831 { setDataObject sets a value by path, index or property
832 *
833 * Sets a property of either this object or an object reachable from it,
834 * as identified by the specified path,
835 * to the specified value.
836 }
837 procedure setDataObject(const APath : string; AValue : ISDODataObject); overload;
838 procedure setDataObject(const APropertyIndex : PtrUInt; AValue : ISDODataObject); overload;
839 procedure setDataObject(const AProperty : ISDOProperty; AValue : ISDODataObject); overload;
840
841 { getBoolean returns a TSDOBoolean by path, index or property
842 *
843 * Returns the value of a property of either this object or an object
844 * reachable from it, as identified by the specified path.
845 }
getBooleannull846 function getBoolean(const APath : string) : TSDOBoolean; overload;
getBooleannull847 function getBoolean(const APropertyIndex : PtrUInt) : TSDOBoolean; overload;
getBooleannull848 function getBoolean(const AProperty : ISDOProperty) : TSDOBoolean; overload;
849
850 procedure setBoolean(const APath : string; const AValue : TSDOBoolean); overload;
851 procedure setBoolean(const APropertyIndex : PtrUInt; const AValue : TSDOBoolean); overload;
852 procedure setBoolean(const AProperty : ISDOProperty; const AValue : TSDOBoolean); overload;
853
854 { getByte returns a char by path, index or property
855 *
856 * Returns the value of a property of either this object or an object
857 * reachable from it, as identified by the specified path.
858 }
getBytenull859 function getByte(const APath : string) : TSDOByte;overload;
getBytenull860 function getByte(const APropertyIndex : PtrUInt) : TSDOByte;overload;
getBytenull861 function getByte(const AProperty : ISDOProperty) : TSDOByte;overload;
862
863 procedure setByte(const APath : string; const AValue : TSDOByte);overload;
864 procedure setByte(const APropertyIndex : PtrUInt; const AValue : TSDOByte);overload;
865 procedure setByte(const AProperty : ISDOProperty; const AValue : TSDOByte);overload;
866
867 {$IFDEF HAS_SDO_CHAR}
868 { getCharacter returns a wchar_t by path, index or property
869 *
870 * Returns the value of a property of either this object or an object
871 * reachable from it, as identified by the specified path.
872 }
getCharacternull873 function getCharacter(const APath : string) : TSDOChar;overload;
getCharacternull874 function getCharacter(const APropertyIndex : PtrUInt) : TSDOChar;overload;
getCharacternull875 function getCharacter(const AProperty : ISDOProperty) : TSDOChar;overload;
876
877 procedure setCharacter(const APath : string; const AValue : TSDOChar);overload;
878 procedure setCharacter(const APropertyIndex : PtrUInt; const AValue : TSDOChar);overload;
879 procedure setCharacter(const AProperty : ISDOProperty; const AValue : TSDOChar);overload;
880 {$ENDIF HAS_SDO_CHAR}
881
882 {$IFDEF HAS_SDO_CURRENCY}
getCurrencynull883 function getCurrency(const APath : string) : TSDOCurrency;overload;
getCurrencynull884 function getCurrency(const APropertyIndex : PtrUInt) : TSDOCurrency;overload;
getCurrencynull885 function getCurrency(const AProperty : ISDOProperty) : TSDOCurrency;overload;
886
887 procedure setCurrency(const APath : string; const AValue : TSDOCurrency);overload;
888 procedure setCurrency(const APropertyIndex : PtrUInt; const AValue : TSDOCurrency);overload;
889 procedure setCurrency(const AProperty : ISDOProperty; const AValue : TSDOCurrency);overload;
890 {$ENDIF HAS_SDO_CURRENCY}
891
892 {$IFDEF HAS_SDO_BYTES}
893 { getBytes returns a byte buffer
894 *
895 * A DataObject of type Bytes holds an array of bytes as its value. These
896 * methods transfer the contents of that buffer into an array of chars allocated
897 * by the users program. The return value is the number of bytes actually
898 * copied.
899 * The byte array is not necessarily null terminated. If a null terminated
900 * C style string is required, then getCString is an alternative.
901 * The third paarameter is the length of the allocated buffer, which may be more
902 * than the length of the byte array. If the length specified is less than the
903 * length of the byte array, then only a portion of the
904 * byte array is returned.
905 }
getBytesnull906 function getBytes(const APath : string) : TSDOBytes;overload;
getBytesnull907 function getBytes(const APropertyIndex : PtrUInt) : TSDOBytes;overload;
getBytesnull908 function getBytes(const AProperty : ISDOProperty) : TSDOBytes;overload;
909
910 procedure setBytes(const APath : string; AValue : TSDOBytes);overload;
911 procedure setBytes(const APropertyIndex : PtrUInt; AValue : TSDOBytes);overload;
912 procedure setBytes(const AProperty : ISDOProperty; AValue : TSDOBytes);overload;
913 {$ENDIF HAS_SDO_BYTES}
914
915 { getString returns a wide char buffer
916 *
917 * A DataObject of type String holds an array of wide characters as its value. These
918 * methods transfer the contents of that buffer into an array of wchar_t allocated
919 * by the users program. The return value is the number of wchar_t actually
920 * copied.
921 * The array is not necessarily null terminated.
922 * The third paarameter is the length of the allocated buffer, which may be more
923 * than the length of the array. If the length specified is less than the
924 * length of the array, then only a portion of the array is returned.
925 }
getStringnull926 function getString(const APath : string) : TSDOString;overload;
getStringnull927 function getString(const APropertyIndex : PtrUInt) : TSDOString;overload;
getStringnull928 function getString(const AProperty : ISDOProperty) : TSDOString;overload;
929
930 procedure setString(const APath : string; const AValue : TSDOString);overload;
931 procedure setString(const APropertyIndex : PtrUInt; const AValue : TSDOString);overload;
932 procedure setString(const AProperty : ISDOProperty; const AValue : TSDOString);overload;
933
934 { Extension : Variant support }
getVariantnull935 function getVariant(const APath : string) : TSDOVariant;overload;
getVariantnull936 function getVariant(const APropertyIndex : PtrUInt) : TSDOVariant;overload;
getVariantnull937 function getVariant(const AProperty : ISDOProperty) : TSDOVariant;overload;
938
939 procedure setVariant(const APath : string; const AValue : TSDOVariant);overload;
940 procedure setVariant(const APropertyIndex : PtrUInt; const AValue : TSDOVariant);overload;
941 procedure setVariant(const AProperty : ISDOProperty; const AValue : TSDOVariant);overload;
942
943
944 { getDate returns an SDODate by path, index or property
945 *
946 * Returns the value of a property of either this object or an object
947 * reachable from it, as identified by the specified path.
948 }
getDatenull949 function getDate(const APath : string) : TSDODate;overload;
getDatenull950 function getDate(const APropertyIndex : PtrUInt) : TSDODate;overload;
getDatenull951 function getDate(const AProperty : ISDOProperty) : TSDODate;overload;
952
953 procedure setDate(const APath : string; const AValue : TSDODate);overload;
954 procedure setDate(const APropertyIndex : PtrUInt; const AValue : TSDODate);overload;
955 procedure setDate(const AProperty : ISDOProperty; const AValue : TSDODate);overload;
956
957 {$IFDEF HAS_SDO_DOUBLE}
958 { getDouble returns a long double by path, index or property
959 *
960 * Returns the value of a property of either this object or an object
961 * reachable from it, as identified by the specified path.
962 }
getDoublenull963 function getDouble(const APath : string) : TSDODouble;overload;
getDoublenull964 function getDouble(const APropertyIndex : PtrUInt) : TSDODouble;overload;
getDoublenull965 function getDouble(const AProperty : ISDOProperty) : TSDODouble;overload;
966
967 procedure setDouble(const APath : string; const AValue : TSDODouble);overload;
968 procedure setDouble(const APropertyIndex : PtrUInt; const AValue : TSDODouble);overload;
969 procedure setDouble(const AProperty : ISDOProperty; const AValue : TSDODouble);overload;
970 {$ENDIF HAS_SDO_DOUBLE}
971
972 {$IFDEF HAS_SDO_FLOAT}
973 { getFloat returns a float by path, index or property
974 *
975 * Returns the value of a property of either this object or an object
976 * reachable from it, as identified by the specified path.
977 }
getFloatnull978 function getFloat(const APath : string) : TSDOFloat;overload;
getFloatnull979 function getFloat(const APropertyIndex : PtrUInt) : TSDOFloat;overload;
getFloatnull980 function getFloat(const AProperty : ISDOProperty) : TSDOFloat;overload;
981
982 procedure setFloat(const APath : string; const AValue : TSDOFloat);overload;
983 procedure setFloat(const APropertyIndex : PtrUInt; const AValue : TSDOFloat);overload;
984 procedure setFloat(const AProperty : ISDOProperty; const AValue : TSDOFloat);overload;
985 {$ENDIF HAS_SDO_FLOAT}
986
987 { getInteger returns a long by path, index or property
988 *
989 * Returns the value of a property of either this object or an object
990 * reachable from it, as identified by the specified path.
991 }
getIntegernull992 function getInteger(const APath : string) : TSDOInteger;overload;
getIntegernull993 function getInteger(const APropertyIndex : PtrUInt) : TSDOInteger;overload;
getIntegernull994 function getInteger(const AProperty : ISDOProperty) : TSDOInteger;overload;
995
996 procedure setInteger(const APath : string; const AValue : TSDOInteger);overload;
997 procedure setInteger(const APropertyIndex : PtrUInt; const AValue : TSDOInteger);overload;
998 procedure setInteger(const AProperty : ISDOProperty; const AValue : TSDOInteger);overload;
999
1000 { getLong returns a int64_t by path, index or property
1001 *
1002 * Returns the value of a property of either this object or an object
1003 * reachable from it, as identified by the specified path.
1004 }
getLongnull1005 function getLong(const APath : string) : TSDOLong;overload;
getLongnull1006 function getLong(const APropertyIndex : PtrUInt) : TSDOLong;overload;
getLongnull1007 function getLong(const AProperty : ISDOProperty) : TSDOLong;overload;
1008
1009 procedure setLong(const APath : string; const AValue : TSDOLong);overload;
1010 procedure setLong(const APropertyIndex : PtrUInt; const AValue : TSDOLong);overload;
1011 procedure setLong(const AProperty : ISDOProperty; const AValue : TSDOLong);overload;
1012
1013 { getShort returns a short by path, index or property
1014 *
1015 * Returns the value of a property of either this object or an object
1016 * reachable from it, as identified by the specified path.
1017 }
getShortnull1018 function getShort(const APath : string) : TSDOShort;overload;
getShortnull1019 function getShort(const APropertyIndex : PtrUInt) : TSDOShort;overload;
getShortnull1020 function getShort(const AProperty : ISDOProperty) : TSDOShort;overload;
1021
1022 procedure setShort(const APath : string; const AValue : TSDOShort);overload;
1023 procedure setShort(const APropertyIndex : PtrUInt; const AValue : TSDOShort);overload;
1024 procedure setShort(const AProperty : ISDOProperty; const AValue : TSDOShort);overload;
1025
1026 { setNull sets a data object value to null.
1027 *
1028 * A DataObjectType or DataType value may be set or unset. If it is set, then
1029 * it may have a value, or it may be set to null. A distinction is drawn between
1030 * being unset, having the default value, being set and being null.
1031 * When the value of an integer (for example) is returned as zero, it could have
1032 * been set to zero, or it could be null. Use isNull() to verify.
1033 }
1034 procedure setNull(const APath : string);overload;
1035 procedure setNull(const APropertyIndex : PtrUInt);overload;
1036 procedure setNull(const AProperty : ISDOProperty);overload;
1037
isNullnull1038 function isNull(const APath : string) : Boolean;overload;
isNullnull1039 function isNull(const APropertyIndex : PtrUInt) : Boolean;overload;
isNullnull1040 function isNull(const AProperty : ISDOProperty) : Boolean;overload;
1041
1042
1043 { isSet test whether the value has been set
1044 *
1045 * Returns whether a property of either this object or an object reachable
1046 * from it, as identified by the specified path,
1047 * is considered to be set.
1048 }
isSetnull1049 function isSet(const APath : string) : Boolean;overload;
isSetnull1050 function isSet(const APropertyIndex : PtrUInt) : Boolean;overload;
isSetnull1051 function isSet(const AProperty : ISDOProperty) : Boolean;overload;
1052
1053
1054 { unset unsets a value previously set.
1055 *
1056 * unsets a property of either this object or an object reachable
1057 * from it, as identified by the specified path.
1058 }
1059
1060 procedure unset(const APath : string);overload;
1061 procedure unset(const APropertyIndex : PtrUInt);overload;
1062 procedure unset(const AProperty : ISDOProperty);overload;
1063
1064 { setUserData sets a reserved field in the data object.
1065 *
1066 * Each data object has precisely one 32 bit slot available to
1067 * be used by applications. This is not part of the data, its
1068 * just a place to store anything for later retrieval.
1069 }
1070
1071 {virtual SDO_API void setUserData(const char* path,void* value) = 0;
1072 virtual SDO_API void setUserData(unsigned int propertyIndex, void* value) = 0;
1073 virtual SDO_API void setUserData(const Property& property, void* value) = 0;
1074 virtual SDO_API void setUserData(void* value) = 0;
1075 virtual SDO_API void* getUserData(const char* path) = 0;
1076 virtual SDO_API void* getUserData(unsigned int propertyIndex) = 0;
1077 virtual SDO_API void* getUserData(const Property& property) = 0;
1078 virtual SDO_API void* getUserData() = 0;
1079 }
1080
1081 { getSequence returns the sequence for a data object
1082 *
1083 * Returns the value of a Sequence property identified by
1084 * the specified path. See Sequence.
1085 }
1086
1087 {virtual SDO_API SequencePtr getSequence() = 0;
1088 virtual SDO_API SequencePtr getSequence(const char* path) = 0;
1089 virtual SDO_API SequencePtr getSequence(unsigned int propertyIndex) = 0;
1090 virtual SDO_API SequencePtr getSequence(const Property& property) = 0;
1091 }
1092
1093
1094 { createDataObject creates a data object value
1095 *
1096 * Returns a new data object contained by this object using the
1097 * specified property,which must be a containment property.
1098 * The type of the created object is the declared type
1099 * of the specified property.
1100 * If the property is many valued, this method adds an element to the
1101 * list, otherwise it sets the value, removing any old value.
1102 }
createDataObjectnull1103 function createDataObject(const APath : string) : ISDODataObject; overload;
createDataObjectnull1104 function createDataObject(const APropertyIndex : PtrUInt) : ISDODataObject; overload;
createDataObjectnull1105 function createDataObject(const AProperty : ISDOProperty) : ISDODataObject; overload;
1106
1107 { detach detaches an object from the graph
1108 *
1109 * This method removes the current data object from the graph, but does
1110 * not destroy it. The DataObject can be re-attached to the graph later.
1111 }
1112
1113 //procedure detach();
1114
1115 { clear unsets all the properties
1116 *
1117 * This method unsets all the properties, and deletes all the data object
1118 * propertiy values from this data object.
1119 }
1120
1121 procedure clear();
1122
1123
1124 { getList gets the value of a many-valued property
1125 *
1126 * Many valued properties are returned as lists of DataObjects.
1127 * These lists may contain primitives or data objects, but they behave
1128 * like data objects.
1129 * Getting a many valued integer consists of getting the list, then
1130 * using the DataObjectList API to getInteger() for each list element.
1131 }
getListnull1132 function getList(const APath : string) : ISDODataObjectList; overload;
getListnull1133 function getList(const APropertyIndex : PtrUInt) : ISDODataObjectList; overload;
getListnull1134 function getList(const AProperty : ISDOProperty) : ISDODataObjectList; overload;
1135 {
1136 virtual DataObjectList& getList() = 0;
1137 }
1138
1139 { getChangeSummary get the applicable change summary
1140 *
1141 * This method gets the applicable change summary for a data object.
1142 * The summary is not necessarily attached to the data object, it may be
1143 * the summary for a parent data object. No object with a summary attached
1144 * may be a child of another object with a summary attached.
1145 * See the ChangeSummary API for details of using the change sumamry.
1146 }
getChangeSummarynull1147 function getChangeSummary() : ISDOChangeSummary;overload;
1148 {function getChangeSummary(const APath : string) : ISDOChangeSummary;overload;
1149 function getChangeSummary(const APropIndex : PtrUInt) : ISDOChangeSummary;overload;
1150 function getChangeSummary(const AProp : ISDOProperty ) : ISDOChangeSummary;overload;}
1151
1152 { objectToXPath - utility to find the xpath from the root.
1153 *
1154 * objectToXPath returns a string which could be used to locate this data
1155 * object from the root data object of the graph.
1156 }
1157
1158 //virtual SDO_SPI const char* objectToXPath() = 0;
1159
1160 end;
1161
1162
1163 ISDOCursorBookmark = TLinkedListBookmark;
1164 ISDOCursor = ILinkedListCursor;
1165 ISDODataObjectList = interface
1166 ['{54C2BFCE-60B4-492B-A7EF-0B43BC994840}']
1167
sizenull1168 function size() : PtrInt;
getCursornull1169 function getCursor() : ILinkedListCursor;
1170
1171 {These operations use the cursor location}
getBooleannull1172 function getBoolean() : TSDOBoolean;overload;
getBytenull1173 function getByte() : TSDOByte;overload;
1174 {$IFDEF HAS_SDO_BYTES}
getBytesnull1175 function getBytes() : TSDOBytes;overload;
1176 {$ENDIF HAS_SDO_BYTES}
1177 {$IFDEF HAS_SDO_CHAR}
getCharacternull1178 function getCharacter() : TSDOChar;overload;
1179 {$ENDIF HAS_SDO_CHAR}
1180 {$IFDEF HAS_SDO_CURRENCY}
getCurrencynull1181 function getCurrency() : TSDOCurrency;overload;
1182 {$ENDIF HAS_SDO_CURRENCY}
getDatenull1183 function getDate() : TSDODate;overload;
1184 {$IFDEF HAS_SDO_DOUBLE}
getDoublenull1185 function getDouble() : TSDODouble;overload;
1186 {$ENDIF HAS_SDO_DOUBLE}
1187 {$IFDEF HAS_SDO_FLOAT}
getFloatnull1188 function getFloat() : TSDOFloat;overload;
1189 {$ENDIF HAS_SDO_FLOAT}
getIntegernull1190 function getInteger() : TSDOInteger;overload;
1191 {$IFDEF HAS_SDO_LONG}
getLongnull1192 function getLong() : TSDOLong;overload;
1193 {$ENDIF HAS_SDO_LONG}
1194 {$IFDEF HAS_SDO_SHORT}
getShortnull1195 function getShort() : TSDOShort;overload;
1196 {$ENDIF HAS_SDO_SHORT}
getStringnull1197 function getString() : TSDOString;overload;
getDataObjectnull1198 function getDataObject() : ISDODataObject;overload;
getVariantnull1199 function getVariant() : TSDOVariant;overload;
1200
1201 {These operations use the cursor location}
1202 procedure setBoolean(const AValue : TSDOBoolean);overload;
1203 procedure setByte(const AValue : TSDOByte);overload;
1204 {$IFDEF HAS_SDO_BYTES}
1205 procedure setBytes(AValue : TSDOBytes);overload;
1206 {$ENDIF HAS_SDO_BYTES}
1207 {$IFDEF HAS_SDO_CHAR}
1208 procedure setCharacter(const AValue : TSDOChar);overload;
1209 {$ENDIF HAS_SDO_CHAR}
1210 {$IFDEF HAS_SDO_CURRENCY}
1211 procedure setCurrency(const AValue : TSDOCurrency);overload;
1212 {$ENDIF HAS_SDO_CURRENCY}
1213 procedure setDate(const AValue : TSDODate);overload;
1214 {$IFDEF HAS_SDO_DOUBLE}
1215 procedure setDouble(const AValue : TSDODouble);overload;
1216 {$ENDIF HAS_SDO_DOUBLE}
1217 {$IFDEF HAS_SDO_FLOAT}
1218 procedure setFloat(const AValue : TSDOFloat);overload;
1219 {$ENDIF HAS_SDO_FLOAT}
1220 procedure setInteger(const AValue : TSDOInteger);overload;
1221 {$IFDEF HAS_SDO_LONG}
1222 procedure setLong(const AValue : TSDOLong);overload;
1223 {$ENDIF HAS_SDO_LONG}
1224 {$IFDEF HAS_SDO_SHORT}
1225 procedure setShort(const AValue : TSDOShort);overload;
1226 {$ENDIF HAS_SDO_SHORT}
1227 procedure setString(const AValue : TSDOString);overload;
1228 procedure setDataObject(AValue : ISDODataObject);overload;
1229 procedure setVariant(const AValue : TSDOVariant);overload;
1230
1231 {These operations use the cursor location}
1232 procedure delete();overload;
1233 procedure delete(const AIndex : PtrInt);overload;
1234
getBooleannull1235 function getBoolean(const AIndex : PtrInt) : TSDOBoolean;overload;
getBytenull1236 function getByte(const AIndex : PtrInt) : TSDOByte;overload;
1237 {$IFDEF HAS_SDO_BYTES}
getBytesnull1238 function getBytes(const AIndex : PtrInt) : TSDOBytes;overload;
1239 {$ENDIF HAS_SDO_BYTES}
1240 {$IFDEF HAS_SDO_CHAR}
getCharacternull1241 function getCharacter(const AIndex : PtrInt) : TSDOChar;overload;
1242 {$ENDIF HAS_SDO_CHAR}
1243 {$IFDEF HAS_SDO_CURRENCY}
getCurrencynull1244 function getCurrency(const AIndex : PtrInt) : TSDOCurrency;overload;
1245 {$ENDIF HAS_SDO_CURRENCY}
getDatenull1246 function getDate(const AIndex : PtrInt) : TSDODate;overload;
1247 {$IFDEF HAS_SDO_DOUBLE}
getDoublenull1248 function getDouble(const AIndex : PtrInt) : TSDODouble;overload;
1249 {$ENDIF HAS_SDO_DOUBLE}
1250 {$IFDEF HAS_SDO_FLOAT}
getFloatnull1251 function getFloat(const AIndex : PtrInt) : TSDOFloat;overload;
1252 {$ENDIF HAS_SDO_FLOAT}
getIntegernull1253 function getInteger(const AIndex : PtrInt) : TSDOInteger;overload;
1254 {$IFDEF HAS_SDO_LONG}
getLongnull1255 function getLong(const AIndex : PtrInt) : TSDOLong;overload;
1256 {$ENDIF HAS_SDO_LONG}
1257 {$IFDEF HAS_SDO_SHORT}
getShortnull1258 function getShort(const AIndex : PtrInt) : TSDOShort;overload;
1259 {$ENDIF HAS_SDO_SHORT}
getStringnull1260 function getString(const AIndex : PtrInt) : TSDOString;overload;
getDataObjectnull1261 function getDataObject(const AIndex : PtrInt) : ISDODataObject;overload;
getVariantnull1262 function getVariant(const AIndex : PtrInt) : TSDOVariant;overload;
1263
1264 procedure setBoolean(const AIndex : PtrInt; const AValue : TSDOBoolean);overload;
1265 procedure setByte(const AIndex : PtrInt; const AValue : TSDOByte);overload;
1266 {$IFDEF HAS_SDO_BYTES}
1267 procedure setBytes(const AIndex : PtrInt; AValue : TSDOBytes);overload;
1268 {$ENDIF HAS_SDO_BYTES}
1269 {$IFDEF HAS_SDO_CHAR}
1270 procedure setCharacter(const AIndex : PtrInt; const AValue : TSDOChar);overload;
1271 {$ENDIF HAS_SDO_CHAR}
1272 {$IFDEF HAS_SDO_CURRENCY}
1273 procedure setCurrency(const AIndex : PtrInt; const AValue : TSDOCurrency);overload;
1274 {$ENDIF HAS_SDO_CURRENCY}
1275 procedure setDate(const AIndex : PtrInt; const AValue : TSDODate);overload;
1276 {$IFDEF HAS_SDO_DOUBLE}
1277 procedure setDouble(const AIndex : PtrInt; const AValue : TSDODouble);overload;
1278 {$ENDIF HAS_SDO_DOUBLE}
1279 {$IFDEF HAS_SDO_FLOAT}
1280 procedure setFloat(const AIndex : PtrInt; const AValue : TSDOFloat);overload;
1281 {$ENDIF HAS_SDO_FLOAT}
1282 procedure setInteger(const AIndex : PtrInt; const AValue : TSDOInteger);overload;
1283 {$IFDEF HAS_SDO_LONG}
1284 procedure setLong(const AIndex : PtrInt; const AValue : TSDOLong);overload;
1285 {$ENDIF HAS_SDO_LONG}
1286 {$IFDEF HAS_SDO_SHORT}
1287 procedure setShort(const AIndex : PtrInt; const AValue : TSDOShort);overload;
1288 {$ENDIF HAS_SDO_SHORT}
1289 procedure setString(const AIndex : PtrInt; const AValue : TSDOString);overload;
1290 procedure setDataObject(const AIndex : PtrInt; AValue : ISDODataObject);overload;
1291 procedure setVariant(const AIndex : PtrInt; const AValue : TSDOVariant);overload;
1292
1293 procedure insert(const AIndex : PtrInt; AValue : ISDODataObject);overload;
1294 procedure insert(const AIndex : PtrInt; const AValue : TSDOBoolean);overload;
1295 procedure insert(const AIndex : PtrInt; const AValue : TSDOByte);overload;
1296 {$IFDEF HAS_SDO_BYTES}
1297 procedure insertBytes(const AIndex : PtrInt; AValue : TSDOBytes);overload;
1298 {$ENDIF HAS_SDO_BYTES}
1299 {$IFDEF HAS_SDO_CHAR}
1300 procedure insert(const AIndex : PtrInt; const AValue : TSDOChar);overload;
1301 {$ENDIF HAS_SDO_CHAR}
1302 {$IFDEF HAS_SDO_CURRENCY}
1303 procedure insertCurrency(const AIndex : PtrInt; const AValue : TSDOCurrency);
1304 {$ENDIF HAS_SDO_CURRENCY}
1305 procedure insert(const AIndex : PtrInt; const AValue : TSDODate);overload;
1306 {$IFDEF HAS_SDO_DOUBLE}
1307 procedure insert(const AIndex : PtrInt; const AValue : TSDODouble);overload;
1308 {$ENDIF HAS_SDO_DOUBLE}
1309 {$IFDEF HAS_SDO_FLOAT}
1310 procedure insert(const AIndex : PtrInt; const AValue : TSDOFloat);overload;
1311 {$ENDIF HAS_SDO_FLOAT}
1312 procedure insert(const AIndex : PtrInt; const AValue : TSDOInteger);overload;
1313 {$IFDEF HAS_SDO_LONG}
1314 procedure insert(const AIndex : PtrInt; const AValue : TSDOLong);overload;
1315 {$ENDIF HAS_SDO_LONG}
1316 {$IFDEF HAS_SDO_SHORT}
1317 procedure insert(const AIndex : PtrInt; const AValue : TSDOShort);overload;
1318 {$ENDIF HAS_SDO_SHORT}
1319 procedure insert(const AIndex : PtrInt; const AValue : TSDOString);overload;
1320
1321 procedure append(AValue : ISDODataObject);overload;
1322 procedure append(const AValue : TSDOBoolean);overload;
1323 procedure append(const AValue : TSDOByte);overload;
1324 {$IFDEF HAS_SDO_BYTES}
1325 procedure appendBytes(AValue : TSDOBytes);overload;
1326 {$ENDIF HAS_SDO_BYTES}
1327 {$IFDEF HAS_SDO_CHAR}
1328 procedure append(const AValue : TSDOChar);overload;
1329 {$ENDIF HAS_SDO_CHAR}
1330 {$IFDEF HAS_SDO_CURRENCY}
1331 procedure appendCurrency(const AValue : TSDOCurrency);
1332 {$ENDIF HAS_SDO_CURRENCY}
1333 procedure append(const AValue : TSDODate);overload;
1334 {$IFDEF HAS_SDO_DOUBLE}
1335 procedure append(const AValue : TSDODouble);overload;
1336 {$ENDIF HAS_SDO_DOUBLE}
1337 {$IFDEF HAS_SDO_FLOAT}
1338 procedure append(const AValue : TSDOFloat);overload;
1339 {$ENDIF HAS_SDO_FLOAT}
1340 procedure append(const AValue : TSDOInteger);overload;
1341 {$IFDEF HAS_SDO_LONG}
1342 procedure append(const AValue : TSDOLong);overload;
1343 {$ENDIF HAS_SDO_LONG}
1344 {$IFDEF HAS_SDO_SHORT}
1345 procedure append(const AValue : TSDOShort);overload;
1346 {$ENDIF HAS_SDO_SHORT}
1347 procedure append(const AValue : TSDOString);overload;
1348 end;
1349
1350 IXSDHelper = interface
1351 ['{D8E3D8F1-E8AE-4EE8-B60E-1235C72DD532}']
1352 procedure LoadFromStream(AStream : TStream);
1353 procedure LoadFromFile(const AFileName : string);
1354 procedure LoadFromString(const ASchemaString : string);
1355
1356 procedure Generate(
1357 ATypeList : ISDOTypeList;
1358 ADestStream : TStream;
1359 const ATargetNamespace : string
1360 );overload;
1361 procedure Generate(
1362 ATypeList : ISDOTypeList;
1363 const ATargetNamespace : string;
1364 const AFileName : string
1365 );overload;
Generatenull1366 function Generate(
1367 ATypeList : ISDOTypeList;
1368 const ATargetNamespace : string
1369 ) : string;overload;
1370 procedure GenerateCode(
1371 ATypeList : ISDOTypeList;
1372 ADestStream : TStream;
1373 const ATargetNamespace : string
1374 );overload;
GenerateCodenull1375 function GenerateCode(
1376 ATypeList : ISDOTypeList;
1377 const ATargetNamespace : string
1378 ) : string;overload;
1379 procedure GenerateCode(
1380 ATypeList : ISDOTypeList;
1381 const ATargetNamespace : string;
1382 const AFileName : string
1383 );overload;
GetDataFactorynull1384 function GetDataFactory() : ISDODataFactory;
1385 end;
1386
1387 ISDOSerializer = interface
1388 ['{AE41D827-E606-43A4-A56C-22CBFCA5F197}']
1389 procedure save(
1390 const AName : string;
1391 AObject : ISDODataObject;
1392 const ADestStream : TStream
1393 );overload;
1394 procedure save(
1395 AObject : ISDODataObject;
1396 const ADestStream : TStream
1397 );overload;
1398 procedure save(
1399 const AName : string;
1400 AObject : ISDODataObject;
1401 const AFileName : string
1402 );overload;
1403 procedure save(
1404 AObject : ISDODataObject;
1405 const AFileName : string
1406 );overload;
1407 procedure load(
1408 const AStream : TStream;
1409 ADestList : ISDODataObjectList
1410 );overload;
1411 procedure load(
1412 const AFileName : string;
1413 ADestList : ISDODataObjectList
1414 );overload;
loadnull1415 function load(const AStream : TStream) : ISDODataObject;overload;
loadnull1416 function load(const AFileName : string) : ISDODataObject;overload;
1417
1418 // these are the implementation's extensions
1419 function getOptions() : TSerializerOptions;
1420 procedure setOptions(const AValue : TSerializerOptions);
1421 property Options : TSerializerOptions read getOptions write setOptions;
1422 end;
1423
1424 ISDOChangedDataObjectList = interface
1425 ['{E4E4A9F1-5287-44B6-876B-1A128E70BDA9}']
1426 function size() : PtrInt;
1427 function getType(const AIndex : PtrInt) : TChangeType;
1428 function getDataObject(const AIndex : PtrInt) : ISDODataObject;
1429 end;
1430
1431 TValueBuffer = packed record
1432 case TSDOTypeKind of
1433 BooleanType : ( BooleanValue : TSDOBoolean );
1434 ByteType : ( ByteValue : TSDOByte );
1435 {$IFDEF HAS_SDO_BYTES}
1436 BytesType : ( BytesValue : PSDOBytes );
1437 {$ENDIF HAS_SDO_BYTES}
1438 {$IFDEF HAS_SDO_CHAR}
1439 CharacterType : ( CharValue : TSDOChar );
1440 {$ENDIF HAS_SDO_CHAR}
1441 {$IFDEF HAS_SDO_CURRENCY}
1442 CurrencyType : ( CurrencyValue : TSDOCurrency );
1443 {$ENDIF HAS_SDO_CURRENCY}
1444 DateTimeType : ( DateValue : TSDODateTime );
1445 {$IFDEF HAS_SDO_DOUBLE}
1446 DoubleType : ( DoubleValue : TSDODouble );
1447 {$ENDIF HAS_SDO_DOUBLE}
1448 {$IFDEF HAS_SDO_FLOAT}
1449 FloatType : ( FloatValue : TSDOFloat );
1450 {$ENDIF HAS_SDO_FLOAT}
1451 IntegerType : ( IntegerValue : TSDOInteger );
1452 {$IFDEF HAS_SDO_LONG}
1453 LongType : ( LongValue : TSDOLong );
1454 {$ENDIF HAS_SDO_LONG}
1455 ObjectType : ( ObjectValue : PSDODataObject );
1456 {$IFDEF HAS_SDO_SHORT}
1457 ShortType : ( ShortValue : TSDOShort );
1458 {$ENDIF HAS_SDO_SHORT}
1459 StringType : ( StringValue : PSDOString );
1460 end;
1461 TValueSetting = class
1462 private
1463 FSet : Boolean;
1464 FNull : Boolean;
1465 FProperty : ISDOProperty;
1466 FIndex : PtrInt;
1467 FValue : TValueBuffer;
1468 private
1469 procedure PrepareBuffer();{$IFDEF USE_INLINE}inline;{$ENDIF}
1470 procedure FreeBuffer();{$IFDEF USE_INLINE}inline;{$ENDIF}
1471 protected
1472 procedure SetValue(const ABuffer);{$IFDEF USE_INLINE}inline;{$ENDIF}
1473 public
1474 constructor Create(
1475 const ASet, ANull : Boolean;
1476 const AValue;
1477 const AProperty : ISDOProperty;
1478 const AIndex : PtrInt
1479 );
1480 destructor Destroy();override;
1481 function getProperty() : ISDOProperty;{$IFDEF USE_INLINE}inline;{$ENDIF}
1482 function isSet() : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
1483 function isNull() : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
1484 function getIndex() : PtrInt;{$IFDEF USE_INLINE}inline;{$ENDIF}
1485
1486 function getBooleanValue() : TSDOBoolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
1487 function getByteValue() : TSDOByte;{$IFDEF USE_INLINE}inline;{$ENDIF}
1488 {$IFDEF HAS_SDO_CHAR}
1489 function getCharacterValue() : TSDOChar;{$IFDEF USE_INLINE}inline;{$ENDIF}
1490 {$ENDIF HAS_SDO_CHAR}
1491 {$IFDEF HAS_SDO_CURRENCY}
1492 function getCurrencyValue() : TSDOCurrency;{$IFDEF USE_INLINE}inline;{$ENDIF}
1493 {$ENDIF HAS_SDO_CURRENCY}
1494 {$IFDEF HAS_SDO_BYTES}
1495 function getBytesValue() : TSDOBytes;{$IFDEF USE_INLINE}inline;{$ENDIF}
1496 {$ENDIF HAS_SDO_BYTES}
1497 function getStringValue() : TSDOString;{$IFDEF USE_INLINE}inline;{$ENDIF}
1498 {$IFDEF HAS_SDO_SHORT}
1499 function getShortValue() : TSDOShort;{$IFDEF USE_INLINE}inline;{$ENDIF}
1500 {$ENDIF HAS_SDO_SHORT}
1501 function getIntegerValue() : TSDOInteger;{$IFDEF USE_INLINE}inline;{$ENDIF}
1502 {$IFDEF HAS_SDO_LONG}
1503 function getLongValue() : TSDOLong;{$IFDEF USE_INLINE}inline;{$ENDIF}
1504 {$ENDIF HAS_SDO_LONG}
1505 {$IFDEF HAS_SDO_FLOAT}
1506 function getFloatValue() : TSDOFloat;{$IFDEF USE_INLINE}inline;{$ENDIF}
1507 {$ENDIF HAS_SDO_FLOAT}
1508 {$IFDEF HAS_SDO_DOUBLE}
1509 function getDoubleValue() : TSDODouble;{$IFDEF USE_INLINE}inline;{$ENDIF}
1510 {$ENDIF HAS_SDO_DOUBLE}
1511 function getDateValue() : TSDODate;{$IFDEF USE_INLINE}inline;{$ENDIF}
1512 function getDataObjectValue() : ISDODataObject;{$IFDEF USE_INLINE}inline;{$ENDIF}
1513 end;
1514
1515 ISDOSettingList = interface
1516 ['{502BE24D-17C7-4537-883C-E213E4714852}']
1517 function size() : PtrInt;
1518 function getItem(const AIndex : PtrInt) : TValueSetting;
1519 procedure insert (const AIndex : PtrInt; const ASetting : TValueSetting);
1520 procedure append (const ASetting : TValueSetting);
1521 procedure remove (const AIndex : PtrInt);
1522 end;
1523
1524 ISDOChangeSummary = interface
1525 ['{5DB0D74B-A1D8-446A-83A4-98CB35D446F2}']
1526 function getChangedDataObjects() : ISDOChangedDataObjectList;
1527 function getOldValues(const ADataObject : ISDODataObject) : ISDOSettingList;
1528 function getOldXpath(const ADataObject : ISDODataObject) : string;
1529 procedure beginLogging();
1530 procedure endLogging();
1531 function isLogging() : Boolean;
1532 function isCreated(const ADataObject : ISDODataObject) : Boolean;
1533 function isDeleted(const ADataObject : ISDODataObject) : Boolean;
1534 function isModified(const ADataObject : ISDODataObject) : Boolean;
1535 function getOldValue(const ADataObject : ISDODataObject; const AProperty : ISDOProperty) : TValueSetting;
1536 function getOldContainer(const ADataObject : ISDODataObject) : ISDODataObject;
1537 function getOldContainmentProperty(const ADataObject : ISDODataObject) : ISDOProperty;
1538 procedure undoChanges() ;
1539 //SequencePtr getOldSequence(DataObjectPtr dataObject);
1540 end;
1541
1542 TSDOConvertHelper = class
1543 public
1544 class function BoolToByte(const AValue : TSDOBoolean) : TSDOByte;{$IFDEF USE_INLINE}inline;{$ENDIF}
1545 {$IFDEF HAS_SDO_BYTES}
1546 class function BoolToBytes(const AValue : TSDOBoolean) : TSDOBytes;{$IFDEF USE_INLINE}inline;{$ENDIF}
1547 {$ENDIF HAS_SDO_BYTES}
1548 {$IFDEF HAS_SDO_CHAR}
1549 class function BoolToChar(const AValue : TSDOBoolean) : TSDOChar;{$IFDEF USE_INLINE}inline;{$ENDIF}
1550 {$ENDIF HAS_SDO_CHAR}
1551 class function BoolToInteger(const AValue : TSDOBoolean) : TSDOInteger;{$IFDEF USE_INLINE}inline;{$ENDIF}
1552 {$IFDEF HAS_SDO_LONG}
1553 class function BoolToLong(const AValue : TSDOBoolean) : TSDOLong;{$IFDEF USE_INLINE}inline;{$ENDIF}
1554 {$ENDIF HAS_SDO_LONG}
1555 {$IFDEF HAS_SDO_SHORT}
1556 class function BoolToShort(const AValue : TSDOBoolean) : TSDOShort;{$IFDEF USE_INLINE}inline;{$ENDIF}
1557 class function BoolToString(const AValue : TSDOBoolean) : TSDOString;{$IFDEF USE_INLINE}inline;{$ENDIF}
1558 {$ENDIF HAS_SDO_SHORT}
1559
1560 class function IntegerToBool(const AValue : TSDOInteger) : TSDOBoolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
1561 {$IFDEF HAS_SDO_CHAR}
1562 class function IntegerToChar(const AValue : TSDOInteger) : TSDOChar; {$IFDEF USE_INLINE}inline;{$ENDIF}
1563 {$ENDIF HAS_SDO_CHAR}
1564 class function IntegerToString(const AValue : TSDOInteger) : TSDOString; {$IFDEF USE_INLINE}inline;{$ENDIF}
1565
1566 class function ByteToBool(const AValue : TSDOByte) : TSDOBoolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
1567 {$IFDEF HAS_SDO_CHAR}
1568 class function ByteToChar(const AValue : TSDOByte) : TSDOChar; {$IFDEF USE_INLINE}inline;{$ENDIF}
1569 {$ENDIF HAS_SDO_CHAR}
1570 class function ByteToString(const AValue : TSDOByte) : TSDOString; {$IFDEF USE_INLINE}inline;{$ENDIF}
1571
1572 class function StringToBool(const AValue : TSDOString) : TSDOBoolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
1573 class function StringToByte(const AValue : TSDOString) : TSDOByte; {$IFDEF USE_INLINE}inline;{$ENDIF}
1574 class function StringToBytes(const AValue : TSDOString) : TSDOBytes; {$IFDEF USE_INLINE}inline;{$ENDIF}
1575 {$IFDEF HAS_SDO_CHAR}
1576 class function StringToChar(const AValue : TSDOString) : TSDOChar; {$IFDEF USE_INLINE}inline;{$ENDIF}
1577 {$ENDIF HAS_SDO_CHAR}
1578 class function StringToDate(const AValue : TSDOString) : TSDODate; {$IFDEF USE_INLINE}inline;{$ENDIF}
1579 class function StringToInteger(const AValue : TSDOString) : TSDOInteger; {$IFDEF USE_INLINE}inline;{$ENDIF}
1580 { $IFDEF HAS_SDO_FLOAT}
1581 class function StringToFloat(const AValue : TSDOString) : Extended; {$IFDEF USE_INLINE}inline;{$ENDIF}
1582 { $ENDIF HAS_SDO_FLOAT}
1583 {$IFDEF HAS_SDO_LONG}
1584 class function StringToLong(const AValue : TSDOString) : TSDOLong; {$IFDEF USE_INLINE}inline;{$ENDIF}
1585 {$ENDIF HAS_SDO_LONG}
1586 {$IFDEF HAS_SDO_SHORT}
1587 class function StringToShort(const AValue : TSDOString) : TSDOShort; {$IFDEF USE_INLINE}inline;{$ENDIF}
1588 {$ENDIF HAS_SDO_SHORT}
1589
1590 { $IFDEF HAS_SDO_FLOAT}
1591 class function FloatToString(const AValue : Extended) : TSDOString; {$IFDEF USE_INLINE}inline;{$ENDIF}
1592 class function FloatToBool(const AValue : Extended) : TSDOBoolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
1593 { $ENDIF HAS_SDO_FLOAT}
1594
1595 class function DateToString(const AValue : TSDODate) : TSDOString; {$IFDEF USE_INLINE}inline;{$ENDIF}
1596
1597 {$IFDEF HAS_SDO_CHAR}
1598 class function CharToBool(const AValue : TSDOChar) : TSDOBoolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
1599 class function CharToByte(const AValue : TSDOChar) : TSDOByte; {$IFDEF USE_INLINE}inline;{$ENDIF}
1600 class function CharToInteger(const AValue : TSDOChar) : TSDOInteger; {$IFDEF USE_INLINE}inline;{$ENDIF}
1601 class function CharToLong(const AValue : TSDOChar) : TSDOLong; {$IFDEF USE_INLINE}inline;{$ENDIF}
1602 class function CharToShort(const AValue : TSDOChar) : TSDOShort; {$IFDEF USE_INLINE}inline;{$ENDIF}
1603 {$ENDIF HAS_SDO_CHAR}
1604
1605 {$IFDEF HAS_SDO_LONG}
1606 class function LongToBool(const AValue : TSDOLong) : TSDOBoolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
1607 {$IFDEF HAS_SDO_CHAR}
1608 class function LongToChar(const AValue : TSDOLong) : TSDOChar; {$IFDEF USE_INLINE}inline;{$ENDIF}
1609 {$ENDIF HAS_SDO_CHAR}
1610 class function LongToString(const AValue : TSDOLong) : TSDOString; {$IFDEF USE_INLINE}inline;{$ENDIF}
1611 {$ENDIF HAS_SDO_LONG}
1612
1613 {$IFDEF HAS_SDO_SHORT}
1614 class function ShortToBool(const AValue : TSDOShort) : TSDOBoolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
1615 {$IFDEF HAS_SDO_CHAR}
1616 class function ShortToChar(const AValue : TSDOShort) : TSDOChar; {$IFDEF USE_INLINE}inline;{$ENDIF}
1617 {$ENDIF HAS_SDO_CHAR}
1618 class function ShortToString(const AValue : TSDOShort) : TSDOString; {$IFDEF USE_INLINE}inline;{$ENDIF}
1619 {$ENDIF HAS_SDO_SHORT}
1620
1621 class function BytesToString(const AValue : TSDOBytes) : TSDOString; {$IFDEF USE_INLINE}inline;{$ENDIF}
1622 {$IFDEF HAS_SDO_CURRENCY}
1623 class function CurrencyToString(const AValue : TSDOCurrency) : TSDOString; {$IFDEF USE_INLINE}inline;{$ENDIF}
1624 class function StringToCurrency(const AValue : TSDOString) : TSDOCurrency; {$IFDEF USE_INLINE}inline;{$ENDIF}
1625 {$ENDIF HAS_SDO_CURRENCY}
1626 end;
1627 TSDOConvertHelperClass = class of TSDOConvertHelper;
1628
1629 TSDOCopyHelper = class
1630 private
1631 class procedure copyProperty(const A, B : ISDODataObject; const AProp : ISDOProperty);{$IFDEF USE_INLINE}inline;{$ENDIF}
1632 class procedure copyPropertyList(const A, B : ISDODataObjectList; const AType : ISDOType; const ADeepCopy : Boolean);{$IFDEF USE_INLINE}inline;{$ENDIF}
1633 class function internalCopy(const ADataObject : ISDODataObject; const ADeepCopy : Boolean) : ISDODataObject;
1634 public
1635 class function copyShallow(const ADataObject : ISDODataObject) : ISDODataObject;{$IFDEF USE_INLINE}inline;{$ENDIF}
1636 class function copy(const ADataObject : ISDODataObject) : ISDODataObject;{$IFDEF USE_INLINE}inline;{$ENDIF}
1637 end;
1638 TSDOCopyHelperClass = class of TSDOCopyHelper;
1639
1640 //implementation extension
1641 procedure CopySimpleList(
1642 const ASource, ADest : ISDODataObjectList;
1643 const AType : TSDOTypeKind
1644 );
1645
1646 type
1647
1648 TSDOEqualityHelper = class
1649 private
1650 class function CompareProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
1651 class function CompareList(const A,B : ISDODataObjectList; const AType : ISDOType) : Boolean;
1652 class function InternalEqual(const A,B : ISDODataObject; const AFullCompare : Boolean) : Boolean;
1653 public
1654 class function equalShallow(const A,B : ISDODataObject) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
1655 class function equal(const A,B : ISDODataObject) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
1656 end;
1657 TSDOEqualityHelperClass = class of TSDOEqualityHelper;
1658
1659 const
1660 NIL_OBJECT : ISDODataObject = nil;
1661
1662 procedure InitBufferResources(const ADataType : TSDOTypeKind; var ABuffer : TValueBuffer);{$IFDEF USE_INLINE}inline;{$ENDIF}
1663 procedure FreeBufferResources(const ADataType : TSDOTypeKind; var ABuffer : TValueBuffer);{$IFDEF USE_INLINE}inline;{$ENDIF}
1664
1665 implementation
1666
1667 uses
1668 StrUtils;
1669
1670 procedure InitBufferResources(const ADataType : TSDOTypeKind; var ABuffer : TValueBuffer);
1671 begin
1672 case ADataType of
1673 {$IFDEF HAS_SDO_BYTES}
1674 BytesType : New(ABuffer.BytesValue);
1675 {$ENDIF HAS_SDO_BYTES}
1676 ObjectType : New(ABuffer.ObjectValue);
1677 StringType : New(ABuffer.StringValue);
1678 end;
1679 end;
1680
1681 procedure FreeBufferResources(const ADataType : TSDOTypeKind; var ABuffer : TValueBuffer);
1682 begin
1683 case ADataType of
1684 {$IFDEF HAS_SDO_BYTES}
1685 BytesType :
1686 begin
1687 ABuffer.BytesValue^ := nil;
1688 Dispose(ABuffer.BytesValue);
1689 ABuffer.BytesValue := nil;
1690 end;
1691 {$ENDIF HAS_SDO_BYTES}
1692 ObjectType :
1693 begin
1694 ABuffer.ObjectValue^ := nil;
1695 Dispose(ABuffer.ObjectValue);
1696 ABuffer.ObjectValue := nil;
1697 end;
1698 StringType :
1699 begin
1700 ABuffer.StringValue^ := '';
1701 Dispose(ABuffer.StringValue);
1702 ABuffer.StringValue := nil;
1703 end;
1704 end;
1705 end;
1706
1707 { ESDOPropertyNotFoundException }
1708
1709 constructor ESDOPropertyNotFoundException.Create(const APropName: string);
1710 begin
1711 inherited CreateFmt('Property not found : %s.',[APropName]);
1712 FPropertyName := APropName;
1713 end;
1714
1715 { ESDOUnsupportedOperationException }
1716
1717 constructor ESDOUnsupportedOperationException.Create(const AOperation: string);
1718 begin
1719 inherited CreateFmt('Unsupported Operation : %s.',[AOperation]);
1720 FOperation := AOperation;
1721 end;
1722
1723 { ESDOIllegalArgumentException }
1724
1725 constructor ESDOIllegalArgumentException.Create(const AArgumentName: string);
1726 begin
1727 inherited CreateFmt('Illegal Argument : %s.',[AArgumentName]);
1728 FArgumentName := AArgumentName;
1729 end;
1730
1731 { ESDOIndexOutOfRangeException }
1732
1733 constructor ESDOIndexOutOfRangeException.Create(const AValue: Integer);
1734 begin
1735 inherited CreateFmt('Index out of range : %d',[AValue]);
1736 FValue := AValue;
1737 end;
1738
1739 { ESDOTypeNotFoundException }
1740
1741 constructor ESDOTypeNotFoundException.Create(const AName: string);
1742 begin
1743 inherited CreateFmt('Type not found : %s.',[AName]);
1744 FName := AName;
1745 end;
1746
1747 { ESDOIncompleteTypeException }
1748
1749 constructor ESDOIncompleteTypeException.Create(const ATypeName: string);
1750 begin
1751 inherited CreateFmt('Incomplete Type definition : %s.',[ATypeName]);
1752 FTypeName := ATypeName;
1753 end;
1754
1755 { ESDODuplicatedItemException }
1756
1757 constructor ESDODuplicatedItemException.Create(const AName: string);
1758 begin
1759 inherited CreateFmt('Duplicated item : %s.',[AName]);
1760 FName := AName;
1761 end;
1762
1763 { ESDOInvalidConversionException }
1764
1765 constructor ESDOInvalidConversionException.Create(const AName: string);
1766 begin
1767 inherited CreateFmt('Invalid conversion : %s.',[AName]);
1768 FName := AName;
1769 end;
1770
1771 { TValueSetting }
1772
1773 constructor TValueSetting.Create(
1774 const ASet, ANull : Boolean;
1775 const AValue;
1776 const AProperty: ISDOProperty;
1777 const AIndex: PtrInt
1778 );
1779 begin
1780 if ( AProperty = nil ) then
1781 raise ESDOIllegalArgumentException.Create('AProperty');
1782 FSet := ASet;
1783 FNull := ANull;
1784 FProperty := AProperty;
1785 FIndex := AIndex;
1786 PrepareBuffer();
1787 if FSet and ( not FNull ) then
1788 SetValue(AValue);
1789 end;
1790
1791 destructor TValueSetting.Destroy();
1792 begin
1793 if Assigned(FProperty) then begin
1794 FreeBuffer();
1795 end;
1796 inherited;
1797 end;
1798
1799 procedure TValueSetting.FreeBuffer();
1800 begin
1801 FreeBufferResources(FProperty.getTypeEnum(), FValue);
1802 end;
1803
getBooleanValuenull1804 function TValueSetting.getBooleanValue() : TSDOBoolean;
1805 begin
1806 case FProperty.getTypeEnum() of
1807 BooleanType : Result := FValue.BooleanValue;
1808 ByteType : Result := TSDOConvertHelper.ByteToBool(FValue.ByteValue);
1809 {$IFDEF HAS_SDO_CHAR}
1810 CharacterType : Result := TSDOConvertHelper.CharToBool(FValue.CharValue);
1811 {$ENDIF HAS_SDO_CHAR}
1812 IntegerType : Result := TSDOConvertHelper.IntegerToBool(FValue.IntegerValue);
1813 {$IFDEF HAS_SDO_LONG}
1814 LongType : Result := TSDOConvertHelper.LongToBool(FValue.LongValue);
1815 {$ENDIF HAS_SDO_LONG}
1816 {$IFDEF HAS_SDO_SHORT}
1817 ShortType : Result := TSDOConvertHelper.ShortToBool(FValue.ShortValue);
1818 {$ENDIF HAS_SDO_SHORT}
1819 StringType : Result := TSDOConvertHelper.StringToBool(FValue.StringValue^);
1820 else
1821 raise ESDONotImplementedException.Create('getBooleanValue() this with DataType.');
1822 end;
1823 end;
1824
1825 {$IFDEF HAS_SDO_BYTES}
getBytesValuenull1826 function TValueSetting.getBytesValue() : TSDOBytes;
1827 begin
1828 case FProperty.getTypeEnum() of
1829 BooleanType : Result := TSDOConvertHelper.BoolToBytes(FValue.BooleanValue);
1830 BytesType : Result := FValue.BytesValue^;
1831 StringType : Result := TSDOConvertHelper.StringToBytes(FValue.StringValue^);
1832 else
1833 raise ESDONotImplementedException.Create('getBytesValue() this with DataType.');
1834 end;
1835 end;
1836 {$ENDIF HAS_SDO_BYTES}
1837
getByteValuenull1838 function TValueSetting.getByteValue() : TSDOByte;
1839 begin
1840 case FProperty.getTypeEnum() of
1841 BooleanType : Result := TSDOConvertHelper.BoolToByte(FValue.BooleanValue);
1842 ByteType : Result := FValue.ByteValue;
1843 {$IFDEF HAS_SDO_CHAR}
1844 CharacterType : Result := TSDOConvertHelper.CharToByte(FValue.CharValue);
1845 {$ENDIF HAS_SDO_CHAR}
1846 IntegerType : Result := FValue.IntegerValue;
1847 {$IFDEF HAS_SDO_LONG}
1848 LongType : Result := FValue.LongValue;
1849 {$ENDIF HAS_SDO_LONG}
1850 {$IFDEF HAS_SDO_SHORT}
1851 ShortType : Result := FValue.ShortValue;
1852 {$ENDIF HAS_SDO_SHORT}
1853 StringType : Result := TSDOConvertHelper.StringToByte(FValue.StringValue^);
1854 else
1855 raise ESDONotImplementedException.Create('getByteValue() this with DataType.');
1856 end;
1857 end;
1858
1859 {$IFDEF HAS_SDO_CHAR}
getCharacterValuenull1860 function TValueSetting.getCharacterValue() : TSDOChar;
1861 begin
1862 case FProperty.getTypeEnum() of
1863 BooleanType : Result := TSDOConvertHelper.BoolToChar(FValue.BooleanValue);
1864 ByteType : Result := TSDOConvertHelper.ByteToChar(FValue.ByteValue);
1865 {$IFDEF HAS_SDO_CHAR}
1866 CharacterType : Result := FValue.CharValue;
1867 {$ENDIF HAS_SDO_CHAR}
1868 IntegerType : Result := TSDOConvertHelper.IntegerToChar(FValue.IntegerValue);
1869 {$IFDEF HAS_SDO_LONG}
1870 LongType : Result := TSDOConvertHelper.LongToChar(FValue.LongValue);
1871 {$ENDIF HAS_SDO_LONG}
1872 {$IFDEF HAS_SDO_SHORT}
1873 ShortType : Result := TSDOConvertHelper.ShortToChar(FValue.ShortValue);
1874 {$ENDIF HAS_SDO_SHORT}
1875 StringType : Result := TSDOConvertHelper.StringToChar(FValue.StringValue^);
1876 else
1877 raise ESDONotImplementedException.Create('getCharacterValue() this with DataType.');
1878 end;
1879 end;
1880 {$ENDIF HAS_SDO_CHAR}
1881
1882 {$IFDEF HAS_SDO_CURRENCY }
getCurrencyValuenull1883 function TValueSetting.getCurrencyValue() : TSDOCurrency;
1884 begin
1885 case FProperty.getTypeEnum() of
1886 ByteType : Result := FValue.ByteValue;
1887 CurrencyType : Result := FValue.CurrencyValue;
1888 {$IFDEF HAS_SDO_DOUBLE}
1889 DoubleType : Result := FValue.DoubleValue;
1890 {$ENDIF HAS_SDO_DOUBLE}
1891 IntegerType : Result := FValue.IntegerValue;
1892 {$IFDEF HAS_SDO_FLOAT}
1893 FloatType : Result := FValue.FloatValue;
1894 {$ENDIF HAS_SDO_FLOAT}
1895 {$IFDEF HAS_SDO_LONG}
1896 LongType : Result := FValue.LongValue;
1897 {$ENDIF HAS_SDO_LONG}
1898 {$IFDEF HAS_SDO_SHORT}
1899 ShortType : Result := FValue.ShortValue;
1900 {$ENDIF HAS_SDO_SHORT}
1901 StringType : Result := TSDOConvertHelper.StringToInteger(FValue.StringValue^);
1902 else
1903 raise ESDONotImplementedException.Create('getFloatValue() this with DataType.');
1904 end;
1905 end;
1906 {$ENDIF HAS_SDO_CURRENCY }
1907
getDataObjectValuenull1908 function TValueSetting.getDataObjectValue() : ISDODataObject;
1909 begin
1910 if ( FProperty.getTypeEnum() = ObjectType ) then
1911 Result := FValue.ObjectValue^
1912 else
1913 raise ESDONotImplementedException.Create('getDataObjectValue() this with DataType.');;
1914 end;
1915
getDateValuenull1916 function TValueSetting.getDateValue() : TSDODate;
1917 begin
1918 case FProperty.getTypeEnum() of
1919 DateTimeType : Result := FValue.DateValue;
1920 StringType : Result := TSDOConvertHelper.StringToDate(FValue.StringValue^);
1921 else
1922 raise ESDONotImplementedException.Create('getDateValue() this with DataType.');
1923 end;
1924 end;
1925
1926 {$IFDEF HAS_SDO_DOUBLE}
getDoubleValuenull1927 function TValueSetting.getDoubleValue() : TSDODouble;
1928 begin
1929 case FProperty.getTypeEnum() of
1930 ByteType : Result := FValue.ByteValue;
1931 {$IFDEF HAS_SDO_CURRENCY }
1932 CurrencyType : Result := FValue.CurrencyValue;
1933 {$ENDIF HAS_SDO_CURRENCY }
1934 DoubleType : Result := FValue.DoubleValue;
1935 IntegerType : Result := FValue.IntegerValue;
1936 {$IFDEF HAS_SDO_FLOAT}
1937 FloatType : Result := FValue.FloatValue;
1938 {$ENDIF HAS_SDO_FLOAT}
1939 {$IFDEF HAS_SDO_LONG}
1940 LongType : Result := FValue.LongValue;
1941 {$ENDIF HAS_SDO_LONG}
1942 {$IFDEF HAS_SDO_SHORT}
1943 ShortType : Result := FValue.ShortValue;
1944 {$ENDIF HAS_SDO_SHORT}
1945 StringType : Result := TSDOConvertHelper.StringToInteger(FValue.StringValue^);
1946 else
1947 raise ESDONotImplementedException.Create('getFloatValue() this with DataType.');
1948 end;
1949 end;
1950 {$ENDIF HAS_SDO_DOUBLE}
1951
1952 {$IFDEF HAS_SDO_FLOAT}
getFloatValuenull1953 function TValueSetting.getFloatValue() : TSDOFloat;
1954 begin
1955 case FProperty.getTypeEnum() of
1956 ByteType : Result := FValue.ByteValue;
1957 {$IFDEF HAS_SDO_CURRENCY }
1958 CurrencyType : Result := FValue.CurrencyValue;
1959 {$ENDIF HAS_SDO_CURRENCY }
1960 {$IFDEF HAS_SDO_DOUBLE}
1961 DoubleType : Result := FValue.DoubleValue;
1962 {$ENDIF HAS_SDO_DOUBLE}
1963 IntegerType : Result := FValue.IntegerValue;
1964 FloatType : Result := FValue.FloatValue;
1965 {$IFDEF HAS_SDO_LONG}
1966 LongType : Result := FValue.LongValue;
1967 {$ENDIF HAS_SDO_LONG}
1968 {$IFDEF HAS_SDO_SHORT}
1969 ShortType : Result := FValue.ShortValue;
1970 {$ENDIF HAS_SDO_SHORT}
1971 StringType : Result := TSDOConvertHelper.StringToInteger(FValue.StringValue^);
1972 else
1973 raise ESDONotImplementedException.Create('getFloatValue() this with DataType.');
1974 end;
1975 end;
1976 {$ENDIF HAS_SDO_FLOAT}
1977
getIndexnull1978 function TValueSetting.getIndex() : PtrInt;
1979 begin
1980 Result := FIndex;
1981 end;
1982
getIntegerValuenull1983 function TValueSetting.getIntegerValue() : TSDOInteger;
1984 begin
1985 case FProperty.getTypeEnum() of
1986 BooleanType : Result := TSDOConvertHelper.BoolToInteger(FValue.BooleanValue);
1987 ByteType : Result := FValue.ByteValue;
1988 {$IFDEF HAS_SDO_CHAR}
1989 CharacterType : Result := TSDOConvertHelper.CharToInteger(FValue.CharValue);
1990 {$ENDIF HAS_SDO_CHAR}
1991 IntegerType : Result := FValue.IntegerValue;
1992 {$IFDEF HAS_SDO_LONG}
1993 LongType : Result := FValue.LongValue;
1994 {$ENDIF HAS_SDO_LONG}
1995 {$IFDEF HAS_SDO_SHORT}
1996 ShortType : Result := FValue.ShortValue;
1997 {$ENDIF HAS_SDO_SHORT}
1998 StringType : Result := TSDOConvertHelper.StringToInteger(FValue.StringValue^);
1999 else
2000 raise ESDONotImplementedException.Create('getIntegerValue() this with DataType.');
2001 end;
2002 end;
2003
2004 {$IFDEF HAS_SDO_LONG}
getLongValuenull2005 function TValueSetting.getLongValue() : TSDOLong;
2006 begin
2007 case FProperty.getTypeEnum() of
2008 BooleanType : Result := TSDOConvertHelper.BoolToLong(FValue.BooleanValue);
2009 ByteType : Result := FValue.ByteValue;
2010 {$IFDEF HAS_SDO_CHAR}
2011 CharacterType : Result := TSDOConvertHelper.CharToLong(FValue.CharValue);
2012 {$ENDIF HAS_SDO_CHAR}
2013 IntegerType : Result := FValue.IntegerValue;
2014 {$IFDEF HAS_SDO_LONG}
2015 LongType : Result := FValue.LongValue;
2016 {$ENDIF HAS_SDO_LONG}
2017 {$IFDEF HAS_SDO_SHORT}
2018 ShortType : Result := FValue.ShortValue;
2019 {$ENDIF HAS_SDO_SHORT}
2020 StringType : Result := TSDOConvertHelper.StringToLong(FValue.StringValue^);
2021 else
2022 raise ESDONotImplementedException.Create('getLongValue() this with DataType.');
2023 end;
2024 end;
2025 {$ENDIF HAS_SDO_LONG}
2026
getPropertynull2027 function TValueSetting.getProperty() : ISDOProperty;
2028 begin
2029 Result := FProperty;
2030 end;
2031
2032 {$IFDEF HAS_SDO_SHORT}
getShortValuenull2033 function TValueSetting.getShortValue() : TSDOShort;
2034 begin
2035 case FProperty.getTypeEnum() of
2036 BooleanType : Result := TSDOConvertHelper.BoolToShort(FValue.BooleanValue);
2037 ByteType : Result := FValue.ByteValue;
2038 {$IFDEF HAS_SDO_CHAR}
2039 CharacterType : Result := TSDOConvertHelper.CharToShort(FValue.CharValue);
2040 {$ENDIF HAS_SDO_CHAR}
2041 IntegerType : Result := FValue.IntegerValue;
2042 {$IFDEF HAS_SDO_LONG}
2043 LongType : Result := FValue.LongValue;
2044 {$ENDIF HAS_SDO_LONG}
2045 {$IFDEF HAS_SDO_SHORT}
2046 ShortType : Result := FValue.ShortValue;
2047 {$ENDIF HAS_SDO_SHORT}
2048 StringType : Result := TSDOConvertHelper.StringToShort(FValue.StringValue^);
2049 else
2050 raise ESDONotImplementedException.Create('getShortValue() this with DataType.');
2051 end;
2052 end;
2053 {$ENDIF HAS_SDO_SHORT}
2054
getStringValuenull2055 function TValueSetting.getStringValue() : TSDOString;
2056 begin
2057 case FProperty.getTypeEnum() of
2058 BooleanType : Result := TSDOConvertHelper.BoolToString(FValue.BooleanValue);
2059 ByteType : Result := TSDOConvertHelper.ByteToString(FValue.ByteValue);
2060 {$IFDEF HAS_SDO_BYTES}
2061 BytesType : Result := TSDOConvertHelper.BytesToString(FValue.BytesValue^);
2062 {$ENDIF HAS_SDO_BYTES}
2063 {$IFDEF HAS_SDO_CHAR}
2064 CharacterType : Result := FValue.CharValue;
2065 {$ENDIF HAS_SDO_CHAR}
2066 {$IFDEF HAS_SDO_CURRENCY}
2067 CurrencyType : Result := TSDOConvertHelper.CurrencyToString(FValue.CurrencyValue);
2068 {$ENDIF HAS_SDO_CURRENCY}
2069 DateTimeType : Result := TSDOConvertHelper.DateToString(FValue.DateValue);
2070 {$IFDEF HAS_SDO_DOUBLE}
2071 DoubleType : Result := TSDOConvertHelper.FloatToString(FValue.DoubleValue);
2072 {$ENDIF HAS_SDO_DOUBLE}
2073 {$IFDEF HAS_SDO_FLOAT}
2074 FloatType : Result := TSDOConvertHelper.FloatToString(FValue.FloatValue);
2075 {$ENDIF HAS_SDO_FLOAT}
2076 IntegerType : Result := TSDOConvertHelper.IntegerToString(FValue.IntegerValue);
2077 {$IFDEF HAS_SDO_LONG}
2078 LongType : Result := TSDOConvertHelper.LongToString(FValue.LongValue);
2079 {$ENDIF HAS_SDO_LONG}
2080 {$IFDEF HAS_SDO_SHORT}
2081 ShortType : Result := TSDOConvertHelper.ShortToString(FValue.ShortValue);
2082 {$ENDIF HAS_SDO_SHORT}
2083 StringType : Result := FValue.StringValue^;
2084 else
2085 raise ESDONotImplementedException.Create('getStringValue() this with DataType.');
2086 end;
2087 end;
2088
isNullnull2089 function TValueSetting.isNull() : Boolean;
2090 begin
2091 Result := FNull;
2092 end;
2093
isSetnull2094 function TValueSetting.isSet() : Boolean;
2095 begin
2096 Result := FSet;
2097 end;
2098
2099 procedure TValueSetting.PrepareBuffer();
2100 begin
2101 case FProperty.getTypeEnum() of
2102 {$IFDEF HAS_SDO_BYTES}
2103 BytesType : New(FValue.BytesValue);
2104 {$ENDIF HAS_SDO_BYTES}
2105 ObjectType : New(FValue.ObjectValue);
2106 StringType : New(FValue.StringValue);
2107 end;
2108 end;
2109
2110 procedure TValueSetting.SetValue(const ABuffer);
2111 begin
2112 case FProperty.getTypeEnum() of
2113 BooleanType : FValue.BooleanValue := TSDOBoolean(ABuffer);
2114 ByteType : FValue.ByteValue := TSDOByte(ABuffer);
2115 {$IFDEF HAS_SDO_BYTES}
2116 BytesType : FValue.BytesValue^ := TSDOBytes(ABuffer);
2117 {$ENDIF HAS_SDO_BYTES}
2118 {$IFDEF HAS_SDO_CHAR}
2119 CharacterType : FValue.CharValue := TSDOChar(ABuffer);
2120 {$ENDIF HAS_SDO_CHAR}
2121 {$IFDEF HAS_SDO_CURRENCY}
2122 CurrencyType : FValue.CurrencyValue := TSDOCurrency(ABuffer);
2123 {$ENDIF HAS_SDO_CURRENCY}
2124 DateTimeType : FValue.DateValue := TSDODate(ABuffer);
2125 {$IFDEF HAS_SDO_DOUBLE}
2126 DoubleType : FValue.DoubleValue := TSDODouble(ABuffer);
2127 {$ENDIF HAS_SDO_DOUBLE}
2128 {$IFDEF HAS_SDO_FLOAT}
2129 FloatType : FValue.FloatValue := TSDOFloat(ABuffer);
2130 {$ENDIF HAS_SDO_FLOAT}
2131 IntegerType : FValue.IntegerValue := TSDOInteger(ABuffer);
2132 {$IFDEF HAS_SDO_LONG}
2133 LongType : FValue.LongValue := TSDOLong(ABuffer);
2134 {$ENDIF HAS_SDO_LONG}
2135 ObjectType : FValue.ObjectValue^ := ISDODataObject(ABuffer);
2136 {$IFDEF HAS_SDO_SHORT}
2137 ShortType : FValue.ShortValue := TSDOShort(ABuffer);
2138 {$ENDIF HAS_SDO_SHORT}
2139 StringType : FValue.StringValue^ := TSDOString(ABuffer);
2140 end;
2141 end;
2142
2143 { ESDOCircularDependencyTypeException }
2144
2145 constructor ESDOCircularDependencyTypeException.Create(
2146 const ATypeName,
2147 APropertyName,
2148 APropertyType: string
2149 );
2150 begin
2151 inherited Create(APropertyName);
2152 Message := Format(
2153 'A circular dependendy has been found the type definition ' + sLineBreak +
2154 ' Type name : "%s"' + sLineBreak +
2155 ' Property name : "%s"' + sLineBreak +
2156 ' Property type : "%s"',
2157 [ATypeName,APropertyName,APropertyType]
2158 );
2159 FTypeName := ATypeName;
2160 FPropertyType := APropertyType;
2161 FPropertyName := APropertyName;
2162 end;
2163
2164 { ESDOInvalidPathException }
2165
2166 constructor ESDOInvalidPathException.Create(const APath: string);
2167 begin
2168 FPath := APath;
2169 end;
2170
2171 var
2172 ConverterFormatSetting : TFormatSettings;
2173 function sdo_TryStrToInt(const s: string; out i : Int64) : Boolean;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
2174 var
2175 e: Integer;
2176 begin
2177 Val(s,i,e);
2178 Result := ( e = 0 );
2179 end;
2180
2181 function sdo_TryStrToInt(const s: string; out i : Integer) : Boolean;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
2182 var
2183 e: Integer;
2184 begin
2185 Val(s,i,e);
2186 Result := ( e = 0 );
2187 end;
2188
2189 function sdo_TryStrToInt(const s: string; out i : Smallint) : Boolean;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
2190 var
2191 e: Integer;
2192 begin
2193 Val(s,i,e);
2194 Result := ( e = 0 );
2195 end;
2196
2197 function sdo_TryStrToInt(const s: string; out i : TSDOByte) : Boolean;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
2198 var
2199 e: Integer;
2200 begin
2201 Val(s,i,e);
2202 Result := ( e = 0 );
2203 end;
2204
2205 { TSDOConvertHelper }
2206
2207 class function TSDOConvertHelper.BoolToByte(const AValue: TSDOBoolean): TSDOByte;
2208 begin
2209 if AValue then
2210 Result := 1
2211 else
2212 Result := 0;
2213 end;
2214
2215 {$IFDEF HAS_SDO_BYTES}
2216 class function TSDOConvertHelper.BoolToBytes(const AValue: TSDOBoolean): TSDOBytes;
2217 const
2218 ITEM_LENGTH = 5;
2219 STR_BOOL : array[TSDOBoolean] of String[ITEM_LENGTH] = ( 'false', 'true' );
2220 begin
2221 SetLength(Result,Length(STR_BOOL[AValue]));
2222 Move(STR_BOOL[AValue][0],Result[0],ITEM_LENGTH);
2223 end;
2224 {$ENDIF HAS_SDO_BYTES}
2225
2226 {$IFDEF HAS_SDO_CHAR}
2227 class function TSDOConvertHelper.BoolToChar(const AValue: TSDOBoolean) : TSDOChar;
2228 begin
2229 if AValue then
2230 Result := '1'
2231 else
2232 Result := '0';
2233 end;
2234 {$ENDIF HAS_SDO_CHAR}
2235
2236 class function TSDOConvertHelper.BoolToInteger(const AValue: TSDOBoolean): TSDOInteger;
2237 begin
2238 Result := BoolToByte(AValue)
2239 end;
2240
2241 class function TSDOConvertHelper.BoolToLong(const AValue: TSDOBoolean): TSDOLong;
2242 begin
2243 Result := BoolToByte(AValue);
2244 end;
2245
2246 class function TSDOConvertHelper.BoolToShort(const AValue: TSDOBoolean): TSDOShort;
2247 begin
2248 Result := BoolToByte(AValue);
2249 end;
2250
2251 class function TSDOConvertHelper.BoolToString(const AValue: TSDOBoolean): TSDOString;
2252 begin
2253 if AValue then
2254 Result := '1'
2255 else
2256 Result := '0';
2257 end;
2258
2259 class function TSDOConvertHelper.BytesToString(const AValue: TSDOBytes): TSDOString;
2260 var
2261 locRes : AnsiString;
2262 begin
2263 if ( Length(AValue) > 0 ) then begin
2264 SetLength(locRes, ( 2 * Length(AValue) ) );
2265 BinToHex(PAnsiChar(@(AValue[0])),PAnsiChar(@(locRes[1])),Length(AValue));
2266 Result := locRes;
2267 end else begin
2268 Result := '';
2269 end;
2270 end;
2271
2272 class function TSDOConvertHelper.ByteToBool(const AValue: TSDOByte): TSDOBoolean;
2273 begin
2274 Result := ( AValue <> 0 );
2275 end;
2276
2277 {$IFDEF HAS_SDO_CHAR}
2278 class function TSDOConvertHelper.ByteToChar(const AValue: TSDOByte): TSDOChar;
2279 begin
2280 Result := TSDOChar(AValue);
2281 end;
2282 {$ENDIF HAS_SDO_CHAR}
2283
2284 class function TSDOConvertHelper.ByteToString(const AValue: TSDOByte): TSDOString;
2285 begin
2286 Result := IntToStr(AValue);
2287 end;
2288
2289 {$IFDEF HAS_SDO_CHAR}
2290 class function TSDOConvertHelper.CharToBool(const AValue: TSDOChar): TSDOBoolean;
2291 begin
2292 Result := ( Ord(AValue) <> 0 );
2293 end;
2294
2295 class function TSDOConvertHelper.CharToByte(const AValue: TSDOChar): TSDOByte;
2296 begin
2297 {$IF SizeOf(TSDOChar) = SizeOf(Byte)}
2298 Result := Ord(AValue);
2299 {$ELSE}
2300 case Ord(AValue) of
2301 Low(Byte)..High(Byte) : Result := Ord(AValue);
2302 else
2303 Result := 0;
2304 end;
2305 {$IFEND}
2306 end;
2307
2308 class function TSDOConvertHelper.CharToInteger(const AValue: TSDOChar): TSDOInteger;
2309 begin
2310 Result := Ord(AValue);
2311 end;
2312
2313 class function TSDOConvertHelper.CharToLong(const AValue: TSDOChar): TSDOLong;
2314 begin
2315 Result := Ord(AValue);
2316 end;
2317
2318 class function TSDOConvertHelper.CharToShort(const AValue: TSDOChar): TSDOShort;
2319 begin
2320 Result := Ord(AValue);
2321 end;
2322 {$ENDIF HAS_SDO_CHAR}
2323
2324 class function TSDOConvertHelper.DateToString(const AValue: TSDODate): TSDOString;
2325 begin
2326 Result := xsd_DateTimeToStr(AValue,xdkDateTime);
2327 end;
2328
2329 { $IFDEF HAS_SDO_FLOAT}
2330 class function TSDOConvertHelper.FloatToBool(const AValue: Extended): TSDOBoolean;
2331 begin
2332 Result := ( AValue <> 0 );
2333 end;
2334
2335 class function TSDOConvertHelper.FloatToString(const AValue: Extended) : TSDOString;
2336 begin
2337 Result := FloatToStrF(AValue,ffGeneral,18,18,ConverterFormatSetting);
2338 end;
2339 { $ENDIF HAS_SDO_FLOAT}
2340
2341 class function TSDOConvertHelper.IntegerToBool(const AValue: TSDOInteger): TSDOBoolean;
2342 begin
2343 Result := ( AValue <> 0 );
2344 end;
2345
2346 {$IFDEF HAS_SDO_CHAR}
2347 class function TSDOConvertHelper.IntegerToChar(const AValue: TSDOInteger): TSDOChar;
2348 begin
2349 Result := TSDOChar(AValue);
2350 end;
2351 {$ENDIF HAS_SDO_CHAR}
2352
2353 class function TSDOConvertHelper.IntegerToString(const AValue: TSDOInteger): TSDOString;
2354 begin
2355 Result := IntToStr(AValue);
2356 end;
2357
2358 class function TSDOConvertHelper.LongToBool(const AValue: TSDOLong): TSDOBoolean;
2359 begin
2360 Result := ( AValue <> 0 );
2361 end;
2362
2363 {$IFDEF HAS_SDO_LONG}
2364 {$IFDEF HAS_SDO_CHAR}
2365 class function TSDOConvertHelper.LongToChar(const AValue: TSDOLong): TSDOChar;
2366 begin
2367 Result := TSDOChar(AValue);
2368 end;
2369 {$ENDIF HAS_SDO_CHAR}
2370
2371 class function TSDOConvertHelper.LongToString(const AValue: TSDOLong): TSDOString;
2372 begin
2373 Result := IntToStr(AValue);
2374 end;
2375 {$ENDIF HAS_SDO_LONG}
2376
2377 class function TSDOConvertHelper.ShortToBool(const AValue: TSDOShort): TSDOBoolean;
2378 begin
2379 Result := ( AValue <> 0 );
2380 end;
2381
2382 {$IFDEF HAS_SDO_SHORT}
2383 {$IFDEF HAS_SDO_CHAR}
2384 class function TSDOConvertHelper.ShortToChar(const AValue: TSDOShort): TSDOChar;
2385 begin
2386 Result := TSDOChar(AValue);
2387 end;
2388 {$ENDIF HAS_SDO_CHAR}
2389
2390 class function TSDOConvertHelper.ShortToString(const AValue: TSDOShort): TSDOString;
2391 begin
2392 Result := IntToStr(AValue);
2393 end;
2394 {$ENDIF HAS_SDO_SHORT}
2395
2396 class function TSDOConvertHelper.StringToBool(const AValue: TSDOString): TSDOBoolean;
2397 begin
2398 case AnsiIndexStr(LowerCase(AValue),['0', '1', 'false', 'true'] ) of
2399 0, 2 : Result := False;
2400 1, 3 : Result := True;
2401 else
2402 raise ESDOInvalidConversionException.Create('TSDOConvertHelper.StringToBool');
2403 end;
2404 end;
2405
2406 class function TSDOConvertHelper.StringToByte(const AValue: TSDOString): TSDOByte;
2407 begin
2408 if not sdo_TryStrToInt(AValue, Result) then
2409 raise ESDOInvalidConversionException.Create('TSDOConvertHelper.StringToInteger');
2410 end;
2411
2412 class function TSDOConvertHelper.StringToBytes(const AValue: TSDOString): TSDOBytes;
2413 var
2414 locValue : AnsiString;
2415 begin
2416 if ( Length(AValue) > 0 ) then begin
2417 locValue := AValue;
2418 SetLength(Result,( Length(locValue) div 2 ));
2419 HexToBin(PAnsiChar(locValue),PAnsiChar(@(Result[0])),Length(Result));
2420 end else begin
2421 Result := nil;
2422 end;
2423 end;
2424
2425 {$IFDEF HAS_SDO_CHAR}
2426 class function TSDOConvertHelper.StringToChar(const AValue: TSDOString): TSDOChar;
2427 begin
2428 if ( Length(AValue) > 0 ) then
2429 Result := AValue[1]
2430 else
2431 raise ESDOInvalidConversionException.Create('TSDOConvertHelper.StringToChar');
2432 end;
2433 {$ENDIF HAS_SDO_ENDIF}
2434
2435 class function TSDOConvertHelper.StringToDate(const AValue: TSDOString): TSDODate;
2436 begin
2437 if not xsd_TryStrToDate(AValue,Result,xdkDateTime) then
2438 raise ESDOInvalidConversionException.Create('TSDOConvertHelper.StringToDate');
2439 end;
2440
2441 { $IFDEF HAS_SDO_FLOAT}
2442 class function TSDOConvertHelper.StringToFloat(const AValue: TSDOString): Extended;
2443 begin
2444 if not TryStrToFloat(AValue,Result,ConverterFormatSetting) then
2445 raise ESDOInvalidConversionException.Create('TSDOConvertHelper.StringToFloat');
2446 end;
2447 { $ENDIF HAS_SDO_FLOAT}
2448
2449 class function TSDOConvertHelper.StringToInteger(const AValue: TSDOString): TSDOInteger;
2450 begin
2451 if not sdo_TryStrToInt(AValue, Result) then
2452 raise ESDOInvalidConversionException.Create('TSDOConvertHelper.StringToInteger');
2453 end;
2454
2455 {$IFDEF HAS_SDO_LONG}
2456 class function TSDOConvertHelper.StringToLong(const AValue: TSDOString): TSDOLong;
2457 begin
2458 if not sdo_TryStrToInt(AValue, Result) then
2459 raise ESDOInvalidConversionException.Create('TSDOConvertHelper.StringToLong');
2460 end;
2461 {$ENDIF HAS_SDO_LONG}
2462
2463 {$IFDEF HAS_SDO_SHORT}
2464 class function TSDOConvertHelper.StringToShort(const AValue: TSDOString): TSDOShort;
2465 begin
2466 if not sdo_TryStrToInt(AValue, Result) then
2467 raise ESDOInvalidConversionException.Create('TSDOConvertHelper.StringToShort');
2468 end;
2469 {$ENDIF HAS_SDO_SHORT}
2470
2471 {$IFDEF HAS_SDO_CURRENCY}
2472 class function TSDOConvertHelper.CurrencyToString(const AValue: TSDOCurrency): TSDOString;
2473 begin
2474 Result := CurrToStrF(AValue,ffFixed,4,ConverterFormatSetting);
2475 end;
2476
2477 class function TSDOConvertHelper.StringToCurrency(const AValue: TSDOString): TSDOCurrency;
2478 begin
2479 if not TryStrToCurr(AValue,Result,ConverterFormatSetting) then
2480 raise ESDOInvalidConversionException.Create('TSDOConvertHelper.StringToCurrency');
2481 end;
2482 {$ENDIF HAS_SDO_CURRENCY}
2483
2484
2485
2486 type
2487 TSimpleTypeCopyProc = procedure (const A,B : ISDODataObject; const AProp : ISDOProperty);
2488 TListTypeCopyProc = procedure (const A,B : ISDODataObjectList);
2489 TCopyProcRecord = record
2490 Simple : TSimpleTypeCopyProc;
2491 List : TListTypeCopyProc;
2492 end;
2493
2494 procedure NotImplementedSimplePROC(const A,B : ISDODataObject; const AProp : ISDOProperty);
2495 begin
2496 raise ESDONotImplementedException.Create('');
2497 end;
2498
2499 procedure NotImplementedListPROC(const A,B : ISDODataObjectList);
2500 begin
2501 raise ESDONotImplementedException.Create('');
2502 end;
2503
2504 procedure CopyBoolProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2505 begin
2506 if A.isSet(AProp) then begin
2507 if A.isNull(AProp) then
2508 B.setNull(AProp)
2509 else
2510 B.setBoolean(AProp,A.getBoolean(AProp));
2511 end else begin
2512 B.unset(AProp);
2513 end;
2514 end;
2515
2516 procedure CopyByteProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2517 begin
2518 if A.isSet(AProp) then begin
2519 if A.isNull(AProp) then
2520 B.setNull(AProp)
2521 else
2522 B.setByte(AProp,A.getByte(AProp));
2523 end else begin
2524 B.unset(AProp);
2525 end;
2526 end;
2527
2528 {$IFDEF HAS_SDO_BYTES}
2529 procedure CopyBytesProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2530 begin
2531 if A.isSet(AProp) then begin
2532 if A.isNull(AProp) then
2533 B.setNull(AProp)
2534 else
2535 B.setBytes(AProp,Copy(A.getBytes(AProp)));
2536 end else begin
2537 B.unset(AProp);
2538 end;
2539 end;
2540
2541 procedure CopyListBytes(const A,B : ISDODataObjectList);
2542 begin
2543 B.appendBytes(Copy(A.getBytes()));
2544 end;
2545 {$ENDIF HAS_SDO_BYTES}
2546
2547 {$IFDEF HAS_SDO_CHAR}
2548 procedure CopyCharProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2549 begin
2550 if A.isSet(AProp) then begin
2551 if A.isNull(AProp) then
2552 B.setNull(AProp)
2553 else
2554 B.setCharacter(AProp,A.getCharacter(AProp));
2555 end else begin
2556 B.unset(AProp);
2557 end;
2558 end;
2559
2560 procedure CopyListChar(const A,B : ISDODataObjectList);
2561 begin
2562 B.append(A.getCharacter());
2563 end;
2564 {$ENDIF HAS_SDO_CHAR}
2565
2566 {$IFDEF HAS_SDO_CURRENCY}
2567 procedure CopyCurrencyProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2568 begin
2569 if A.isSet(AProp) then begin
2570 if A.isNull(AProp) then
2571 B.setNull(AProp)
2572 else
2573 B.setCurrency(AProp,A.getCurrency(AProp));
2574 end else begin
2575 B.unset(AProp);
2576 end;
2577 end;
2578
2579 procedure CopyListCurrency(const A,B : ISDODataObjectList);
2580 begin
2581 B.appendCurrency(A.getCurrency());
2582 end;
2583 {$ENDIF HAS_SDO_CURRENCY}
2584
2585 {$IFDEF HAS_SDO_DOUBLE}
2586 procedure CopyDoubleProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2587 begin
2588 if A.isSet(AProp) then begin
2589 if A.isNull(AProp) then
2590 B.setNull(AProp)
2591 else
2592 B.setDouble(AProp,A.getDouble(AProp));
2593 end else begin
2594 B.unset(AProp);
2595 end;
2596 end;
2597
2598 procedure CopyListDouble(const A,B : ISDODataObjectList);
2599 begin
2600 B.append(A.getDouble());
2601 end;
2602 {$ENDIF HAS_SDO_DOUBLE}
2603
2604 procedure CopyDateProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2605 begin
2606 if A.isSet(AProp) then begin
2607 if A.isNull(AProp) then
2608 B.setNull(AProp)
2609 else
2610 B.setDate(AProp,A.getDate(AProp));
2611 end else begin
2612 B.unset(AProp);
2613 end;
2614 end;
2615
2616 {$IFDEF HAS_SDO_FLOAT}
2617 procedure CopyFloatProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2618 begin
2619 if A.isSet(AProp) then begin
2620 if A.isNull(AProp) then
2621 B.setNull(AProp)
2622 else
2623 B.setFloat(AProp,A.getFloat(AProp));
2624 end else begin
2625 B.unset(AProp);
2626 end;
2627 end;
2628
2629 procedure CopyListFloat(const A,B : ISDODataObjectList);
2630 begin
2631 B.append(A.getFloat());
2632 end;
2633 {$ENDIF HAS_SDO_FLOAT}
2634
2635 procedure CopyIntegerProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2636 begin
2637 if A.isSet(AProp) then begin
2638 if A.isNull(AProp) then
2639 B.setNull(AProp)
2640 else
2641 B.setInteger(AProp,A.getInteger(AProp));
2642 end else begin
2643 B.unset(AProp);
2644 end;
2645 end;
2646
2647 {$IFDEF HAS_SDO_LONG}
2648 procedure CopyLongProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2649 begin
2650 if A.isSet(AProp) then begin
2651 if A.isNull(AProp) then
2652 B.setNull(AProp)
2653 else
2654 B.setLong(AProp,A.getLong(AProp));
2655 end else begin
2656 B.unset(AProp);
2657 end;
2658 end;
2659 {$ENDIF HAS_SDO_LONG}
2660
2661 {$IFDEF HAS_SDO_SHORT}
2662 procedure CopyShortProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2663 begin
2664 if A.isSet(AProp) then begin
2665 if A.isNull(AProp) then
2666 B.setNull(AProp)
2667 else
2668 B.setShort(AProp,A.getShort(AProp));
2669 end else begin
2670 B.unset(AProp);
2671 end;
2672 end;
2673 {$ENDIF HAS_SDO_SHORT}
2674
2675 procedure CopyStringProperty(const A,B : ISDODataObject; const AProp : ISDOProperty);
2676 begin
2677 if A.isSet(AProp) then begin
2678 if A.isNull(AProp) then
2679 B.setNull(AProp)
2680 else
2681 B.setString(AProp,A.getString(AProp));
2682 end else begin
2683 B.unset(AProp);
2684 end;
2685 end;
2686
2687 procedure CopyListBool(const A,B : ISDODataObjectList);
2688 begin
2689 B.append(A.getBoolean());
2690 end;
2691
2692 procedure CopyListByte(const A,B : ISDODataObjectList);
2693 begin
2694 B.append(A.getByte());
2695 end;
2696
2697 procedure CopyListDate(const A,B : ISDODataObjectList);
2698 begin
2699 B.append(A.getDate());
2700 end;
2701
2702 procedure CopyListInteger(const A,B : ISDODataObjectList);
2703 begin
2704 B.append(A.getInteger());
2705 end;
2706
2707 {$IFDEF HAS_SDO_LONG}
2708 procedure CopyListLong(const A,B : ISDODataObjectList);
2709 begin
2710 B.append(A.getLong());
2711 end;
2712 {$ENDIF HAS_SDO_LONG}
2713
2714 {$IFDEF HAS_SDO_SHORT}
2715 procedure CopyListShort(const A,B : ISDODataObjectList);
2716 begin
2717 B.append(A.getShort());
2718 end;
2719 {$ENDIF HAS_SDO_SHORT}
2720
2721 procedure CopyListObjectRef(const A,B : ISDODataObjectList);
2722 begin
2723 B.append(A.getDataObject());
2724 end;
2725
2726 procedure CopyListString(const A,B : ISDODataObjectList);
2727 begin
2728 B.append(A.getString());
2729 end;
2730
2731 var
2732 ValueCopyFunctions : array[TSDOTypeKind] of TCopyProcRecord =(
2733 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyBoolProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListBool ), // BooleanType,
2734 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyByteProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListByte ), //ByteType,
2735 {$IFDEF HAS_SDO_BYTES}
2736 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyBytesProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListBytes ), //BytesType,
2737 {$ENDIF HAS_SDO_BYTES}
2738 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}NotImplementedSimplePROC; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}NotImplementedListPROC ), //ChangeSummaryType,
2739 {$IFDEF HAS_SDO_CHAR}
2740 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyCharProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListChar ), //CharacterType,
2741 {$ENDIF HAS_SDO_CHAR}
2742 {$IFDEF HAS_SDO_CURRENCY}
2743 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyCurrencyProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListCurrency ), //CurrencyType,
2744 {$ENDIF HAS_SDO_CURRENCY}
2745 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyDateProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListDate ), //DateTimeType,
2746 {$IFDEF HAS_SDO_DOUBLE}
2747 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyDoubleProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListDouble ), //DoubleType,
2748 {$ENDIF HAS_SDO_DOUBLE}
2749 {$IFDEF HAS_SDO_FLOAT}
2750 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyFloatProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListFloat ), //FloatType,
2751 {$ENDIF HAS_SDO_FLOAT}
2752 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyIntegerProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListInteger ), //IntegerType,
2753 {$IFDEF HAS_SDO_LONG}
2754 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyLongProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListLong ), //LongType,
2755 {$ENDIF HAS_SDO_LONG}
2756 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}NotImplementedSimplePROC; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListObjectRef ), //ObjectType,
2757 {$IFDEF HAS_SDO_SHORT}
2758 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyShortProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListShort ), //ShortType,
2759 {$ENDIF HAS_SDO_SHORT}
2760 ( Simple : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyStringProperty; List : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyListString ) //StringType,
2761
2762 );
2763
2764 procedure CopySimpleList(
2765 const ASource, ADest : ISDODataObjectList;
2766 const AType : TSDOTypeKind
2767 );
2768 var
2769 crsA : ILinkedListCursor;
2770 func : TListTypeCopyProc;
2771 bmkA : TLinkedListBookmark;
2772 begin
2773 // if not ( AType in SDODataTypeKinds ) then
2774 // raise ESDOIllegalArgumentException.Create('AType');
2775 func := ValueCopyFunctions[AType].List;
2776 crsA := ASource.getCursor();
2777 bmkA := crsA.GetBookmark();
2778 try
2779 crsA.Reset();
2780 while crsA.MoveNext() do begin
2781 func(ASource,ADest);
2782 end;
2783 finally
2784 crsA.GotoBookmark(bmkA);
2785 end;
2786 end;
2787
2788 { TSDOCopyHelper }
2789
2790 class function TSDOCopyHelper.copy(const ADataObject: ISDODataObject): ISDODataObject;
2791 begin
2792 Result := internalCopy(ADataObject,True);
2793 end;
2794
2795 class procedure TSDOCopyHelper.copyProperty(const A, B: ISDODataObject; const AProp: ISDOProperty);
2796 begin
2797 ValueCopyFunctions[AProp.getTypeEnum()].Simple(A,B,AProp);
2798 end;
2799
2800 class procedure TSDOCopyHelper.copyPropertyList(
2801 const A, B : ISDODataObjectList;
2802 const AType : ISDOType;
2803 const ADeepCopy : Boolean
2804 );
2805 var
2806 crsA : ILinkedListCursor;
2807 func : TListTypeCopyProc;
2808 bmkA : TLinkedListBookmark;
2809 begin
2810 func := ValueCopyFunctions[AType.getTypeEnum()].List;
2811 crsA := A.getCursor();
2812 bmkA := crsA.GetBookmark();
2813 try
2814 crsA.Reset();
2815 if AType.isDataType() then begin
2816 while crsA.MoveNext() do begin
2817 func(A,B);
2818 end;
2819 end else begin
2820 while crsA.MoveNext() do begin
2821 B.append(internalCopy(A.getDataObject(),ADeepCopy));
2822 end;
2823 end;
2824 finally
2825 crsA.GotoBookmark(bmkA);
2826 end;
2827 end;
2828
2829 class function TSDOCopyHelper.copyShallow(const ADataObject: ISDODataObject): ISDODataObject;
2830 begin
2831 Result := internalCopy(ADataObject,False);
2832 end;
2833
2834 class function TSDOCopyHelper.internalCopy(
2835 const ADataObject: ISDODataObject;
2836 const ADeepCopy: Boolean
2837 ) : ISDODataObject;
2838 var
2839 locType, locPropType : ISDOType;
2840 a, b : ISDODataObject;
2841 al, bl : ISDODataObjectList;
2842 locProps : ISDOPropertyList;
2843 locProp : ISDOProperty;
2844 i, c : PtrInt;
2845 begin
2846 if ( ADataObject = nil ) then begin
2847 b := nil;
2848 end else begin
2849 a := ADataObject;
2850 locType := ADataObject.getType();
2851 locProps := locType.getProperties();
2852 b := locType.getOwner().CreateNew(locType);
2853 c := locProps.getCount();
2854 for i := 0 to Pred(c) do begin
2855 locProp := locProps.getItem(i);
2856 if not locProp.isReadOnly() then begin
2857 locPropType := locProp.getType();
2858 if locProp.isMany() then begin
2859 al := a.getList(locProp);
2860 bl := b.getList(locProp);
2861 copyPropertyList(al,bl,locPropType,ADeepCopy);
2862 end else begin
2863 if locPropType.isDataType() then
2864 copyProperty(a,b,locProp)
2865 else if locPropType.isDataObjectType() then
2866 b.setDataObject(locProp,internalCopy(a.getDataObject(locProp),ADeepCopy));
2867 end;
2868 end;
2869 end;
2870 end;
2871 Result := b;
2872 end;
2873
2874
2875 type
2876 TSimpleTypeCompareFunction = function (const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2877 TListTypeCompareFunction = function (const A,B : ISDODataObjectList) : Boolean;
2878 TCompareFunctionRecord = record
2879 SimpleFunction : TSimpleTypeCompareFunction;
2880 ListFunction : TListTypeCompareFunction;
2881 end;
2882
2883 {$WARNINGS OFF}
2884 function NotImplementedSimpleFUNC(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2885 begin
2886 raise ESDONotImplementedException.Create('');
2887 end;
2888 {$WARNINGS ON}
2889
2890 {$WARNINGS OFF}
2891 function NotImplementedListFUNC(const A,B : ISDODataObjectList) : Boolean;
2892 begin
2893 raise ESDONotImplementedException.Create('');
2894 end;
2895 {$WARNINGS ON}
2896
2897 {$IFNDEF EQUALITY_USE_SET_NULL}
2898 function CompareBoolProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2899 begin
2900 Result := ( A.getBoolean(AProp.getName()) = B.getBoolean(AProp.getName()) );
2901 end;
2902
2903 function CompareByteProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2904 begin
2905 Result := ( A.getByte(AProp.getName()) = B.getByte(AProp.getName()) );
2906 end;
2907
2908 function CompareDateProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2909 begin
2910 Result := ValueEquals(A.getDate(AProp.getName()),B.getDate(AProp.getName()));
2911 end;
2912
2913 function CompareIntegerProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2914 begin
2915 Result := ( A.getInteger(AProp.getName()) = B.getInteger(AProp.getName()) );
2916 end;
2917
2918 function CompareStringProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2919 begin
2920 Result := ( A.getString(AProp.getName()) = B.getString(AProp.getName()) );
2921 end;
2922 {$ENDIF EQUALITY_USE_SET_NULL}
2923
2924 {$IFDEF EQUALITY_USE_SET_NULL}
2925 function CompareBoolProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2926 begin
2927 Result := ( ( A.isSet(AProp.getName()) = False ) and
2928 ( B.isSet(AProp.getName()) = False )
2929 ) or
2930 ( ( ( A.isSet(AProp.getName()) = True ) and
2931 ( B.isSet(AProp.getName()) = True )
2932 ) and
2933 ( A.getBoolean(AProp.getName()) = B.getBoolean(AProp.getName()) )
2934 ) ;
2935 end;
2936
2937 function CompareByteProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2938 begin
2939 Result := ( ( A.isSet(AProp.getName()) = False ) and
2940 ( B.isSet(AProp.getName()) = False )
2941 ) or
2942 ( ( ( A.isSet(AProp.getName()) = True ) and
2943 ( B.isSet(AProp.getName()) = True )
2944 ) and
2945 ( A.getByte(AProp.getName()) = B.getByte(AProp.getName()) )
2946 ) ;
2947 end;
2948
2949 function CompareIntegerProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2950 begin
2951 Result := ( ( A.isSet(AProp.getName()) = False ) and
2952 ( B.isSet(AProp.getName()) = False )
2953 ) or
2954 ( ( ( A.isSet(AProp.getName()) = True ) and
2955 ( B.isSet(AProp.getName()) = True )
2956 ) and
2957 ( A.getInteger(AProp.getName()) = B.getInteger(AProp.getName()) )
2958 ) ;
2959 end;
2960
2961 function CompareStringProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2962 begin
2963 Result := ( ( A.isSet(AProp.getName()) = False ) and
2964 ( B.isSet(AProp.getName()) = False )
2965 ) or
2966 ( ( ( A.isSet(AProp.getName()) = True ) and
2967 ( B.isSet(AProp.getName()) = True )
2968 ) and
2969 ( A.getString(AProp.getName()) = B.getString(AProp.getName()) )
2970 ) ;
2971 end;
2972
2973 {$ENDIF EQUALITY_USE_SET_NULL}
2974
2975 function CompareListChangeSummary(const A,B : ISDODataObjectList) : Boolean;
2976 begin
2977 Result := True;
2978 end;
2979
2980 function CompareChangeSummaryProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
2981 begin
2982 Result := True;
2983 end;
2984
2985 function CompareListBool(const A,B : ISDODataObjectList) : Boolean;
2986 begin
2987 Result := ( A.getBoolean() = B.getBoolean() );
2988 end;
2989
2990 function CompareListByte(const A,B : ISDODataObjectList) : Boolean;
2991 begin
2992 Result := ( A.getByte() = B.getByte() );
2993 end;
2994
2995 function CompareListDate(const A,B : ISDODataObjectList) : Boolean;
2996 begin
2997 Result := ValueEquals(A.getDate(),B.getDate());
2998 end;
2999
3000 function CompareListInteger(const A,B : ISDODataObjectList) : Boolean;
3001 begin
3002 Result := ( A.getInteger() = B.getInteger() );
3003 end;
3004
3005 function CompareListString(const A,B : ISDODataObjectList) : Boolean;
3006 begin
3007 Result := ( A.getString() = B.getString() );
3008 end;
3009
3010 {$IFDEF HAS_SDO_BYTES}
3011 function CompareBytesProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
3012 var
3013 av, bv : TSDOBytes;
3014 begin
3015 av := A.getBytes(AProp.getName());
3016 bv := B.getBytes(AProp.getName());
3017 Result := ( ( av = nil ) and ( bv = nil ) ) or
3018 ( ( av <> nil ) and ( bv <> nil) and ( Length(av) = Length(bv) ) and CompareMem(Pointer(av),Pointer(av),Length(av)) );
3019 end;
3020
3021 function CompareListBytes(const A,B : ISDODataObjectList) : Boolean;
3022 var
3023 av, bv : TSDOBytes;
3024 begin
3025 av := A.getBytes();
3026 bv := B.getBytes();
3027 Result := ( ( av = nil ) and ( bv = nil ) ) or
3028 ( ( av <> nil ) and ( bv <> nil) and ( Length(av) = Length(bv) ) and CompareMem(Pointer(av),Pointer(av),Length(av)) );
3029 end;
3030 {$ENDIF HAS_SDO_BYTES}
3031
3032 {$IFDEF HAS_SDO_CHAR}
3033 function CompareCharProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
3034 begin
3035 Result := ( A.getCharacter(AProp.getName()) = B.getCharacter(AProp.getName()) );
3036 end;
3037
3038 function CompareListChar(const A,B : ISDODataObjectList) : Boolean;
3039 begin
3040 Result := ( A.getCharacter() = B.getCharacter() );
3041 end;
3042 {$ENDIF HAS_SDO_CHAR}
3043
3044 {$IFDEF HAS_SDO_CURRENCY}
3045 function CompareCurrencyProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
3046 begin
3047 Result := ( A.getCurrency(AProp.getName()) = B.getCurrency(AProp.getName()) );
3048 end;
3049
3050 function CompareListCurrency(const A,B : ISDODataObjectList) : Boolean;
3051 begin
3052 Result := ( A.getCurrency() = B.getCurrency() );
3053 end;
3054 {$ENDIF HAS_SDO_CURRENCY}
3055
3056 {$IFDEF HAS_SDO_DOUBLE}
3057 function CompareDoubleProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
3058 begin
3059 Result := ( A.getDouble(AProp.getName()) = B.getDouble(AProp.getName()) );
3060 end;
3061
3062 function CompareListDouble(const A,B : ISDODataObjectList) : Boolean;
3063 begin
3064 Result := ( A.getDouble() = B.getDouble() );
3065 end;
3066 {$ENDIF HAS_SDO_DOUBLE}
3067
3068 {$IFDEF HAS_SDO_FLOAT}
3069 function CompareFloatProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
3070 begin
3071 Result := ( A.getFloat(AProp.getName()) = B.getFloat(AProp.getName()) );
3072 end;
3073
3074 function CompareListFloat(const A,B : ISDODataObjectList) : Boolean;
3075 begin
3076 Result := ( A.getFloat() = B.getFloat() );
3077 end;
3078 {$ENDIF HAS_SDO_FLOAT}
3079
3080 {$IFDEF HAS_SDO_LONG}
3081 function CompareLongProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
3082 begin
3083 Result := ( A.getLong(AProp.getName()) = B.getLong(AProp.getName()) );
3084 end;
3085
3086 function CompareListLong(const A,B : ISDODataObjectList) : Boolean;
3087 begin
3088 Result := ( A.getLong() = B.getLong() );
3089 end;
3090 {$ENDIF HAS_SDO_LONG}
3091
3092 {$IFDEF HAS_SDO_SHORT}
3093 function CompareShortProperty(const A,B : ISDODataObject; const AProp : ISDOProperty) : Boolean;
3094 begin
3095 Result := ( A.getShort(AProp.getName()) = B.getShort(AProp.getName()) );
3096 end;
3097
3098 function CompareListShort(const A,B : ISDODataObjectList) : Boolean;
3099 begin
3100 Result := ( A.getShort() = B.getShort() );
3101 end;
3102 {$ENDIF HAS_SDO_SHORT}
3103
3104 var
3105 ValueCompareFunctions : array[TSDOTypeKind] of TCompareFunctionRecord =(
3106 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareBoolProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListBool ), // BooleanType,
3107 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareByteProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListByte ), //ByteType,
3108 {$IFDEF HAS_SDO_BYTES}
3109 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareBytesProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListBytes ), //BytesType,
3110 {$ENDIF HAS_SDO_BYTES}
3111 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareChangeSummaryProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListChangeSummary ), //ChangeSummaryType,
3112 {$IFDEF HAS_SDO_CHAR}
3113 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareCharProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListChar ), //CharacterType,
3114 {$ENDIF HAS_SDO_CHAR}
3115 {$IFDEF HAS_SDO_CURRENCY}
3116 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareCurrencyProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListCurrency ), //CurrencyType,
3117 {$ENDIF HAS_SDO_CURRENCY}
3118 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareDateProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListDate ), //DateTimeType,
3119 {$IFDEF HAS_SDO_DOUBLE}
3120 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareDoubleProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListDouble ), //DoubleType,
3121 {$ENDIF HAS_SDO_DOUBLE}
3122 {$IFDEF HAS_SDO_FLOAT}
3123 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareFloatProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListFloat ), //FloatType,
3124 {$ENDIF HAS_SDO_FLOAT}
3125 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareIntegerProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListInteger ), //IntegerType,
3126 {$IFDEF HAS_SDO_LONG}
3127 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareLongProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListLong ), //LongType,
3128 {$ENDIF HAS_SDO_LONG}
3129 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}NotImplementedSimpleFUNC; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}NotImplementedListFUNC ), //ObjectType,
3130 {$IFDEF HAS_SDO_SHORT}
3131 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareShortProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListShort ), //ShortType,
3132 {$ENDIF HAS_SDO_SHORT}
3133 ( SimpleFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareStringProperty; ListFunction : {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListString ) //StringType,
3134
3135 );
3136
3137 (*procedure Init();
3138 begin
3139 FillChar(ValueCompareFunctions,SizeOf(ValueCompareFunctions),#0);
3140 ValueCompareFunctions[BooleanType].SimpleFunction := {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareBoolProperty;
3141 ValueCompareFunctions[BooleanType].ListFunction := {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListBool;
3142 ValueCompareFunctions[IntegerType].SimpleFunction := {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareIntegerProperty;
3143 ValueCompareFunctions[IntegerType].ListFunction := {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListInteger;
3144 ValueCompareFunctions[StringType].SimpleFunction := {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareStringProperty;
3145 ValueCompareFunctions[StringType].ListFunction := {$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CompareListString;
3146 end;
3147 *)
3148
3149 { TSDOEqualityHelper }
3150
3151 class function TSDOEqualityHelper.CompareList(
3152 const A,B: ISDODataObjectList;
3153 const AType : ISDOType
3154 ) : Boolean;
3155 var
3156 c : PtrInt;
3157 crsA, crsB : ISDOCursor;
3158 ok : Boolean;
3159 func : TListTypeCompareFunction;
3160 bmkA, bmkB : ISDOCursorBookmark;
3161 begin
3162 if ( A = nil ) and ( B = nil ) then begin
3163 Result := True;
3164 end else if ( A <> nil ) and ( B <> nil ) then begin
3165 Result := False;
3166 c := A.size();
3167 if ( c = B.size() ) then begin
3168 ok := True;
3169 if ( c > 0 ) then begin
3170 func := ValueCompareFunctions[AType.getTypeEnum()].ListFunction;
3171 crsA := A.getCursor();
3172 crsB := B.getCursor();
3173 bmkA := crsA.GetBookmark();
3174 bmkB := crsB.GetBookmark();
3175 try
3176 crsA.Reset();
3177 crsB.Reset();
3178 if AType.isDataType() then begin
3179 while crsA.MoveNext() do begin
3180 if not ( crsB.MoveNext() and func(A,B) ) then begin
3181 ok := False;
3182 Break;
3183 end;
3184 end;
3185 end else begin
3186 while crsA.MoveNext() do begin
3187 if not ( crsB.MoveNext() and InternalEqual(A.getDataObject(),B.getDataObject(),True) ) then begin
3188 ok := False;
3189 Break;
3190 end;
3191 end;
3192 end;
3193 finally
3194 crsB.GotoBookmark(bmkB);
3195 crsA.GotoBookmark(bmkA);
3196 end;
3197 end;
3198 Result := ok;
3199 end;
3200 end else begin
3201 Result := False;
3202 end;
3203 end;
3204
3205 class function TSDOEqualityHelper.CompareProperty(
3206 const A, B : ISDODataObject;
3207 const AProp : ISDOProperty
3208 ) : Boolean;
3209 begin
3210 Result := ValueCompareFunctions[AProp.getTypeEnum()].SimpleFunction(A,B,AProp);
3211 end;
3212
3213 class function TSDOEqualityHelper.equal(const A, B: ISDODataObject): Boolean;
3214 begin
3215 Result := InternalEqual(A,B,True);
3216 end;
3217
3218 class function TSDOEqualityHelper.equalShallow(const A,B: ISDODataObject): Boolean;
3219 begin
3220 Result := InternalEqual(A,B,False);
3221 end;
3222
3223 class function TSDOEqualityHelper.InternalEqual(
3224 const A, B: ISDODataObject;
3225 const AFullCompare: Boolean
3226 ) : Boolean;
3227 var
3228 i, c : PtrInt;
3229 plsA, plsB : ISDOPropertyList;
3230 ok : Boolean;
3231 pA, pB : ISDOProperty;
3232 begin
3233 if ( A = nil ) and ( B = nil ) then begin
3234 Result := True;
3235 end else if ( A <> nil ) and ( B <> nil ) then begin
3236 Result := False;
3237 if A.getType().equals(B.getType()) then begin
3238 plsA := A.getInstanceProperties();
3239 plsB := B.getInstanceProperties();
3240 c := plsA.getCount();
3241 if ( c = plsB.getCount() ) then begin
3242 ok := True;
3243 if ( c > 0 ) then begin
3244 for i := 0 to Pred(c) do begin
3245 pA := plsA.getItem(i);
3246 pB := plsB.find(pA.getName());
3247 if ( pB = nil ) then begin
3248 ok := False;
3249 Break;
3250 end;
3251 if ( pA.getType().isDataType() <> pB.getType().isDataType() ) then begin
3252 ok := False;
3253 Break;
3254 end;
3255 if pA.getType().isDataType() then begin
3256 if pA.isMany() then
3257 ok := CompareList(A.getList(pA),B.getList(pB),pA.getType())
3258 else
3259 ok := CompareProperty(A,B,pA);
3260 if not ok then
3261 Break;
3262 end else if AFullCompare then begin
3263 if pA.isMany() then
3264 ok := CompareList(A.getList(pA),B.getList(pB),pA.getType())
3265 else
3266 ok := InternalEqual(A.getDataObject(pA.getName()),B.getDataObject(pA.getName()),True);
3267 if not ok then
3268 Break;
3269 end;
3270 end;
3271 end;
3272 if ok then
3273 Result := True;
3274 end;
3275 end;
3276 end else begin
3277 Result := False;
3278 end;
3279 end;
3280
3281
3282 initialization
3283 {$IFDEF DELPHI}
3284 GetLocaleFormatSettings(GetThreadLocale(),ConverterFormatSetting);
3285 {$ENDIF}
3286 {$IFDEF FPC}
3287 ConverterFormatSetting := DefaultFormatSettings;
3288 {$ENDIF}
3289 ConverterFormatSetting.DecimalSeparator := '.';
3290
3291 end.
3292