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 streaming to binary file.
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_serialization_binary;
18
19 interface
20
21 uses
22 Classes, SysUtils, Contnrs,
23 sdo_binary_streamer,
24 sdo_types, sdo, sdo_consts, sdo_serialization_utils;
25
26 {$DEFINE sdo_binary_header}
27
28 const
29 sBINARY_FORMAT_NAME = 'sdo-binary';
30 sROOT = 'ROOT';
31 sSCOPE_INNER_NAME = 'INNER_VAL';
32 sFORMAT = 'format';
33
34 type
35
36 TDataName = String;
37 TDataType = (
38 dtInt8U = 1, dtInt8S = 2,
39 dtInt16U = 3, dtInt16S = 4,
40 dtInt32U = 5, dtInt32S = 6,
41 dtInt64U = 7, dtInt64S = 8,
42 dtBool = 9,
43 dtAnsiChar = 10, dtWideChar = 11, dtEnum = 12,
44 dtSingle = 13, dtDouble = 14, dtExtended = 15, dtCurrency = 16,
45 dtAnsiString = 17, dtWideString = 18,
46 {$IFDEF USE_UNICODE}
47 dtUnicodeString = 19,
48 {$ENDIF USE_UNICODE}
49 dtObject = 30, dtArray = 31,
50 dtByteDynArray = 32
51 );
52 const
53 dtDefaultString =
54 {$IFDEF USE_UNICODE}
55 {$IFDEF DELPHI}
56 dtUnicodeString
57 {$ENDIF DELPHI}
58 {$IFDEF FPC}
59 dtAnsiString
60 {$ENDIF FPC}
61 {$ELSE USE_UNICODE}
62 dtAnsiString
63 {$ENDIF USE_UNICODE}
64 ;
65
66 type
67
68 PAnsiStringBuffer = ^TAnsiStringBuffer;
69 PWideStringBuffer = ^TWideStringBuffer;
70 {$IFDEF USE_UNICODE}
71 PUnicodeStringBuffer = ^TUnicodeStringBuffer;
72 {$ENDIF USE_UNICODE}
73 PObjectBuffer = ^TObjectBuffer;
74 PArrayBuffer = ^TArrayBuffer;
75 PByteDynArrayBuffer = ^TByteDynArrayBuffer;
76 PDataBuffer = ^TDataBuffer;
77
78 TDataBuffer = Record
79 Name : TDataName;
80 Case DataType : TDataType of
81 dtInt8S : ( Int8S : TInt8S );
82 dtInt8U : ( Int8U : TInt8U );
83 dtInt16U : ( Int16U : TInt16U );
84 dtInt16S : ( Int16S : TInt16S );
85 dtInt32U : ( Int32U : TInt32U );
86 dtInt32S : ( Int32S : TInt32S );
87 dtInt64U : ( Int64U : TInt64U );
88 dtInt64S : ( Int64S : TInt64S );
89 dtBool : ( BoolData : TBoolData );
90 dtAnsiChar : ( AnsiCharData : TAnsiCharacter; );
91 dtWideChar : ( WideCharData : TWideCharacter; );
92 dtEnum : ( EnumData : TEnumData );
93 dtSingle : ( SingleData : TFloat_Single_4 );
94 dtDouble : ( DoubleData : TFloat_Double_8 );
95 dtExtended : ( ExtendedData : TFloat_Extended_10 );
96 dtCurrency : ( CurrencyData : TFloat_Currency_8 );
97
98 dtAnsiString : ( AnsiStrData : PAnsiStringBuffer );
99 dtWideString : ( WideStrData : PWideStringBuffer );
100 {$IFDEF USE_UNICODE}
101 dtUnicodeString : ( UnicodeStrData : PUnicodeStringBuffer );
102 {$ENDIF USE_UNICODE}
103 dtObject : ( ObjectData : PObjectBuffer );
104 dtArray : ( ArrayData : PArrayBuffer );
105 dtByteDynArray : ( ByteDynArrayData : PByteDynArrayBuffer );
106 End;
107
108 TAnsiStringBuffer = record
109 Data : TAnsiStringData;
110 end;
111
112 TWideStringBuffer = record
113 Data : TWideStringData;
114 end;
115
116 {$IFDEF USE_UNICODE}
117 TUnicodeStringBuffer = record
118 Data : TUnicodeStringData;
119 end;
120 {$ENDIF USE_UNICODE}
121
122
123
124 PObjectBufferItem = ^TObjectBufferItem;
125 TObjectBufferItem = Record
126 Data : PDataBuffer;
127 Next : PObjectBufferItem;
128 End;
129
130 TObjectBuffer = Record
131 NilObject : TBoolData;
132 Count : Integer;
133 Head : PObjectBufferItem;
134 Last : PObjectBufferItem;
135 Attributes : PObjectBuffer;
136 InnerData : PDataBuffer;
137 End;
138
139 PDataBufferList = ^TDataBufferList;
140 TDataBufferList = array[0..MAX_ARRAY_LENGTH] of PDataBuffer;
141 TArrayBuffer = Record
142 Count : Integer;
143 Items : PDataBufferList;
144 Attributes : PObjectBuffer;
145 End;
146
147 TByteDynArrayBuffer = record
148 Data : TByteDynArray;
149 end;
150
151 { TStackItem }
152
153 TStackItem = class
154 private
155 FScopeObject: PDataBuffer;
156 protected
157 procedure CopyTo(const AClone : TStackItem);virtual;
158 Public
159 constructor Create(const AScopeObject : PDataBuffer);virtual;
Clonenull160 function Clone() : TStackItem;virtual;
GetItemCountnull161 function GetItemCount():Integer;virtual;abstract;
Findnull162 function Find(var AName : TDataName):PDataBuffer;virtual;abstract;
GetByIndexnull163 function GetByIndex(const AIndex : Integer):PDataBuffer;virtual;abstract;
CreateBuffernull164 function CreateBuffer(
165 Const AName : String;
166 const ADataType : TDataType
167 ):PDataBuffer;virtual;abstract;
CreateInnerBuffernull168 function CreateInnerBuffer(const ADataType : TDataType):PDataBuffer;virtual;abstract;
GetInnerBuffernull169 function GetInnerBuffer():PDataBuffer;virtual;abstract;
170 procedure NilCurrentScope();virtual;abstract;
IsCurrentScopeNilnull171 function IsCurrentScopeNil():Boolean;virtual;abstract;
172 property ScopeObject : PDataBuffer Read FScopeObject;
173
GetScopeItemNamesnull174 function GetScopeItemNames(const AReturnList : TStrings) : Integer;virtual;abstract;
175 End;
176 TStackItemClass = class of TStackItem;
177
178 { TObjectStackItem }
179
180 TObjectStackItem = class(TStackItem)
181 Public
GetItemCountnull182 function GetItemCount():Integer;override;
Findnull183 function Find(var AName : TDataName):PDataBuffer;override;
GetByIndexnull184 function GetByIndex(const AIndex : Integer):PDataBuffer;override;
CreateBuffernull185 function CreateBuffer(
186 Const AName : String;
187 const ADataType : TDataType
188 ):PDataBuffer;override;
CreateInnerBuffernull189 function CreateInnerBuffer(const ADataType : TDataType):PDataBuffer;override;
GetInnerBuffernull190 function GetInnerBuffer():PDataBuffer;override;
191 procedure NilCurrentScope();override;
IsCurrentScopeNilnull192 function IsCurrentScopeNil():Boolean;override;
GetScopeItemNamesnull193 function GetScopeItemNames(const AReturnList : TStrings) : Integer;override;
194 End;
195 TObjectStackItemClass = class of TObjectStackItem;
196
197
198 { TObjectBaseArrayStackItem }
199
200 TObjectBaseArrayStackItem = class(TObjectStackItem)
201 private
202 FIndex : Integer;
203 FItemName : TDataName;
204 protected
205 procedure CopyTo(const AClone : TStackItem);override;
206 public
GetItemCountnull207 function GetItemCount():Integer;override;
Findnull208 function Find(var AName : TDataName):PDataBuffer;override;
209 procedure SetItemName(const AValue : TDataName);
210 end;
211
212 { TArrayStackItem }
213
214 TArrayStackItem = class(TStackItem)
215 Private
216 FIndex : Integer;
217 protected
218 procedure CopyTo(const AClone : TStackItem);override;
219 Public
GetItemCountnull220 function GetItemCount():Integer;override;
Findnull221 function Find(var AName : TDataName):PDataBuffer;override;
GetByIndexnull222 function GetByIndex(const AIndex : Integer):PDataBuffer;override;
CreateBuffernull223 function CreateBuffer(
224 Const AName : String;
225 const ADataType : TDataType
226 ):PDataBuffer;override;
CreateInnerBuffernull227 function CreateInnerBuffer(const ADataType : TDataType):PDataBuffer;override;
GetInnerBuffernull228 function GetInnerBuffer():PDataBuffer;overload;override;
229 procedure NilCurrentScope();override;
IsCurrentScopeNilnull230 function IsCurrentScopeNil():Boolean;override;
GetScopeItemNamesnull231 function GetScopeItemNames(const AReturnList : TStrings) : Integer;override;
232 End;
233 TArrayStackItemClass = class of TArrayStackItem;
234
235 TStreamBinaryBookmark = class(TStreamBookmark)
236 private
237 FNameStyle: TNameStyle;
238 FStack: TObjectStackEx;
239 FRootData : PDataBuffer;
240 FSerializationStyle: TSerializationStyle;
241 public
242 destructor Destroy();override;
243 property SerializationStyle : TSerializationStyle read FSerializationStyle;
244 property NameStyle : TNameStyle read FNameStyle;
245 property RootData : PDataBuffer read FRootData;
246 property Stack : TObjectStackEx read FStack;
247 end;
248
249 { TSDOSerializationStreamBinary }
250
251 TSDOSerializationStreamBinary = class(TInterfacedObject,IInterface,ISDOSerializerStream)
252 private
253 FRootData : PDataBuffer;
254 FStack : TObjectStackEx;
255 FSerializationStyle : TSerializationStyle;
256 FNameStyle : TNameStyle;
257 protected
GetCurrentScopeObjectnull258 function GetCurrentScopeObject():PDataBuffer;
259 protected
HasScopenull260 function HasScope():Boolean;
261 procedure CheckScope();
262 procedure ClearStack();{$IFDEF USE_INLINE}inline;{$ENDIF}
263 procedure PushStack(AScopeObject : PDataBuffer;Const AScopeType : TScopeType = stObject);{$IFDEF USE_INLINE}inline;{$ENDIF}
StackTopnull264 function StackTop():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
PopStacknull265 function PopStack():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
GetRootDatanull266 function GetRootData() : PDataBuffer;{$IFDEF USE_INLINE}inline;{$ENDIF}
267 protected
268 procedure PutBoolean(const AName : string; const AData : TSDOBoolean);{$IFDEF USE_INLINE}inline;{$ENDIF}
269 procedure PutByte(const AName : string; const AData : TSDOByte);{$IFDEF USE_INLINE}inline;{$ENDIF}
270 {$IFDEF HAS_SDO_BYTES}
271 procedure PutBytes(const AName : string; const AData : TSDOBytes);{$IFDEF USE_INLINE}inline;{$ENDIF}
272 {$ENDIF HAS_SDO_BYTES}
273 {$IFDEF HAS_SDO_CHAR}
274 procedure PutChar(const AName : string; const AData : TSDOChar);{$IFDEF USE_INLINE}inline;{$ENDIF}
275 {$ENDIF HAS_SDO_CHAR}
276 {$IFDEF HAS_SDO_CURRENCY}
277 procedure PutCurrency(const AName : string; const AData : TSDOCurrency);{$IFDEF USE_INLINE}inline;{$ENDIF}
278 {$ENDIF HAS_SDO_CURRENCY}
279 procedure PutDate(const AName : string; const AData : TSDODateTime);{$IFDEF USE_INLINE}inline;{$ENDIF}
280 {$IFDEF HAS_SDO_DOUBLE}
281 procedure PutDouble(const AName : string; const AData : TSDODouble);{$IFDEF USE_INLINE}inline;{$ENDIF}
282 {$ENDIF HAS_SDO_DOUBLE}
283 {$IFDEF HAS_SDO_FLOAT}
284 procedure PutFloat(const AName : string; const AData : TSDOFloat);{$IFDEF USE_INLINE}inline;{$ENDIF}
285 {$ENDIF HAS_SDO_FLOAT}
286 procedure PutInteger(const AName : string; const AData : TSDOInteger);{$IFDEF USE_INLINE}inline;{$ENDIF}
287 {$IFDEF HAS_SDO_LONG}
288 procedure PutLong(const AName : string; const AData : TSDOLong);{$IFDEF USE_INLINE}inline;{$ENDIF}
289 {$ENDIF HAS_SDO_LONG}
290 {$IFDEF HAS_SDO_SHORT}
291 procedure PutShort(const AName : string; const AData : TSDOShort);{$IFDEF USE_INLINE}inline;{$ENDIF}
292 {$ENDIF HAS_SDO_SHORT}
293 procedure PutString(const AName : string; const AData : TSDOString);{$IFDEF USE_INLINE}inline;{$ENDIF}
294
GetDataBuffernull295 function GetDataBuffer(
296 var AName : string;
297 out AResultBuffer : PDataBuffer
298 ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
GetBooleannull299 function GetBoolean(var AName : string;var AData : TSDOBoolean) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
GetBytenull300 function GetByte(var AName : string;var AData : TSDOByte) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
301 {$IFDEF HAS_SDO_BYTES}
GetBytesnull302 function GetBytes(var AName : string;var AData : TSDOBytes) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
303 {$ENDIF HAS_SDO_BYTES}
304 {$IFDEF HAS_SDO_CHAR}
GetCharnull305 function GetChar(var AName : string;var AData : TSDOChar) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
306 {$ENDIF HAS_SDO_CHAR}
307 {$IFDEF HAS_SDO_CURRENCY}
GetCurrencynull308 function GetCurrency(var AName : string;var AData : TSDOCurrency) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
309 {$ENDIF HAS_SDO_CURRENCY}
GetDatenull310 function GetDate(var AName : string;var AData : TSDODateTime) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
311 {$IFDEF HAS_SDO_DOUBLE}
GetDoublenull312 function GetDouble(var AName : string;var AData : TSDODouble) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
313 {$ENDIF HAS_SDO_DOUBLE}
314 {$IFDEF HAS_SDO_FLOAT}
GetFloatnull315 function GetFloat(var AName : string;var AData : TSDOFloat) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
316 {$ENDIF HAS_SDO_FLOAT}
GetIntegernull317 function GetInteger(var AName : string;var AData : TSDOInteger) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
318 {$IFDEF HAS_SDO_LONG}
GetLongnull319 function GetLong(var AName : string;var AData : TSDOLong) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
320 {$ENDIF HAS_SDO_LONG}
321 {$IFDEF HAS_SDO_SHORT}
GetShortnull322 function GetShort(var AName : string;var AData : TSDOShort) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
323 {$ENDIF HAS_SDO_SHORT}
GetStringnull324 function GetString(var AName : string;var AData : TSDOString) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
325
326 protected // ISDOSerializerStream
GetFormatNamenull327 function GetFormatName() : string;
328 procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle);
GetSerializationStylenull329 function GetSerializationStyle():TSerializationStyle;
330 procedure SetNameStyle(const AValue : TNameStyle);
GetNameStylenull331 function GetNameStyle() : TNameStyle;
GetCurrentScopenull332 function GetCurrentScope():string;
333 procedure Clear();
334 procedure Initialize();
335
336 procedure BeginObject(
337 Const AName : string;
338 Const ATypeInfo : ISDOType
339 );
340 procedure BeginArray(
341 const AName : string;
342 const AItemTypeInfo : ISDOType;
343 const ABounds : array of Integer
344 );
345 procedure NilCurrentScope();
IsCurrentScopeNilnull346 function IsCurrentScopeNil():Boolean;
347 procedure EndScope();
BeginObjectReadnull348 function BeginObjectRead(
349 var AScopeName : string;
350 const ATypeInfo : ISDOType
351 ) : Integer;
BeginArrayReadnull352 function BeginArrayRead(
353 var AScopeName : string;
354 const ATypeInfo : ISDOType;
355 const AItemName : string
356 ):Integer;
GetScopeItemNamesnull357 function GetScopeItemNames(
358 const AItemStyle : TSerializationStyle;
359 const AReturnList : TStrings
360 ) : Integer;
361 procedure EndScopeRead();
362
363 procedure Put(
364 const AName : string;
365 const ATypeInfo : ISDOType;
366 const AData
367 );overload;
368 procedure Put(
369 const ANameSpace,
370 AName : string;
371 const ATypeInfo : ISDOType;
372 const AData
373 );overload;
374 procedure PutScopeInnerValue(
375 const ATypeInfo : ISDOType;
376 const AData
377 );
Getnull378 function Get(
379 const ATypeInfo : ISDOType;
380 var AName : string;
381 var AData
382 ) : Boolean;overload;
Getnull383 function Get(
384 const ANameSpace : string;
385 const ATypeInfo : ISDOType;
386 var AName : string;
387 var AData
388 ) : Boolean;overload;
GetScopeInnerValuenull389 function GetScopeInnerValue(
390 const ATypeInfo : ISDOType;
391 var AData
392 ) : Boolean;
ReadBuffernull393 function ReadBuffer(const AName : string) : string;
394 //Please use this method if and _only_ if you do not have another way to achieve your aim!
395 procedure WriteBuffer(const AValue : string);
396
397 procedure SaveToStream(AStream : TStream);overload;
398 procedure SaveToFile(const AFileName : string);overload;
399 procedure LoadFromStream(AStream : TStream);overload;
400 procedure LoadFromFile(const AFileName : string);overload;
401
GetBookMarknull402 function GetBookMark() : TStreamBookmark;
GotoBookmarknull403 function GotoBookmark(const AValue : TStreamBookmark) : Boolean;
404 // This procedures will raise exceptions!!!
405 procedure Error(Const AMsg:string);overload;
406 procedure Error(Const AMsg:string; Const AArgs : array of const);overload;
407 public
408 constructor Create();
409 destructor Destroy();override;
410 end;
411
412 TDBGPinterProc = procedure(const AMsg:string);
413
414 procedure ClearObj(const AOwner: PDataBuffer);
415 procedure FreeObjectBuffer(var ABuffer : PDataBuffer); overload;
LoadObjectFromStreamnull416 function LoadObjectFromStream(const AStoreRdr : IDataStoreReader):PDataBuffer;
417 procedure SaveObjectToStream(const ARoot: PDataBuffer; const ADest : IDataStore);
CreateArrayBuffernull418 function CreateArrayBuffer(
419 const ALength : Integer;
420 const AName : TDataName;
421 const AOwner : PDataBuffer = nil
422 ):PDataBuffer;
CreateObjBuffernull423 function CreateObjBuffer(
424 const ADataType : TDataType;
425 const AName : TDataName;
426 const AOwner : PDataBuffer = nil
427 ):PDataBuffer;
428
ToStrnull429 function ToStr(const ABuffer : PDataBuffer) : TSDOString;
430 procedure PrintObj(const ARoot: PDataBuffer; const ALevel : Integer; const APrinterProc : TDBGPinterProc);
431
432
433 implementation
434
sdo_GetMemnull435 function sdo_GetMem(Size : PtrInt) : Pointer;{$IFDEF USE_INLINE}inline;{$ENDIF}
436 begin
437 {$IFDEF FPC}
438 Result := GetMem(Size);
439 {$ELSE}
440 GetMem(Result,Size);
441 {$ENDIF}
442 end;
443
ToStrnull444 function ToStr(const ABuffer : PDataBuffer) : TSDOString;
445 begin
446 Result := '';
447 if ( ABuffer <> nil ) then begin
448 case ABuffer^.DataType of
449 dtInt8U : Result := TSDOConvertHelper.ByteToString(ABuffer^.Int8U);
450 dtInt8S : Result := TSDOConvertHelper.ShortToString(ABuffer^.Int8S);
451 dtInt16U : Result := TSDOConvertHelper.IntegerToString(ABuffer^.Int16U);
452 dtInt16S : Result := TSDOConvertHelper.ShortToString(ABuffer^.Int16S);
453 dtInt32U : Result := TSDOConvertHelper.LongToString(ABuffer^.Int32U);
454 dtInt32S : Result := TSDOConvertHelper.IntegerToString(ABuffer^.Int32S);
455 dtInt64U : Result := IntToStr(ABuffer^.Int64U);
456 dtInt64S : Result := IntToStr(ABuffer^.Int64S);
457
458 dtBool : Result := TSDOConvertHelper.BoolToString(ABuffer^.BoolData);
459 dtAnsiChar : Result := String(ABuffer^.AnsiCharData);
460 dtWideChar : Result := ABuffer^.WideCharData;
461 dtEnum : Result := IntToStr(ABuffer^.EnumData);
462 dtSingle : Result := TSDOConvertHelper.FloatToString(ABuffer^.SingleData);
463 dtDouble : Result := TSDOConvertHelper.FloatToString(ABuffer^.DoubleData);
464 dtExtended : Result := TSDOConvertHelper.FloatToString(ABuffer^.ExtendedData);
465 dtCurrency : Result := TSDOConvertHelper.CurrencyToString(ABuffer^.CurrencyData);
466 dtAnsiString: Result := String(ABuffer^.AnsiStrData^.Data);
467 dtWideString: Result := ABuffer^.WideStrData^.Data;
468 {$IFDEF USE_UNICODE}
469 dtUnicodeString : Result := ABuffer^.UnicodeStrData^.Data;
470 {$ENDIF USE_UNICODE}
471 end;
472 end;
473 end;
474
475 {var FFile : TMemoryStream = nil;
476 procedure DBG_Write(const AMsg:string);
477 var
478 s : string;
479 begin
480 if ( FFile = nil ) then
481 FFile := TMemoryStream.Create();
482 s := AMsg + sLineBreak;
483 FFile.Write(s[1],Length(s));
484 end;}
485
486 procedure PrintObj(const ARoot: PDataBuffer; const ALevel : Integer; const APrinterProc : TDBGPinterProc);
487 Var
488 p : PObjectBufferItem;
489 s : string;
490 i ,j: Integer;
491 da : TByteDynArray;
492 Begin
493 If Not Assigned(ARoot) Then
494 Exit;
495 s := StringOfChar(' ',ALevel);
496 Case ARoot^.DataType Of
497 dtInt8S : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int8S) );
498 dtInt8U : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int8U) );
499 dtInt32U : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int32U) );
500 dtInt32S : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int32S) );
501 dtInt64U : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int64U) );
502 dtInt64S : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int64S) );
503
504 dtSingle : APrinterProc( s + ARoot^.Name + ' = ' + FloatToStr(ARoot^.SingleData) );
505 dtDouble : APrinterProc( s + ARoot^.Name + ' = ' + FloatToStr(ARoot^.DoubleData) );
506 dtExtended : APrinterProc( s + ARoot^.Name + ' = ' + FloatToStr(ARoot^.ExtendedData) );
507 dtCurrency : APrinterProc( s + ARoot^.Name + ' = ' + FloatToStr(ARoot^.CurrencyData) );
508
509 dtAnsiString : APrinterProc( s + ARoot^.Name + ' = ' + String(ARoot^.AnsiStrData^.Data) );
510 dtWideString : APrinterProc( s + ARoot^.Name + ' = ' + ARoot^.WideStrData^.Data );
511 {$IFDEF USE_UNICODE}
512 dtUnicodeString : APrinterProc( s + ARoot^.Name + ' = ' + ARoot^.UnicodeStrData^.Data );
513 {$ENDIF USE_UNICODE}
514 dtObject :
515 Begin
516 APrinterProc( s + ARoot^.Name + ' = ');
517 If Not Assigned(ARoot^.ObjectData) Then Begin
518 APrinterProc(s + ' <Vide>');
519 End Else Begin
520 APrinterProc('( ' + IntToStr(ARoot^.ObjectData^.Count) + ' Objects )');
521 p := ARoot^.ObjectData^.Head;
522 i := ALevel + 1;
523 While Assigned(p) Do Begin
524 PrintObj(p^.Data,i,APrinterProc);
525 p := p^.Next;
526 End;
527 End;
528 End;
529 dtArray :
530 Begin
531 APrinterProc( s + ARoot^.Name + ' = ');
532 If Not Assigned(ARoot^.ArrayData) Then Begin
533 APrinterProc(s + ' <Vide>');
534 End Else Begin
535 j := ARoot^.ArrayData^.Count;
536 APrinterProc('( Objects[ '+ IntToStr(j)+ '] )');
537 i := ALevel + 1;
538 For j := 0 To Pred(j) Do Begin
539 PrintObj(ARoot^.ArrayData^.Items^[j],i,APrinterProc);
540 End;
541 End;
542 End;
543 dtByteDynArray :
544 begin
545 APrinterProc( s + ARoot^.Name + ' = ');
546 if ( ARoot^.ByteDynArrayData = nil ) then begin
547 APrinterProc(s + ' <Vide>');
548 end else begin
549 i := Length(ARoot^.ByteDynArrayData^.Data);
550 j := i;
551 da := ARoot^.ByteDynArrayData^.Data;
552 for j := 1 to j do
553 s := s + Format(' %d',[da[Pred(j)]]);
554 APrinterProc('( Bytes[ '+ IntToStr(i)+ '] )' + s);
555 end;
556 end;
557 End;
558 End;
559
FindObjnull560 function FindObj(const AOwner: PDataBuffer; const AName : TDataName) : PDataBuffer;
561 Var
562 p : PObjectBufferItem;
563 Begin
564 Assert(AOwner^.DataType >= dtObject);
565 Result := Nil;
566 p:= AOwner^.ObjectData^.Head;
567 While Assigned(p) Do Begin
568 If AnsiSameText(AName,p^.Data^.Name) Then Begin
569 Result := p^.Data;
570 Exit;
571 End;
572 p := p^.Next;
573 End;
574 End;
575
576 procedure AddObj(
577 const AOwner, AChildData: PDataBuffer;
578 const AIndex : Integer = -1
579 );
580 Var
581 p : PObjectBufferItem;
582 Begin
583 If ( AOwner^.DataType = dtObject ) Then Begin
584 p := sdo_GetMem(SizeOf(TObjectBufferItem));
585 p^.Data := AChildData;
586 p^.Next := Nil;
587 If Assigned(AOwner^.ObjectData^.Head) Then Begin
588 AOwner^.ObjectData^.Last^.Next := p;
589 End Else Begin
590 AOwner^.ObjectData^.Head := p;
591 End;
592 AOwner^.ObjectData^.Last := p;
593 Inc(AOwner^.ObjectData^.Count);
594 End Else If ( AOwner^.DataType = dtArray ) Then Begin
595 If ( AIndex >= 0 ) And ( AIndex < AOwner^.ArrayData^.Count ) Then
596 AOwner^.ArrayData^.Items^[AIndex] := AChildData
597 Else
598 raise ESDOSerializationException.CreateFmt(SERR_IndexOutOfBound,[AIndex])
599 End Else Begin
600 Raise ESDOSerializationException.CreateFmt(SERR_InvalidDataTypeInContext,[IntToStr(Ord(AOwner^.DataType))])
601 End;
602 End;
603
CreateObjBuffernull604 function CreateObjBuffer(
605 const ADataType : TDataType;
606 const AName : TDataName;
607 const AOwner : PDataBuffer = nil
608 ):PDataBuffer;
609 var
610 resLen, i : Integer;
611 begin
612 resLen := SizeOf(TDataBuffer);
613 Result := sdo_GetMem(resLen);
614 Try
615 FillChar(Result^,resLen,#0);
616 Result^.Name := AName;
617 Result^.DataType := ADataType;
618 Case Result^.DataType Of
619 dtAnsiString :
620 Begin
621 i := SizeOf(TAnsiStringBuffer);
622 Result^.AnsiStrData := sdo_GetMem(i);
623 FillChar(Result^.AnsiStrData^,i,#0);
624 Result^.AnsiStrData^.Data := '';
625 End;
626 dtWideString :
627 begin
628 i := SizeOf(TWideStringBuffer);
629 Result^.WideStrData := sdo_GetMem(i);
630 FillChar(Result^.WideStrData^,i,#0);
631 Result^.WideStrData^.Data := '';
632 end;
633 {$IFDEF USE_UNICODE}
634 dtUnicodeString :
635 begin
636 i := SizeOf(TUnicodeStringBuffer);
637 Result^.UnicodeStrData := sdo_GetMem(i);
638 FillChar(Result^.UnicodeStrData^,i,#0);
639 Result^.UnicodeStrData^.Data := '';
640 end;
641 {$ENDIF USE_UNICODE}
642 dtObject :
643 Begin
644 Result^.ObjectData := sdo_GetMem(SizeOf(TObjectBuffer));
645 FillChar(Result^.ObjectData^,SizeOf(TObjectBuffer),#0);
646 End;
647 dtByteDynArray :
648 begin
649 i := SizeOf(TByteDynArrayBuffer);
650 Result^.ByteDynArrayData := sdo_GetMem(i);
651 FillChar(Result^.ByteDynArrayData^,i,#0);
652 Result^.ByteDynArrayData^.Data := nil;
653 end;
654 End;
655 If Assigned(AOwner) Then
656 AddObj(AOwner,Result);
657 Except
658 Freemem(Result,resLen);
659 Result := nil;
660 Raise;
661 End;
662 end;
663
CreateArrayBuffernull664 function CreateArrayBuffer(
665 const ALength : Integer;
666 const AName : TDataName;
667 const AOwner : PDataBuffer = nil
668 ):PDataBuffer;
669 Var
670 i, resLen : Integer;
671 begin
672 Assert(ALength>=0);
673 resLen := SizeOf(TDataBuffer);
674 Result := sdo_GetMem(resLen);
675 Try
676 FillChar(Result^,resLen,#0);
677 Result^.Name := AName;
678 Result^.DataType := dtArray;
679 Result^.ArrayData := sdo_GetMem(SizeOf(TArrayBuffer));
680 FillChar(Result^.ArrayData^,SizeOf(TArrayBuffer),#0);
681 Result^.ArrayData^.Count := ALength;
682 If ( ALength > 0 ) Then Begin
683 i := ALength*SizeOf(PDataBuffer);
684 Result^.ArrayData^.Items := sdo_GetMem(i);
685 FillChar(Result^.ArrayData^.Items^[0],i,#0);
686 End Else Begin
687 Result^.ArrayData^.Items := Nil;
688 End;
689 If Assigned(AOwner) Then
690 AddObj(AOwner,Result);
691 Except
692 Freemem(Result,resLen);
693 Result := nil;
694 Raise;
695 End;
696 end;
697
698 procedure SaveObjectToStream(const ARoot: PDataBuffer; const ADest : IDataStore);
699 Var
700 p : PObjectBufferItem;
701 i : TInt32S;
702 Begin
703 If Not Assigned(ARoot) Then
704 Exit;
705 i := Ord(ARoot^.DataType);
706 ADest.WriteInt32S(i);
707 ADest.WriteAnsiStr(ARoot^.Name);
708 Case ARoot^.DataType Of
709 dtInt8S : ADest.WriteInt8S(ARoot^.Int8S);
710 dtInt8U : ADest.WriteInt8U(ARoot^.Int8U);
711 dtInt16U : ADest.WriteInt16U(ARoot^.Int16U);
712 dtInt16S : ADest.WriteInt16S(ARoot^.Int16S);
713 dtInt32U : ADest.WriteInt32U(ARoot^.Int32U);
714 dtInt32S : ADest.WriteInt32S(ARoot^.Int32S);
715 dtInt64U : ADest.WriteInt64U(ARoot^.Int64U);
716 dtInt64S : ADest.WriteInt64S(ARoot^.Int64S);
717
718 dtSingle : ADest.WriteSingle(ARoot^.SingleData);
719 dtDouble : ADest.WriteDouble(ARoot^.DoubleData);
720 dtExtended : ADest.WriteExtended(ARoot^.ExtendedData);
721 dtCurrency : ADest.WriteCurrency(ARoot^.CurrencyData);
722
723 dtAnsiString : ADest.WriteAnsiStr(ARoot^.AnsiStrData^.Data);
724 dtWideString : ADest.WriteWideStr(ARoot^.WideStrData^.Data);
725 {$IFDEF USE_UNICODE}
726 dtUnicodeString : ADest.WriteUnicodeStr(ARoot^.UnicodeStrData^.Data);
727 {$ENDIF USE_UNICODE}
728 dtBool : ADest.WriteBool(ARoot^.BoolData);
729 dtAnsiChar : ADest.WriteAnsiChar(ARoot^.AnsiCharData);
730 dtWideChar : ADest.WriteWideChar(ARoot^.WideCharData);
731 dtEnum : ADest.WriteEnum(ARoot^.EnumData);
732 dtObject :
733 Begin
734 ADest.WriteBool(ARoot^.ObjectData^.NilObject) ;
735 if not ARoot^.ObjectData^.NilObject then begin
736 i := ARoot^.ObjectData^.Count;
737 ADest.WriteInt32S(i);
738
739 If ( i > 0 ) Then Begin
740 p := ARoot^.ObjectData^.Head;
741 For i := 1 To i Do Begin
742 SaveObjectToStream(p^.Data,ADest);
743 p := p^.Next;
744 End;
745 End;
746 ADest.WriteBool(Assigned(ARoot^.ObjectData^.InnerData));
747 if Assigned(ARoot^.ObjectData^.InnerData) then
748 SaveObjectToStream(ARoot^.ObjectData^.InnerData,ADest);
749 end;
750 End;
751 dtArray :
752 Begin
753 i := ARoot^.ArrayData^.Count;
754 ADest.WriteInt32S(i);
755
756 If ( i > 0 ) Then Begin
757 For i := 0 To Pred(i) Do Begin
758 SaveObjectToStream(ARoot^.ArrayData^.Items^[i],ADest);
759 End;
760 End;
761 End;
762 dtByteDynArray : ADest.WriteBinary(ARoot^.ByteDynArrayData^.Data);
763 End;
764 End;
765
LoadObjectFromStreamnull766 function LoadObjectFromStream(const AStoreRdr : IDataStoreReader):PDataBuffer;
767 Var
768 i : TInt32S;
769 s : string;
770 Begin
771 Result := Nil;
772 If AStoreRdr.IsAtEof() Then
773 Exit;
774 i := AStoreRdr.ReadInt32S();
775 s := AStoreRdr.ReadAnsiStr();
776 if (TDataType(i) < dtArray) or (TDataType(i) = dtByteDynArray) then
777 Result := CreateObjBuffer(TDataType(i),s);
778 Case TDataType(i) Of
779 dtInt8S : Result^.Int8S := AStoreRdr.ReadInt8S();
780 dtInt8U : Result^.Int8U := AStoreRdr.ReadInt8U();
781 dtInt16U : Result^.Int16U := AStoreRdr.ReadInt16U();
782 dtInt16S : Result^.Int16S := AStoreRdr.ReadInt16S();
783 dtInt32U : Result^.Int32U := AStoreRdr.ReadInt32U();
784 dtInt32S : Result^.Int32S := AStoreRdr.ReadInt32S();
785 dtInt64U : Result^.Int64U := AStoreRdr.ReadInt64U();
786 dtInt64S : Result^.Int64S := AStoreRdr.ReadInt64S();
787
788 dtSingle : Result^.SingleData := AStoreRdr.ReadSingle();
789 dtDouble : Result^.DoubleData := AStoreRdr.ReadDouble();
790 dtExtended : Result^.ExtendedData := AStoreRdr.ReadExtended();
791 dtCurrency : Result^.CurrencyData := AStoreRdr.ReadCurrency();
792
793 dtAnsiString : Result^.AnsiStrData^.Data := AStoreRdr.ReadAnsiStr();
794 dtWideString : Result^.WideStrData^.Data := AStoreRdr.ReadWideStr();
795 {$IFDEF USE_UNICODE}
796 dtUnicodeString : Result^.UnicodeStrData^.Data := AStoreRdr.ReadUnicodeStr();
797 {$ENDIF USE_UNICODE}
798 dtBool : Result^.BoolData := AStoreRdr.ReadBool();
799 dtAnsiChar : Result^.AnsiCharData := AStoreRdr.ReadAnsiChar();
800 dtWideChar : Result^.WideCharData := AStoreRdr.ReadWideChar();
801 dtEnum : Result^.EnumData := AStoreRdr.ReadEnum();
802 dtObject :
803 Begin
804 Result^.ObjectData^.NilObject := AStoreRdr.ReadBool();
805 if not Result^.ObjectData^.NilObject then begin
806 i := AStoreRdr.ReadInt32S();
807 For i := 1 To i Do Begin
808 AddObj(Result,LoadObjectFromStream(AStoreRdr));
809 End;
810 if AStoreRdr.ReadBool() then
811 Result^.ObjectData^.InnerData := LoadObjectFromStream(AStoreRdr);
812 end;
813 end;
814 dtArray :
815 Begin
816 i := AStoreRdr.ReadInt32S();
817 Result := CreateArrayBuffer(i,s);
818 For i := 0 To Pred(i) Do Begin
819 AddObj(Result,LoadObjectFromStream(AStoreRdr),i);
820 End;
821 End;
822 dtByteDynArray : Result^.ByteDynArrayData^.Data := AStoreRdr.ReadBinary();
823 End;
824 End;
825
826 procedure FreeObjectBuffer(var ABuffer : PObjectBuffer);overload;
827 var
828 p,q : PObjectBufferItem;
829 begin
830 if Assigned(ABuffer) then begin
831 if Assigned(ABuffer^.Attributes) then
832 FreeObjectBuffer(ABuffer^.Attributes);
833 p := ABuffer^.Head;
834 while Assigned(p) do begin
835 q := p;
836 p := p^.Next;
837 ClearObj(q^.Data);
838 Freemem(q^.Data);
839 q^.Data := Nil;
840 Freemem(q);
841 end;
842 if Assigned(ABuffer^.InnerData) then begin
843 ClearObj(ABuffer^.InnerData);
844 Freemem(ABuffer^.InnerData);
845 ABuffer^.InnerData := nil;
846 end;
847 //ABuffer^.Head := nil;
848 //ABuffer^.Last := nil;
849 Freemem(ABuffer);
850 ABuffer := nil;
851 end;
852 end;
853
854 procedure FreeObjectBuffer(var ABuffer : PDataBuffer);
855 var
856 tmpBuffer : PDataBuffer;
857 begin
858 if ( ABuffer <> nil ) then begin
859 tmpBuffer := ABuffer;
860 ABuffer := nil;
861 ClearObj(tmpBuffer);
862 FreeMem(tmpBuffer)
863 end;
864 end;
865
866 procedure ClearObj(const AOwner: PDataBuffer);
867 Var
868 i , j: Integer;
869 eltLen : Integer;
870 Begin
871 AOwner^.Name := '';
872 Case AOwner^.DataType Of
873 dtAnsiString :
874 Begin
875 AOwner^.AnsiStrData^.Data := '';
876 Freemem(AOwner^.AnsiStrData);
877 AOwner^.AnsiStrData := Nil;
878 End;
879 dtWideString :
880 begin
881 AOwner^.WideStrData^.Data := '';
882 Freemem(AOwner^.WideStrData);
883 AOwner^.WideStrData := Nil;
884 end;
885 {$IFDEF USE_UNICODE}
886 dtUnicodeString :
887 begin
888 AOwner^.UnicodeStrData^.Data := '';
889 Freemem(AOwner^.UnicodeStrData);
890 AOwner^.UnicodeStrData := Nil;
891 end;
892 {$ENDIF USE_UNICODE}
893 dtObject :
894 Begin
895 FreeObjectBuffer(AOwner^.ObjectData);
896 End;
897 dtArray :
898 Begin
899 eltLen := SizeOf(TDataBuffer);
900 For j := 0 to Pred(AOwner^.ArrayData^.Count) Do Begin
901 if (AOwner^.ArrayData^.Items^[j] <> nil) then begin
902 ClearObj(AOwner^.ArrayData^.Items^[j]);
903 Freemem(AOwner^.ArrayData^.Items^[j],eltLen);
904 end;
905 AOwner^.ArrayData^.Items^[j] := Nil;
906 End;
907 i := AOwner^.ArrayData^.Count * SizeOf(PDataBuffer);
908 Freemem(AOwner^.ArrayData^.Items,i);
909 AOwner^.ArrayData^.Items := Nil;
910 FreeObjectBuffer(AOwner^.ArrayData^.Attributes);
911 i := SizeOf(TArrayBuffer);
912 Freemem(AOwner^.ArrayData,i);
913 AOwner^.ArrayData := Nil;
914 End;
915 dtByteDynArray :
916 begin
917 SetLength(AOwner^.ByteDynArrayData^.Data,0);
918 AOwner^.ByteDynArrayData^.Data := nil;
919 Freemem(AOwner^.ByteDynArrayData);
920 AOwner^.ByteDynArrayData := Nil;
921 end;
922 End;
923 End;
924
925 { TObjectBaseArrayStackItem }
926
927 procedure TObjectBaseArrayStackItem.CopyTo(const AClone: TStackItem);
928 begin
929 inherited CopyTo(AClone);
930 TObjectBaseArrayStackItem(AClone).FIndex := FIndex;
931 TObjectBaseArrayStackItem(AClone).FItemName := FItemName;
932 end;
933
TObjectBaseArrayStackItem.GetItemCountnull934 function TObjectBaseArrayStackItem.GetItemCount: Integer;
935 var
936 p : PObjectBufferItem;
937 begin
938 Result := 0;
939 p := FScopeObject^.ObjectData^.Head;
940 while (p <> nil) do begin
941 if AnsiSameText(FItemName,p^.Data^.Name) then
942 Inc(Result);
943 p := p^.Next;
944 end;
945 end;
946
Findnull947 function TObjectBaseArrayStackItem.Find(var AName: TDataName): PDataBuffer;
948 var
949 p : PObjectBufferItem;
950 i : Integer;
951 begin
952 Result := nil;
953 if (FIndex >= ScopeObject^.ObjectData^.Count) then
954 exit;
955 i := -1;
956 p := FScopeObject^.ObjectData^.Head;
957 while (i < FIndex) and (p <> nil) do begin
958 if AnsiSameText(FItemName,p^.Data^.Name) then begin
959 Inc(i);
960 if (i = FIndex) then begin
961 Result := p^.Data;
962 Inc(FIndex);
963 end;
964 end;
965 p := p^.Next;
966 end;
967 end;
968
969 procedure TObjectBaseArrayStackItem.SetItemName(const AValue: TDataName);
970 begin
971 FItemName := AValue;
972 end;
973
974 { TStackItem }
975
976 procedure TStackItem.CopyTo(const AClone: TStackItem);
977 begin
978 AClone.FScopeObject := Self.FScopeObject;
979 end;
980
981 constructor TStackItem.Create(const AScopeObject: PDataBuffer);
982 begin
983 Assert(Assigned(AScopeObject));
984 FScopeObject := AScopeObject;
985 end;
986
TStackItem.Clonenull987 function TStackItem.Clone() : TStackItem;
988 begin
989 Result := TStackItemClass(Self.ClassType).Create(FScopeObject);
990 try
991 CopyTo(Result);
992 except
993 FreeAndNil(Result);
994 raise;
995 end;
996 end;
997
998 { TObjectStackItem }
999
TObjectStackItem.GetItemCountnull1000 function TObjectStackItem.GetItemCount(): Integer;
1001 begin
1002 Result := ScopeObject^.ObjectData^.Count;
1003 end;
1004
Findnull1005 function TObjectStackItem.Find(var AName: TDataName): PDataBuffer;
1006 begin
1007 Result := FindObj(ScopeObject,AName);
1008 end;
1009
GetByIndexnull1010 function TObjectStackItem.GetByIndex(const AIndex: Integer): PDataBuffer;
1011 Var
1012 p : PObjectBufferItem;
1013 i : Integer;
1014 begin
1015 If ( AIndex >=0 ) And ( AIndex < ScopeObject^.ObjectData^.Count) Then Begin
1016 p := ScopeObject^.ObjectData^.Head;
1017 For i := 1 To AIndex Do
1018 p := p^.Next;
1019 Result := p^.Data;
1020 End Else
1021 Raise ESDOSerializationException.CreateFmt(SERR_IndexOutOfBound,[AIndex]);
1022 end;
1023
CreateBuffernull1024 function TObjectStackItem.CreateBuffer(
1025 Const AName : String;
1026 const ADataType : TDataType
1027 ):PDataBuffer;
1028 begin
1029 Result := CreateObjBuffer(ADataType,AName,ScopeObject);
1030 end;
1031
TObjectStackItem.CreateInnerBuffernull1032 function TObjectStackItem.CreateInnerBuffer(const ADataType: TDataType): PDataBuffer;
1033 begin
1034 Result := CreateObjBuffer(ADataType,sSCOPE_INNER_NAME,nil);
1035 ScopeObject^.ObjectData^.InnerData := Result;
1036 end;
1037
TObjectStackItem.GetInnerBuffernull1038 function TObjectStackItem.GetInnerBuffer(): PDataBuffer;
1039 begin
1040 Result := ScopeObject^.ObjectData^.InnerData;
1041 end;
1042
1043 procedure TObjectStackItem.NilCurrentScope();
1044 begin
1045 Assert(ScopeObject^.ObjectData^.Count = 0);
1046 ScopeObject^.ObjectData^.NilObject := True;
1047 end;
1048
TObjectStackItem.IsCurrentScopeNilnull1049 function TObjectStackItem.IsCurrentScopeNil(): Boolean;
1050 begin
1051 Result := ScopeObject^.ObjectData^.NilObject;
1052 end;
1053
1054 //----------------------------------------------------------------
GetScopeItemNamesnull1055 function TObjectStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer;
1056 var
1057 locBuffer : PObjectBufferItem;
1058 begin
1059 AReturnList.Clear();
1060 if Assigned(ScopeObject) and ( ScopeObject^.ObjectData^.Count > 0 ) then begin
1061 locBuffer := ScopeObject^.ObjectData^.Head;
1062 while Assigned(locBuffer) do begin
1063 AReturnList.Add(locBuffer^.Data^.Name);
1064 locBuffer := locBuffer^.Next;
1065 end;
1066 end;
1067 Result := AReturnList.Count;
1068 end;
1069
1070 { TSDOSerializationStreamBinary }
1071
1072 procedure TSDOSerializationStreamBinary.ClearStack();
1073 Var
1074 i, c : Integer;
1075 begin
1076 c := FStack.Count;
1077 For I := 1 To c Do
1078 FStack.Pop().Free();
1079 end;
1080
1081 procedure TSDOSerializationStreamBinary.PushStack(AScopeObject: PDataBuffer;const AScopeType: TScopeType);
1082 begin
1083 if ( AScopeType = stObject ) then begin
1084 FStack.Push(TObjectStackItem.Create(AScopeObject))
1085 end else if (AScopeType = stArray) then begin
1086 if (AScopeObject^.DataType = dtObject) then
1087 FStack.Push(TObjectBaseArrayStackItem.Create(AScopeObject))
1088 else
1089 FStack.Push(TArrayStackItem.Create(AScopeObject));
1090 end else begin
1091 Assert(False);
1092 end;
1093 end;
1094
StackTopnull1095 function TSDOSerializationStreamBinary.StackTop(): TStackItem;
1096 begin
1097 Result := FStack.Peek() as TStackItem;
1098 end;
1099
TSDOSerializationStreamBinary.PopStacknull1100 function TSDOSerializationStreamBinary.PopStack(): TStackItem;
1101 begin
1102 Result := FStack.Pop() as TStackItem;
1103 end;
1104
GetRootDatanull1105 function TSDOSerializationStreamBinary.GetRootData(): PDataBuffer;
1106 begin
1107 Result := FRootData;
1108 end;
1109
TSDOSerializationStreamBinary.GetCurrentScopeObjectnull1110 function TSDOSerializationStreamBinary.GetCurrentScopeObject(): PDataBuffer;
1111 begin
1112 Result := StackTop().ScopeObject;
1113 end;
1114
1115 procedure TSDOSerializationStreamBinary.SetSerializationStyle(
1116 const ASerializationStyle: TSerializationStyle
1117 );
1118 begin
1119 FSerializationStyle := ASerializationStyle;
1120 end;
1121
TSDOSerializationStreamBinary.GetSerializationStylenull1122 function TSDOSerializationStreamBinary.GetSerializationStyle(): TSerializationStyle;
1123 begin
1124 Result := FSerializationStyle;
1125 end;
1126
HasScopenull1127 function TSDOSerializationStreamBinary.HasScope(): Boolean;
1128 begin
1129 Result := ( FStack.Count > 0 );
1130 end;
1131
1132 procedure TSDOSerializationStreamBinary.CheckScope();
1133 begin
1134 If Not HasScope() Then
1135 Error(SERR_NoScope);
1136 end;
1137
TSDOSerializationStreamBinary.GetCurrentScopenull1138 function TSDOSerializationStreamBinary.GetCurrentScope: String;
1139 begin
1140 Result := GetCurrentScopeObject()^.Name;
1141 end;
1142
GetDataBuffernull1143 function TSDOSerializationStreamBinary.GetDataBuffer(
1144 var AName: string;
1145 out AResultBuffer : PDataBuffer
1146 ) : Boolean;
1147 begin
1148 AResultBuffer := StackTop().Find(AName);
1149 Result := ( AResultBuffer <> nil );
1150 end;
1151
1152 procedure TSDOSerializationStreamBinary.Clear();
1153 begin
1154 ClearStack();
1155 if ( FRootData <> nil ) then begin
1156 ClearObj(FRootData);
1157 Freemem(FRootData);
1158 end;
1159 //FRootData := CreateObjBuffer(dtObject,sROOT);
1160 //PushStack(FRootData,stObject);
1161 FRootData := nil;
1162 end;
1163
1164 procedure TSDOSerializationStreamBinary.BeginArray(
1165 const AName : string;
1166 const AItemTypeInfo : ISDOType;
1167 const ABounds : array of Integer
1168 );
1169 var
1170 i, j, k : Integer;
1171 begin
1172 if ( Length(ABounds) < 2 ) then
1173 Error(SERR_InvalidArrayBounds);
1174 i := ABounds[0];
1175 j := ABounds[1];
1176 k := ( j - i + 1 );
1177 if ( k < 0 ) then
1178 Error(SERR_InvalidArrayBounds);
1179 PushStack(CreateArrayBuffer(k,AName,StackTop().ScopeObject),stArray);
1180 end;
1181
1182 procedure TSDOSerializationStreamBinary.NilCurrentScope();
1183 begin
1184 CheckScope();
1185 StackTop().NilCurrentScope();
1186 end;
1187
IsCurrentScopeNilnull1188 function TSDOSerializationStreamBinary.IsCurrentScopeNil(): Boolean;
1189 begin
1190 Result := StackTop().IsCurrentScopeNil();
1191 end;
1192
1193 procedure TSDOSerializationStreamBinary.BeginObject(
1194 const AName: string;
1195 const ATypeInfo: ISDOType
1196 );
1197 begin
1198 if HasScope() then begin
1199 PushStack(StackTop().CreateBuffer(AName,dtObject));
1200 end else begin
1201 FRootData := CreateObjBuffer(dtObject,AName);
1202 PushStack(FRootData,stObject);
1203 end;
1204 end;
1205
1206 procedure TSDOSerializationStreamBinary.EndScope();
1207 begin
1208 FStack.Pop().Free();
1209 end;
1210
BeginObjectReadnull1211 function TSDOSerializationStreamBinary.BeginObjectRead(
1212 var AScopeName : string;
1213 const ATypeInfo : ISDOType
1214 ): Integer;
1215 var
1216 locNode : PDataBuffer;
1217 stk : TStackItem;
1218 begin
1219 stk := StackTop();
1220 locNode := stk.Find(AScopeName);
1221 if (locNode = nil) then
1222 exit(-1);
1223 PushStack(locNode,stObject);
1224 Result := StackTop().GetItemCount();
1225 end;
1226
BeginArrayReadnull1227 function TSDOSerializationStreamBinary.BeginArrayRead(
1228 var AScopeName : string;
1229 const ATypeInfo : ISDOType;
1230 const AItemName : string
1231 ): Integer;
1232 var
1233 locNode : PDataBuffer;
1234 stk : TStackItem;
1235 begin
1236 Result := -1;
1237 stk := StackTop();
1238 locNode := stk.Find(AScopeName);
1239 if (locNode <> nil) then begin
1240 if (locNode^.DataType <> dtArray) then begin
1241 PushStack(stk.ScopeObject,stArray);
1242 (StackTop() as TObjectBaseArrayStackItem).SetItemName(AItemName);
1243 end else begin
1244 PushStack(locNode,stArray);
1245 end;
1246 Result := StackTop().GetItemCount();
1247 end;
1248 end;
1249
GetScopeItemNamesnull1250 function TSDOSerializationStreamBinary.GetScopeItemNames(
1251 const AItemStyle : TSerializationStyle;
1252 const AReturnList : TStrings
1253 ) : Integer;
1254 begin
1255 CheckScope();
1256 Result := StackTop.GetScopeItemNames(AReturnList);
1257 end;
1258
1259 procedure TSDOSerializationStreamBinary.EndScopeRead();
1260 begin
1261 PopStack().Free();
1262 end;
1263
1264 procedure TSDOSerializationStreamBinary.Put(
1265 const AName : string;
1266 const ATypeInfo : ISDOType;
1267 const AData
1268 );
1269 var
1270 valBuffer : TValueBuffer;
1271 strData : TSDOString;
1272 bytesData : TSDOBytes;
1273 begin
1274 case ATypeInfo.getTypeEnum() Of
1275 BooleanType :
1276 begin
1277 valBuffer.BooleanValue := TSDOBoolean(AData);
1278 PutBoolean(AName,valBuffer.BooleanValue);
1279 end;
1280 ByteType :
1281 begin
1282 valBuffer.ByteValue := TSDOByte(AData);
1283 PutByte(AName,valBuffer.ByteValue);
1284 end;
1285 {$IFDEF HAS_SDO_BYTES}
1286 BytesType :
1287 begin
1288 bytesData := TSDOBytes(AData);
1289 PutBytes(AName,bytesData);
1290 end;
1291 {$ENDIF HAS_SDO_BYTES}
1292 {$IFDEF HAS_SDO_CHAR}
1293 CharacterType :
1294 begin
1295 valBuffer.CharValue := TSDOChar(AData);
1296 PutChar(AName,valBuffer.CharValue);
1297 end;
1298 {$ENDIF HAS_SDO_CHAR}
1299 {$IFDEF HAS_SDO_CURRENCY}
1300 CurrencyType :
1301 begin
1302 valBuffer.CurrencyValue := TSDOCurrency(AData);
1303 PutCurrency(AName,valBuffer.CurrencyValue);
1304 end;
1305 {$ENDIF HAS_SDO_CURRENCY}
1306 DateTimeType :
1307 begin
1308 valBuffer.DateValue := TSDODateTime(AData);
1309 PutDate(AName,valBuffer.DateValue);
1310 end;
1311 {$IFDEF HAS_SDO_DOUBLE}
1312 DoubleType :
1313 begin
1314 valBuffer.DoubleValue := TSDODouble(AData);
1315 PutDouble(AName,valBuffer.DoubleValue);
1316 end;
1317 {$ENDIF HAS_SDO_DOUBLE}
1318 {$IFDEF HAS_SDO_FLOAT}
1319 FloatType :
1320 begin
1321 valBuffer.FloatValue := TSDOFloat(AData);
1322 PutFloat(AName,valBuffer.FloatValue);
1323 end;
1324 {$ENDIF HAS_SDO_FLOAT}
1325 IntegerType :
1326 begin
1327 valBuffer.IntegerValue := TSDOInteger(AData);
1328 PutInteger(AName,valBuffer.IntegerValue);
1329 end;
1330 {$IFDEF HAS_SDO_LONG}
1331 LongType :
1332 begin
1333 valBuffer.LongValue := TSDOLong(AData);
1334 PutLong(AName,valBuffer.LongValue);
1335 end;
1336 {$ENDIF HAS_SDO_LONG}
1337 {$IFDEF HAS_SDO_SHORT}
1338 ShortType :
1339 begin
1340 valBuffer.ShortValue := TSDOShort(AData);
1341 PutShort(AName,valBuffer.ShortValue);
1342 end;
1343 {$ENDIF HAS_SDO_SHORT}
1344 StringType :
1345 begin
1346 strData := TSDOString(AData);
1347 PutString(AName,strData);
1348 end;
1349 else
1350 Assert(False);
1351 end;
1352 end;
1353
1354 procedure TSDOSerializationStreamBinary.Put(
1355 const ANameSpace,
1356 AName : string;
1357 const ATypeInfo : ISDOType;
1358 const AData
1359 );
1360 begin
1361 Put(AName,ATypeInfo,AData);
1362 end;
1363
1364 procedure TSDOSerializationStreamBinary.PutScopeInnerValue(
1365 const ATypeInfo : ISDOType;
1366 const AData
1367 );
1368
1369
1370 procedure doPutDate();
1371 var
1372 locBuffer : TByteDynArray;
1373 locDate : TSDODateTime;
1374 begin
1375 locDate := TSDODateTime(AData);
1376 SetLength(locBuffer,SizeOf(TSDODateTime));
1377 Move(locDate,locBuffer[0],SizeOf(TSDODateTime));
1378 ReverseBytes(locBuffer[0],SizeOf(TSDODateTime));
1379 StackTop().CreateInnerBuffer(dtByteDynArray)^.ByteDynArrayData^.Data := locBuffer;
1380 end;
1381
1382
1383 begin
1384 CheckScope();
1385 case ATypeInfo.getTypeEnum() Of
1386 BooleanType : StackTop().CreateInnerBuffer(dtBool)^.BoolData := TSDOBoolean(AData);
1387 {$IFDEF HAS_SDO_BYTES}
1388 BytesType : StackTop().CreateInnerBuffer(dtByteDynArray)^.ByteDynArrayData^.Data := Copy(TSDOBytes(AData));
1389 {$ENDIF HAS_SDO_BYTES}
1390 ByteType : StackTop().CreateInnerBuffer(dtInt8U)^.Int8U := TSDOByte(AData);
1391 {$IFDEF HAS_SDO_CHAR}
1392 {$IFDEF USE_UNICODE}
1393 CharacterType : StackTop().CreateInnerBuffer(dtWideChar)^.WideCharData := TSDOChar(AData);
1394 {$ELSE USE_UNICODE}
1395 CharacterType : StackTop().CreateInnerBuffer(dtAnsiChar)^.AnsiCharData := TSDOChar(AData);
1396 {$ENDIF USE_UNICODE}
1397 {$ENDIF HAS_SDO_CHAR}
1398 {$IFDEF HAS_SDO_CURRENCY}
1399 CurrencyType : StackTop().CreateInnerBuffer(dtCurrency)^.CurrencyData := TSDOCurrency(AData);
1400 {$ENDIF HAS_SDO_CURRENCY}
1401 DateTimeType: doPutDate();
1402 IntegerType : StackTop().CreateInnerBuffer(dtInt32S)^.Int32S := TSDOInteger(AData);
1403 {$IFDEF HAS_SDO_DOUBLE}
1404 DoubleType : StackTop().CreateInnerBuffer(dtDouble)^.DoubleData := TSDODouble(AData);
1405 {$ENDIF HAS_SDO_DOUBLE}
1406 {$IFDEF HAS_SDO_FLOAT}
1407 FloatType : StackTop().CreateInnerBuffer(dtSingle)^.SingleData := TSDOFloat(AData);
1408 {$ENDIF HAS_SDO_FLOAT}
1409 {$IFDEF HAS_SDO_LONG}
1410 LongType : StackTop().CreateInnerBuffer(dtInt64S)^.Int64S := TSDOLong(AData);
1411 {$ENDIF HAS_SDO_LONG}
1412 {$IFDEF HAS_SDO_SHORT}
1413 ShortType : StackTop().CreateInnerBuffer(dtInt16S)^.Int16S := TSDOShort(AData);
1414 {$ENDIF HAS_SDO_SHORT}
1415 StringType :
1416 {$IFDEF USE_UNICODE}
1417 StackTop().CreateInnerBuffer(dtUnicodeString)^.UnicodeStrData^.Data := TSDOString(AData);
1418 {$ELSE USE_UNICODE}
1419 StackTop().CreateInnerBuffer(dtAnsiString)^.AnsiStrData^.Data := TSDOString(AData);
1420 {$ENDIF USE_UNICODE}
1421 else
1422 Assert(False);
1423 end;
1424 end;
1425
TSDOSerializationStreamBinary.Getnull1426 function TSDOSerializationStreamBinary.Get(
1427 const ATypeInfo: ISDOType;
1428 var AName: String;
1429 var AData
1430 ) : Boolean;
1431 var
1432 valBuffer : TValueBuffer;
1433 strData : TSDOString;
1434 bytesData : TSDOBytes;
1435 begin
1436 FillChar(valBuffer,SizeOf(valBuffer),#0);
1437 case ATypeInfo.getTypeEnum() of
1438 BooleanType :
1439 begin
1440 Result := GetBoolean(AName,valBuffer.BooleanValue);
1441 if Result then
1442 TSDOBoolean(AData) := valBuffer.BooleanValue;
1443 end;
1444 ByteType :
1445 begin
1446 Result := GetByte(AName,valBuffer.ByteValue);
1447 if Result then
1448 TSDOByte(AData) := valBuffer.ByteValue;
1449 end;
1450 {$IFDEF HAS_SDO_BYTES}
1451 BytesType :
1452 begin
1453 Result := GetBytes(AName,bytesData);
1454 if Result then
1455 TSDOBytes(AData) := bytesData;
1456 end;
1457 {$ENDIF HAS_SDO_BYTES}
1458 {$IFDEF HAS_SDO_CHAR}
1459 CharacterType :
1460 begin
1461 Result := GetChar(AName,valBuffer.CharValue);
1462 if Result then
1463 TSDOChar(AData) := valBuffer.CharValue;
1464 end;
1465 {$ENDIF HAS_SDO_CHAR}
1466 {$IFDEF HAS_SDO_CURRENCY}
1467 CurrencyType :
1468 begin
1469 Result := GetCurrency(AName,valBuffer.CurrencyValue);
1470 if Result then
1471 TSDOCurrency(AData) := valBuffer.CurrencyValue;
1472 end;
1473 {$ENDIF HAS_SDO_CURRENCY}
1474 DateTimeType :
1475 begin
1476 Result := GetDate(AName,valBuffer.DateValue);
1477 if Result then
1478 TSDODateTime(AData) := valBuffer.DateValue;
1479 end;
1480 {$IFDEF HAS_SDO_DOUBLE}
1481 DoubleType :
1482 begin
1483 Result := GetDouble(AName,valBuffer.DoubleValue);
1484 if Result then
1485 TSDODouble(AData) := valBuffer.DoubleValue;
1486 end;
1487 {$ENDIF HAS_SDO_DOUBLE}
1488 {$IFDEF HAS_SDO_FLOAT}
1489 FloatType :
1490 begin
1491 Result := GetFloat(AName,valBuffer.FloatValue);
1492 if Result then
1493 TSDOFloat(AData) := valBuffer.FloatValue;
1494 end;
1495 {$ENDIF HAS_SDO_FLOAT}
1496 IntegerType :
1497 begin
1498 Result := GetInteger(AName,valBuffer.IntegerValue);
1499 if Result then
1500 TSDOInteger(AData) := valBuffer.IntegerValue;
1501 end;
1502 {$IFDEF HAS_SDO_LONG}
1503 LongType :
1504 begin
1505 Result := GetLong(AName,valBuffer.LongValue);
1506 if Result then
1507 TSDOLong(AData) := valBuffer.LongValue;
1508 end;
1509 {$ENDIF HAS_SDO_LONG}
1510 {$IFDEF HAS_SDO_SHORT}
1511 ShortType :
1512 begin
1513 Result := GetShort(AName,valBuffer.ShortValue);
1514 if Result then
1515 TSDOShort(AData) := valBuffer.ShortValue;
1516 end;
1517 {$ENDIF HAS_SDO_SHORT}
1518 StringType :
1519 begin
1520 strData := TSDOString(AData);
1521 Result := GetString(AName,strData);
1522 if Result then
1523 TSDOString(AData) := strData;
1524 end;
1525 else
1526 Result := False;
1527 end;
1528 end;
1529
TSDOSerializationStreamBinary.Getnull1530 function TSDOSerializationStreamBinary.Get(
1531 const ANameSpace : string;
1532 const ATypeInfo : ISDOType;
1533 var AName : string;
1534 var AData
1535 ) : Boolean;
1536 begin
1537 Result := Get(ATypeInfo,AName,AData);
1538 end;
1539
TSDOSerializationStreamBinary.GetScopeInnerValuenull1540 function TSDOSerializationStreamBinary.GetScopeInnerValue(
1541 const ATypeInfo : ISDOType;
1542 var AData
1543 ) : Boolean;
1544 var
1545 dataBuffer : PDataBuffer;
1546
HandleDatenull1547 function HandleDate() : Boolean;
1548 var
1549 locDate : TSDODateTime;
1550 locBuffer : TByteDynArray;
1551 begin
1552 Result := False;
1553 locBuffer := Copy(dataBuffer^.ByteDynArrayData^.Data);
1554 if ( Length(locBuffer) = SizeOf(TSDODateTime) ) then begin
1555 ReverseBytes(locBuffer[0],SizeOf(TSDODateTime));
1556 Move(locBuffer[0],locDate,SizeOf(TSDODateTime));
1557 TSDODateTime(AData) := locDate;
1558 Result := True;
1559 end;
1560 end;
1561
1562 begin
1563 CheckScope();
1564 Result := True;
1565 dataBuffer := StackTop().GetInnerBuffer();
1566 case ATypeInfo.getTypeEnum() of
1567 BooleanType : TSDOBoolean(AData) := dataBuffer^.BoolData;
1568 ByteType : TSDOByte(AData) := dataBuffer^.Int8U;
1569 CharacterType : TSDOChar(AData) := {$IFDEF USE_UNICODE}dataBuffer^.WideCharData{$ELSE}dataBuffer^.AnsiCharData{$ENDIF};
1570 CurrencyType : TSDOCurrency(AData) := dataBuffer^.CurrencyData;
1571 DateTimeType : HandleDate();
1572 DoubleType : TSDODouble(AData) := dataBuffer^.DoubleData;
1573 FloatType : TSDOFloat(AData) := dataBuffer^.SingleData;
1574 IntegerType : TSDOInteger(AData) := dataBuffer^.Int32S;
1575 LongType : TSDOLong(AData) := dataBuffer^.Int64S;
1576 ShortType : TSDOShort(AData) := dataBuffer^.Int16S;
1577 StringType : TSDOString(AData) := {$IFDEF USE_UNICODE}dataBuffer^.UnicodeStrData^.Data{$ELSE}dataBuffer^.AnsiStrData^.Data{$ENDIF};
1578 else
1579 Assert(False);
1580 end;
1581 end;
1582
ReadBuffernull1583 function TSDOSerializationStreamBinary.ReadBuffer (const AName : string) : string;
1584 Var
1585 locStore : IDataStore;
1586 bffr : PDataBuffer;
1587 locName : string;
1588 locStream : TStringStream;
1589 begin
1590 Result := '';
1591 if GetDataBuffer(locName,bffr) then begin
1592 locStream := TStringStream.Create('');
1593 try
1594 locStore := CreateBinaryWriter(locStream);
1595 SaveObjectToStream(bffr,locStore);
1596 Result := locStream.DataString;
1597 finally
1598 locStream.Free();
1599 end;
1600 end;
1601 end;
1602
1603 procedure TSDOSerializationStreamBinary.SaveToStream(AStream: TStream);
1604 Var
1605 locStore : IDataStore;
1606 begin
1607 locStore := CreateBinaryWriter(AStream);
1608 SaveObjectToStream(FRootData,locStore);
1609 end;
1610
1611 procedure TSDOSerializationStreamBinary.LoadFromStream(AStream: TStream);
1612 Var
1613 locRdr : IDataStoreReader;
1614 tmpRoot : PDataBuffer;
1615 begin
1616 locRdr := CreateBinaryReader(AStream);
1617 tmpRoot := LoadObjectFromStream(locRdr);
1618
1619 Clear();
1620 FRootData := tmpRoot;
1621 PushStack(FRootData,stObject);
1622 end;
1623
1624 procedure TSDOSerializationStreamBinary.Error(const AMsg: string);
1625 begin
1626 Raise ESDOSerializationException.Create(AMsg);
1627 end;
1628
1629 procedure TSDOSerializationStreamBinary.Error(const AMsg: string;const AArgs: array of const);
1630 begin
1631 Raise ESDOSerializationException.CreateFmt(AMsg,AArgs);
1632 end;
1633
1634 constructor TSDOSerializationStreamBinary.Create();
1635 begin
1636 //FRootData := CreateObjBuffer(dtObject,sROOT);
1637 FStack := TObjectStackEx.Create();
1638 //PushStack(FRootData,stObject);
1639 end;
1640
1641 destructor TSDOSerializationStreamBinary.Destroy();
1642 begin
1643 ClearStack();
1644 FreeAndNil(FStack);
1645 if ( FRootData <> nil ) then begin
1646 ClearObj(FRootData);
1647 Freemem(FRootData);
1648 end;
1649 inherited Destroy();
1650 end;
1651
TSDOSerializationStreamBinary.GetFormatNamenull1652 function TSDOSerializationStreamBinary.GetFormatName() : string;
1653 begin
1654 Result := sBINARY_FORMAT_NAME;
1655 end;
1656
1657 procedure TSDOSerializationStreamBinary.WriteBuffer(const AValue: string);
1658 var
1659 locStore : IDataStoreReader;
1660 bffr : PDataBuffer;
1661 locStream : TStringStream;
1662 begin
1663 CheckScope();
1664 locStream := TStringStream.Create(AValue);
1665 try
1666 locStream.Position := 0;
1667 locStore := CreateBinaryReader(locStream);
1668 bffr := LoadObjectFromStream(locStore);
1669 AddObj(StackTop.ScopeObject,bffr);
1670 finally
1671 locStream.Free();
1672 end;
1673 end;
1674
CopyStackItemnull1675 function CopyStackItem(const AItem : TObject) : TObject;
1676 begin
1677 if ( AItem <> nil ) then
1678 Result := TStackItem(AItem).Clone()
1679 else
1680 Result := nil;
1681 end;
1682
GetBookMarknull1683 function TSDOSerializationStreamBinary.GetBookMark: TStreamBookmark;
1684 var
1685 locRes : TStreamBinaryBookmark;
1686 begin
1687 locRes := TStreamBinaryBookmark.Create();
1688 try
1689 locRes.FNameStyle := Self.FNameStyle;
1690 locRes.FStack := Self.FStack.Clone({$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyStackItem);
1691 locRes.FRootData := Self.FRootData;
1692 locRes.FSerializationStyle := Self.FSerializationStyle;
1693 Result := locRes;
1694 except
1695 FreeAndNil(locRes);
1696 raise;
1697 end;
1698 end;
1699
TSDOSerializationStreamBinary.GetBooleannull1700 function TSDOSerializationStreamBinary.GetBoolean(var AName: string; var AData: TSDOBoolean): Boolean;
1701 var
1702 locBuffer : PDataBuffer;
1703 begin
1704 Result := GetDataBuffer(AName,locBuffer);
1705 if Result then
1706 AData := locBuffer^.BoolData;
1707 end;
1708
GetBytenull1709 function TSDOSerializationStreamBinary.GetByte(var AName: string; var AData: TSDOByte): Boolean;
1710 var
1711 locBuffer : PDataBuffer;
1712 begin
1713 Result := GetDataBuffer(AName,locBuffer);
1714 if Result then
1715 AData := locBuffer^.Int8U;
1716 end;
1717
GetBytesnull1718 function TSDOSerializationStreamBinary.GetBytes(var AName: string; var AData: TSDOBytes): Boolean;
1719 var
1720 locBuffer : PDataBuffer;
1721 begin
1722 Result := GetDataBuffer(AName,locBuffer);
1723 if Result then
1724 AData := Copy(locBuffer^.ByteDynArrayData^.Data);
1725 end;
1726
GetCharnull1727 function TSDOSerializationStreamBinary.GetChar(var AName: string; var AData: TSDOChar): Boolean;
1728 var
1729 locBuffer : PDataBuffer;
1730 begin
1731 Result := GetDataBuffer(AName,locBuffer);
1732 if Result then
1733 AData := {$IFDEF USE_UNICODE}locBuffer^.WideCharData{$ELSE}locBuffer^.AnsiCharData{$ENDIF};
1734
1735 end;
1736
TSDOSerializationStreamBinary.GetCurrencynull1737 function TSDOSerializationStreamBinary.GetCurrency(var AName: string; var AData: TSDOCurrency): Boolean;
1738 var
1739 locBuffer : PDataBuffer;
1740 begin
1741 Result := GetDataBuffer(AName,locBuffer);
1742 if Result then
1743 AData := locBuffer^.CurrencyData;
1744 end;
1745
GetDatenull1746 function TSDOSerializationStreamBinary.GetDate(var AName: string; var AData: TSDODateTime): Boolean;
1747 var
1748 locBytesBuffer : TByteDynArray;
1749 locBuffer : PDataBuffer;
1750 begin
1751 Result := False;
1752 if GetDataBuffer(AName,locBuffer) then begin
1753 locBytesBuffer := Copy(locBuffer^.ByteDynArrayData^.Data);
1754 if ( Length(locBytesBuffer) = SizeOf(TSDODateTime) ) then begin
1755 ReverseBytes(locBytesBuffer[0],SizeOf(TSDODateTime));
1756 Move(locBytesBuffer[0],AData,SizeOf(TSDODateTime));
1757 Result := True;
1758 end;
1759 end;
1760 end;
1761
GetDoublenull1762 function TSDOSerializationStreamBinary.GetDouble(var AName: string; var AData: TSDODouble): Boolean;
1763 var
1764 locBuffer : PDataBuffer;
1765 begin
1766 Result := GetDataBuffer(AName,locBuffer);
1767 if Result then
1768 AData := locBuffer^.DoubleData;
1769 end;
1770
TSDOSerializationStreamBinary.GetFloatnull1771 function TSDOSerializationStreamBinary.GetFloat(var AName: string; var AData: TSDOFloat): Boolean;
1772 var
1773 locBuffer : PDataBuffer;
1774 begin
1775 Result := GetDataBuffer(AName,locBuffer);
1776 if Result then
1777 AData := locBuffer^.SingleData;
1778 end;
1779
GetIntegernull1780 function TSDOSerializationStreamBinary.GetInteger(var AName: string; var AData: TSDOInteger): Boolean;
1781 var
1782 locBuffer : PDataBuffer;
1783 begin
1784 Result := GetDataBuffer(AName,locBuffer);
1785 if Result then
1786 AData := locBuffer^.Int32S;
1787 end;
1788
TSDOSerializationStreamBinary.GetLongnull1789 function TSDOSerializationStreamBinary.GetLong(var AName: string; var AData: TSDOLong): Boolean;
1790 var
1791 locBuffer : PDataBuffer;
1792 begin
1793 Result := GetDataBuffer(AName,locBuffer);
1794 if Result then
1795 AData := locBuffer^.Int64S;
1796 end;
1797
TSDOSerializationStreamBinary.GetNameStylenull1798 function TSDOSerializationStreamBinary.GetNameStyle: TNameStyle;
1799 begin
1800 Result := FNameStyle;
1801 end;
1802
TSDOSerializationStreamBinary.GetShortnull1803 function TSDOSerializationStreamBinary.GetShort(var AName: string; var AData: TSDOShort): Boolean;
1804 var
1805 locBuffer : PDataBuffer;
1806 begin
1807 Result := GetDataBuffer(AName,locBuffer);
1808 if Result then
1809 AData := locBuffer^.Int16S;
1810 end;
1811
TSDOSerializationStreamBinary.GetStringnull1812 function TSDOSerializationStreamBinary.GetString(var AName: string; var AData: TSDOString): Boolean;
1813 var
1814 locBuffer : PDataBuffer;
1815 begin
1816 Result := GetDataBuffer(AName,locBuffer);
1817 if Result then begin
1818 if ( locBuffer^.DataType = dtAnsiString ) then
1819 AData := locBuffer^.AnsiStrData^.Data
1820 else if ( locBuffer^.DataType = dtWideString ) then
1821 AData := locBuffer^.WideStrData^.Data
1822 {$IFDEF USE_UNICODE}
1823 else if ( locBuffer^.DataType = dtUnicodeString ) then
1824 AData := locBuffer^.UnicodeStrData^.Data
1825 {$ENDIF USE_UNICODE}
1826 else
1827 AData := ToStr(locBuffer);
1828 end;
1829 end;
1830
GotoBookmarknull1831 function TSDOSerializationStreamBinary.GotoBookmark(const AValue: TStreamBookmark): Boolean;
1832 var
1833 locBM : TStreamBinaryBookmark;
1834 begin
1835 Result := False;
1836 if ( AValue <> nil ) then begin
1837 locBM := AValue as TStreamBinaryBookmark;
1838 if (locBM.FRootData = Self.FRootData) then begin
1839 ClearStack();
1840 FreeAndNil(FStack);
1841 FStack := locBM.FStack.Clone({$IFDEF ATT_PROC_ADDRESS}@{$ENDIF}CopyStackItem);
1842 FSerializationStyle := locBM.SerializationStyle;
1843 FNameStyle := locBM.NameStyle;
1844 FRootData := locBM.RootData;
1845 Result := True;
1846 end;
1847 end;
1848 end;
1849
1850 procedure TSDOSerializationStreamBinary.Initialize;
1851 begin
1852 ClearStack();
1853 if ( FRootData <> nil ) then
1854 PushStack(FRootData);
1855 end;
1856
1857 procedure TSDOSerializationStreamBinary.LoadFromFile(const AFileName: string);
1858 var
1859 locStream : TStream;
1860 begin
1861 if not FileExists(AFileName) then
1862 Error(SMSG_FileNotFound,[AFileName]);
1863 locStream := TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
1864 try
1865 locStream.Position := 0;
1866 LoadFromStream(locStream);
1867 finally
1868 locStream.Free();
1869 end;
1870 end;
1871
1872 procedure TSDOSerializationStreamBinary.PutBoolean(const AName: string; const AData: TSDOBoolean);
1873 begin
1874 StackTop().CreateBuffer(AName,dtBool)^.BoolData := AData;
1875 end;
1876
1877 procedure TSDOSerializationStreamBinary.PutByte(const AName: string; const AData: TSDOByte);
1878 begin
1879 StackTop().CreateBuffer(AName,dtInt8U)^.Int8U := AData;
1880 end;
1881
1882 procedure TSDOSerializationStreamBinary.PutBytes(const AName: string; const AData: TSDOBytes);
1883 begin
1884 StackTop().CreateBuffer(AName,dtByteDynArray)^.ByteDynArrayData^.Data := Copy(AData);
1885 end;
1886
1887 procedure TSDOSerializationStreamBinary.PutChar(const AName: string; const AData: TSDOChar);
1888 begin
1889 {$IFDEF USE_UNICODE}
1890 StackTop().CreateBuffer(AName,dtWideChar)^.WideCharData := AData;
1891 {$ELSE USE_UNICODE}
1892 StackTop().CreateBuffer(AName,dtAnsiChar)^.AnsiCharData := AData;
1893 {$ENDIF USE_UNICODE}
1894 end;
1895
1896 procedure TSDOSerializationStreamBinary.PutCurrency(const AName: string; const AData: TSDOCurrency);
1897 begin
1898 StackTop().CreateBuffer(AName,dtCurrency)^.CurrencyData := AData;
1899 end;
1900
1901 procedure TSDOSerializationStreamBinary.PutDate(const AName: string; const AData: TSDODateTime);
1902 var
1903 locBuffer : TByteDynArray;
1904 begin
1905 SetLength(locBuffer,SizeOf(TSDODateTime));
1906 Move(AData,locBuffer[0],SizeOf(TSDODateTime));
1907 ReverseBytes(locBuffer[0],SizeOf(TSDODateTime));
1908 StackTop().CreateBuffer(AName,dtByteDynArray)^.ByteDynArrayData^.Data := locBuffer;
1909 end;
1910
1911 procedure TSDOSerializationStreamBinary.PutDouble(const AName: string; const AData: TSDODouble);
1912 begin
1913 StackTop().CreateBuffer(AName,dtDouble)^.DoubleData := AData;
1914 end;
1915
1916 procedure TSDOSerializationStreamBinary.PutFloat(const AName: string; const AData: TSDOFloat);
1917 begin
1918 StackTop().CreateBuffer(AName,dtSingle)^.SingleData := AData;
1919 end;
1920
1921 procedure TSDOSerializationStreamBinary.PutInteger(const AName: string; const AData: TSDOInteger);
1922 begin
1923 StackTop().CreateBuffer(AName,dtInt32S)^.Int32S := AData;
1924 end;
1925
1926 procedure TSDOSerializationStreamBinary.PutLong(const AName: string; const AData: TSDOLong);
1927 begin
1928 StackTop().CreateBuffer(AName,dtInt64S)^.Int64S := AData;
1929 end;
1930
1931 procedure TSDOSerializationStreamBinary.PutShort(const AName: string; const AData: TSDOShort);
1932 begin
1933 StackTop().CreateBuffer(AName,dtInt16S)^.Int16S := AData;
1934 end;
1935
1936 procedure TSDOSerializationStreamBinary.PutString(const AName: string; const AData: TSDOString);
1937 begin
1938 {$IFDEF USE_UNICODE}
1939 StackTop().CreateBuffer(AName,dtUnicodeString)^.UnicodeStrData^.Data := AData;
1940 {$ELSE}
1941 StackTop().CreateBuffer(AName,dtAnsiString)^.AnsiStrData^.Data := AData;
1942 {$ENDIF}
1943 end;
1944
1945 procedure TSDOSerializationStreamBinary.SaveToFile(const AFileName: string);
1946 var
1947 locStream : TStream;
1948 begin
1949 locStream := TFileStream.Create(AFileName,fmCreate);
1950 try
1951 SaveToStream(locStream);
1952 finally
1953 locStream.Free();
1954 end;
1955 end;
1956
1957 procedure TSDOSerializationStreamBinary.SetNameStyle(const AValue: TNameStyle);
1958 begin
1959 if ( AValue <> FNameStyle ) then
1960 FNameStyle := AValue;
1961 end;
1962
1963 { TArrayStackItem }
1964
TArrayStackItem.GetItemCountnull1965 function TArrayStackItem.GetItemCount(): Integer;
1966 begin
1967 Result := ScopeObject^.ArrayData^.Count;
1968 end;
1969
Findnull1970 function TArrayStackItem.Find(var AName: TDataName): PDataBuffer;
1971 begin
1972 If ( FIndex >= 0 ) And ( FIndex < ScopeObject^.ArrayData^.Count ) Then
1973 Result := ScopeObject^.ArrayData^.Items^[FIndex]
1974 Else
1975 Raise ESDOSerializationException.CreateFmt(SERR_IndexOutOfBound,[FIndex]);
1976 Inc(FIndex);
1977 end;
1978
GetByIndexnull1979 function TArrayStackItem.GetByIndex(const AIndex: Integer): PDataBuffer;
1980 begin
1981 If ( AIndex >= 0 ) And ( AIndex < ScopeObject^.ArrayData^.Count ) Then
1982 Result := ScopeObject^.ArrayData^.Items^[AIndex]
1983 Else
1984 Raise ESDOSerializationException.CreateFmt(SERR_IndexOutOfBound,[AIndex]);
1985 end;
1986
TArrayStackItem.CreateBuffernull1987 function TArrayStackItem.CreateBuffer(
1988 const AName : String;
1989 const ADataType : TDataType
1990 ): PDataBuffer;
1991 begin
1992 If ( FIndex >= 0 ) And ( FIndex < ScopeObject^.ArrayData^.Count ) Then
1993 Result := CreateObjBuffer(ADataType,AName,Nil)
1994 Else
1995 Raise ESDOSerializationException.CreateFmt(SERR_IndexOutOfBound,[FIndex]);
1996 ScopeObject^.ArrayData^.Items^[FIndex] := Result;
1997 Inc(FIndex);
1998 end;
1999
2000 {$WARNINGS OFF}
TArrayStackItem.CreateInnerBuffernull2001 function TArrayStackItem.CreateInnerBuffer(const ADataType: TDataType): PDataBuffer;
2002 begin
2003 raise ESDOSerializationException.CreateFmt(SERR_UnsupportedOperation,['TArrayStackItem.CreateInnerBuffer']);
2004 end;
2005
TArrayStackItem.GetInnerBuffernull2006 function TArrayStackItem.GetInnerBuffer(): PDataBuffer;
2007 begin
2008 raise ESDOSerializationException.CreateFmt(SERR_UnsupportedOperation,['TArrayStackItem.GetInnerBuffer']);
2009 end;
2010 {$WARNINGS ON}
2011
2012 procedure TArrayStackItem.NilCurrentScope();
2013 begin
2014 end;
2015
IsCurrentScopeNilnull2016 function TArrayStackItem.IsCurrentScopeNil(): Boolean;
2017 begin
2018 Result := False;
2019 end;
2020
TArrayStackItem.GetScopeItemNamesnull2021 function TArrayStackItem.GetScopeItemNames(const AReturnList: TStrings): Integer;
2022 var
2023 locBuffer : PDataBufferList;
2024 i : PtrInt;
2025 begin
2026 AReturnList.Clear();
2027 if Assigned(ScopeObject) and ( ScopeObject^.ArrayData^.Count > 0 ) then begin
2028 locBuffer := ScopeObject^.ArrayData^.Items;
2029 for i := 0 to Pred(ScopeObject^.ArrayData^.Count) do begin
2030 AReturnList.Add(locBuffer^[i]^.Name);
2031 end;
2032 end;
2033 Result := AReturnList.Count;
2034 end;
2035
2036 procedure TArrayStackItem.CopyTo(const AClone: TStackItem);
2037 begin
2038 inherited CopyTo(AClone);
2039 TArrayStackItem(AClone).FIndex := Self.FIndex;
2040 end;
2041
2042 { TStreamBinaryBookmark }
2043
2044 destructor TStreamBinaryBookmark.Destroy();
2045 var
2046 i : PtrInt;
2047 begin
2048 if ( FStack <> nil ) and ( FStack.Count > 0 ) then begin
2049 for i := 0 to Pred(FStack.Count) do
2050 FStack.Pop().Free();
2051 end;
2052 FreeAndNil(FStack);
2053 inherited;
2054 end;
2055
2056
2057 end.
2058