|  | (* | 
|  | * Licensed to the Apache Software Foundation (ASF) under one | 
|  | * or more contributor license agreements. See the NOTICE file | 
|  | * distributed with this work for additional information | 
|  | * regarding copyright ownership. The ASF licenses this file | 
|  | * to you under the Apache License, Version 2.0 (the | 
|  | * "License"); you may not use this file except in compliance | 
|  | * with the License. You may obtain a copy of the License at | 
|  | * | 
|  | *   http://www.apache.org/licenses/LICENSE-2.0 | 
|  | * | 
|  | * Unless required by applicable law or agreed to in writing, | 
|  | * software distributed under the License is distributed on an | 
|  | * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY | 
|  | * KIND, either express or implied. See the License for the | 
|  | * specific language governing permissions and limitations | 
|  | * under the License. | 
|  | *) | 
|  |  | 
|  | {$SCOPEDENUMS ON} | 
|  |  | 
|  | unit Thrift.Protocol; | 
|  |  | 
|  | interface | 
|  |  | 
|  | uses | 
|  | Classes, | 
|  | SysUtils, | 
|  | Contnrs, | 
|  | Thrift.Stream, | 
|  | Thrift.Collections, | 
|  | Thrift.Transport; | 
|  |  | 
|  | type | 
|  |  | 
|  | TType = ( | 
|  | Stop = 0, | 
|  | Void = 1, | 
|  | Bool_ = 2, | 
|  | Byte_ = 3, | 
|  | Double_ = 4, | 
|  | I16 = 6, | 
|  | I32 = 8, | 
|  | I64 = 10, | 
|  | String_ = 11, | 
|  | Struct = 12, | 
|  | Map = 13, | 
|  | Set_ = 14, | 
|  | List = 15 | 
|  | ); | 
|  |  | 
|  | TMessageType = ( | 
|  | Call = 1, | 
|  | Reply = 2, | 
|  | Exception = 3, | 
|  | Oneway = 4 | 
|  | ); | 
|  |  | 
|  | const | 
|  | VALID_TTYPES = [ | 
|  | TType.Stop, TType.Void, | 
|  | TType.Bool_, TType.Byte_, TType.Double_, TType.I16, TType.I32, TType.I64, TType.String_, | 
|  | TType.Struct, TType.Map, TType.Set_, TType.List | 
|  | ]; | 
|  |  | 
|  | VALID_MESSAGETYPES = [Low(TMessageType)..High(TMessageType)]; | 
|  |  | 
|  | const | 
|  | DEFAULT_RECURSION_LIMIT = 64; | 
|  |  | 
|  | type | 
|  | IProtocol = interface; | 
|  | IStruct = interface; | 
|  |  | 
|  | IProtocolFactory = interface | 
|  | ['{7CD64A10-4E9F-4E99-93BF-708A31F4A67B}'] | 
|  | function GetProtocol( const trans: ITransport): IProtocol; | 
|  | end; | 
|  |  | 
|  | TThriftStringBuilder = class( TStringBuilder) | 
|  | public | 
|  | function Append(const Value: TBytes): TStringBuilder; overload; | 
|  | function Append(const Value: IThriftContainer): TStringBuilder; overload; | 
|  | end; | 
|  |  | 
|  | TProtocolException = class( Exception ) | 
|  | public | 
|  | const // TODO(jensg): change into enum | 
|  | UNKNOWN : Integer = 0; | 
|  | INVALID_DATA : Integer = 1; | 
|  | NEGATIVE_SIZE : Integer = 2; | 
|  | SIZE_LIMIT : Integer = 3; | 
|  | BAD_VERSION : Integer = 4; | 
|  | NOT_IMPLEMENTED : Integer = 5; | 
|  | DEPTH_LIMIT : Integer = 6; | 
|  | protected | 
|  | FType : Integer; | 
|  | public | 
|  | constructor Create; overload; | 
|  | constructor Create( type_: Integer ); overload; | 
|  | constructor Create( type_: Integer; const msg: string); overload; | 
|  | end; | 
|  |  | 
|  | IMap = interface | 
|  | ['{30531D97-7E06-4233-B800-C3F53CCD23E7}'] | 
|  | function GetKeyType: TType; | 
|  | procedure SetKeyType( Value: TType); | 
|  | function GetValueType: TType; | 
|  | procedure SetValueType( Value: TType); | 
|  | function GetCount: Integer; | 
|  | procedure SetCount( Value: Integer); | 
|  | property KeyType: TType read GetKeyType write SetKeyType; | 
|  | property ValueType: TType read GetValueType write SetValueType; | 
|  | property Count: Integer read GetCount write SetCount; | 
|  | end; | 
|  |  | 
|  | TMapImpl = class( TInterfacedObject, IMap) | 
|  | private | 
|  | FValueType: TType; | 
|  | FKeyType: TType; | 
|  | FCount: Integer; | 
|  | protected | 
|  | function GetKeyType: TType; | 
|  | procedure SetKeyType( Value: TType); | 
|  | function GetValueType: TType; | 
|  | procedure SetValueType( Value: TType); | 
|  | function GetCount: Integer; | 
|  | procedure SetCount( Value: Integer); | 
|  | public | 
|  | constructor Create( AKeyType, AValueType: TType; ACount: Integer); overload; | 
|  | constructor Create; overload; | 
|  | end; | 
|  |  | 
|  | IList = interface | 
|  | ['{6763E1EA-A934-4472-904F-0083980B9B87}'] | 
|  | function GetElementType: TType; | 
|  | procedure SetElementType( Value: TType); | 
|  | function GetCount: Integer; | 
|  | procedure SetCount( Value: Integer); | 
|  | property ElementType: TType read GetElementType write SetElementType; | 
|  | property Count: Integer read GetCount write SetCount; | 
|  | end; | 
|  |  | 
|  | TListImpl = class( TInterfacedObject, IList) | 
|  | private | 
|  | FElementType: TType; | 
|  | FCount : Integer; | 
|  | protected | 
|  | function GetElementType: TType; | 
|  | procedure SetElementType( Value: TType); | 
|  | function GetCount: Integer; | 
|  | procedure SetCount( Value: Integer); | 
|  | public | 
|  | constructor Create( AElementType: TType; ACount: Integer); overload; | 
|  | constructor Create; overload; | 
|  | end; | 
|  |  | 
|  | ISet = interface | 
|  | ['{A8671700-7514-4C1E-8A05-62786872005F}'] | 
|  | function GetElementType: TType; | 
|  | procedure SetElementType( Value: TType); | 
|  | function GetCount: Integer; | 
|  | procedure SetCount( Value: Integer); | 
|  | property ElementType: TType read GetElementType write SetElementType; | 
|  | property Count: Integer read GetCount write SetCount; | 
|  | end; | 
|  |  | 
|  | TSetImpl = class( TInterfacedObject, ISet) | 
|  | private | 
|  | FCount: Integer; | 
|  | FElementType: TType; | 
|  | protected | 
|  | function GetElementType: TType; | 
|  | procedure SetElementType( Value: TType); | 
|  | function GetCount: Integer; | 
|  | procedure SetCount( Value: Integer); | 
|  | public | 
|  | constructor Create( AElementType: TType; ACount: Integer); overload; | 
|  | constructor Create; overload; | 
|  | end; | 
|  |  | 
|  | IMessage = interface | 
|  | ['{9E368B4A-B1FA-43E7-8CF5-56C66D256CA7}'] | 
|  | function GetName: string; | 
|  | procedure SetName( const Value: string); | 
|  | function GetType: TMessageType; | 
|  | procedure SetType( Value: TMessageType); | 
|  | function GetSeqID: Integer; | 
|  | procedure SetSeqID( Value: Integer); | 
|  | property Name: string read GetName write SetName; | 
|  | property Type_: TMessageType read GetType write SetType; | 
|  | property SeqID: Integer read GetSeqID write SetSeqID; | 
|  | end; | 
|  |  | 
|  | TMessageImpl = class( TInterfacedObject, IMessage ) | 
|  | private | 
|  | FName: string; | 
|  | FMessageType: TMessageType; | 
|  | FSeqID: Integer; | 
|  | protected | 
|  | function GetName: string; | 
|  | procedure SetName( const Value: string); | 
|  | function GetType: TMessageType; | 
|  | procedure SetType( Value: TMessageType); | 
|  | function GetSeqID: Integer; | 
|  | procedure SetSeqID( Value: Integer); | 
|  | public | 
|  | property Name: string read FName write FName; | 
|  | property Type_: TMessageType read FMessageType write FMessageType; | 
|  | property SeqID: Integer read FSeqID write FSeqID; | 
|  | constructor Create( AName: string; AMessageType: TMessageType; ASeqID: Integer); overload; | 
|  | constructor Create; overload; | 
|  | end; | 
|  |  | 
|  | IField = interface | 
|  | ['{F0D43BE5-7883-442E-83FF-0580CC632B72}'] | 
|  | function GetName: string; | 
|  | procedure SetName( const Value: string); | 
|  | function GetType: TType; | 
|  | procedure SetType( Value: TType); | 
|  | function GetId: SmallInt; | 
|  | procedure SetId( Value: SmallInt); | 
|  | property Name: string read GetName write SetName; | 
|  | property Type_: TType read GetType write SetType; | 
|  | property Id: SmallInt read GetId write SetId; | 
|  | end; | 
|  |  | 
|  | TFieldImpl = class( TInterfacedObject, IField) | 
|  | private | 
|  | FName : string; | 
|  | FType : TType; | 
|  | FId   : SmallInt; | 
|  | protected | 
|  | function GetName: string; | 
|  | procedure SetName( const Value: string); | 
|  | function GetType: TType; | 
|  | procedure SetType( Value: TType); | 
|  | function GetId: SmallInt; | 
|  | procedure SetId( Value: SmallInt); | 
|  | public | 
|  | constructor Create( const AName: string; const AType: TType; AId: SmallInt); overload; | 
|  | constructor Create; overload; | 
|  | end; | 
|  |  | 
|  | TProtocolUtil = class | 
|  | public | 
|  | class procedure Skip( prot: IProtocol; type_: TType); | 
|  | end; | 
|  |  | 
|  | IProtocolRecursionTracker = interface | 
|  | ['{29CA033F-BB56-49B1-9EE3-31B1E82FC7A5}'] | 
|  | // no members yet | 
|  | end; | 
|  |  | 
|  | TProtocolRecursionTrackerImpl = class abstract( TInterfacedObject, IProtocolRecursionTracker) | 
|  | protected | 
|  | FProtocol : IProtocol; | 
|  | public | 
|  | constructor Create( prot : IProtocol); | 
|  | destructor Destroy; override; | 
|  | end; | 
|  |  | 
|  | IProtocol = interface | 
|  | ['{602A7FFB-0D9E-4CD8-8D7F-E5076660588A}'] | 
|  | function GetTransport: ITransport; | 
|  | procedure WriteMessageBegin( const msg: IMessage); | 
|  | procedure WriteMessageEnd; | 
|  | procedure WriteStructBegin( const struc: IStruct); | 
|  | procedure WriteStructEnd; | 
|  | procedure WriteFieldBegin( const field: IField); | 
|  | procedure WriteFieldEnd; | 
|  | procedure WriteFieldStop; | 
|  | procedure WriteMapBegin( const map: IMap); | 
|  | procedure WriteMapEnd; | 
|  | procedure WriteListBegin( const list: IList); | 
|  | procedure WriteListEnd(); | 
|  | procedure WriteSetBegin( const set_: ISet ); | 
|  | procedure WriteSetEnd(); | 
|  | procedure WriteBool( b: Boolean); | 
|  | procedure WriteByte( b: ShortInt); | 
|  | procedure WriteI16( i16: SmallInt); | 
|  | procedure WriteI32( i32: Integer); | 
|  | procedure WriteI64( const i64: Int64); | 
|  | procedure WriteDouble( const d: Double); | 
|  | procedure WriteString( const s: string ); | 
|  | procedure WriteAnsiString( const s: AnsiString); | 
|  | procedure WriteBinary( const b: TBytes); | 
|  |  | 
|  | function ReadMessageBegin: IMessage; | 
|  | procedure ReadMessageEnd(); | 
|  | function ReadStructBegin: IStruct; | 
|  | procedure ReadStructEnd; | 
|  | function ReadFieldBegin: IField; | 
|  | procedure ReadFieldEnd(); | 
|  | function ReadMapBegin: IMap; | 
|  | procedure ReadMapEnd(); | 
|  | function ReadListBegin: IList; | 
|  | procedure ReadListEnd(); | 
|  | function ReadSetBegin: ISet; | 
|  | procedure ReadSetEnd(); | 
|  | function ReadBool: Boolean; | 
|  | function ReadByte: ShortInt; | 
|  | function ReadI16: SmallInt; | 
|  | function ReadI32: Integer; | 
|  | function ReadI64: Int64; | 
|  | function ReadDouble:Double; | 
|  | function ReadBinary: TBytes; | 
|  | function ReadString: string; | 
|  | function ReadAnsiString: AnsiString; | 
|  |  | 
|  | procedure SetRecursionLimit( value : Integer); | 
|  | function  GetRecursionLimit : Integer; | 
|  | function  NextRecursionLevel : IProtocolRecursionTracker; | 
|  | procedure IncrementRecursionDepth; | 
|  | procedure DecrementRecursionDepth; | 
|  |  | 
|  | property Transport: ITransport read GetTransport; | 
|  | property RecursionLimit : Integer read GetRecursionLimit write SetRecursionLimit; | 
|  | end; | 
|  |  | 
|  | TProtocolImpl = class abstract( TInterfacedObject, IProtocol) | 
|  | protected | 
|  | FTrans : ITransport; | 
|  | FRecursionLimit : Integer; | 
|  | FRecursionDepth : Integer; | 
|  |  | 
|  | procedure SetRecursionLimit( value : Integer); | 
|  | function  GetRecursionLimit : Integer; | 
|  | function  NextRecursionLevel : IProtocolRecursionTracker; | 
|  | procedure IncrementRecursionDepth; | 
|  | procedure DecrementRecursionDepth; | 
|  |  | 
|  | function GetTransport: ITransport; | 
|  | public | 
|  | procedure WriteMessageBegin( const msg: IMessage); virtual; abstract; | 
|  | procedure WriteMessageEnd; virtual; abstract; | 
|  | procedure WriteStructBegin( const struc: IStruct); virtual; abstract; | 
|  | procedure WriteStructEnd; virtual; abstract; | 
|  | procedure WriteFieldBegin( const field: IField); virtual; abstract; | 
|  | procedure WriteFieldEnd; virtual; abstract; | 
|  | procedure WriteFieldStop; virtual; abstract; | 
|  | procedure WriteMapBegin( const map: IMap); virtual; abstract; | 
|  | procedure WriteMapEnd; virtual; abstract; | 
|  | procedure WriteListBegin( const list: IList); virtual; abstract; | 
|  | procedure WriteListEnd(); virtual; abstract; | 
|  | procedure WriteSetBegin( const set_: ISet ); virtual; abstract; | 
|  | procedure WriteSetEnd(); virtual; abstract; | 
|  | procedure WriteBool( b: Boolean); virtual; abstract; | 
|  | procedure WriteByte( b: ShortInt); virtual; abstract; | 
|  | procedure WriteI16( i16: SmallInt); virtual; abstract; | 
|  | procedure WriteI32( i32: Integer); virtual; abstract; | 
|  | procedure WriteI64( const i64: Int64); virtual; abstract; | 
|  | procedure WriteDouble( const d: Double); virtual; abstract; | 
|  | procedure WriteString( const s: string ); virtual; | 
|  | procedure WriteAnsiString( const s: AnsiString); virtual; | 
|  | procedure WriteBinary( const b: TBytes); virtual; abstract; | 
|  |  | 
|  | function ReadMessageBegin: IMessage; virtual; abstract; | 
|  | procedure ReadMessageEnd(); virtual; abstract; | 
|  | function ReadStructBegin: IStruct; virtual; abstract; | 
|  | procedure ReadStructEnd; virtual; abstract; | 
|  | function ReadFieldBegin: IField; virtual; abstract; | 
|  | procedure ReadFieldEnd(); virtual; abstract; | 
|  | function ReadMapBegin: IMap; virtual; abstract; | 
|  | procedure ReadMapEnd(); virtual; abstract; | 
|  | function ReadListBegin: IList; virtual; abstract; | 
|  | procedure ReadListEnd(); virtual; abstract; | 
|  | function ReadSetBegin: ISet; virtual; abstract; | 
|  | procedure ReadSetEnd(); virtual; abstract; | 
|  | function ReadBool: Boolean; virtual; abstract; | 
|  | function ReadByte: ShortInt; virtual; abstract; | 
|  | function ReadI16: SmallInt; virtual; abstract; | 
|  | function ReadI32: Integer; virtual; abstract; | 
|  | function ReadI64: Int64; virtual; abstract; | 
|  | function ReadDouble:Double; virtual; abstract; | 
|  | function ReadBinary: TBytes; virtual; abstract; | 
|  | function ReadString: string; virtual; | 
|  | function ReadAnsiString: AnsiString; virtual; | 
|  |  | 
|  | property Transport: ITransport read GetTransport; | 
|  |  | 
|  | constructor Create( trans: ITransport ); | 
|  | end; | 
|  |  | 
|  | IBase = interface | 
|  | ['{08D9BAA8-5EAA-410F-B50B-AC2E6E5E4155}'] | 
|  | function ToString: string; | 
|  | procedure Read( const iprot: IProtocol); | 
|  | procedure Write( const iprot: IProtocol); | 
|  | end; | 
|  |  | 
|  | IStruct = interface | 
|  | ['{5DCE39AA-C916-4BC7-A79B-96A0C36B2220}'] | 
|  | procedure SetName(const Value: string); | 
|  | function GetName: string; | 
|  | property Name: string read GetName write SetName; | 
|  | end; | 
|  |  | 
|  | TStructImpl = class( TInterfacedObject, IStruct ) | 
|  | private | 
|  | FName: string; | 
|  | protected | 
|  | function GetName: string; | 
|  | procedure SetName(const Value: string); | 
|  | public | 
|  | constructor Create( const AName: string); | 
|  | end; | 
|  |  | 
|  | TBinaryProtocolImpl = class( TProtocolImpl ) | 
|  | protected | 
|  | const | 
|  | VERSION_MASK : Cardinal = $ffff0000; | 
|  | VERSION_1 : Cardinal = $80010000; | 
|  | protected | 
|  | FStrictRead : Boolean; | 
|  | FStrictWrite : Boolean; | 
|  |  | 
|  | private | 
|  | function ReadAll( var buf: TBytes; off: Integer; len: Integer ): Integer; | 
|  | function ReadStringBody( size: Integer): string; | 
|  |  | 
|  | public | 
|  |  | 
|  | type | 
|  | TFactory = class( TInterfacedObject, IProtocolFactory) | 
|  | protected | 
|  | FStrictRead : Boolean; | 
|  | FStrictWrite : Boolean; | 
|  | public | 
|  | function GetProtocol( const trans: ITransport): IProtocol; | 
|  | constructor Create( AStrictRead, AStrictWrite: Boolean ); overload; | 
|  | constructor Create; overload; | 
|  | end; | 
|  |  | 
|  | constructor Create( const trans: ITransport); overload; | 
|  | constructor Create( const trans: ITransport; strictRead: Boolean; strictWrite: Boolean); overload; | 
|  |  | 
|  | procedure WriteMessageBegin( const msg: IMessage); override; | 
|  | procedure WriteMessageEnd; override; | 
|  | procedure WriteStructBegin( const struc: IStruct); override; | 
|  | procedure WriteStructEnd; override; | 
|  | procedure WriteFieldBegin( const field: IField); override; | 
|  | procedure WriteFieldEnd; override; | 
|  | procedure WriteFieldStop; override; | 
|  | procedure WriteMapBegin( const map: IMap); override; | 
|  | procedure WriteMapEnd; override; | 
|  | procedure WriteListBegin( const list: IList); override; | 
|  | procedure WriteListEnd(); override; | 
|  | procedure WriteSetBegin( const set_: ISet ); override; | 
|  | procedure WriteSetEnd(); override; | 
|  | procedure WriteBool( b: Boolean); override; | 
|  | procedure WriteByte( b: ShortInt); override; | 
|  | procedure WriteI16( i16: SmallInt); override; | 
|  | procedure WriteI32( i32: Integer); override; | 
|  | procedure WriteI64( const i64: Int64); override; | 
|  | procedure WriteDouble( const d: Double); override; | 
|  | procedure WriteBinary( const b: TBytes); override; | 
|  |  | 
|  | function ReadMessageBegin: IMessage; override; | 
|  | procedure ReadMessageEnd(); override; | 
|  | function ReadStructBegin: IStruct; override; | 
|  | procedure ReadStructEnd; override; | 
|  | function ReadFieldBegin: IField; override; | 
|  | procedure ReadFieldEnd(); override; | 
|  | function ReadMapBegin: IMap; override; | 
|  | procedure ReadMapEnd(); override; | 
|  | function ReadListBegin: IList; override; | 
|  | procedure ReadListEnd(); override; | 
|  | function ReadSetBegin: ISet; override; | 
|  | procedure ReadSetEnd(); override; | 
|  | function ReadBool: Boolean; override; | 
|  | function ReadByte: ShortInt; override; | 
|  | function ReadI16: SmallInt; override; | 
|  | function ReadI32: Integer; override; | 
|  | function ReadI64: Int64; override; | 
|  | function ReadDouble:Double; override; | 
|  | function ReadBinary: TBytes; override; | 
|  |  | 
|  | end; | 
|  |  | 
|  |  | 
|  | { TProtocolDecorator forwards all requests to an enclosed TProtocol instance, | 
|  | providing a way to author concise concrete decorator subclasses. The decorator | 
|  | does not (and should not) modify the behaviour of the enclosed TProtocol | 
|  |  | 
|  | See p.175 of Design Patterns (by Gamma et al.) | 
|  | } | 
|  | TProtocolDecorator = class( TProtocolImpl) | 
|  | private | 
|  | FWrappedProtocol : IProtocol; | 
|  |  | 
|  | public | 
|  | // Encloses the specified protocol. | 
|  | // All operations will be forward to the given protocol.  Must be non-null. | 
|  | constructor Create( const aProtocol : IProtocol); | 
|  |  | 
|  | procedure WriteMessageBegin( const msg: IMessage); override; | 
|  | procedure WriteMessageEnd; override; | 
|  | procedure WriteStructBegin( const struc: IStruct); override; | 
|  | procedure WriteStructEnd; override; | 
|  | procedure WriteFieldBegin( const field: IField); override; | 
|  | procedure WriteFieldEnd; override; | 
|  | procedure WriteFieldStop; override; | 
|  | procedure WriteMapBegin( const map: IMap); override; | 
|  | procedure WriteMapEnd; override; | 
|  | procedure WriteListBegin( const list: IList); override; | 
|  | procedure WriteListEnd(); override; | 
|  | procedure WriteSetBegin( const set_: ISet ); override; | 
|  | procedure WriteSetEnd(); override; | 
|  | procedure WriteBool( b: Boolean); override; | 
|  | procedure WriteByte( b: ShortInt); override; | 
|  | procedure WriteI16( i16: SmallInt); override; | 
|  | procedure WriteI32( i32: Integer); override; | 
|  | procedure WriteI64( const i64: Int64); override; | 
|  | procedure WriteDouble( const d: Double); override; | 
|  | procedure WriteString( const s: string ); override; | 
|  | procedure WriteAnsiString( const s: AnsiString); override; | 
|  | procedure WriteBinary( const b: TBytes); override; | 
|  |  | 
|  | function ReadMessageBegin: IMessage; override; | 
|  | procedure ReadMessageEnd(); override; | 
|  | function ReadStructBegin: IStruct; override; | 
|  | procedure ReadStructEnd; override; | 
|  | function ReadFieldBegin: IField; override; | 
|  | procedure ReadFieldEnd(); override; | 
|  | function ReadMapBegin: IMap; override; | 
|  | procedure ReadMapEnd(); override; | 
|  | function ReadListBegin: IList; override; | 
|  | procedure ReadListEnd(); override; | 
|  | function ReadSetBegin: ISet; override; | 
|  | procedure ReadSetEnd(); override; | 
|  | function ReadBool: Boolean; override; | 
|  | function ReadByte: ShortInt; override; | 
|  | function ReadI16: SmallInt; override; | 
|  | function ReadI32: Integer; override; | 
|  | function ReadI64: Int64; override; | 
|  | function ReadDouble:Double; override; | 
|  | function ReadBinary: TBytes; override; | 
|  | function ReadString: string; override; | 
|  | function ReadAnsiString: AnsiString; override; | 
|  | end; | 
|  |  | 
|  |  | 
|  | type | 
|  | IRequestEvents = interface | 
|  | ['{F926A26A-5B00-4560-86FA-2CAE3BA73DAF}'] | 
|  | // Called before reading arguments. | 
|  | procedure PreRead; | 
|  | // Called between reading arguments and calling the handler. | 
|  | procedure PostRead; | 
|  | // Called between calling the handler and writing the response. | 
|  | procedure PreWrite; | 
|  | // Called after writing the response. | 
|  | procedure PostWrite; | 
|  | // Called when an oneway (async) function call completes successfully. | 
|  | procedure OnewayComplete; | 
|  | // Called if the handler throws an undeclared exception. | 
|  | procedure UnhandledError( const e : Exception); | 
|  | // Called when a client has finished request-handling to clean up | 
|  | procedure CleanupContext; | 
|  | end; | 
|  |  | 
|  |  | 
|  | IProcessorEvents = interface | 
|  | ['{A8661119-657C-447D-93C5-512E36162A45}'] | 
|  | // Called when a client is about to call the processor. | 
|  | procedure Processing( const transport : ITransport); | 
|  | // Called on any service function invocation | 
|  | function  CreateRequestContext( const aFunctionName : string) : IRequestEvents; | 
|  | // Called when a client has finished request-handling to clean up | 
|  | procedure CleanupContext; | 
|  | end; | 
|  |  | 
|  |  | 
|  | IProcessor = interface | 
|  | ['{7BAE92A5-46DA-4F13-B6EA-0EABE233EE5F}'] | 
|  | function Process( const iprot :IProtocol; const oprot: IProtocol; const events : IProcessorEvents = nil): Boolean; | 
|  | end; | 
|  |  | 
|  |  | 
|  |  | 
|  | implementation | 
|  |  | 
|  | function ConvertInt64ToDouble( const n: Int64): Double; | 
|  | begin | 
|  | ASSERT( SizeOf(n) = SizeOf(Result)); | 
|  | System.Move( n, Result, SizeOf(Result)); | 
|  | end; | 
|  |  | 
|  | function ConvertDoubleToInt64( const d: Double): Int64; | 
|  | begin | 
|  | ASSERT( SizeOf(d) = SizeOf(Result)); | 
|  | System.Move( d, Result, SizeOf(Result)); | 
|  | end; | 
|  |  | 
|  | { TFieldImpl } | 
|  |  | 
|  | constructor TFieldImpl.Create(const AName: string; const AType: TType; | 
|  | AId: SmallInt); | 
|  | begin | 
|  | inherited Create; | 
|  | FName := AName; | 
|  | FType := AType; | 
|  | FId := AId; | 
|  | end; | 
|  |  | 
|  | constructor TFieldImpl.Create; | 
|  | begin | 
|  | inherited Create; | 
|  | FName := ''; | 
|  | FType := Low(TType); | 
|  | FId   := 0; | 
|  | end; | 
|  |  | 
|  | function TFieldImpl.GetId: SmallInt; | 
|  | begin | 
|  | Result := FId; | 
|  | end; | 
|  |  | 
|  | function TFieldImpl.GetName: string; | 
|  | begin | 
|  | Result := FName; | 
|  | end; | 
|  |  | 
|  | function TFieldImpl.GetType: TType; | 
|  | begin | 
|  | Result := FType; | 
|  | end; | 
|  |  | 
|  | procedure TFieldImpl.SetId(Value: SmallInt); | 
|  | begin | 
|  | FId := Value; | 
|  | end; | 
|  |  | 
|  | procedure TFieldImpl.SetName(const Value: string); | 
|  | begin | 
|  | FName := Value; | 
|  | end; | 
|  |  | 
|  | procedure TFieldImpl.SetType(Value: TType); | 
|  | begin | 
|  | FType := Value; | 
|  | end; | 
|  |  | 
|  | { TProtocolRecursionTrackerImpl } | 
|  |  | 
|  | constructor TProtocolRecursionTrackerImpl.Create( prot : IProtocol); | 
|  | begin | 
|  | inherited Create; | 
|  |  | 
|  | // storing the pointer *after* the (successful) increment is important here | 
|  | prot.IncrementRecursionDepth; | 
|  | FProtocol := prot; | 
|  | end; | 
|  |  | 
|  | destructor TProtocolRecursionTrackerImpl.Destroy; | 
|  | begin | 
|  | try | 
|  | // we have to release the reference iff the pointer has been stored | 
|  | if FProtocol <> nil then begin | 
|  | FProtocol.DecrementRecursionDepth; | 
|  | FProtocol := nil; | 
|  | end; | 
|  | finally | 
|  | inherited Destroy; | 
|  | end; | 
|  | end; | 
|  |  | 
|  | { TProtocolImpl } | 
|  |  | 
|  | constructor TProtocolImpl.Create(trans: ITransport); | 
|  | begin | 
|  | inherited Create; | 
|  | FTrans := trans; | 
|  | FRecursionLimit := DEFAULT_RECURSION_LIMIT; | 
|  | FRecursionDepth := 0; | 
|  | end; | 
|  |  | 
|  | procedure TProtocolImpl.SetRecursionLimit( value : Integer); | 
|  | begin | 
|  | FRecursionLimit := value; | 
|  | end; | 
|  |  | 
|  | function TProtocolImpl.GetRecursionLimit : Integer; | 
|  | begin | 
|  | result := FRecursionLimit; | 
|  | end; | 
|  |  | 
|  | function TProtocolImpl.NextRecursionLevel : IProtocolRecursionTracker; | 
|  | begin | 
|  | result := TProtocolRecursionTrackerImpl.Create(Self); | 
|  | end; | 
|  |  | 
|  | procedure TProtocolImpl.IncrementRecursionDepth; | 
|  | begin | 
|  | if FRecursionDepth < FRecursionLimit | 
|  | then Inc(FRecursionDepth) | 
|  | else raise TProtocolException.Create( TProtocolException.DEPTH_LIMIT, 'Depth limit exceeded'); | 
|  | end; | 
|  |  | 
|  | procedure TProtocolImpl.DecrementRecursionDepth; | 
|  | begin | 
|  | Dec(FRecursionDepth) | 
|  | end; | 
|  |  | 
|  | function TProtocolImpl.GetTransport: ITransport; | 
|  | begin | 
|  | Result := FTrans; | 
|  | end; | 
|  |  | 
|  | function TProtocolImpl.ReadAnsiString: AnsiString; | 
|  | var | 
|  | b : TBytes; | 
|  | len : Integer; | 
|  | begin | 
|  | Result := ''; | 
|  | b := ReadBinary; | 
|  | len := Length( b ); | 
|  | if len > 0 then | 
|  | begin | 
|  | SetLength( Result, len); | 
|  | System.Move( b[0], Pointer(Result)^, len ); | 
|  | end; | 
|  | end; | 
|  |  | 
|  | function TProtocolImpl.ReadString: string; | 
|  | begin | 
|  | Result := TEncoding.UTF8.GetString( ReadBinary ); | 
|  | end; | 
|  |  | 
|  | procedure TProtocolImpl.WriteAnsiString(const s: AnsiString); | 
|  | var | 
|  | b : TBytes; | 
|  | len : Integer; | 
|  | begin | 
|  | len := Length(s); | 
|  | SetLength( b, len); | 
|  | if len > 0 then | 
|  | begin | 
|  | System.Move( Pointer(s)^, b[0], len ); | 
|  | end; | 
|  | WriteBinary( b ); | 
|  | end; | 
|  |  | 
|  | procedure TProtocolImpl.WriteString(const s: string); | 
|  | var | 
|  | b : TBytes; | 
|  | begin | 
|  | b := TEncoding.UTF8.GetBytes(s); | 
|  | WriteBinary( b ); | 
|  | end; | 
|  |  | 
|  | { TProtocolUtil } | 
|  |  | 
|  | class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType); | 
|  | var field : IField; | 
|  | map   : IMap; | 
|  | set_  : ISet; | 
|  | list  : IList; | 
|  | i     : Integer; | 
|  | tracker : IProtocolRecursionTracker; | 
|  | begin | 
|  | tracker := prot.NextRecursionLevel; | 
|  | case type_ of | 
|  | // simple types | 
|  | TType.Bool_   :  prot.ReadBool(); | 
|  | TType.Byte_   :  prot.ReadByte(); | 
|  | TType.I16     :  prot.ReadI16(); | 
|  | TType.I32     :  prot.ReadI32(); | 
|  | TType.I64     :  prot.ReadI64(); | 
|  | TType.Double_ :  prot.ReadDouble(); | 
|  | TType.String_ :  prot.ReadBinary();// Don't try to decode the string, just skip it. | 
|  |  | 
|  | // structured types | 
|  | TType.Struct :  begin | 
|  | prot.ReadStructBegin(); | 
|  | while TRUE do begin | 
|  | field := prot.ReadFieldBegin(); | 
|  | if (field.Type_ = TType.Stop) then Break; | 
|  | Skip(prot, field.Type_); | 
|  | prot.ReadFieldEnd(); | 
|  | end; | 
|  | prot.ReadStructEnd(); | 
|  | end; | 
|  |  | 
|  | TType.Map :  begin | 
|  | map := prot.ReadMapBegin(); | 
|  | for i := 0 to map.Count-1 do begin | 
|  | Skip(prot, map.KeyType); | 
|  | Skip(prot, map.ValueType); | 
|  | end; | 
|  | prot.ReadMapEnd(); | 
|  | end; | 
|  |  | 
|  | TType.Set_ :  begin | 
|  | set_ := prot.ReadSetBegin(); | 
|  | for i := 0 to set_.Count-1 | 
|  | do Skip( prot, set_.ElementType); | 
|  | prot.ReadSetEnd(); | 
|  | end; | 
|  |  | 
|  | TType.List :  begin | 
|  | list := prot.ReadListBegin(); | 
|  | for i := 0 to list.Count-1 | 
|  | do Skip( prot, list.ElementType); | 
|  | prot.ReadListEnd(); | 
|  | end; | 
|  |  | 
|  | else | 
|  | ASSERT( FALSE); // any new types? | 
|  | end; | 
|  | end; | 
|  |  | 
|  | { TStructImpl } | 
|  |  | 
|  | constructor TStructImpl.Create(const AName: string); | 
|  | begin | 
|  | inherited Create; | 
|  | FName := AName; | 
|  | end; | 
|  |  | 
|  | function TStructImpl.GetName: string; | 
|  | begin | 
|  | Result := FName; | 
|  | end; | 
|  |  | 
|  | procedure TStructImpl.SetName(const Value: string); | 
|  | begin | 
|  | FName := Value; | 
|  | end; | 
|  |  | 
|  | { TMapImpl } | 
|  |  | 
|  | constructor TMapImpl.Create( AKeyType, AValueType: TType; ACount: Integer); | 
|  | begin | 
|  | inherited Create; | 
|  | FValueType := AValueType; | 
|  | FKeyType := AKeyType; | 
|  | FCount := ACount; | 
|  | end; | 
|  |  | 
|  | constructor TMapImpl.Create; | 
|  | begin | 
|  | inherited Create; | 
|  | end; | 
|  |  | 
|  | function TMapImpl.GetCount: Integer; | 
|  | begin | 
|  | Result := FCount; | 
|  | end; | 
|  |  | 
|  | function TMapImpl.GetKeyType: TType; | 
|  | begin | 
|  | Result := FKeyType; | 
|  | end; | 
|  |  | 
|  | function TMapImpl.GetValueType: TType; | 
|  | begin | 
|  | Result := FValueType; | 
|  | end; | 
|  |  | 
|  | procedure TMapImpl.SetCount(Value: Integer); | 
|  | begin | 
|  | FCount := Value; | 
|  | end; | 
|  |  | 
|  | procedure TMapImpl.SetKeyType(Value: TType); | 
|  | begin | 
|  | FKeyType := Value; | 
|  | end; | 
|  |  | 
|  | procedure TMapImpl.SetValueType(Value: TType); | 
|  | begin | 
|  | FValueType := Value; | 
|  | end; | 
|  |  | 
|  | { IMessage } | 
|  |  | 
|  | constructor TMessageImpl.Create(AName: string; AMessageType: TMessageType; | 
|  | ASeqID: Integer); | 
|  | begin | 
|  | inherited Create; | 
|  | FName := AName; | 
|  | FMessageType := AMessageType; | 
|  | FSeqID := ASeqID; | 
|  | end; | 
|  |  | 
|  | constructor TMessageImpl.Create; | 
|  | begin | 
|  | inherited; | 
|  | end; | 
|  |  | 
|  | function TMessageImpl.GetName: string; | 
|  | begin | 
|  | Result := FName; | 
|  | end; | 
|  |  | 
|  | function TMessageImpl.GetSeqID: Integer; | 
|  | begin | 
|  | Result := FSeqID; | 
|  | end; | 
|  |  | 
|  | function TMessageImpl.GetType: TMessageType; | 
|  | begin | 
|  | Result := FMessageType; | 
|  | end; | 
|  |  | 
|  | procedure TMessageImpl.SetName(const Value: string); | 
|  | begin | 
|  | FName := Value; | 
|  | end; | 
|  |  | 
|  | procedure TMessageImpl.SetSeqID(Value: Integer); | 
|  | begin | 
|  | FSeqID := Value; | 
|  | end; | 
|  |  | 
|  | procedure TMessageImpl.SetType(Value: TMessageType); | 
|  | begin | 
|  | FMessageType := Value; | 
|  | end; | 
|  |  | 
|  | { ISet } | 
|  |  | 
|  | constructor TSetImpl.Create( AElementType: TType; ACount: Integer); | 
|  | begin | 
|  | inherited Create; | 
|  | FCount := ACount; | 
|  | FElementType := AElementType; | 
|  | end; | 
|  |  | 
|  | constructor TSetImpl.Create; | 
|  | begin | 
|  | inherited Create; | 
|  | end; | 
|  |  | 
|  | function TSetImpl.GetCount: Integer; | 
|  | begin | 
|  | Result := FCount; | 
|  | end; | 
|  |  | 
|  | function TSetImpl.GetElementType: TType; | 
|  | begin | 
|  | Result := FElementType; | 
|  | end; | 
|  |  | 
|  | procedure TSetImpl.SetCount(Value: Integer); | 
|  | begin | 
|  | FCount := Value; | 
|  | end; | 
|  |  | 
|  | procedure TSetImpl.SetElementType(Value: TType); | 
|  | begin | 
|  | FElementType := Value; | 
|  | end; | 
|  |  | 
|  | { IList } | 
|  |  | 
|  | constructor TListImpl.Create( AElementType: TType; ACount: Integer); | 
|  | begin | 
|  | inherited Create; | 
|  | FCount := ACount; | 
|  | FElementType := AElementType; | 
|  | end; | 
|  |  | 
|  | constructor TListImpl.Create; | 
|  | begin | 
|  | inherited Create; | 
|  | end; | 
|  |  | 
|  | function TListImpl.GetCount: Integer; | 
|  | begin | 
|  | Result := FCount; | 
|  | end; | 
|  |  | 
|  | function TListImpl.GetElementType: TType; | 
|  | begin | 
|  | Result := FElementType; | 
|  | end; | 
|  |  | 
|  | procedure TListImpl.SetCount(Value: Integer); | 
|  | begin | 
|  | FCount := Value; | 
|  | end; | 
|  |  | 
|  | procedure TListImpl.SetElementType(Value: TType); | 
|  | begin | 
|  | FElementType := Value; | 
|  | end; | 
|  |  | 
|  | { TBinaryProtocolImpl } | 
|  |  | 
|  | constructor TBinaryProtocolImpl.Create( const trans: ITransport); | 
|  | begin | 
|  | //no inherited | 
|  | Create( trans, False, True); | 
|  | end; | 
|  |  | 
|  | constructor TBinaryProtocolImpl.Create( const trans: ITransport; strictRead, | 
|  | strictWrite: Boolean); | 
|  | begin | 
|  | inherited Create( trans ); | 
|  | FStrictRead := strictRead; | 
|  | FStrictWrite := strictWrite; | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadAll( var buf: TBytes; off, | 
|  | len: Integer): Integer; | 
|  | begin | 
|  | Result := FTrans.ReadAll( buf, off, len ); | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadBinary: TBytes; | 
|  | var | 
|  | size : Integer; | 
|  | buf : TBytes; | 
|  | begin | 
|  | size := ReadI32; | 
|  | SetLength( buf, size ); | 
|  | FTrans.ReadAll( buf, 0, size); | 
|  | Result := buf; | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadBool: Boolean; | 
|  | begin | 
|  | Result := ReadByte = 1; | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadByte: ShortInt; | 
|  | var | 
|  | bin : TBytes; | 
|  | begin | 
|  | SetLength( bin, 1); | 
|  | ReadAll( bin, 0, 1 ); | 
|  | Result := ShortInt( bin[0]); | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadDouble: Double; | 
|  | begin | 
|  | Result := ConvertInt64ToDouble( ReadI64 ) | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadFieldBegin: IField; | 
|  | var | 
|  | field : IField; | 
|  | begin | 
|  | field := TFieldImpl.Create; | 
|  | field.Type_ := TType( ReadByte); | 
|  | if ( field.Type_ <> TType.Stop ) then | 
|  | begin | 
|  | field.Id := ReadI16; | 
|  | end; | 
|  | Result := field; | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.ReadFieldEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadI16: SmallInt; | 
|  | var | 
|  | i16in : TBytes; | 
|  | begin | 
|  | SetLength( i16in, 2 ); | 
|  | ReadAll( i16in, 0, 2); | 
|  | Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF)); | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadI32: Integer; | 
|  | var | 
|  | i32in : TBytes; | 
|  | begin | 
|  | SetLength( i32in, 4 ); | 
|  | ReadAll( i32in, 0, 4); | 
|  |  | 
|  | Result := Integer( | 
|  | ((i32in[0] and $FF) shl 24) or | 
|  | ((i32in[1] and $FF) shl 16) or | 
|  | ((i32in[2] and $FF) shl 8) or | 
|  | (i32in[3] and $FF)); | 
|  |  | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadI64: Int64; | 
|  | var | 
|  | i64in : TBytes; | 
|  | begin | 
|  | SetLength( i64in, 8); | 
|  | ReadAll( i64in, 0, 8); | 
|  | Result := | 
|  | (Int64( i64in[0] and $FF) shl 56) or | 
|  | (Int64( i64in[1] and $FF) shl 48) or | 
|  | (Int64( i64in[2] and $FF) shl 40) or | 
|  | (Int64( i64in[3] and $FF) shl 32) or | 
|  | (Int64( i64in[4] and $FF) shl 24) or | 
|  | (Int64( i64in[5] and $FF) shl 16) or | 
|  | (Int64( i64in[6] and $FF) shl 8) or | 
|  | (Int64( i64in[7] and $FF)); | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadListBegin: IList; | 
|  | var | 
|  | list : IList; | 
|  | begin | 
|  | list := TListImpl.Create; | 
|  | list.ElementType := TType( ReadByte ); | 
|  | list.Count := ReadI32; | 
|  | Result := list; | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.ReadListEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadMapBegin: IMap; | 
|  | var | 
|  | map : IMap; | 
|  | begin | 
|  | map := TMapImpl.Create; | 
|  | map.KeyType := TType( ReadByte ); | 
|  | map.ValueType := TType( ReadByte ); | 
|  | map.Count := ReadI32; | 
|  | Result := map; | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.ReadMapEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadMessageBegin: IMessage; | 
|  | var | 
|  | size : Integer; | 
|  | version : Integer; | 
|  | message : IMessage; | 
|  | begin | 
|  | message := TMessageImpl.Create; | 
|  | size := ReadI32; | 
|  | if (size < 0) then | 
|  | begin | 
|  | version := size and Integer( VERSION_MASK); | 
|  | if ( version <> Integer( VERSION_1)) then | 
|  | begin | 
|  | raise TProtocolException.Create(TProtocolException.BAD_VERSION, 'Bad version in ReadMessageBegin: ' + IntToStr(version) ); | 
|  | end; | 
|  | message.Type_ := TMessageType( size and $000000ff); | 
|  | message.Name := ReadString; | 
|  | message.SeqID := ReadI32; | 
|  | end else | 
|  | begin | 
|  | if FStrictRead then | 
|  | begin | 
|  | raise TProtocolException.Create( TProtocolException.BAD_VERSION, 'Missing version in readMessageBegin, old client?' ); | 
|  | end; | 
|  | message.Name := ReadStringBody( size ); | 
|  | message.Type_ := TMessageType( ReadByte ); | 
|  | message.SeqID := ReadI32; | 
|  | end; | 
|  | Result := message; | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.ReadMessageEnd; | 
|  | begin | 
|  | inherited; | 
|  |  | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadSetBegin: ISet; | 
|  | var | 
|  | set_ : ISet; | 
|  | begin | 
|  | set_ := TSetImpl.Create; | 
|  | set_.ElementType := TType( ReadByte ); | 
|  | set_.Count := ReadI32; | 
|  | Result := set_; | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.ReadSetEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadStringBody( size: Integer): string; | 
|  | var | 
|  | buf : TBytes; | 
|  | begin | 
|  | SetLength( buf, size ); | 
|  | FTrans.ReadAll( buf, 0, size ); | 
|  | Result := TEncoding.UTF8.GetString( buf); | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.ReadStructBegin: IStruct; | 
|  | begin | 
|  | Result := TStructImpl.Create(''); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.ReadStructEnd; | 
|  | begin | 
|  | inherited; | 
|  |  | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteBinary( const b: TBytes); | 
|  | var iLen : Integer; | 
|  | begin | 
|  | iLen := Length(b); | 
|  | WriteI32( iLen); | 
|  | if iLen > 0 then FTrans.Write(b, 0, iLen); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteBool(b: Boolean); | 
|  | begin | 
|  | if b then | 
|  | begin | 
|  | WriteByte( 1 ); | 
|  | end else | 
|  | begin | 
|  | WriteByte( 0 ); | 
|  | end; | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteByte(b: ShortInt); | 
|  | var | 
|  | a : TBytes; | 
|  | begin | 
|  | SetLength( a, 1); | 
|  | a[0] := Byte( b ); | 
|  | FTrans.Write( a, 0, 1 ); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteDouble( const d: Double); | 
|  | begin | 
|  | WriteI64(ConvertDoubleToInt64(d)); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteFieldBegin( const field: IField); | 
|  | begin | 
|  | WriteByte(ShortInt(field.Type_)); | 
|  | WriteI16(field.ID); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteFieldEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteFieldStop; | 
|  | begin | 
|  | WriteByte(ShortInt(TType.Stop)); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteI16(i16: SmallInt); | 
|  | var | 
|  | i16out : TBytes; | 
|  | begin | 
|  | SetLength( i16out, 2); | 
|  | i16out[0] := Byte($FF and (i16 shr 8)); | 
|  | i16out[1] := Byte($FF and i16); | 
|  | FTrans.Write( i16out ); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteI32(i32: Integer); | 
|  | var | 
|  | i32out : TBytes; | 
|  | begin | 
|  | SetLength( i32out, 4); | 
|  | i32out[0] := Byte($FF and (i32 shr 24)); | 
|  | i32out[1] := Byte($FF and (i32 shr 16)); | 
|  | i32out[2] := Byte($FF and (i32 shr 8)); | 
|  | i32out[3] := Byte($FF and i32); | 
|  | FTrans.Write( i32out, 0, 4); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteI64( const i64: Int64); | 
|  | var | 
|  | i64out : TBytes; | 
|  | begin | 
|  | SetLength( i64out, 8); | 
|  | i64out[0] := Byte($FF and (i64 shr 56)); | 
|  | i64out[1] := Byte($FF and (i64 shr 48)); | 
|  | i64out[2] := Byte($FF and (i64 shr 40)); | 
|  | i64out[3] := Byte($FF and (i64 shr 32)); | 
|  | i64out[4] := Byte($FF and (i64 shr 24)); | 
|  | i64out[5] := Byte($FF and (i64 shr 16)); | 
|  | i64out[6] := Byte($FF and (i64 shr 8)); | 
|  | i64out[7] := Byte($FF and i64); | 
|  | FTrans.Write( i64out, 0, 8); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteListBegin( const list: IList); | 
|  | begin | 
|  | WriteByte(ShortInt(list.ElementType)); | 
|  | WriteI32(list.Count); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteListEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteMapBegin( const map: IMap); | 
|  | begin | 
|  | WriteByte(ShortInt(map.KeyType)); | 
|  | WriteByte(ShortInt(map.ValueType)); | 
|  | WriteI32(map.Count); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteMapEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteMessageBegin( const msg: IMessage); | 
|  | var | 
|  | version : Cardinal; | 
|  | begin | 
|  | if FStrictWrite then | 
|  | begin | 
|  | version := VERSION_1 or Cardinal( msg.Type_); | 
|  | WriteI32( Integer( version) ); | 
|  | WriteString( msg.Name); | 
|  | WriteI32( msg.SeqID); | 
|  | end else | 
|  | begin | 
|  | WriteString( msg.Name); | 
|  | WriteByte(ShortInt( msg.Type_)); | 
|  | WriteI32( msg.SeqID); | 
|  | end; | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteMessageEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteSetBegin( const set_: ISet); | 
|  | begin | 
|  | WriteByte(ShortInt(set_.ElementType)); | 
|  | WriteI32(set_.Count); | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteSetEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteStructBegin( const struc: IStruct); | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | procedure TBinaryProtocolImpl.WriteStructEnd; | 
|  | begin | 
|  |  | 
|  | end; | 
|  |  | 
|  | { TProtocolException } | 
|  |  | 
|  | constructor TProtocolException.Create; | 
|  | begin | 
|  | inherited Create(''); | 
|  | FType := UNKNOWN; | 
|  | end; | 
|  |  | 
|  | constructor TProtocolException.Create(type_: Integer); | 
|  | begin | 
|  | inherited Create(''); | 
|  | FType := type_; | 
|  | end; | 
|  |  | 
|  | constructor TProtocolException.Create(type_: Integer; const msg: string); | 
|  | begin | 
|  | inherited Create( msg ); | 
|  | FType := type_; | 
|  | end; | 
|  |  | 
|  | { TThriftStringBuilder } | 
|  |  | 
|  | function TThriftStringBuilder.Append(const Value: TBytes): TStringBuilder; | 
|  | begin | 
|  | Result := Append( string( RawByteString(Value)) ); | 
|  | end; | 
|  |  | 
|  | function TThriftStringBuilder.Append( | 
|  | const Value: IThriftContainer): TStringBuilder; | 
|  | begin | 
|  | Result := Append( Value.ToString ); | 
|  | end; | 
|  |  | 
|  | { TBinaryProtocolImpl.TFactory } | 
|  |  | 
|  | constructor TBinaryProtocolImpl.TFactory.Create(AStrictRead, AStrictWrite: Boolean); | 
|  | begin | 
|  | inherited Create; | 
|  | FStrictRead := AStrictRead; | 
|  | FStrictWrite := AStrictWrite; | 
|  | end; | 
|  |  | 
|  | constructor TBinaryProtocolImpl.TFactory.Create; | 
|  | begin | 
|  | //no inherited; | 
|  | Create( False, True ) | 
|  | end; | 
|  |  | 
|  | function TBinaryProtocolImpl.TFactory.GetProtocol( const trans: ITransport): IProtocol; | 
|  | begin | 
|  | Result := TBinaryProtocolImpl.Create( trans, FStrictRead, FStrictWrite); | 
|  | end; | 
|  |  | 
|  |  | 
|  | { TProtocolDecorator } | 
|  |  | 
|  | constructor TProtocolDecorator.Create( const aProtocol : IProtocol); | 
|  | begin | 
|  | ASSERT( aProtocol <> nil); | 
|  | inherited Create( aProtocol.Transport); | 
|  | FWrappedProtocol := aProtocol; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteMessageBegin( const msg: IMessage); | 
|  | begin | 
|  | FWrappedProtocol.WriteMessageBegin( msg); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteMessageEnd; | 
|  | begin | 
|  | FWrappedProtocol.WriteMessageEnd; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteStructBegin( const struc: IStruct); | 
|  | begin | 
|  | FWrappedProtocol.WriteStructBegin( struc); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteStructEnd; | 
|  | begin | 
|  | FWrappedProtocol.WriteStructEnd; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteFieldBegin( const field: IField); | 
|  | begin | 
|  | FWrappedProtocol.WriteFieldBegin( field); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteFieldEnd; | 
|  | begin | 
|  | FWrappedProtocol.WriteFieldEnd; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteFieldStop; | 
|  | begin | 
|  | FWrappedProtocol.WriteFieldStop; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteMapBegin( const map: IMap); | 
|  | begin | 
|  | FWrappedProtocol.WriteMapBegin( map); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteMapEnd; | 
|  | begin | 
|  | FWrappedProtocol.WriteMapEnd; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteListBegin( const list: IList); | 
|  | begin | 
|  | FWrappedProtocol.WriteListBegin( list); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteListEnd(); | 
|  | begin | 
|  | FWrappedProtocol.WriteListEnd(); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteSetBegin( const set_: ISet ); | 
|  | begin | 
|  | FWrappedProtocol.WriteSetBegin( set_); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteSetEnd(); | 
|  | begin | 
|  | FWrappedProtocol.WriteSetEnd(); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteBool( b: Boolean); | 
|  | begin | 
|  | FWrappedProtocol.WriteBool( b); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteByte( b: ShortInt); | 
|  | begin | 
|  | FWrappedProtocol.WriteByte( b); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteI16( i16: SmallInt); | 
|  | begin | 
|  | FWrappedProtocol.WriteI16( i16); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteI32( i32: Integer); | 
|  | begin | 
|  | FWrappedProtocol.WriteI32( i32); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteI64( const i64: Int64); | 
|  | begin | 
|  | FWrappedProtocol.WriteI64( i64); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteDouble( const d: Double); | 
|  | begin | 
|  | FWrappedProtocol.WriteDouble( d); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteString( const s: string ); | 
|  | begin | 
|  | FWrappedProtocol.WriteString( s); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteAnsiString( const s: AnsiString); | 
|  | begin | 
|  | FWrappedProtocol.WriteAnsiString( s); | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.WriteBinary( const b: TBytes); | 
|  | begin | 
|  | FWrappedProtocol.WriteBinary( b); | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadMessageBegin: IMessage; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadMessageBegin; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.ReadMessageEnd(); | 
|  | begin | 
|  | FWrappedProtocol.ReadMessageEnd(); | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadStructBegin: IStruct; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadStructBegin; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.ReadStructEnd; | 
|  | begin | 
|  | FWrappedProtocol.ReadStructEnd; | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadFieldBegin: IField; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadFieldBegin; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.ReadFieldEnd(); | 
|  | begin | 
|  | FWrappedProtocol.ReadFieldEnd(); | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadMapBegin: IMap; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadMapBegin; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.ReadMapEnd(); | 
|  | begin | 
|  | FWrappedProtocol.ReadMapEnd(); | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadListBegin: IList; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadListBegin; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.ReadListEnd(); | 
|  | begin | 
|  | FWrappedProtocol.ReadListEnd(); | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadSetBegin: ISet; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadSetBegin; | 
|  | end; | 
|  |  | 
|  |  | 
|  | procedure TProtocolDecorator.ReadSetEnd(); | 
|  | begin | 
|  | FWrappedProtocol.ReadSetEnd(); | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadBool: Boolean; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadBool; | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadByte: ShortInt; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadByte; | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadI16: SmallInt; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadI16; | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadI32: Integer; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadI32; | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadI64: Int64; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadI64; | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadDouble:Double; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadDouble; | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadBinary: TBytes; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadBinary; | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadString: string; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadString; | 
|  | end; | 
|  |  | 
|  |  | 
|  | function TProtocolDecorator.ReadAnsiString: AnsiString; | 
|  | begin | 
|  | result := FWrappedProtocol.ReadAnsiString; | 
|  | end; | 
|  |  | 
|  |  | 
|  |  | 
|  | end. | 
|  |  |