1 (*
2 * Licensed to the Apache Software Foundation (ASF) under one
3 * or more contributor license agreements. See the NOTICE file
4 * distributed with this work for additional information
5 * regarding copyright ownership. The ASF licenses this file
6 * to you under the Apache License, Version 2.0 (the
7 * "License"); you may not use this file except in compliance
8 * with the License. You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing,
13 * software distributed under the License is distributed on an
14 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 * KIND, either express or implied. See the License for the
16 * specific language governing permissions and limitations
17 * under the License.
18 *)
19
20 {$SCOPEDENUMS ON}
21
22 unit Thrift.Protocol;
23
24 interface
25
26 uses
27 Classes,
28 SysUtils,
29 Contnrs,
30 Thrift.Exception,
31 Thrift.Stream,
32 Thrift.Collections,
33 Thrift.Transport;
34
35 type
36
37 TType = (
38 Stop = 0,
39 Void = 1,
40 Bool_ = 2,
41 Byte_ = 3,
42 Double_ = 4,
43 I16 = 6,
44 I32 = 8,
45 I64 = 10,
46 String_ = 11,
47 Struct = 12,
48 Map = 13,
49 Set_ = 14,
50 List = 15
51 );
52
53 TMessageType = (
54 Call = 1,
55 Reply = 2,
56 Exception = 3,
57 Oneway = 4
58 );
59
60 const
61 VALID_TTYPES = [
62 TType.Stop, TType.Void,
63 TType.Bool_, TType.Byte_, TType.Double_, TType.I16, TType.I32, TType.I64, TType.String_,
64 TType.Struct, TType.Map, TType.Set_, TType.List
65 ];
66
67 VALID_MESSAGETYPES = [Low(TMessageType)..High(TMessageType)];
68
69 const
70 DEFAULT_RECURSION_LIMIT = 64;
71
72 type
73 IProtocol = interface;
74
75 TThriftMessage = record
76 Name: string;
77 Type_: TMessageType;
78 SeqID: Integer;
79 end;
80
81 TThriftStruct = record
82 Name: string;
83 end;
84
85 TThriftField = record
86 Name: string;
87 Type_: TType;
88 Id: SmallInt;
89 end;
90
91 TThriftList = record
92 ElementType: TType;
93 Count: Integer;
94 end;
95
96 TThriftMap = record
97 KeyType: TType;
98 ValueType: TType;
99 Count: Integer;
100 end;
101
102 TThriftSet = record
103 ElementType: TType;
104 Count: Integer;
105 end;
106
107
108
109 IProtocolFactory = interface
110 ['{7CD64A10-4E9F-4E99-93BF-708A31F4A67B}']
GetProtocolnull111 function GetProtocol( const trans: ITransport): IProtocol;
112 end;
113
114 TThriftStringBuilder = class( TStringBuilder)
115 public
Appendnull116 function Append(const Value: TBytes): TStringBuilder; overload;
Appendnull117 function Append(const Value: IThriftContainer): TStringBuilder; overload;
118 end;
119
120 TProtocolException = class( TException)
121 public
122 const // TODO(jensg): change into enum
123 UNKNOWN = 0;
124 INVALID_DATA = 1;
125 NEGATIVE_SIZE = 2;
126 SIZE_LIMIT = 3;
127 BAD_VERSION = 4;
128 NOT_IMPLEMENTED = 5;
129 DEPTH_LIMIT = 6;
130 protected
131 constructor HiddenCreate(const Msg: string);
132 public
133 // purposefully hide inherited constructor
134 class function Create(const Msg: string): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
Createnull135 class function Create: TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
Createnull136 class function Create( type_: Integer): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
Createnull137 class function Create( type_: Integer; const msg: string): TProtocolException; overload; deprecated 'Use specialized TProtocolException types (or regenerate from IDL)';
138 end;
139
140 // Needed to remove deprecation warning
141 TProtocolExceptionSpecialized = class abstract (TProtocolException)
142 public
143 constructor Create(const Msg: string);
144 end;
145
146 TProtocolExceptionUnknown = class (TProtocolExceptionSpecialized);
147 TProtocolExceptionInvalidData = class (TProtocolExceptionSpecialized);
148 TProtocolExceptionNegativeSize = class (TProtocolExceptionSpecialized);
149 TProtocolExceptionSizeLimit = class (TProtocolExceptionSpecialized);
150 TProtocolExceptionBadVersion = class (TProtocolExceptionSpecialized);
151 TProtocolExceptionNotImplemented = class (TProtocolExceptionSpecialized);
152 TProtocolExceptionDepthLimit = class (TProtocolExceptionSpecialized);
153
154
155 TProtocolUtil = class
156 public
157 class procedure Skip( prot: IProtocol; type_: TType);
158 end;
159
160 IProtocolRecursionTracker = interface
161 ['{29CA033F-BB56-49B1-9EE3-31B1E82FC7A5}']
162 // no members yet
163 end;
164
165 TProtocolRecursionTrackerImpl = class abstract( TInterfacedObject, IProtocolRecursionTracker)
166 protected
167 FProtocol : IProtocol;
168 public
169 constructor Create( prot : IProtocol);
170 destructor Destroy; override;
171 end;
172
173 IProtocol = interface
174 ['{602A7FFB-0D9E-4CD8-8D7F-E5076660588A}']
GetTransportnull175 function GetTransport: ITransport;
176 procedure WriteMessageBegin( const msg: TThriftMessage);
177 procedure WriteMessageEnd;
178 procedure WriteStructBegin( const struc: TThriftStruct);
179 procedure WriteStructEnd;
180 procedure WriteFieldBegin( const field: TThriftField);
181 procedure WriteFieldEnd;
182 procedure WriteFieldStop;
183 procedure WriteMapBegin( const map: TThriftMap);
184 procedure WriteMapEnd;
185 procedure WriteListBegin( const list: TThriftList);
186 procedure WriteListEnd();
187 procedure WriteSetBegin( const set_: TThriftSet );
188 procedure WriteSetEnd();
189 procedure WriteBool( b: Boolean);
190 procedure WriteByte( b: ShortInt);
191 procedure WriteI16( i16: SmallInt);
192 procedure WriteI32( i32: Integer);
193 procedure WriteI64( const i64: Int64);
194 procedure WriteDouble( const d: Double);
195 procedure WriteString( const s: string );
196 procedure WriteAnsiString( const s: AnsiString);
197 procedure WriteBinary( const b: TBytes);
198
ReadMessageBeginnull199 function ReadMessageBegin: TThriftMessage;
200 procedure ReadMessageEnd();
ReadStructBeginnull201 function ReadStructBegin: TThriftStruct;
202 procedure ReadStructEnd;
ReadFieldBeginnull203 function ReadFieldBegin: TThriftField;
204 procedure ReadFieldEnd();
ReadMapBeginnull205 function ReadMapBegin: TThriftMap;
206 procedure ReadMapEnd();
ReadListBeginnull207 function ReadListBegin: TThriftList;
208 procedure ReadListEnd();
ReadSetBeginnull209 function ReadSetBegin: TThriftSet;
210 procedure ReadSetEnd();
ReadBoolnull211 function ReadBool: Boolean;
ReadBytenull212 function ReadByte: ShortInt;
ReadI16null213 function ReadI16: SmallInt;
ReadI32null214 function ReadI32: Integer;
ReadI64null215 function ReadI64: Int64;
ReadDoublenull216 function ReadDouble:Double;
ReadBinarynull217 function ReadBinary: TBytes;
ReadStringnull218 function ReadString: string;
ReadAnsiStringnull219 function ReadAnsiString: AnsiString;
220
221 procedure SetRecursionLimit( value : Integer);
GetRecursionLimitnull222 function GetRecursionLimit : Integer;
NextRecursionLevelnull223 function NextRecursionLevel : IProtocolRecursionTracker;
224 procedure IncrementRecursionDepth;
225 procedure DecrementRecursionDepth;
226
227 property Transport: ITransport read GetTransport;
228 property RecursionLimit : Integer read GetRecursionLimit write SetRecursionLimit;
229 end;
230
231 TProtocolImpl = class abstract( TInterfacedObject, IProtocol)
232 protected
233 FTrans : ITransport;
234 FRecursionLimit : Integer;
235 FRecursionDepth : Integer;
236
237 procedure SetRecursionLimit( value : Integer);
GetRecursionLimitnull238 function GetRecursionLimit : Integer;
NextRecursionLevelnull239 function NextRecursionLevel : IProtocolRecursionTracker;
240 procedure IncrementRecursionDepth;
241 procedure DecrementRecursionDepth;
242
GetTransportnull243 function GetTransport: ITransport;
244 public
245 procedure WriteMessageBegin( const msg: TThriftMessage); virtual; abstract;
246 procedure WriteMessageEnd; virtual; abstract;
247 procedure WriteStructBegin( const struc: TThriftStruct); virtual; abstract;
248 procedure WriteStructEnd; virtual; abstract;
249 procedure WriteFieldBegin( const field: TThriftField); virtual; abstract;
250 procedure WriteFieldEnd; virtual; abstract;
251 procedure WriteFieldStop; virtual; abstract;
252 procedure WriteMapBegin( const map: TThriftMap); virtual; abstract;
253 procedure WriteMapEnd; virtual; abstract;
254 procedure WriteListBegin( const list: TThriftList); virtual; abstract;
255 procedure WriteListEnd(); virtual; abstract;
256 procedure WriteSetBegin( const set_: TThriftSet ); virtual; abstract;
257 procedure WriteSetEnd(); virtual; abstract;
258 procedure WriteBool( b: Boolean); virtual; abstract;
259 procedure WriteByte( b: ShortInt); virtual; abstract;
260 procedure WriteI16( i16: SmallInt); virtual; abstract;
261 procedure WriteI32( i32: Integer); virtual; abstract;
262 procedure WriteI64( const i64: Int64); virtual; abstract;
263 procedure WriteDouble( const d: Double); virtual; abstract;
264 procedure WriteString( const s: string ); virtual;
265 procedure WriteAnsiString( const s: AnsiString); virtual;
266 procedure WriteBinary( const b: TBytes); virtual; abstract;
267
ReadMessageBeginnull268 function ReadMessageBegin: TThriftMessage; virtual; abstract;
269 procedure ReadMessageEnd(); virtual; abstract;
ReadStructBeginnull270 function ReadStructBegin: TThriftStruct; virtual; abstract;
271 procedure ReadStructEnd; virtual; abstract;
ReadFieldBeginnull272 function ReadFieldBegin: TThriftField; virtual; abstract;
273 procedure ReadFieldEnd(); virtual; abstract;
ReadMapBeginnull274 function ReadMapBegin: TThriftMap; virtual; abstract;
275 procedure ReadMapEnd(); virtual; abstract;
ReadListBeginnull276 function ReadListBegin: TThriftList; virtual; abstract;
277 procedure ReadListEnd(); virtual; abstract;
ReadSetBeginnull278 function ReadSetBegin: TThriftSet; virtual; abstract;
279 procedure ReadSetEnd(); virtual; abstract;
ReadBoolnull280 function ReadBool: Boolean; virtual; abstract;
ReadBytenull281 function ReadByte: ShortInt; virtual; abstract;
ReadI16null282 function ReadI16: SmallInt; virtual; abstract;
ReadI32null283 function ReadI32: Integer; virtual; abstract;
ReadI64null284 function ReadI64: Int64; virtual; abstract;
ReadDoublenull285 function ReadDouble:Double; virtual; abstract;
ReadBinarynull286 function ReadBinary: TBytes; virtual; abstract;
ReadStringnull287 function ReadString: string; virtual;
ReadAnsiStringnull288 function ReadAnsiString: AnsiString; virtual;
289
290 property Transport: ITransport read GetTransport;
291
292 constructor Create( trans: ITransport );
293 end;
294
295 IBase = interface
296 ['{08D9BAA8-5EAA-410F-B50B-AC2E6E5E4155}']
ToStringnull297 function ToString: string;
298 procedure Read( const iprot: IProtocol);
299 procedure Write( const iprot: IProtocol);
300 end;
301
302
303 TBinaryProtocolImpl = class( TProtocolImpl )
304 protected
305 const
306 VERSION_MASK : Cardinal = $ffff0000;
307 VERSION_1 : Cardinal = $80010000;
308 protected
309 FStrictRead : Boolean;
310 FStrictWrite : Boolean;
311
312 private
ReadAllnull313 function ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer; inline;
ReadStringBodynull314 function ReadStringBody( size: Integer): string;
315
316 public
317
318 type
319 TFactory = class( TInterfacedObject, IProtocolFactory)
320 protected
321 FStrictRead : Boolean;
322 FStrictWrite : Boolean;
323 public
GetProtocolnull324 function GetProtocol( const trans: ITransport): IProtocol;
325 constructor Create( AStrictRead, AStrictWrite: Boolean ); overload;
326 constructor Create; overload;
327 end;
328
329 constructor Create( const trans: ITransport); overload;
330 constructor Create( const trans: ITransport; strictRead: Boolean; strictWrite: Boolean); overload;
331
332 procedure WriteMessageBegin( const msg: TThriftMessage); override;
333 procedure WriteMessageEnd; override;
334 procedure WriteStructBegin( const struc: TThriftStruct); override;
335 procedure WriteStructEnd; override;
336 procedure WriteFieldBegin( const field: TThriftField); override;
337 procedure WriteFieldEnd; override;
338 procedure WriteFieldStop; override;
339 procedure WriteMapBegin( const map: TThriftMap); override;
340 procedure WriteMapEnd; override;
341 procedure WriteListBegin( const list: TThriftList); override;
342 procedure WriteListEnd(); override;
343 procedure WriteSetBegin( const set_: TThriftSet ); override;
344 procedure WriteSetEnd(); override;
345 procedure WriteBool( b: Boolean); override;
346 procedure WriteByte( b: ShortInt); override;
347 procedure WriteI16( i16: SmallInt); override;
348 procedure WriteI32( i32: Integer); override;
349 procedure WriteI64( const i64: Int64); override;
350 procedure WriteDouble( const d: Double); override;
351 procedure WriteBinary( const b: TBytes); override;
352
ReadMessageBeginnull353 function ReadMessageBegin: TThriftMessage; override;
354 procedure ReadMessageEnd(); override;
ReadStructBeginnull355 function ReadStructBegin: TThriftStruct; override;
356 procedure ReadStructEnd; override;
ReadFieldBeginnull357 function ReadFieldBegin: TThriftField; override;
358 procedure ReadFieldEnd(); override;
ReadMapBeginnull359 function ReadMapBegin: TThriftMap; override;
360 procedure ReadMapEnd(); override;
ReadListBeginnull361 function ReadListBegin: TThriftList; override;
362 procedure ReadListEnd(); override;
ReadSetBeginnull363 function ReadSetBegin: TThriftSet; override;
364 procedure ReadSetEnd(); override;
ReadBoolnull365 function ReadBool: Boolean; override;
ReadBytenull366 function ReadByte: ShortInt; override;
ReadI16null367 function ReadI16: SmallInt; override;
ReadI32null368 function ReadI32: Integer; override;
ReadI64null369 function ReadI64: Int64; override;
ReadDoublenull370 function ReadDouble:Double; override;
ReadBinarynull371 function ReadBinary: TBytes; override;
372
373 end;
374
375
376 { TProtocolDecorator forwards all requests to an enclosed TProtocol instance,
377 providing a way to author concise concrete decorator subclasses. The decorator
378 does not (and should not) modify the behaviour of the enclosed TProtocol
379
380 See p.175 of Design Patterns (by Gamma et al.)
381 }
382 TProtocolDecorator = class( TProtocolImpl)
383 private
384 FWrappedProtocol : IProtocol;
385
386 public
387 // Encloses the specified protocol.
388 // All operations will be forward to the given protocol. Must be non-null.
389 constructor Create( const aProtocol : IProtocol);
390
391 procedure WriteMessageBegin( const msg: TThriftMessage); override;
392 procedure WriteMessageEnd; override;
393 procedure WriteStructBegin( const struc: TThriftStruct); override;
394 procedure WriteStructEnd; override;
395 procedure WriteFieldBegin( const field: TThriftField); override;
396 procedure WriteFieldEnd; override;
397 procedure WriteFieldStop; override;
398 procedure WriteMapBegin( const map: TThriftMap); override;
399 procedure WriteMapEnd; override;
400 procedure WriteListBegin( const list: TThriftList); override;
401 procedure WriteListEnd(); override;
402 procedure WriteSetBegin( const set_: TThriftSet ); override;
403 procedure WriteSetEnd(); override;
404 procedure WriteBool( b: Boolean); override;
405 procedure WriteByte( b: ShortInt); override;
406 procedure WriteI16( i16: SmallInt); override;
407 procedure WriteI32( i32: Integer); override;
408 procedure WriteI64( const i64: Int64); override;
409 procedure WriteDouble( const d: Double); override;
410 procedure WriteString( const s: string ); override;
411 procedure WriteAnsiString( const s: AnsiString); override;
412 procedure WriteBinary( const b: TBytes); override;
413
ReadMessageBeginnull414 function ReadMessageBegin: TThriftMessage; override;
415 procedure ReadMessageEnd(); override;
ReadStructBeginnull416 function ReadStructBegin: TThriftStruct; override;
417 procedure ReadStructEnd; override;
ReadFieldBeginnull418 function ReadFieldBegin: TThriftField; override;
419 procedure ReadFieldEnd(); override;
ReadMapBeginnull420 function ReadMapBegin: TThriftMap; override;
421 procedure ReadMapEnd(); override;
ReadListBeginnull422 function ReadListBegin: TThriftList; override;
423 procedure ReadListEnd(); override;
ReadSetBeginnull424 function ReadSetBegin: TThriftSet; override;
425 procedure ReadSetEnd(); override;
ReadBoolnull426 function ReadBool: Boolean; override;
ReadBytenull427 function ReadByte: ShortInt; override;
ReadI16null428 function ReadI16: SmallInt; override;
ReadI32null429 function ReadI32: Integer; override;
ReadI64null430 function ReadI64: Int64; override;
ReadDoublenull431 function ReadDouble:Double; override;
ReadBinarynull432 function ReadBinary: TBytes; override;
ReadStringnull433 function ReadString: string; override;
ReadAnsiStringnull434 function ReadAnsiString: AnsiString; override;
435 end;
436
437
438 type
439 IRequestEvents = interface
440 ['{F926A26A-5B00-4560-86FA-2CAE3BA73DAF}']
441 // Called before reading arguments.
442 procedure PreRead;
443 // Called between reading arguments and calling the handler.
444 procedure PostRead;
445 // Called between calling the handler and writing the response.
446 procedure PreWrite;
447 // Called after writing the response.
448 procedure PostWrite;
callnull449 // Called when an oneway (async) function call completes successfully.
450 procedure OnewayComplete;
451 // Called if the handler throws an undeclared exception.
452 procedure UnhandledError( const e : Exception);
453 // Called when a client has finished request-handling to clean up
454 procedure CleanupContext;
455 end;
456
457
458 IProcessorEvents = interface
459 ['{A8661119-657C-447D-93C5-512E36162A45}']
460 // Called when a client is about to call the processor.
461 procedure Processing( const transport : ITransport);
invocationnull462 // Called on any service function invocation
463 function CreateRequestContext( const aFunctionName : string) : IRequestEvents;
464 // Called when a client has finished request-handling to clean up
465 procedure CleanupContext;
466 end;
467
468
469 IProcessor = interface
470 ['{7BAE92A5-46DA-4F13-B6EA-0EABE233EE5F}']
Processnull471 function Process( const iprot :IProtocol; const oprot: IProtocol; const events : IProcessorEvents = nil): Boolean;
472 end;
473
474
475 procedure Init( var rec : TThriftMessage; const AName: string = ''; const AMessageType: TMessageType = Low(TMessageType); const ASeqID: Integer = 0); overload; inline;
476 procedure Init( var rec : TThriftStruct; const AName: string = ''); overload; inline;
477 procedure Init( var rec : TThriftField; const AName: string = ''; const AType: TType = Low(TType); const AID: SmallInt = 0); overload; inline;
478 procedure Init( var rec : TThriftMap; const AKeyType: TType = Low(TType); const AValueType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
479 procedure Init( var rec : TThriftSet; const AElementType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
480 procedure Init( var rec : TThriftList; const AElementType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
481
482
483 implementation
484
ConvertInt64ToDoublenull485 function ConvertInt64ToDouble( const n: Int64): Double;
486 begin
487 ASSERT( SizeOf(n) = SizeOf(Result));
488 System.Move( n, Result, SizeOf(Result));
489 end;
490
ConvertDoubleToInt64null491 function ConvertDoubleToInt64( const d: Double): Int64;
492 begin
493 ASSERT( SizeOf(d) = SizeOf(Result));
494 System.Move( d, Result, SizeOf(Result));
495 end;
496
497
498
499 { TProtocolRecursionTrackerImpl }
500
501 constructor TProtocolRecursionTrackerImpl.Create( prot : IProtocol);
502 begin
503 inherited Create;
504
505 // storing the pointer *after* the (successful) increment is important here
506 prot.IncrementRecursionDepth;
507 FProtocol := prot;
508 end;
509
510 destructor TProtocolRecursionTrackerImpl.Destroy;
511 begin
512 try
513 // we have to release the reference iff the pointer has been stored
514 if FProtocol <> nil then begin
515 FProtocol.DecrementRecursionDepth;
516 FProtocol := nil;
517 end;
518 finally
519 inherited Destroy;
520 end;
521 end;
522
523 { TProtocolImpl }
524
525 constructor TProtocolImpl.Create(trans: ITransport);
526 begin
527 inherited Create;
528 FTrans := trans;
529 FRecursionLimit := DEFAULT_RECURSION_LIMIT;
530 FRecursionDepth := 0;
531 end;
532
533 procedure TProtocolImpl.SetRecursionLimit( value : Integer);
534 begin
535 FRecursionLimit := value;
536 end;
537
TProtocolImpl.GetRecursionLimitnull538 function TProtocolImpl.GetRecursionLimit : Integer;
539 begin
540 result := FRecursionLimit;
541 end;
542
TProtocolImpl.NextRecursionLevelnull543 function TProtocolImpl.NextRecursionLevel : IProtocolRecursionTracker;
544 begin
545 result := TProtocolRecursionTrackerImpl.Create(Self);
546 end;
547
548 procedure TProtocolImpl.IncrementRecursionDepth;
549 begin
550 if FRecursionDepth < FRecursionLimit
551 then Inc(FRecursionDepth)
552 else raise TProtocolExceptionDepthLimit.Create('Depth limit exceeded');
553 end;
554
555 procedure TProtocolImpl.DecrementRecursionDepth;
556 begin
557 Dec(FRecursionDepth)
558 end;
559
GetTransportnull560 function TProtocolImpl.GetTransport: ITransport;
561 begin
562 Result := FTrans;
563 end;
564
ReadAnsiStringnull565 function TProtocolImpl.ReadAnsiString: AnsiString;
566 var
567 b : TBytes;
568 len : Integer;
569 begin
570 Result := '';
571 b := ReadBinary;
572 len := Length( b );
573 if len > 0 then
574 begin
575 SetLength( Result, len);
576 System.Move( b[0], Pointer(Result)^, len );
577 end;
578 end;
579
ReadStringnull580 function TProtocolImpl.ReadString: string;
581 begin
582 Result := TEncoding.UTF8.GetString( ReadBinary );
583 end;
584
585 procedure TProtocolImpl.WriteAnsiString(const s: AnsiString);
586 var
587 b : TBytes;
588 len : Integer;
589 begin
590 len := Length(s);
591 SetLength( b, len);
592 if len > 0 then
593 begin
594 System.Move( Pointer(s)^, b[0], len );
595 end;
596 WriteBinary( b );
597 end;
598
599 procedure TProtocolImpl.WriteString(const s: string);
600 var
601 b : TBytes;
602 begin
603 b := TEncoding.UTF8.GetBytes(s);
604 WriteBinary( b );
605 end;
606
607 { TProtocolUtil }
608
609 class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType);
610 var field : TThriftField;
611 map : TThriftMap;
612 set_ : TThriftSet;
613 list : TThriftList;
614 i : Integer;
615 tracker : IProtocolRecursionTracker;
616 begin
617 tracker := prot.NextRecursionLevel;
618 case type_ of
619 // simple types
620 TType.Bool_ : prot.ReadBool();
621 TType.Byte_ : prot.ReadByte();
622 TType.I16 : prot.ReadI16();
623 TType.I32 : prot.ReadI32();
624 TType.I64 : prot.ReadI64();
625 TType.Double_ : prot.ReadDouble();
626 TType.String_ : prot.ReadBinary();// Don't try to decode the string, just skip it.
627
628 // structured types
629 TType.Struct : begin
630 prot.ReadStructBegin();
631 while TRUE do begin
632 field := prot.ReadFieldBegin();
633 if (field.Type_ = TType.Stop) then Break;
634 Skip(prot, field.Type_);
635 prot.ReadFieldEnd();
636 end;
637 prot.ReadStructEnd();
638 end;
639
640 TType.Map : begin
641 map := prot.ReadMapBegin();
642 for i := 0 to map.Count-1 do begin
643 Skip(prot, map.KeyType);
644 Skip(prot, map.ValueType);
645 end;
646 prot.ReadMapEnd();
647 end;
648
649 TType.Set_ : begin
650 set_ := prot.ReadSetBegin();
651 for i := 0 to set_.Count-1
652 do Skip( prot, set_.ElementType);
653 prot.ReadSetEnd();
654 end;
655
656 TType.List : begin
657 list := prot.ReadListBegin();
658 for i := 0 to list.Count-1
659 do Skip( prot, list.ElementType);
660 prot.ReadListEnd();
661 end;
662
663 else
664 raise TProtocolExceptionInvalidData.Create('Unexpected type '+IntToStr(Ord(type_)));
665 end;
666 end;
667
668
669 { TBinaryProtocolImpl }
670
671 constructor TBinaryProtocolImpl.Create( const trans: ITransport);
672 begin
673 //no inherited
674 Create( trans, False, True);
675 end;
676
677 constructor TBinaryProtocolImpl.Create( const trans: ITransport; strictRead,
678 strictWrite: Boolean);
679 begin
680 inherited Create( trans );
681 FStrictRead := strictRead;
682 FStrictWrite := strictWrite;
683 end;
684
ReadAllnull685 function TBinaryProtocolImpl.ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer;
686 begin
687 Result := FTrans.ReadAll( pBuf, buflen, off, len );
688 end;
689
ReadBinarynull690 function TBinaryProtocolImpl.ReadBinary: TBytes;
691 var
692 size : Integer;
693 buf : TBytes;
694 begin
695 size := ReadI32;
696 SetLength( buf, size );
697 FTrans.ReadAll( buf, 0, size);
698 Result := buf;
699 end;
700
ReadBoolnull701 function TBinaryProtocolImpl.ReadBool: Boolean;
702 begin
703 Result := (ReadByte = 1);
704 end;
705
ReadBytenull706 function TBinaryProtocolImpl.ReadByte: ShortInt;
707 begin
708 ReadAll( @result, SizeOf(result), 0, 1);
709 end;
710
ReadDoublenull711 function TBinaryProtocolImpl.ReadDouble: Double;
712 begin
713 Result := ConvertInt64ToDouble( ReadI64 )
714 end;
715
ReadFieldBeginnull716 function TBinaryProtocolImpl.ReadFieldBegin: TThriftField;
717 begin
718 Init( result, '', TType( ReadByte), 0);
719 if ( result.Type_ <> TType.Stop ) then begin
720 result.Id := ReadI16;
721 end;
722 end;
723
724 procedure TBinaryProtocolImpl.ReadFieldEnd;
725 begin
726
727 end;
728
ReadI16null729 function TBinaryProtocolImpl.ReadI16: SmallInt;
730 var i16in : packed array[0..1] of Byte;
731 begin
732 ReadAll( @i16in, Sizeof(i16in), 0, 2);
733 Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF));
734 end;
735
ReadI32null736 function TBinaryProtocolImpl.ReadI32: Integer;
737 var i32in : packed array[0..3] of Byte;
738 begin
739 ReadAll( @i32in, SizeOf(i32in), 0, 4);
740
741 Result := Integer(
742 ((i32in[0] and $FF) shl 24) or
743 ((i32in[1] and $FF) shl 16) or
744 ((i32in[2] and $FF) shl 8) or
745 (i32in[3] and $FF));
746
747 end;
748
ReadI64null749 function TBinaryProtocolImpl.ReadI64: Int64;
750 var i64in : packed array[0..7] of Byte;
751 begin
752 ReadAll( @i64in, SizeOf(i64in), 0, 8);
753 Result :=
754 (Int64( i64in[0] and $FF) shl 56) or
755 (Int64( i64in[1] and $FF) shl 48) or
756 (Int64( i64in[2] and $FF) shl 40) or
757 (Int64( i64in[3] and $FF) shl 32) or
758 (Int64( i64in[4] and $FF) shl 24) or
759 (Int64( i64in[5] and $FF) shl 16) or
760 (Int64( i64in[6] and $FF) shl 8) or
761 (Int64( i64in[7] and $FF));
762 end;
763
ReadListBeginnull764 function TBinaryProtocolImpl.ReadListBegin: TThriftList;
765 begin
766 result.ElementType := TType(ReadByte);
767 result.Count := ReadI32;
768 end;
769
770 procedure TBinaryProtocolImpl.ReadListEnd;
771 begin
772
773 end;
774
ReadMapBeginnull775 function TBinaryProtocolImpl.ReadMapBegin: TThriftMap;
776 begin
777 result.KeyType := TType(ReadByte);
778 result.ValueType := TType(ReadByte);
779 result.Count := ReadI32;
780 end;
781
782 procedure TBinaryProtocolImpl.ReadMapEnd;
783 begin
784
785 end;
786
ReadMessageBeginnull787 function TBinaryProtocolImpl.ReadMessageBegin: TThriftMessage;
788 var
789 size : Integer;
790 version : Integer;
791 begin
792 Init( result);
793 size := ReadI32;
794 if (size < 0) then begin
795 version := size and Integer( VERSION_MASK);
796 if ( version <> Integer( VERSION_1)) then begin
797 raise TProtocolExceptionBadVersion.Create('Bad version in ReadMessageBegin: ' + IntToStr(version) );
798 end;
799 result.Type_ := TMessageType( size and $000000ff);
800 result.Name := ReadString;
801 result.SeqID := ReadI32;
802 end
803 else begin
804 if FStrictRead then begin
805 raise TProtocolExceptionBadVersion.Create('Missing version in readMessageBegin, old client?' );
806 end;
807 result.Name := ReadStringBody( size );
808 result.Type_ := TMessageType( ReadByte );
809 result.SeqID := ReadI32;
810 end;
811 end;
812
813 procedure TBinaryProtocolImpl.ReadMessageEnd;
814 begin
815 inherited;
816
817 end;
818
ReadSetBeginnull819 function TBinaryProtocolImpl.ReadSetBegin: TThriftSet;
820 begin
821 result.ElementType := TType(ReadByte);
822 result.Count := ReadI32;
823 end;
824
825 procedure TBinaryProtocolImpl.ReadSetEnd;
826 begin
827
828 end;
829
ReadStringBodynull830 function TBinaryProtocolImpl.ReadStringBody( size: Integer): string;
831 var
832 buf : TBytes;
833 begin
834 SetLength( buf, size );
835 FTrans.ReadAll( buf, 0, size );
836 Result := TEncoding.UTF8.GetString( buf);
837 end;
838
ReadStructBeginnull839 function TBinaryProtocolImpl.ReadStructBegin: TThriftStruct;
840 begin
841 Init( Result);
842 end;
843
844 procedure TBinaryProtocolImpl.ReadStructEnd;
845 begin
846 inherited;
847
848 end;
849
850 procedure TBinaryProtocolImpl.WriteBinary( const b: TBytes);
851 var iLen : Integer;
852 begin
853 iLen := Length(b);
854 WriteI32( iLen);
855 if iLen > 0 then FTrans.Write(b, 0, iLen);
856 end;
857
858 procedure TBinaryProtocolImpl.WriteBool(b: Boolean);
859 begin
860 if b then begin
861 WriteByte( 1 );
862 end else begin
863 WriteByte( 0 );
864 end;
865 end;
866
867 procedure TBinaryProtocolImpl.WriteByte(b: ShortInt);
868 begin
869 FTrans.Write( @b, 0, 1);
870 end;
871
872 procedure TBinaryProtocolImpl.WriteDouble( const d: Double);
873 begin
874 WriteI64(ConvertDoubleToInt64(d));
875 end;
876
877 procedure TBinaryProtocolImpl.WriteFieldBegin( const field: TThriftField);
878 begin
879 WriteByte(ShortInt(field.Type_));
880 WriteI16(field.ID);
881 end;
882
883 procedure TBinaryProtocolImpl.WriteFieldEnd;
884 begin
885
886 end;
887
888 procedure TBinaryProtocolImpl.WriteFieldStop;
889 begin
890 WriteByte(ShortInt(TType.Stop));
891 end;
892
893 procedure TBinaryProtocolImpl.WriteI16(i16: SmallInt);
894 var i16out : packed array[0..1] of Byte;
895 begin
896 i16out[0] := Byte($FF and (i16 shr 8));
897 i16out[1] := Byte($FF and i16);
898 FTrans.Write( @i16out, 0, 2);
899 end;
900
901 procedure TBinaryProtocolImpl.WriteI32(i32: Integer);
902 var i32out : packed array[0..3] of Byte;
903 begin
904 i32out[0] := Byte($FF and (i32 shr 24));
905 i32out[1] := Byte($FF and (i32 shr 16));
906 i32out[2] := Byte($FF and (i32 shr 8));
907 i32out[3] := Byte($FF and i32);
908 FTrans.Write( @i32out, 0, 4);
909 end;
910
911 procedure TBinaryProtocolImpl.WriteI64( const i64: Int64);
912 var i64out : packed array[0..7] of Byte;
913 begin
914 i64out[0] := Byte($FF and (i64 shr 56));
915 i64out[1] := Byte($FF and (i64 shr 48));
916 i64out[2] := Byte($FF and (i64 shr 40));
917 i64out[3] := Byte($FF and (i64 shr 32));
918 i64out[4] := Byte($FF and (i64 shr 24));
919 i64out[5] := Byte($FF and (i64 shr 16));
920 i64out[6] := Byte($FF and (i64 shr 8));
921 i64out[7] := Byte($FF and i64);
922 FTrans.Write( @i64out, 0, 8);
923 end;
924
925 procedure TBinaryProtocolImpl.WriteListBegin( const list: TThriftList);
926 begin
927 WriteByte(ShortInt(list.ElementType));
928 WriteI32(list.Count);
929 end;
930
931 procedure TBinaryProtocolImpl.WriteListEnd;
932 begin
933
934 end;
935
936 procedure TBinaryProtocolImpl.WriteMapBegin( const map: TThriftMap);
937 begin
938 WriteByte(ShortInt(map.KeyType));
939 WriteByte(ShortInt(map.ValueType));
940 WriteI32(map.Count);
941 end;
942
943 procedure TBinaryProtocolImpl.WriteMapEnd;
944 begin
945
946 end;
947
948 procedure TBinaryProtocolImpl.WriteMessageBegin( const msg: TThriftMessage);
949 var
950 version : Cardinal;
951 begin
952 if FStrictWrite then
953 begin
954 version := VERSION_1 or Cardinal( msg.Type_);
955 WriteI32( Integer( version) );
956 WriteString( msg.Name);
957 WriteI32( msg.SeqID);
958 end else
959 begin
960 WriteString( msg.Name);
961 WriteByte(ShortInt( msg.Type_));
962 WriteI32( msg.SeqID);
963 end;
964 end;
965
966 procedure TBinaryProtocolImpl.WriteMessageEnd;
967 begin
968
969 end;
970
971 procedure TBinaryProtocolImpl.WriteSetBegin( const set_: TThriftSet);
972 begin
973 WriteByte(ShortInt(set_.ElementType));
974 WriteI32(set_.Count);
975 end;
976
977 procedure TBinaryProtocolImpl.WriteSetEnd;
978 begin
979
980 end;
981
982 procedure TBinaryProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
983 begin
984
985 end;
986
987 procedure TBinaryProtocolImpl.WriteStructEnd;
988 begin
989
990 end;
991
992 { TProtocolException }
993
994 constructor TProtocolException.HiddenCreate(const Msg: string);
995 begin
996 inherited Create(Msg);
997 end;
998
999 class function TProtocolException.Create(const Msg: string): TProtocolException;
1000 begin
1001 Result := TProtocolExceptionUnknown.Create(Msg);
1002 end;
1003
1004 class function TProtocolException.Create: TProtocolException;
1005 begin
1006 Result := TProtocolExceptionUnknown.Create('');
1007 end;
1008
1009 class function TProtocolException.Create(type_: Integer): TProtocolException;
1010 begin
1011 {$WARN SYMBOL_DEPRECATED OFF}
1012 Result := Create(type_, '');
1013 {$WARN SYMBOL_DEPRECATED DEFAULT}
1014 end;
1015
1016 class function TProtocolException.Create(type_: Integer; const msg: string): TProtocolException;
1017 begin
1018 case type_ of
1019 INVALID_DATA: Result := TProtocolExceptionInvalidData.Create(msg);
1020 NEGATIVE_SIZE: Result := TProtocolExceptionNegativeSize.Create(msg);
1021 SIZE_LIMIT: Result := TProtocolExceptionSizeLimit.Create(msg);
1022 BAD_VERSION: Result := TProtocolExceptionBadVersion.Create(msg);
1023 NOT_IMPLEMENTED: Result := TProtocolExceptionNotImplemented.Create(msg);
1024 DEPTH_LIMIT: Result := TProtocolExceptionDepthLimit.Create(msg);
1025 else
1026 Result := TProtocolExceptionUnknown.Create(msg);
1027 end;
1028 end;
1029
1030 { TProtocolExceptionSpecialized }
1031
1032 constructor TProtocolExceptionSpecialized.Create(const Msg: string);
1033 begin
1034 inherited HiddenCreate(Msg);
1035 end;
1036
1037 { TThriftStringBuilder }
1038
Appendnull1039 function TThriftStringBuilder.Append(const Value: TBytes): TStringBuilder;
1040 begin
1041 Result := Append( string( RawByteString(Value)) );
1042 end;
1043
Appendnull1044 function TThriftStringBuilder.Append(
1045 const Value: IThriftContainer): TStringBuilder;
1046 begin
1047 Result := Append( Value.ToString );
1048 end;
1049
1050 { TBinaryProtocolImpl.TFactory }
1051
1052 constructor TBinaryProtocolImpl.TFactory.Create(AStrictRead, AStrictWrite: Boolean);
1053 begin
1054 inherited Create;
1055 FStrictRead := AStrictRead;
1056 FStrictWrite := AStrictWrite;
1057 end;
1058
1059 constructor TBinaryProtocolImpl.TFactory.Create;
1060 begin
1061 //no inherited;
1062 Create( False, True )
1063 end;
1064
TFactorynull1065 function TBinaryProtocolImpl.TFactory.GetProtocol( const trans: ITransport): IProtocol;
1066 begin
1067 Result := TBinaryProtocolImpl.Create( trans, FStrictRead, FStrictWrite);
1068 end;
1069
1070
1071 { TProtocolDecorator }
1072
1073 constructor TProtocolDecorator.Create( const aProtocol : IProtocol);
1074 begin
1075 ASSERT( aProtocol <> nil);
1076 inherited Create( aProtocol.Transport);
1077 FWrappedProtocol := aProtocol;
1078 end;
1079
1080
1081 procedure TProtocolDecorator.WriteMessageBegin( const msg: TThriftMessage);
1082 begin
1083 FWrappedProtocol.WriteMessageBegin( msg);
1084 end;
1085
1086
1087 procedure TProtocolDecorator.WriteMessageEnd;
1088 begin
1089 FWrappedProtocol.WriteMessageEnd;
1090 end;
1091
1092
1093 procedure TProtocolDecorator.WriteStructBegin( const struc: TThriftStruct);
1094 begin
1095 FWrappedProtocol.WriteStructBegin( struc);
1096 end;
1097
1098
1099 procedure TProtocolDecorator.WriteStructEnd;
1100 begin
1101 FWrappedProtocol.WriteStructEnd;
1102 end;
1103
1104
1105 procedure TProtocolDecorator.WriteFieldBegin( const field: TThriftField);
1106 begin
1107 FWrappedProtocol.WriteFieldBegin( field);
1108 end;
1109
1110
1111 procedure TProtocolDecorator.WriteFieldEnd;
1112 begin
1113 FWrappedProtocol.WriteFieldEnd;
1114 end;
1115
1116
1117 procedure TProtocolDecorator.WriteFieldStop;
1118 begin
1119 FWrappedProtocol.WriteFieldStop;
1120 end;
1121
1122
1123 procedure TProtocolDecorator.WriteMapBegin( const map: TThriftMap);
1124 begin
1125 FWrappedProtocol.WriteMapBegin( map);
1126 end;
1127
1128
1129 procedure TProtocolDecorator.WriteMapEnd;
1130 begin
1131 FWrappedProtocol.WriteMapEnd;
1132 end;
1133
1134
1135 procedure TProtocolDecorator.WriteListBegin( const list: TThriftList);
1136 begin
1137 FWrappedProtocol.WriteListBegin( list);
1138 end;
1139
1140
1141 procedure TProtocolDecorator.WriteListEnd();
1142 begin
1143 FWrappedProtocol.WriteListEnd();
1144 end;
1145
1146
1147 procedure TProtocolDecorator.WriteSetBegin( const set_: TThriftSet );
1148 begin
1149 FWrappedProtocol.WriteSetBegin( set_);
1150 end;
1151
1152
1153 procedure TProtocolDecorator.WriteSetEnd();
1154 begin
1155 FWrappedProtocol.WriteSetEnd();
1156 end;
1157
1158
1159 procedure TProtocolDecorator.WriteBool( b: Boolean);
1160 begin
1161 FWrappedProtocol.WriteBool( b);
1162 end;
1163
1164
1165 procedure TProtocolDecorator.WriteByte( b: ShortInt);
1166 begin
1167 FWrappedProtocol.WriteByte( b);
1168 end;
1169
1170
1171 procedure TProtocolDecorator.WriteI16( i16: SmallInt);
1172 begin
1173 FWrappedProtocol.WriteI16( i16);
1174 end;
1175
1176
1177 procedure TProtocolDecorator.WriteI32( i32: Integer);
1178 begin
1179 FWrappedProtocol.WriteI32( i32);
1180 end;
1181
1182
1183 procedure TProtocolDecorator.WriteI64( const i64: Int64);
1184 begin
1185 FWrappedProtocol.WriteI64( i64);
1186 end;
1187
1188
1189 procedure TProtocolDecorator.WriteDouble( const d: Double);
1190 begin
1191 FWrappedProtocol.WriteDouble( d);
1192 end;
1193
1194
1195 procedure TProtocolDecorator.WriteString( const s: string );
1196 begin
1197 FWrappedProtocol.WriteString( s);
1198 end;
1199
1200
1201 procedure TProtocolDecorator.WriteAnsiString( const s: AnsiString);
1202 begin
1203 FWrappedProtocol.WriteAnsiString( s);
1204 end;
1205
1206
1207 procedure TProtocolDecorator.WriteBinary( const b: TBytes);
1208 begin
1209 FWrappedProtocol.WriteBinary( b);
1210 end;
1211
1212
ReadMessageBeginnull1213 function TProtocolDecorator.ReadMessageBegin: TThriftMessage;
1214 begin
1215 result := FWrappedProtocol.ReadMessageBegin;
1216 end;
1217
1218
1219 procedure TProtocolDecorator.ReadMessageEnd();
1220 begin
1221 FWrappedProtocol.ReadMessageEnd();
1222 end;
1223
1224
ReadStructBeginnull1225 function TProtocolDecorator.ReadStructBegin: TThriftStruct;
1226 begin
1227 result := FWrappedProtocol.ReadStructBegin;
1228 end;
1229
1230
1231 procedure TProtocolDecorator.ReadStructEnd;
1232 begin
1233 FWrappedProtocol.ReadStructEnd;
1234 end;
1235
1236
ReadFieldBeginnull1237 function TProtocolDecorator.ReadFieldBegin: TThriftField;
1238 begin
1239 result := FWrappedProtocol.ReadFieldBegin;
1240 end;
1241
1242
1243 procedure TProtocolDecorator.ReadFieldEnd();
1244 begin
1245 FWrappedProtocol.ReadFieldEnd();
1246 end;
1247
1248
ReadMapBeginnull1249 function TProtocolDecorator.ReadMapBegin: TThriftMap;
1250 begin
1251 result := FWrappedProtocol.ReadMapBegin;
1252 end;
1253
1254
1255 procedure TProtocolDecorator.ReadMapEnd();
1256 begin
1257 FWrappedProtocol.ReadMapEnd();
1258 end;
1259
1260
ReadListBeginnull1261 function TProtocolDecorator.ReadListBegin: TThriftList;
1262 begin
1263 result := FWrappedProtocol.ReadListBegin;
1264 end;
1265
1266
1267 procedure TProtocolDecorator.ReadListEnd();
1268 begin
1269 FWrappedProtocol.ReadListEnd();
1270 end;
1271
1272
ReadSetBeginnull1273 function TProtocolDecorator.ReadSetBegin: TThriftSet;
1274 begin
1275 result := FWrappedProtocol.ReadSetBegin;
1276 end;
1277
1278
1279 procedure TProtocolDecorator.ReadSetEnd();
1280 begin
1281 FWrappedProtocol.ReadSetEnd();
1282 end;
1283
1284
ReadBoolnull1285 function TProtocolDecorator.ReadBool: Boolean;
1286 begin
1287 result := FWrappedProtocol.ReadBool;
1288 end;
1289
1290
ReadBytenull1291 function TProtocolDecorator.ReadByte: ShortInt;
1292 begin
1293 result := FWrappedProtocol.ReadByte;
1294 end;
1295
1296
ReadI16null1297 function TProtocolDecorator.ReadI16: SmallInt;
1298 begin
1299 result := FWrappedProtocol.ReadI16;
1300 end;
1301
1302
ReadI32null1303 function TProtocolDecorator.ReadI32: Integer;
1304 begin
1305 result := FWrappedProtocol.ReadI32;
1306 end;
1307
1308
ReadI64null1309 function TProtocolDecorator.ReadI64: Int64;
1310 begin
1311 result := FWrappedProtocol.ReadI64;
1312 end;
1313
1314
ReadDoublenull1315 function TProtocolDecorator.ReadDouble:Double;
1316 begin
1317 result := FWrappedProtocol.ReadDouble;
1318 end;
1319
1320
ReadBinarynull1321 function TProtocolDecorator.ReadBinary: TBytes;
1322 begin
1323 result := FWrappedProtocol.ReadBinary;
1324 end;
1325
1326
ReadStringnull1327 function TProtocolDecorator.ReadString: string;
1328 begin
1329 result := FWrappedProtocol.ReadString;
1330 end;
1331
1332
ReadAnsiStringnull1333 function TProtocolDecorator.ReadAnsiString: AnsiString;
1334 begin
1335 result := FWrappedProtocol.ReadAnsiString;
1336 end;
1337
1338
1339 { Init helper functions }
1340
1341 procedure Init( var rec : TThriftMessage; const AName: string; const AMessageType: TMessageType; const ASeqID: Integer);
1342 begin
1343 rec.Name := AName;
1344 rec.Type_ := AMessageType;
1345 rec.SeqID := ASeqID;
1346 end;
1347
1348
1349 procedure Init( var rec : TThriftStruct; const AName: string = '');
1350 begin
1351 rec.Name := AName;
1352 end;
1353
1354
1355 procedure Init( var rec : TThriftField; const AName: string; const AType: TType; const AID: SmallInt);
1356 begin
1357 rec.Name := AName;
1358 rec.Type_ := AType;
1359 rec.Id := AId;
1360 end;
1361
1362
1363 procedure Init( var rec : TThriftMap; const AKeyType, AValueType: TType; const ACount: Integer);
1364 begin
1365 rec.ValueType := AValueType;
1366 rec.KeyType := AKeyType;
1367 rec.Count := ACount;
1368 end;
1369
1370
1371 procedure Init( var rec : TThriftSet; const AElementType: TType; const ACount: Integer);
1372 begin
1373 rec.Count := ACount;
1374 rec.ElementType := AElementType;
1375 end;
1376
1377
1378 procedure Init( var rec : TThriftList; const AElementType: TType; const ACount: Integer);
1379 begin
1380 rec.Count := ACount;
1381 rec.ElementType := AElementType;
1382 end;
1383
1384
1385
1386
1387
1388 end.
1389
1390