THRIFT-4318 Delphi performance improvements
Client: Delphi
Patch: Jens Geyer
This closes #1348
diff --git a/lib/delphi/src/Thrift.Processor.Multiplex.pas b/lib/delphi/src/Thrift.Processor.Multiplex.pas
index 756daa1..4cd80ba 100644
--- a/lib/delphi/src/Thrift.Processor.Multiplex.pas
+++ b/lib/delphi/src/Thrift.Processor.Multiplex.pas
@@ -68,16 +68,16 @@
// the standard format, without the service name prepended to TMessage.name.
TStoredMessageProtocol = class( TProtocolDecorator)
private
- FMessageBegin : IMessage;
+ FMessageBegin : TThriftMessage;
public
- constructor Create( const protocol : IProtocol; const aMsgBegin : IMessage);
- function ReadMessageBegin: IMessage; override;
+ constructor Create( const protocol : IProtocol; const aMsgBegin : TThriftMessage);
+ function ReadMessageBegin: TThriftMessage; override;
end;
private
FServiceProcessorMap : TDictionary<String, IProcessor>;
- procedure Error( const oprot : IProtocol; const msg : IMessage;
+ procedure Error( const oprot : IProtocol; const msg : TThriftMessage;
extype : TApplicationExceptionSpecializedClass; const etxt : string);
public
@@ -105,14 +105,14 @@
implementation
-constructor TMultiplexedProcessorImpl.TStoredMessageProtocol.Create( const protocol : IProtocol; const aMsgBegin : IMessage);
+constructor TMultiplexedProcessorImpl.TStoredMessageProtocol.Create( const protocol : IProtocol; const aMsgBegin : TThriftMessage);
begin
inherited Create( protocol);
FMessageBegin := aMsgBegin;
end;
-function TMultiplexedProcessorImpl.TStoredMessageProtocol.ReadMessageBegin: IMessage;
+function TMultiplexedProcessorImpl.TStoredMessageProtocol.ReadMessageBegin: TThriftMessage;
begin
result := FMessageBegin;
end;
@@ -141,15 +141,15 @@
end;
-procedure TMultiplexedProcessorImpl.Error( const oprot : IProtocol; const msg : IMessage;
+procedure TMultiplexedProcessorImpl.Error( const oprot : IProtocol; const msg : TThriftMessage;
extype : TApplicationExceptionSpecializedClass;
const etxt : string);
var appex : TApplicationException;
- newMsg : IMessage;
+ newMsg : TThriftMessage;
begin
appex := extype.Create(etxt);
try
- newMsg := TMessageImpl.Create( msg.Name, TMessageType.Exception, msg.SeqID);
+ Init( newMsg, msg.Name, TMessageType.Exception, msg.SeqID);
oprot.WriteMessageBegin(newMsg);
appex.Write(oprot);
@@ -163,7 +163,7 @@
function TMultiplexedProcessorImpl.Process(const iprot, oprot : IProtocol; const events : IProcessorEvents = nil): Boolean;
-var msg, newMsg : IMessage;
+var msg, newMsg : TThriftMessage;
idx : Integer;
sService : string;
processor : IProcessor;
@@ -204,7 +204,7 @@
// Create a new TMessage, removing the service name
Inc( idx, Length(TMultiplexedProtocol.SEPARATOR));
- newMsg := TMessageImpl.Create( Copy( msg.Name, idx, MAXINT), msg.Type_, msg.SeqID);
+ Init( newMsg, Copy( msg.Name, idx, MAXINT), msg.Type_, msg.SeqID);
// Dispatch processing to the stored processor
protocol := TStoredMessageProtocol.Create( iprot, newMsg);
diff --git a/lib/delphi/src/Thrift.Protocol.Compact.pas b/lib/delphi/src/Thrift.Protocol.Compact.pas
index e9944d6..5b1253a 100644
--- a/lib/delphi/src/Thrift.Protocol.Compact.pas
+++ b/lib/delphi/src/Thrift.Protocol.Compact.pas
@@ -123,7 +123,7 @@
// If we encounter a boolean field begin, save the TField here so it can
// have the value incorporated.
- private booleanField_ : IField;
+ private booleanField_ : TThriftField;
// If we Read a field header, and it's a boolean field, save the boolean
// value here so that ReadBool can use it.
@@ -148,21 +148,21 @@
private
// The workhorse of WriteFieldBegin. It has the option of doing a 'type override'
// of the type header. This is used specifically in the boolean field case.
- procedure WriteFieldBeginInternal( const field : IField; typeOverride : Byte);
+ procedure WriteFieldBeginInternal( const field : TThriftField; typeOverride : Byte);
public
- procedure WriteMessageBegin( const msg: IMessage); override;
+ procedure WriteMessageBegin( const msg: TThriftMessage); override;
procedure WriteMessageEnd; override;
- procedure WriteStructBegin( const struc: IStruct); override;
+ procedure WriteStructBegin( const struc: TThriftStruct); override;
procedure WriteStructEnd; override;
- procedure WriteFieldBegin( const field: IField); override;
+ procedure WriteFieldBegin( const field: TThriftField); override;
procedure WriteFieldEnd; override;
procedure WriteFieldStop; override;
- procedure WriteMapBegin( const map: IMap); override;
+ procedure WriteMapBegin( const map: TThriftMap); override;
procedure WriteMapEnd; override;
- procedure WriteListBegin( const list: IList); override;
+ procedure WriteListBegin( const list: TThriftList); override;
procedure WriteListEnd(); override;
- procedure WriteSetBegin( const set_: ISet ); override;
+ procedure WriteSetBegin( const set_: TThriftSet ); override;
procedure WriteSetEnd(); override;
procedure WriteBool( b: Boolean); override;
procedure WriteByte( b: ShortInt); override;
@@ -194,17 +194,17 @@
class procedure fixedLongToBytes( const n : Int64; var buf : TBytes);
public
- function ReadMessageBegin: IMessage; override;
+ function ReadMessageBegin: TThriftMessage; override;
procedure ReadMessageEnd(); override;
- function ReadStructBegin: IStruct; override;
+ function ReadStructBegin: TThriftStruct; override;
procedure ReadStructEnd; override;
- function ReadFieldBegin: IField; override;
+ function ReadFieldBegin: TThriftField; override;
procedure ReadFieldEnd(); override;
- function ReadMapBegin: IMap; override;
+ function ReadMapBegin: TThriftMap; override;
procedure ReadMapEnd(); override;
- function ReadListBegin: IList; override;
+ function ReadListBegin: TThriftList; override;
procedure ReadListEnd(); override;
- function ReadSetBegin: ISet; override;
+ function ReadSetBegin: TThriftSet; override;
procedure ReadSetEnd(); override;
function ReadBool: Boolean; override;
function ReadByte: ShortInt; override;
@@ -273,7 +273,7 @@
lastFieldId_ := 0;
lastField_ := TStack<Integer>.Create;
- booleanField_ := nil;
+ Init( booleanField_, '', TType.Stop, 0);
boolValue_ := unused;
end;
@@ -293,7 +293,7 @@
begin
lastField_.Clear();
lastFieldId_ := 0;
- booleanField_ := nil;
+ Init( booleanField_, '', TType.Stop, 0);
boolValue_ := unused;
end;
@@ -301,11 +301,8 @@
// Writes a byte without any possibility of all that field header nonsense.
// Used internally by other writing methods that know they need to Write a byte.
procedure TCompactProtocolImpl.WriteByteDirect( const b : Byte);
-var data : TBytes;
begin
- SetLength( data, 1);
- data[0] := b;
- Transport.Write( data);
+ Transport.Write( @b, SizeOf(b));
end;
@@ -344,7 +341,7 @@
// Write a message header to the wire. Compact Protocol messages contain the
// protocol version so we can migrate forwards in the future if need be.
-procedure TCompactProtocolImpl.WriteMessageBegin( const msg: IMessage);
+procedure TCompactProtocolImpl.WriteMessageBegin( const msg: TThriftMessage);
var versionAndType : Byte;
begin
Reset;
@@ -362,7 +359,7 @@
// Write a struct begin. This doesn't actually put anything on the wire. We use it as an
// opportunity to put special placeholder markers on the field stack so we can get the
// field id deltas correct.
-procedure TCompactProtocolImpl.WriteStructBegin( const struc: IStruct);
+procedure TCompactProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
begin
lastField_.Push(lastFieldId_);
lastFieldId_ := 0;
@@ -380,7 +377,7 @@
// Write a field header containing the field id and field type. If the difference between the
// current field id and the last one is small (< 15), then the field id will be encoded in
// the 4 MSB as a delta. Otherwise, the field id will follow the type header as a zigzag varint.
-procedure TCompactProtocolImpl.WriteFieldBegin( const field: IField);
+procedure TCompactProtocolImpl.WriteFieldBegin( const field: TThriftField);
begin
case field.Type_ of
TType.Bool_ : booleanField_ := field; // we want to possibly include the value, so we'll wait.
@@ -392,7 +389,7 @@
// The workhorse of WriteFieldBegin. It has the option of doing a 'type override'
// of the type header. This is used specifically in the boolean field case.
-procedure TCompactProtocolImpl.WriteFieldBeginInternal( const field : IField; typeOverride : Byte);
+procedure TCompactProtocolImpl.WriteFieldBeginInternal( const field : TThriftField; typeOverride : Byte);
var typeToWrite : Byte;
begin
// if there's a type override, use that.
@@ -425,7 +422,7 @@
// Write a map header. If the map is empty, omit the key and value type
// headers, as we don't need any additional information to skip it.
-procedure TCompactProtocolImpl.WriteMapBegin( const map: IMap);
+procedure TCompactProtocolImpl.WriteMapBegin( const map: TThriftMap);
var key, val : Byte;
begin
if (map.Count = 0)
@@ -440,14 +437,14 @@
// Write a list header.
-procedure TCompactProtocolImpl.WriteListBegin( const list: IList);
+procedure TCompactProtocolImpl.WriteListBegin( const list: TThriftList);
begin
WriteCollectionBegin( list.ElementType, list.Count);
end;
// Write a set header.
-procedure TCompactProtocolImpl.WriteSetBegin( const set_: ISet );
+procedure TCompactProtocolImpl.WriteSetBegin( const set_: TThriftSet );
begin
WriteCollectionBegin( set_.ElementType, set_.Count);
end;
@@ -464,10 +461,10 @@
then bt := Types.BOOLEAN_TRUE
else bt := Types.BOOLEAN_FALSE;
- if booleanField_ <> nil then begin
+ if booleanField_.Type_ = TType.Bool_ then begin
// we haven't written the field header yet
WriteFieldBeginInternal( booleanField_, Byte(bt));
- booleanField_ := nil;
+ booleanField_.Type_ := TType.Stop;
end
else begin
// we're not part of a field, so just Write the value.
@@ -642,7 +639,7 @@
// Read a message header.
-function TCompactProtocolImpl.ReadMessageBegin : IMessage;
+function TCompactProtocolImpl.ReadMessageBegin : TThriftMessage;
var protocolId, versionAndType, version, type_ : Byte;
seqid : Integer;
msgNm : String;
@@ -663,17 +660,17 @@
type_ := Byte( (versionAndType shr TYPE_SHIFT_AMOUNT) and TYPE_BITS);
seqid := Integer( ReadVarint32);
msgNm := ReadString;
- result := TMessageImpl.Create( msgNm, TMessageType(type_), seqid);
+ Init( result, msgNm, TMessageType(type_), seqid);
end;
// Read a struct begin. There's nothing on the wire for this, but it is our
// opportunity to push a new struct begin marker onto the field stack.
-function TCompactProtocolImpl.ReadStructBegin: IStruct;
+function TCompactProtocolImpl.ReadStructBegin: TThriftStruct;
begin
lastField_.Push( lastFieldId_);
lastFieldId_ := 0;
- result := TStructImpl.Create('');
+ Init( result);
end;
@@ -687,7 +684,7 @@
// Read a field header off the wire.
-function TCompactProtocolImpl.ReadFieldBegin: IField;
+function TCompactProtocolImpl.ReadFieldBegin: TThriftField;
var type_ : Byte;
fieldId, modifier : ShortInt;
begin
@@ -695,7 +692,7 @@
// if it's a stop, then we can return immediately, as the struct is over.
if type_ = Byte(Types.STOP) then begin
- result := TFieldImpl.Create( '', TType.Stop, 0);
+ Init( result, '', TType.Stop, 0);
Exit;
end;
@@ -705,7 +702,7 @@
then fieldId := ReadI16 // not a delta. look ahead for the zigzag varint field id.
else fieldId := ShortInt( lastFieldId_ + modifier); // add the delta to the last Read field id.
- result := TFieldImpl.Create( '', getTType(Byte(type_ and $0F)), fieldId);
+ Init( result, '', getTType(Byte(type_ and $0F)), fieldId);
// if this happens to be a boolean field, the value is encoded in the type
// save the boolean value in a special instance variable.
@@ -723,7 +720,7 @@
// Read a map header off the wire. If the size is zero, skip Reading the key
// and value type. This means that 0-length maps will yield TMaps without the
// "correct" types.
-function TCompactProtocolImpl.ReadMapBegin: IMap;
+function TCompactProtocolImpl.ReadMapBegin: TThriftMap;
var size : Integer;
keyAndValueType : Byte;
key, val : TType;
@@ -735,7 +732,7 @@
key := getTType( Byte( keyAndValueType shr 4));
val := getTType( Byte( keyAndValueType and $F));
- result := TMapImpl.Create( key, val, size);
+ Init( result, key, val, size);
ASSERT( (result.KeyType = key) and (result.ValueType = val));
end;
@@ -744,7 +741,7 @@
// be packed into the element type header. If it's a longer list, the 4 MSB
// of the element type header will be $F, and a varint will follow with the
// true size.
-function TCompactProtocolImpl.ReadListBegin: IList;
+function TCompactProtocolImpl.ReadListBegin: TThriftList;
var size_and_type : Byte;
size : Integer;
type_ : TType;
@@ -756,7 +753,7 @@
then size := Integer( ReadVarint32);
type_ := getTType( size_and_type);
- result := TListImpl.Create( type_, size);
+ Init( result, type_, size);
end;
@@ -764,7 +761,7 @@
// be packed into the element type header. If it's a longer set, the 4 MSB
// of the element type header will be $F, and a varint will follow with the
// true size.
-function TCompactProtocolImpl.ReadSetBegin: ISet;
+function TCompactProtocolImpl.ReadSetBegin: TThriftSet;
var size_and_type : Byte;
size : Integer;
type_ : TType;
@@ -776,7 +773,7 @@
then size := Integer( ReadVarint32);
type_ := getTType( size_and_type);
- result := TSetImpl.Create( type_, size);
+ Init( result, type_, size);
end;
@@ -797,11 +794,8 @@
// Read a single byte off the wire. Nothing interesting here.
function TCompactProtocolImpl.ReadByte: ShortInt;
-var data : TBytes;
begin
- SetLength( data, 1);
- Transport.ReadAll( data, 0, 1);
- result := ShortInt(data[0]);
+ Transport.ReadAll( @result, SizeOf(result), 0, 1);
end;
diff --git a/lib/delphi/src/Thrift.Protocol.JSON.pas b/lib/delphi/src/Thrift.Protocol.JSON.pas
index 71ee7ae..30600aa 100644
--- a/lib/delphi/src/Thrift.Protocol.JSON.pas
+++ b/lib/delphi/src/Thrift.Protocol.JSON.pas
@@ -103,7 +103,7 @@
private
FHasData : Boolean;
- FData : TBytes;
+ FData : Byte;
public
// Return and consume the next byte to be Read, either taking it from the
@@ -169,18 +169,18 @@
public
// IProtocol
- procedure WriteMessageBegin( const aMsg : IMessage); override;
+ procedure WriteMessageBegin( const aMsg : TThriftMessage); override;
procedure WriteMessageEnd; override;
- procedure WriteStructBegin( const struc: IStruct); override;
+ procedure WriteStructBegin( const struc: TThriftStruct); override;
procedure WriteStructEnd; override;
- procedure WriteFieldBegin( const field: IField); override;
+ procedure WriteFieldBegin( const field: TThriftField); override;
procedure WriteFieldEnd; override;
procedure WriteFieldStop; override;
- procedure WriteMapBegin( const map: IMap); override;
+ procedure WriteMapBegin( const map: TThriftMap); override;
procedure WriteMapEnd; override;
- procedure WriteListBegin( const list: IList); override;
+ procedure WriteListBegin( const list: TThriftList); override;
procedure WriteListEnd(); override;
- procedure WriteSetBegin( const set_: ISet ); override;
+ procedure WriteSetBegin( const set_: TThriftSet ); override;
procedure WriteSetEnd(); override;
procedure WriteBool( b: Boolean); override;
procedure WriteByte( b: ShortInt); override;
@@ -191,17 +191,17 @@
procedure WriteString( const s: string ); override;
procedure WriteBinary( const b: TBytes); override;
//
- function ReadMessageBegin: IMessage; override;
+ function ReadMessageBegin: TThriftMessage; override;
procedure ReadMessageEnd(); override;
- function ReadStructBegin: IStruct; override;
+ function ReadStructBegin: TThriftStruct; override;
procedure ReadStructEnd; override;
- function ReadFieldBegin: IField; override;
+ function ReadFieldBegin: TThriftField; override;
procedure ReadFieldEnd(); override;
- function ReadMapBegin: IMap; override;
+ function ReadMapBegin: TThriftMap; override;
procedure ReadMapEnd(); override;
- function ReadListBegin: IList; override;
+ function ReadListBegin: TThriftList; override;
procedure ReadListEnd(); override;
- function ReadSetBegin: ISet; override;
+ function ReadSetBegin: TThriftSet; override;
procedure ReadSetEnd(); override;
function ReadBool: Boolean; override;
function ReadByte: ShortInt; override;
@@ -437,21 +437,19 @@
if FHasData
then FHasData := FALSE
else begin
- SetLength( FData, 1);
- IJSONProtocol(FProto).Transport.ReadAll( FData, 0, 1);
+ IJSONProtocol(FProto).Transport.ReadAll( @FData, SizeOf(FData), 0, 1);
end;
- result := FData[0];
+ result := FData;
end;
function TJSONProtocolImpl.TLookaheadReader.Peek : Byte;
begin
if not FHasData then begin
- SetLength( FData, 1);
- IJSONProtocol(FProto).Transport.ReadAll( FData, 0, 1);
+ IJSONProtocol(FProto).Transport.ReadAll( @FData, SizeOf(FData), 0, 1);
FHasData := TRUE;
end;
- result := FData[0];
+ result := FData;
end;
@@ -681,7 +679,7 @@
end;
-procedure TJSONProtocolImpl.WriteMessageBegin( const aMsg : IMessage);
+procedure TJSONProtocolImpl.WriteMessageBegin( const aMsg : TThriftMessage);
begin
ResetContextStack; // THRIFT-1473
@@ -700,7 +698,7 @@
end;
-procedure TJSONProtocolImpl.WriteStructBegin( const struc: IStruct);
+procedure TJSONProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
begin
WriteJSONObjectStart;
end;
@@ -712,7 +710,7 @@
end;
-procedure TJSONProtocolImpl.WriteFieldBegin( const field : IField);
+procedure TJSONProtocolImpl.WriteFieldBegin( const field : TThriftField);
begin
WriteJSONInteger(field.ID);
WriteJSONObjectStart;
@@ -731,7 +729,7 @@
// nothing to do
end;
-procedure TJSONProtocolImpl.WriteMapBegin( const map: IMap);
+procedure TJSONProtocolImpl.WriteMapBegin( const map: TThriftMap);
begin
WriteJSONArrayStart;
WriteJSONString( GetTypeNameForTypeID( map.KeyType));
@@ -748,7 +746,7 @@
end;
-procedure TJSONProtocolImpl.WriteListBegin( const list: IList);
+procedure TJSONProtocolImpl.WriteListBegin( const list: TThriftList);
begin
WriteJSONArrayStart;
WriteJSONString( GetTypeNameForTypeID( list.ElementType));
@@ -762,7 +760,7 @@
end;
-procedure TJSONProtocolImpl.WriteSetBegin( const set_: ISet);
+procedure TJSONProtocolImpl.WriteSetBegin( const set_: TThriftSet);
begin
WriteJSONArrayStart;
WriteJSONString( GetTypeNameForTypeID( set_.ElementType));
@@ -1051,11 +1049,11 @@
end;
-function TJSONProtocolImpl.ReadMessageBegin: IMessage;
+function TJSONProtocolImpl.ReadMessageBegin: TThriftMessage;
begin
ResetContextStack; // THRIFT-1473
- result := TMessageImpl.Create;
+ Init( result);
ReadJSONArrayStart;
if ReadJSONInteger <> VERSION
@@ -1073,10 +1071,10 @@
end;
-function TJSONProtocolImpl.ReadStructBegin : IStruct ;
+function TJSONProtocolImpl.ReadStructBegin : TThriftStruct ;
begin
ReadJSONObjectStart;
- result := TStructImpl.Create('');
+ Init( result);
end;
@@ -1086,11 +1084,11 @@
end;
-function TJSONProtocolImpl.ReadFieldBegin : IField;
+function TJSONProtocolImpl.ReadFieldBegin : TThriftField;
var ch : Byte;
str : string;
begin
- result := TFieldImpl.Create;
+ Init( result);
ch := FReader.Peek;
if ch = RBRACE[0]
then result.Type_ := TType.Stop
@@ -1110,10 +1108,10 @@
end;
-function TJSONProtocolImpl.ReadMapBegin : IMap;
+function TJSONProtocolImpl.ReadMapBegin : TThriftMap;
var str : string;
begin
- result := TMapImpl.Create;
+ Init( result);
ReadJSONArrayStart;
str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
@@ -1134,10 +1132,10 @@
end;
-function TJSONProtocolImpl.ReadListBegin : IList;
+function TJSONProtocolImpl.ReadListBegin : TThriftList;
var str : string;
begin
- result := TListImpl.Create;
+ Init( result);
ReadJSONArrayStart;
str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
@@ -1152,10 +1150,10 @@
end;
-function TJSONProtocolImpl.ReadSetBegin : ISet;
+function TJSONProtocolImpl.ReadSetBegin : TThriftSet;
var str : string;
begin
- result := TSetImpl.Create;
+ Init( result);
ReadJSONArrayStart;
str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE));
diff --git a/lib/delphi/src/Thrift.Protocol.Multiplex.pas b/lib/delphi/src/Thrift.Protocol.Multiplex.pas
index 18b39b5..93a3838 100644
--- a/lib/delphi/src/Thrift.Protocol.Multiplex.pas
+++ b/lib/delphi/src/Thrift.Protocol.Multiplex.pas
@@ -71,7 +71,7 @@
{ Prepends the service name to the function name, separated by SEPARATOR.
Args: The original message.
}
- procedure WriteMessageBegin( const msg: IMessage); override;
+ procedure WriteMessageBegin( const msg: TThriftMessage); override;
end;
@@ -86,14 +86,14 @@
end;
-procedure TMultiplexedProtocol.WriteMessageBegin( const msg: IMessage);
+procedure TMultiplexedProtocol.WriteMessageBegin( const msg: TThriftMessage);
// Prepends the service name to the function name, separated by TMultiplexedProtocol.SEPARATOR.
-var newMsg : IMessage;
+var newMsg : TThriftMessage;
begin
case msg.Type_ of
TMessageType.Call,
TMessageType.Oneway : begin
- newMsg := TMessageImpl.Create( FServiceName + SEPARATOR + msg.Name, msg.Type_, msg.SeqID);
+ Init( newMsg, FServiceName + SEPARATOR + msg.Name, msg.Type_, msg.SeqID);
inherited WriteMessageBegin( newMsg);
end;
diff --git a/lib/delphi/src/Thrift.Protocol.pas b/lib/delphi/src/Thrift.Protocol.pas
index 9ea28de..24f6791 100644
--- a/lib/delphi/src/Thrift.Protocol.pas
+++ b/lib/delphi/src/Thrift.Protocol.pas
@@ -70,7 +70,40 @@
type
IProtocol = interface;
- IStruct = interface;
+
+ TThriftMessage = record
+ Name: string;
+ Type_: TMessageType;
+ SeqID: Integer;
+ end;
+
+ TThriftStruct = record
+ Name: string;
+ end;
+
+ TThriftField = record
+ Name: string;
+ Type_: TType;
+ Id: SmallInt;
+ end;
+
+ TThriftList = record
+ ElementType: TType;
+ Count: Integer;
+ end;
+
+ TThriftMap = record
+ KeyType: TType;
+ ValueType: TType;
+ Count: Integer;
+ end;
+
+ TThriftSet = record
+ ElementType: TType;
+ Count: Integer;
+ end;
+
+
IProtocolFactory = interface
['{7CD64A10-4E9F-4E99-93BF-708A31F4A67B}']
@@ -117,146 +150,6 @@
TProtocolExceptionNotImplemented = class (TProtocolExceptionSpecialized);
TProtocolExceptionDepthLimit = class (TProtocolExceptionSpecialized);
- 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
@@ -279,18 +172,18 @@
IProtocol = interface
['{602A7FFB-0D9E-4CD8-8D7F-E5076660588A}']
function GetTransport: ITransport;
- procedure WriteMessageBegin( const msg: IMessage);
+ procedure WriteMessageBegin( const msg: TThriftMessage);
procedure WriteMessageEnd;
- procedure WriteStructBegin( const struc: IStruct);
+ procedure WriteStructBegin( const struc: TThriftStruct);
procedure WriteStructEnd;
- procedure WriteFieldBegin( const field: IField);
+ procedure WriteFieldBegin( const field: TThriftField);
procedure WriteFieldEnd;
procedure WriteFieldStop;
- procedure WriteMapBegin( const map: IMap);
+ procedure WriteMapBegin( const map: TThriftMap);
procedure WriteMapEnd;
- procedure WriteListBegin( const list: IList);
+ procedure WriteListBegin( const list: TThriftList);
procedure WriteListEnd();
- procedure WriteSetBegin( const set_: ISet );
+ procedure WriteSetBegin( const set_: TThriftSet );
procedure WriteSetEnd();
procedure WriteBool( b: Boolean);
procedure WriteByte( b: ShortInt);
@@ -302,17 +195,17 @@
procedure WriteAnsiString( const s: AnsiString);
procedure WriteBinary( const b: TBytes);
- function ReadMessageBegin: IMessage;
+ function ReadMessageBegin: TThriftMessage;
procedure ReadMessageEnd();
- function ReadStructBegin: IStruct;
+ function ReadStructBegin: TThriftStruct;
procedure ReadStructEnd;
- function ReadFieldBegin: IField;
+ function ReadFieldBegin: TThriftField;
procedure ReadFieldEnd();
- function ReadMapBegin: IMap;
+ function ReadMapBegin: TThriftMap;
procedure ReadMapEnd();
- function ReadListBegin: IList;
+ function ReadListBegin: TThriftList;
procedure ReadListEnd();
- function ReadSetBegin: ISet;
+ function ReadSetBegin: TThriftSet;
procedure ReadSetEnd();
function ReadBool: Boolean;
function ReadByte: ShortInt;
@@ -348,18 +241,18 @@
function GetTransport: ITransport;
public
- procedure WriteMessageBegin( const msg: IMessage); virtual; abstract;
+ procedure WriteMessageBegin( const msg: TThriftMessage); virtual; abstract;
procedure WriteMessageEnd; virtual; abstract;
- procedure WriteStructBegin( const struc: IStruct); virtual; abstract;
+ procedure WriteStructBegin( const struc: TThriftStruct); virtual; abstract;
procedure WriteStructEnd; virtual; abstract;
- procedure WriteFieldBegin( const field: IField); virtual; abstract;
+ procedure WriteFieldBegin( const field: TThriftField); virtual; abstract;
procedure WriteFieldEnd; virtual; abstract;
procedure WriteFieldStop; virtual; abstract;
- procedure WriteMapBegin( const map: IMap); virtual; abstract;
+ procedure WriteMapBegin( const map: TThriftMap); virtual; abstract;
procedure WriteMapEnd; virtual; abstract;
- procedure WriteListBegin( const list: IList); virtual; abstract;
+ procedure WriteListBegin( const list: TThriftList); virtual; abstract;
procedure WriteListEnd(); virtual; abstract;
- procedure WriteSetBegin( const set_: ISet ); virtual; abstract;
+ procedure WriteSetBegin( const set_: TThriftSet ); virtual; abstract;
procedure WriteSetEnd(); virtual; abstract;
procedure WriteBool( b: Boolean); virtual; abstract;
procedure WriteByte( b: ShortInt); virtual; abstract;
@@ -371,17 +264,17 @@
procedure WriteAnsiString( const s: AnsiString); virtual;
procedure WriteBinary( const b: TBytes); virtual; abstract;
- function ReadMessageBegin: IMessage; virtual; abstract;
+ function ReadMessageBegin: TThriftMessage; virtual; abstract;
procedure ReadMessageEnd(); virtual; abstract;
- function ReadStructBegin: IStruct; virtual; abstract;
+ function ReadStructBegin: TThriftStruct; virtual; abstract;
procedure ReadStructEnd; virtual; abstract;
- function ReadFieldBegin: IField; virtual; abstract;
+ function ReadFieldBegin: TThriftField; virtual; abstract;
procedure ReadFieldEnd(); virtual; abstract;
- function ReadMapBegin: IMap; virtual; abstract;
+ function ReadMapBegin: TThriftMap; virtual; abstract;
procedure ReadMapEnd(); virtual; abstract;
- function ReadListBegin: IList; virtual; abstract;
+ function ReadListBegin: TThriftList; virtual; abstract;
procedure ReadListEnd(); virtual; abstract;
- function ReadSetBegin: ISet; virtual; abstract;
+ function ReadSetBegin: TThriftSet; virtual; abstract;
procedure ReadSetEnd(); virtual; abstract;
function ReadBool: Boolean; virtual; abstract;
function ReadByte: ShortInt; virtual; abstract;
@@ -405,22 +298,6 @@
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
@@ -432,7 +309,7 @@
FStrictWrite : Boolean;
private
- function ReadAll( var buf: TBytes; off: Integer; len: Integer ): Integer;
+ function ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer; inline;
function ReadStringBody( size: Integer): string;
public
@@ -451,18 +328,18 @@
constructor Create( const trans: ITransport); overload;
constructor Create( const trans: ITransport; strictRead: Boolean; strictWrite: Boolean); overload;
- procedure WriteMessageBegin( const msg: IMessage); override;
+ procedure WriteMessageBegin( const msg: TThriftMessage); override;
procedure WriteMessageEnd; override;
- procedure WriteStructBegin( const struc: IStruct); override;
+ procedure WriteStructBegin( const struc: TThriftStruct); override;
procedure WriteStructEnd; override;
- procedure WriteFieldBegin( const field: IField); override;
+ procedure WriteFieldBegin( const field: TThriftField); override;
procedure WriteFieldEnd; override;
procedure WriteFieldStop; override;
- procedure WriteMapBegin( const map: IMap); override;
+ procedure WriteMapBegin( const map: TThriftMap); override;
procedure WriteMapEnd; override;
- procedure WriteListBegin( const list: IList); override;
+ procedure WriteListBegin( const list: TThriftList); override;
procedure WriteListEnd(); override;
- procedure WriteSetBegin( const set_: ISet ); override;
+ procedure WriteSetBegin( const set_: TThriftSet ); override;
procedure WriteSetEnd(); override;
procedure WriteBool( b: Boolean); override;
procedure WriteByte( b: ShortInt); override;
@@ -472,17 +349,17 @@
procedure WriteDouble( const d: Double); override;
procedure WriteBinary( const b: TBytes); override;
- function ReadMessageBegin: IMessage; override;
+ function ReadMessageBegin: TThriftMessage; override;
procedure ReadMessageEnd(); override;
- function ReadStructBegin: IStruct; override;
+ function ReadStructBegin: TThriftStruct; override;
procedure ReadStructEnd; override;
- function ReadFieldBegin: IField; override;
+ function ReadFieldBegin: TThriftField; override;
procedure ReadFieldEnd(); override;
- function ReadMapBegin: IMap; override;
+ function ReadMapBegin: TThriftMap; override;
procedure ReadMapEnd(); override;
- function ReadListBegin: IList; override;
+ function ReadListBegin: TThriftList; override;
procedure ReadListEnd(); override;
- function ReadSetBegin: ISet; override;
+ function ReadSetBegin: TThriftSet; override;
procedure ReadSetEnd(); override;
function ReadBool: Boolean; override;
function ReadByte: ShortInt; override;
@@ -510,18 +387,18 @@
// 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 WriteMessageBegin( const msg: TThriftMessage); override;
procedure WriteMessageEnd; override;
- procedure WriteStructBegin( const struc: IStruct); override;
+ procedure WriteStructBegin( const struc: TThriftStruct); override;
procedure WriteStructEnd; override;
- procedure WriteFieldBegin( const field: IField); override;
+ procedure WriteFieldBegin( const field: TThriftField); override;
procedure WriteFieldEnd; override;
procedure WriteFieldStop; override;
- procedure WriteMapBegin( const map: IMap); override;
+ procedure WriteMapBegin( const map: TThriftMap); override;
procedure WriteMapEnd; override;
- procedure WriteListBegin( const list: IList); override;
+ procedure WriteListBegin( const list: TThriftList); override;
procedure WriteListEnd(); override;
- procedure WriteSetBegin( const set_: ISet ); override;
+ procedure WriteSetBegin( const set_: TThriftSet ); override;
procedure WriteSetEnd(); override;
procedure WriteBool( b: Boolean); override;
procedure WriteByte( b: ShortInt); override;
@@ -533,17 +410,17 @@
procedure WriteAnsiString( const s: AnsiString); override;
procedure WriteBinary( const b: TBytes); override;
- function ReadMessageBegin: IMessage; override;
+ function ReadMessageBegin: TThriftMessage; override;
procedure ReadMessageEnd(); override;
- function ReadStructBegin: IStruct; override;
+ function ReadStructBegin: TThriftStruct; override;
procedure ReadStructEnd; override;
- function ReadFieldBegin: IField; override;
+ function ReadFieldBegin: TThriftField; override;
procedure ReadFieldEnd(); override;
- function ReadMapBegin: IMap; override;
+ function ReadMapBegin: TThriftMap; override;
procedure ReadMapEnd(); override;
- function ReadListBegin: IList; override;
+ function ReadListBegin: TThriftList; override;
procedure ReadListEnd(); override;
- function ReadSetBegin: ISet; override;
+ function ReadSetBegin: TThriftSet; override;
procedure ReadSetEnd(); override;
function ReadBool: Boolean; override;
function ReadByte: ShortInt; override;
@@ -594,6 +471,13 @@
end;
+procedure Init( var rec : TThriftMessage; const AName: string = ''; const AMessageType: TMessageType = Low(TMessageType); const ASeqID: Integer = 0); overload; inline;
+procedure Init( var rec : TThriftStruct; const AName: string = ''); overload; inline;
+procedure Init( var rec : TThriftField; const AName: string = ''; const AType: TType = Low(TType); const AID: SmallInt = 0); overload; inline;
+procedure Init( var rec : TThriftMap; const AKeyType: TType = Low(TType); const AValueType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
+procedure Init( var rec : TThriftSet; const AElementType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
+procedure Init( var rec : TThriftList; const AElementType: TType = Low(TType); const ACount: Integer = 0); overload; inline;
+
implementation
@@ -609,54 +493,7 @@
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 }
@@ -769,10 +606,10 @@
{ TProtocolUtil }
class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType);
-var field : IField;
- map : IMap;
- set_ : ISet;
- list : IList;
+var field : TThriftField;
+ map : TThriftMap;
+ set_ : TThriftSet;
+ list : TThriftList;
i : Integer;
tracker : IProtocolRecursionTracker;
begin
@@ -827,182 +664,6 @@
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 }
@@ -1020,10 +681,9 @@
FStrictWrite := strictWrite;
end;
-function TBinaryProtocolImpl.ReadAll( var buf: TBytes; off,
- len: Integer): Integer;
+function TBinaryProtocolImpl.ReadAll( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer ): Integer;
begin
- Result := FTrans.ReadAll( buf, off, len );
+ Result := FTrans.ReadAll( pBuf, buflen, off, len );
end;
function TBinaryProtocolImpl.ReadBinary: TBytes;
@@ -1039,16 +699,12 @@
function TBinaryProtocolImpl.ReadBool: Boolean;
begin
- Result := ReadByte = 1;
+ Result := (ReadByte = 1);
end;
function TBinaryProtocolImpl.ReadByte: ShortInt;
-var
- bin : TBytes;
begin
- SetLength( bin, 1);
- ReadAll( bin, 0, 1 );
- Result := ShortInt( bin[0]);
+ ReadAll( @result, SizeOf(result), 0, 1);
end;
function TBinaryProtocolImpl.ReadDouble: Double;
@@ -1056,17 +712,12 @@
Result := ConvertInt64ToDouble( ReadI64 )
end;
-function TBinaryProtocolImpl.ReadFieldBegin: IField;
-var
- field : IField;
+function TBinaryProtocolImpl.ReadFieldBegin: TThriftField;
begin
- field := TFieldImpl.Create;
- field.Type_ := TType( ReadByte);
- if ( field.Type_ <> TType.Stop ) then
- begin
- field.Id := ReadI16;
+ Init( result, '', TType( ReadByte), 0);
+ if ( result.Type_ <> TType.Stop ) then begin
+ result.Id := ReadI16;
end;
- Result := field;
end;
procedure TBinaryProtocolImpl.ReadFieldEnd;
@@ -1075,20 +726,16 @@
end;
function TBinaryProtocolImpl.ReadI16: SmallInt;
-var
- i16in : TBytes;
+var i16in : packed array[0..1] of Byte;
begin
- SetLength( i16in, 2 );
- ReadAll( i16in, 0, 2);
+ ReadAll( @i16in, Sizeof(i16in), 0, 2);
Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF));
end;
function TBinaryProtocolImpl.ReadI32: Integer;
-var
- i32in : TBytes;
+var i32in : packed array[0..3] of Byte;
begin
- SetLength( i32in, 4 );
- ReadAll( i32in, 0, 4);
+ ReadAll( @i32in, SizeOf(i32in), 0, 4);
Result := Integer(
((i32in[0] and $FF) shl 24) or
@@ -1099,11 +746,9 @@
end;
function TBinaryProtocolImpl.ReadI64: Int64;
-var
- i64in : TBytes;
+var i64in : packed array[0..7] of Byte;
begin
- SetLength( i64in, 8);
- ReadAll( i64in, 0, 8);
+ ReadAll( @i64in, SizeOf(i64in), 0, 8);
Result :=
(Int64( i64in[0] and $FF) shl 56) or
(Int64( i64in[1] and $FF) shl 48) or
@@ -1115,14 +760,10 @@
(Int64( i64in[7] and $FF));
end;
-function TBinaryProtocolImpl.ReadListBegin: IList;
-var
- list : IList;
+function TBinaryProtocolImpl.ReadListBegin: TThriftList;
begin
- list := TListImpl.Create;
- list.ElementType := TType( ReadByte );
- list.Count := ReadI32;
- Result := list;
+ result.ElementType := TType(ReadByte);
+ result.Count := ReadI32;
end;
procedure TBinaryProtocolImpl.ReadListEnd;
@@ -1130,15 +771,11 @@
end;
-function TBinaryProtocolImpl.ReadMapBegin: IMap;
-var
- map : IMap;
+function TBinaryProtocolImpl.ReadMapBegin: TThriftMap;
begin
- map := TMapImpl.Create;
- map.KeyType := TType( ReadByte );
- map.ValueType := TType( ReadByte );
- map.Count := ReadI32;
- Result := map;
+ result.KeyType := TType(ReadByte);
+ result.ValueType := TType(ReadByte);
+ result.Count := ReadI32;
end;
procedure TBinaryProtocolImpl.ReadMapEnd;
@@ -1146,35 +783,30 @@
end;
-function TBinaryProtocolImpl.ReadMessageBegin: IMessage;
+function TBinaryProtocolImpl.ReadMessageBegin: TThriftMessage;
var
size : Integer;
version : Integer;
- message : IMessage;
begin
- message := TMessageImpl.Create;
+ Init( result);
size := ReadI32;
- if (size < 0) then
- begin
+ if (size < 0) then begin
version := size and Integer( VERSION_MASK);
- if ( version <> Integer( VERSION_1)) then
- begin
+ if ( version <> Integer( VERSION_1)) then begin
raise TProtocolExceptionBadVersion.Create('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
+ result.Type_ := TMessageType( size and $000000ff);
+ result.Name := ReadString;
+ result.SeqID := ReadI32;
+ end
+ else begin
+ if FStrictRead then begin
raise TProtocolExceptionBadVersion.Create('Missing version in readMessageBegin, old client?' );
end;
- message.Name := ReadStringBody( size );
- message.Type_ := TMessageType( ReadByte );
- message.SeqID := ReadI32;
+ result.Name := ReadStringBody( size );
+ result.Type_ := TMessageType( ReadByte );
+ result.SeqID := ReadI32;
end;
- Result := message;
end;
procedure TBinaryProtocolImpl.ReadMessageEnd;
@@ -1183,14 +815,10 @@
end;
-function TBinaryProtocolImpl.ReadSetBegin: ISet;
-var
- set_ : ISet;
+function TBinaryProtocolImpl.ReadSetBegin: TThriftSet;
begin
- set_ := TSetImpl.Create;
- set_.ElementType := TType( ReadByte );
- set_.Count := ReadI32;
- Result := set_;
+ result.ElementType := TType(ReadByte);
+ result.Count := ReadI32;
end;
procedure TBinaryProtocolImpl.ReadSetEnd;
@@ -1207,9 +835,9 @@
Result := TEncoding.UTF8.GetString( buf);
end;
-function TBinaryProtocolImpl.ReadStructBegin: IStruct;
+function TBinaryProtocolImpl.ReadStructBegin: TThriftStruct;
begin
- Result := TStructImpl.Create('');
+ Init( Result);
end;
procedure TBinaryProtocolImpl.ReadStructEnd;
@@ -1228,22 +856,16 @@
procedure TBinaryProtocolImpl.WriteBool(b: Boolean);
begin
- if b then
- begin
+ if b then begin
WriteByte( 1 );
- end else
- begin
+ 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 );
+ FTrans.Write( @b, 0, 1);
end;
procedure TBinaryProtocolImpl.WriteDouble( const d: Double);
@@ -1251,7 +873,7 @@
WriteI64(ConvertDoubleToInt64(d));
end;
-procedure TBinaryProtocolImpl.WriteFieldBegin( const field: IField);
+procedure TBinaryProtocolImpl.WriteFieldBegin( const field: TThriftField);
begin
WriteByte(ShortInt(field.Type_));
WriteI16(field.ID);
@@ -1268,32 +890,26 @@
end;
procedure TBinaryProtocolImpl.WriteI16(i16: SmallInt);
-var
- i16out : TBytes;
+var i16out : packed array[0..1] of Byte;
begin
- SetLength( i16out, 2);
i16out[0] := Byte($FF and (i16 shr 8));
i16out[1] := Byte($FF and i16);
- FTrans.Write( i16out );
+ FTrans.Write( @i16out, 0, 2);
end;
procedure TBinaryProtocolImpl.WriteI32(i32: Integer);
-var
- i32out : TBytes;
+var i32out : packed array[0..3] of Byte;
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);
+ FTrans.Write( @i32out, 0, 4);
end;
procedure TBinaryProtocolImpl.WriteI64( const i64: Int64);
-var
- i64out : TBytes;
+var i64out : packed array[0..7] of Byte;
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));
@@ -1302,10 +918,10 @@
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);
+ FTrans.Write( @i64out, 0, 8);
end;
-procedure TBinaryProtocolImpl.WriteListBegin( const list: IList);
+procedure TBinaryProtocolImpl.WriteListBegin( const list: TThriftList);
begin
WriteByte(ShortInt(list.ElementType));
WriteI32(list.Count);
@@ -1316,7 +932,7 @@
end;
-procedure TBinaryProtocolImpl.WriteMapBegin( const map: IMap);
+procedure TBinaryProtocolImpl.WriteMapBegin( const map: TThriftMap);
begin
WriteByte(ShortInt(map.KeyType));
WriteByte(ShortInt(map.ValueType));
@@ -1328,7 +944,7 @@
end;
-procedure TBinaryProtocolImpl.WriteMessageBegin( const msg: IMessage);
+procedure TBinaryProtocolImpl.WriteMessageBegin( const msg: TThriftMessage);
var
version : Cardinal;
begin
@@ -1351,7 +967,7 @@
end;
-procedure TBinaryProtocolImpl.WriteSetBegin( const set_: ISet);
+procedure TBinaryProtocolImpl.WriteSetBegin( const set_: TThriftSet);
begin
WriteByte(ShortInt(set_.ElementType));
WriteI32(set_.Count);
@@ -1362,7 +978,7 @@
end;
-procedure TBinaryProtocolImpl.WriteStructBegin( const struc: IStruct);
+procedure TBinaryProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
begin
end;
@@ -1461,7 +1077,7 @@
end;
-procedure TProtocolDecorator.WriteMessageBegin( const msg: IMessage);
+procedure TProtocolDecorator.WriteMessageBegin( const msg: TThriftMessage);
begin
FWrappedProtocol.WriteMessageBegin( msg);
end;
@@ -1473,7 +1089,7 @@
end;
-procedure TProtocolDecorator.WriteStructBegin( const struc: IStruct);
+procedure TProtocolDecorator.WriteStructBegin( const struc: TThriftStruct);
begin
FWrappedProtocol.WriteStructBegin( struc);
end;
@@ -1485,7 +1101,7 @@
end;
-procedure TProtocolDecorator.WriteFieldBegin( const field: IField);
+procedure TProtocolDecorator.WriteFieldBegin( const field: TThriftField);
begin
FWrappedProtocol.WriteFieldBegin( field);
end;
@@ -1503,7 +1119,7 @@
end;
-procedure TProtocolDecorator.WriteMapBegin( const map: IMap);
+procedure TProtocolDecorator.WriteMapBegin( const map: TThriftMap);
begin
FWrappedProtocol.WriteMapBegin( map);
end;
@@ -1515,7 +1131,7 @@
end;
-procedure TProtocolDecorator.WriteListBegin( const list: IList);
+procedure TProtocolDecorator.WriteListBegin( const list: TThriftList);
begin
FWrappedProtocol.WriteListBegin( list);
end;
@@ -1527,7 +1143,7 @@
end;
-procedure TProtocolDecorator.WriteSetBegin( const set_: ISet );
+procedure TProtocolDecorator.WriteSetBegin( const set_: TThriftSet );
begin
FWrappedProtocol.WriteSetBegin( set_);
end;
@@ -1593,7 +1209,7 @@
end;
-function TProtocolDecorator.ReadMessageBegin: IMessage;
+function TProtocolDecorator.ReadMessageBegin: TThriftMessage;
begin
result := FWrappedProtocol.ReadMessageBegin;
end;
@@ -1605,7 +1221,7 @@
end;
-function TProtocolDecorator.ReadStructBegin: IStruct;
+function TProtocolDecorator.ReadStructBegin: TThriftStruct;
begin
result := FWrappedProtocol.ReadStructBegin;
end;
@@ -1617,7 +1233,7 @@
end;
-function TProtocolDecorator.ReadFieldBegin: IField;
+function TProtocolDecorator.ReadFieldBegin: TThriftField;
begin
result := FWrappedProtocol.ReadFieldBegin;
end;
@@ -1629,7 +1245,7 @@
end;
-function TProtocolDecorator.ReadMapBegin: IMap;
+function TProtocolDecorator.ReadMapBegin: TThriftMap;
begin
result := FWrappedProtocol.ReadMapBegin;
end;
@@ -1641,7 +1257,7 @@
end;
-function TProtocolDecorator.ReadListBegin: IList;
+function TProtocolDecorator.ReadListBegin: TThriftList;
begin
result := FWrappedProtocol.ReadListBegin;
end;
@@ -1653,7 +1269,7 @@
end;
-function TProtocolDecorator.ReadSetBegin: ISet;
+function TProtocolDecorator.ReadSetBegin: TThriftSet;
begin
result := FWrappedProtocol.ReadSetBegin;
end;
@@ -1719,6 +1335,54 @@
end;
+{ Init helper functions }
+
+procedure Init( var rec : TThriftMessage; const AName: string; const AMessageType: TMessageType; const ASeqID: Integer);
+begin
+ rec.Name := AName;
+ rec.Type_ := AMessageType;
+ rec.SeqID := ASeqID;
+end;
+
+
+procedure Init( var rec : TThriftStruct; const AName: string = '');
+begin
+ rec.Name := AName;
+end;
+
+
+procedure Init( var rec : TThriftField; const AName: string; const AType: TType; const AID: SmallInt);
+begin
+ rec.Name := AName;
+ rec.Type_ := AType;
+ rec.Id := AId;
+end;
+
+
+procedure Init( var rec : TThriftMap; const AKeyType, AValueType: TType; const ACount: Integer);
+begin
+ rec.ValueType := AValueType;
+ rec.KeyType := AKeyType;
+ rec.Count := ACount;
+end;
+
+
+procedure Init( var rec : TThriftSet; const AElementType: TType; const ACount: Integer);
+begin
+ rec.Count := ACount;
+ rec.ElementType := AElementType;
+end;
+
+
+procedure Init( var rec : TThriftList; const AElementType: TType; const ACount: Integer);
+begin
+ rec.Count := ACount;
+ rec.ElementType := AElementType;
+end;
+
+
+
+
end.
diff --git a/lib/delphi/src/Thrift.Stream.pas b/lib/delphi/src/Thrift.Stream.pas
index 7c448d8..1d357c3 100644
--- a/lib/delphi/src/Thrift.Stream.pas
+++ b/lib/delphi/src/Thrift.Stream.pas
@@ -38,9 +38,11 @@
type
IThriftStream = interface
- ['{732621B3-F697-4D76-A1B0-B4DD5A8E4018}']
- procedure Write( const buffer: TBytes; offset: Integer; count: Integer);
- function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
+ ['{2A77D916-7446-46C1-8545-0AEC0008DBCA}']
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); overload;
+ procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); overload;
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; overload;
+ function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload;
procedure Open;
procedure Close;
procedure Flush;
@@ -50,10 +52,12 @@
TThriftStreamImpl = class( TInterfacedObject, IThriftStream)
private
- procedure CheckSizeAndOffset( const buffer: TBytes; offset: Integer; count: Integer);
+ procedure CheckSizeAndOffset( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer); overload;
protected
- procedure Write( const buffer: TBytes; offset: Integer; count: Integer); virtual;
- function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; virtual;
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); overload; inline;
+ procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); overload; virtual;
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; overload; inline;
+ function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload; virtual;
procedure Open; virtual; abstract;
procedure Close; virtual; abstract;
procedure Flush; virtual; abstract;
@@ -66,8 +70,8 @@
FStream : TStream;
FOwnsStream : Boolean;
protected
- procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
- function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
@@ -82,8 +86,8 @@
private
FStream : IStream;
protected
- procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
- function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
@@ -127,13 +131,17 @@
// nothing to do
end;
-function TThriftStreamAdapterCOM.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
+function TThriftStreamAdapterCOM.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
begin
inherited;
+
+ if count >= buflen-offset
+ then count := buflen-offset;
+
Result := 0;
if FStream <> nil then begin
if count > 0 then begin
- FStream.Read( @buffer[offset], count, @Result);
+ FStream.Read( @(PByteArray(pBuf)^[offset]), count, @Result);
end;
end;
end;
@@ -162,30 +170,26 @@
end;
end;
-procedure TThriftStreamAdapterCOM.Write( const buffer: TBytes; offset: Integer; count: Integer);
+procedure TThriftStreamAdapterCOM.Write( const pBuf: Pointer; offset: Integer; count: Integer);
var nWritten : Integer;
begin
inherited;
if IsOpen then begin
if count > 0 then begin
- FStream.Write( @buffer[0], count, @nWritten);
+ FStream.Write( @(PByteArray(pBuf)^[offset]), count, @nWritten);
end;
end;
end;
{ TThriftStreamImpl }
-procedure TThriftStreamImpl.CheckSizeAndOffset(const buffer: TBytes; offset,
- count: Integer);
-var
- len : Integer;
+procedure TThriftStreamImpl.CheckSizeAndOffset( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer);
begin
if count > 0 then begin
- len := Length( buffer );
- if (offset < 0) or ( offset >= len) then begin
+ if (offset < 0) or ( offset >= buflen) then begin
raise ERangeError.Create( SBitsIndexError );
end;
- if count > len then begin
+ if count > buflen then begin
raise ERangeError.Create( SBitsIndexError );
end;
end;
@@ -193,13 +197,23 @@
function TThriftStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
begin
+ Result := Read( @buffer[0], Length(buffer), offset, count);
+end;
+
+function TThriftStreamImpl.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
+begin
Result := 0;
- CheckSizeAndOffset( buffer, offset, count );
+ CheckSizeAndOffset( pBuf, buflen, offset, count );
end;
procedure TThriftStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
begin
- CheckSizeAndOffset( buffer, offset, count );
+ Write( @buffer[0], offset, count);
+end;
+
+procedure TThriftStreamImpl.Write( const pBuf : Pointer; offset: Integer; count: Integer);
+begin
+ CheckSizeAndOffset( pBuf, offset+count, offset, count);
end;
{ TThriftStreamAdapterDelphi }
@@ -241,14 +255,16 @@
// nothing to do
end;
-function TThriftStreamAdapterDelphi.Read(var buffer: TBytes; offset,
- count: Integer): Integer;
+function TThriftStreamAdapterDelphi.Read(const pBuf : Pointer; const buflen : Integer; offset, count: Integer): Integer;
begin
inherited;
- Result := 0;
- if count > 0 then begin
- Result := FStream.Read( Pointer(@buffer[offset])^, count)
- end;
+
+ if count >= buflen-offset
+ then count := buflen-offset;
+
+ if count > 0
+ then Result := FStream.Read( PByteArray(pBuf)^[offset], count)
+ else Result := 0;
end;
function TThriftStreamAdapterDelphi.ToArray: TBytes;
@@ -276,12 +292,11 @@
end
end;
-procedure TThriftStreamAdapterDelphi.Write(const buffer: TBytes; offset,
- count: Integer);
+procedure TThriftStreamAdapterDelphi.Write(const pBuf : Pointer; offset, count: Integer);
begin
inherited;
if count > 0 then begin
- FStream.Write( Pointer(@buffer[offset])^, count)
+ FStream.Write( PByteArray(pBuf)^[offset], count)
end;
end;
diff --git a/lib/delphi/src/Thrift.Transport.Pipes.pas b/lib/delphi/src/Thrift.Transport.Pipes.pas
index d4f99ab..9b7f842 100644
--- a/lib/delphi/src/Thrift.Transport.Pipes.pas
+++ b/lib/delphi/src/Thrift.Transport.Pipes.pas
@@ -48,16 +48,16 @@
FOpenTimeOut : DWORD; // separate value to allow for fail-fast-on-open scenarios
FOverlapped : Boolean;
- procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
- function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Write( const pBuf : Pointer; offset, count : Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
//procedure Open; override; - see derived classes
procedure Close; override;
procedure Flush; override;
- function ReadDirect( var buffer: TBytes; offset: Integer; count: Integer): Integer;
- function ReadOverlapped( var buffer: TBytes; offset: Integer; count: Integer): Integer;
- procedure WriteDirect( const buffer: TBytes; offset: Integer; count: Integer);
- procedure WriteOverlapped( const buffer: TBytes; offset: Integer; count: Integer);
+ function ReadDirect( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload;
+ function ReadOverlapped( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload;
+ procedure WriteDirect( const pBuf : Pointer; offset: Integer; count: Integer); overload;
+ procedure WriteOverlapped( const pBuf : Pointer; offset: Integer; count: Integer); overload;
function IsOpen: Boolean; override;
function ToArray: TBytes; override;
@@ -310,34 +310,67 @@
end;
-procedure TPipeStreamBase.Write(const buffer: TBytes; offset, count: Integer);
+procedure TPipeStreamBase.Write( const pBuf : Pointer; offset, count : Integer);
begin
if FOverlapped
- then WriteOverlapped( buffer, offset, count)
- else WriteDirect( buffer, offset, count);
+ then WriteOverlapped( pBuf, offset, count)
+ else WriteDirect( pBuf, offset, count);
end;
-function TPipeStreamBase.Read( var buffer: TBytes; offset, count: Integer): Integer;
+function TPipeStreamBase.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
begin
if FOverlapped
- then result := ReadOverlapped( buffer, offset, count)
- else result := ReadDirect( buffer, offset, count);
+ then result := ReadOverlapped( pBuf, buflen, offset, count)
+ else result := ReadDirect( pBuf, buflen, offset, count);
end;
-procedure TPipeStreamBase.WriteDirect(const buffer: TBytes; offset, count: Integer);
+procedure TPipeStreamBase.WriteDirect( const pBuf : Pointer; offset: Integer; count: Integer);
var cbWritten : DWORD;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
- if not WriteFile( FPipe, buffer[offset], count, cbWritten, nil)
+ if not WriteFile( FPipe, PByteArray(pBuf)^[offset], count, cbWritten, nil)
then raise TTransportExceptionNotOpen.Create('Write to pipe failed');
end;
-function TPipeStreamBase.ReadDirect( var buffer: TBytes; offset, count: Integer): Integer;
+procedure TPipeStreamBase.WriteOverlapped( const pBuf : Pointer; offset: Integer; count: Integer);
+var cbWritten, dwWait, dwError : DWORD;
+ overlapped : IOverlappedHelper;
+begin
+ if not IsOpen
+ then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
+
+ overlapped := TOverlappedHelperImpl.Create;
+
+ if not WriteFile( FPipe, PByteArray(pBuf)^[offset], count, cbWritten, overlapped.OverlappedPtr)
+ then begin
+ dwError := GetLastError;
+ case dwError of
+ ERROR_IO_PENDING : begin
+ dwWait := overlapped.WaitFor(FTimeout);
+
+ if (dwWait = WAIT_TIMEOUT)
+ then raise TTransportExceptionTimedOut.Create('Pipe write timed out');
+
+ if (dwWait <> WAIT_OBJECT_0)
+ or not GetOverlappedResult( FPipe, overlapped.Overlapped, cbWritten, TRUE)
+ then raise TTransportExceptionUnknown.Create('Pipe write error');
+ end;
+
+ else
+ raise TTransportExceptionUnknown.Create(SysErrorMessage(dwError));
+ end;
+ end;
+
+ ASSERT( DWORD(count) = cbWritten);
+end;
+
+
+function TPipeStreamBase.ReadDirect( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
var cbRead, dwErr : DWORD;
bytes, retries : LongInt;
bOk : Boolean;
@@ -374,47 +407,14 @@
end;
// read the data (or block INFINITE-ly)
- bOk := ReadFile( FPipe, buffer[offset], count, cbRead, nil);
+ bOk := ReadFile( FPipe, PByteArray(pBuf)^[offset], count, cbRead, nil);
if (not bOk) and (GetLastError() <> ERROR_MORE_DATA)
then result := 0 // No more data, possibly because client disconnected.
else result := cbRead;
end;
-procedure TPipeStreamBase.WriteOverlapped(const buffer: TBytes; offset, count: Integer);
-var cbWritten, dwWait, dwError : DWORD;
- overlapped : IOverlappedHelper;
-begin
- if not IsOpen
- then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
-
- overlapped := TOverlappedHelperImpl.Create;
-
- if not WriteFile( FPipe, buffer[offset], count, cbWritten, overlapped.OverlappedPtr)
- then begin
- dwError := GetLastError;
- case dwError of
- ERROR_IO_PENDING : begin
- dwWait := overlapped.WaitFor(FTimeout);
-
- if (dwWait = WAIT_TIMEOUT)
- then raise TTransportExceptionTimedOut.Create('Pipe write timed out');
-
- if (dwWait <> WAIT_OBJECT_0)
- or not GetOverlappedResult( FPipe, overlapped.Overlapped, cbWritten, TRUE)
- then raise TTransportExceptionUnknown.Create('Pipe write error');
- end;
-
- else
- raise TTransportExceptionUnknown.Create(SysErrorMessage(dwError));
- end;
- end;
-
- ASSERT( DWORD(count) = cbWritten);
-end;
-
-
-function TPipeStreamBase.ReadOverlapped( var buffer: TBytes; offset, count: Integer): Integer;
+function TPipeStreamBase.ReadOverlapped( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
var cbRead, dwWait, dwError : DWORD;
bOk : Boolean;
overlapped : IOverlappedHelper;
@@ -425,7 +425,7 @@
overlapped := TOverlappedHelperImpl.Create;
// read the data
- bOk := ReadFile( FPipe, buffer[offset], count, cbRead, overlapped.OverlappedPtr);
+ bOk := ReadFile( FPipe, PByteArray(pBuf)^[offset], count, cbRead, overlapped.OverlappedPtr);
if not bOk then begin
dwError := GetLastError;
case dwError of
@@ -768,8 +768,6 @@
sa : SECURITY_ATTRIBUTES; //TSecurityAttributes;
hCAR, hPipeW, hCAW, hPipe : THandle;
begin
- result := FALSE;
-
sd := PSECURITY_DESCRIPTOR( LocalAlloc( LPTR,SECURITY_DESCRIPTOR_MIN_LENGTH));
try
Win32Check( InitializeSecurityDescriptor( sd, SECURITY_DESCRIPTOR_REVISION));
@@ -779,12 +777,14 @@
sa.lpSecurityDescriptor := sd;
sa.bInheritHandle := TRUE; //allow passing handle to child
- if not CreatePipe( hCAR, hPipeW, @sa, FBufSize) then begin //create stdin pipe
+ Result := CreatePipe( hCAR, hPipeW, @sa, FBufSize); //create stdin pipe
+ if not Result then begin //create stdin pipe
raise TTransportExceptionNotOpen.Create('TServerPipe CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
Exit;
end;
- if not CreatePipe( hPipe, hCAW, @sa, FBufSize) then begin //create stdout pipe
+ Result := CreatePipe( hPipe, hCAW, @sa, FBufSize); //create stdout pipe
+ if not Result then begin //create stdout pipe
CloseHandle( hCAR);
CloseHandle( hPipeW);
raise TTransportExceptionNotOpen.Create('TServerPipe CreatePipe (anon) failed, '+SysErrorMessage(GetLastError));
@@ -795,9 +795,6 @@
FClientAnonWrite := hCAW;
FReadHandle := hPipe;
FWriteHandle := hPipeW;
-
- result := TRUE;
-
finally
if sd <> nil then LocalFree( Cardinal(sd));
end;
diff --git a/lib/delphi/src/Thrift.Transport.pas b/lib/delphi/src/Thrift.Transport.pas
index 5dfb14e..d20eb2f 100644
--- a/lib/delphi/src/Thrift.Transport.pas
+++ b/lib/delphi/src/Thrift.Transport.pas
@@ -44,16 +44,20 @@
type
ITransport = interface
- ['{A4A9FC37-D620-44DC-AD21-662D16364CE4}']
+ ['{DB84961E-8BB3-4532-99E1-A8C7AC2300F7}']
function GetIsOpen: Boolean;
property IsOpen: Boolean read GetIsOpen;
function Peek: Boolean;
procedure Open;
procedure Close;
- function Read(var buf: TBytes; off: Integer; len: Integer): Integer;
- function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer;
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; overload;
+ function Read(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; overload;
+ function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; overload;
+ function ReadAll(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; overload;
procedure Write( const buf: TBytes); overload;
procedure Write( const buf: TBytes; off: Integer; len: Integer); overload;
+ procedure Write( const pBuf : Pointer; off, len : Integer); overload;
+ procedure Write( const pBuf : Pointer; len : Integer); overload;
procedure Flush;
end;
@@ -64,10 +68,14 @@
function Peek: Boolean; virtual;
procedure Open(); virtual; abstract;
procedure Close(); virtual; abstract;
- function Read(var buf: TBytes; off: Integer; len: Integer): Integer; virtual; abstract;
- function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; virtual;
- procedure Write( const buf: TBytes); overload; virtual;
- procedure Write( const buf: TBytes; off: Integer; len: Integer); overload; virtual; abstract;
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; overload; inline;
+ function Read(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; overload; virtual; abstract;
+ function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; overload; inline;
+ function ReadAll(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; overload; virtual;
+ procedure Write( const buf: TBytes); overload; inline;
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); overload; inline;
+ procedure Write( const pBuf : Pointer; len : Integer); overload; inline;
+ procedure Write( const pBuf : Pointer; off, len : Integer); overload; virtual; abstract;
procedure Flush; virtual;
end;
@@ -135,8 +143,8 @@
function GetIsOpen: Boolean; override;
procedure Open(); override;
procedure Close(); override;
- function Read( var buf: TBytes; off: Integer; len: Integer): Integer; override;
- procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
+ procedure Write( const pBuf : Pointer; off, len : Integer); override;
procedure Flush; override;
procedure SetConnectionTimeout(const Value: Integer);
@@ -193,8 +201,8 @@
SLEEP_TIME = 200;
{$ENDIF}
protected
- procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
- function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Write( const pBuf : Pointer; offset, count: Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
@@ -233,8 +241,8 @@
procedure Open; override;
procedure Close; override;
procedure Flush; override;
- function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;
- procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
+ procedure Write( const pBuf : Pointer; off, len : Integer); override;
constructor Create( const AInputStream : IThriftStream; const AOutputStream : IThriftStream);
destructor Destroy; override;
end;
@@ -246,8 +254,8 @@
FReadBuffer : TMemoryStream;
FWriteBuffer : TMemoryStream;
protected
- procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
- function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
procedure Open; override;
procedure Close; override;
procedure Flush; override;
@@ -299,8 +307,8 @@
public
procedure Open(); override;
procedure Close(); override;
- function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;
- procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
+ procedure Write( const pBuf : Pointer; off, len : Integer); override;
constructor Create( const ATransport : IStreamTransport ); overload;
constructor Create( const ATransport : IStreamTransport; ABufSize: Integer); overload;
property UnderlyingTransport: ITransport read GetUnderlyingTransport;
@@ -377,8 +385,8 @@
function GetIsOpen: Boolean; override;
procedure Close(); override;
- function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;
- procedure Write( const buf: TBytes; off: Integer; len: Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override;
+ procedure Write( const pBuf : Pointer; off, len : Integer); override;
procedure Flush; override;
end;
@@ -404,24 +412,41 @@
Result := IsOpen;
end;
-function TTransportImpl.ReadAll( var buf: TBytes; off, len: Integer): Integer;
-var
- got : Integer;
- ret : Integer;
+function TTransportImpl.Read(var buf: TBytes; off: Integer; len: Integer): Integer;
begin
- got := 0;
- while got < len do begin
- ret := Read( buf, off + got, len - got);
- if ret > 0
- then Inc( got, ret)
- else raise TTransportExceptionNotOpen.Create( 'Cannot read, Remote side has closed' );
- end;
- Result := got;
+ result := Read( @buf[0], Length(buf), off, len);
+end;
+
+function TTransportImpl.ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer;
+begin
+ result := ReadAll( @buf[0], Length(buf), off, len);
end;
procedure TTransportImpl.Write( const buf: TBytes);
begin
- Self.Write( buf, 0, Length(buf) );
+ Write( @buf[0], 0, Length(buf));
+end;
+
+procedure TTransportImpl.Write( const buf: TBytes; off: Integer; len: Integer);
+begin
+ Write( @buf[0], off, len);
+end;
+
+function TTransportImpl.ReadAll(const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
+var ret : Integer;
+begin
+ result := 0;
+ while result < len do begin
+ ret := Read( pBuf, buflen, off + result, len - result);
+ if ret > 0
+ then Inc( result, ret)
+ else raise TTransportExceptionNotOpen.Create( 'Cannot read, Remote side has closed' );
+ end;
+end;
+
+procedure TTransportImpl.Write( const pBuf : Pointer; len : Integer);
+begin
+ Self.Write( pBuf, 0, len);
end;
{ THTTPClientImpl }
@@ -501,14 +526,14 @@
// nothing to do
end;
-function THTTPClientImpl.Read( var buf: TBytes; off, len: Integer): Integer;
+function THTTPClientImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
begin
if FInputStream = nil then begin
raise TTransportExceptionNotOpen.Create('No request has been sent');
end;
try
- Result := FInputStream.Read( buf, off, len )
+ Result := FInputStream.Read( pBuf, buflen, off, len)
except
on E: Exception
do raise TTransportExceptionUnknown.Create(E.Message);
@@ -550,9 +575,9 @@
FReadTimeout := Value
end;
-procedure THTTPClientImpl.Write( const buf: TBytes; off, len: Integer);
+procedure THTTPClientImpl.Write( const pBuf : Pointer; off, len : Integer);
begin
- FOutputStream.Write( buf, off, len);
+ FOutputStream.Write( pBuf, off, len);
end;
{ TTransportException }
@@ -931,7 +956,7 @@
// nothing to do
end;
-function TBufferedStreamImpl.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
+function TBufferedStreamImpl.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
var
nRead : Integer;
tempbuf : TBytes;
@@ -954,7 +979,7 @@
if FReadBuffer.Position < FReadBuffer.Size then begin
nRead := Min( FReadBuffer.Size - FReadBuffer.Position, count);
- Inc( Result, FReadBuffer.Read( Pointer(@buffer[offset])^, nRead));
+ Inc( Result, FReadBuffer.Read( PByteArray(pBuf)^[offset], nRead));
Dec( count, nRead);
Inc( offset, nRead);
end;
@@ -979,12 +1004,12 @@
end;
end;
-procedure TBufferedStreamImpl.Write( const buffer: TBytes; offset: Integer; count: Integer);
+procedure TBufferedStreamImpl.Write( const pBuf : Pointer; offset: Integer; count: Integer);
begin
inherited;
if count > 0 then begin
if IsOpen then begin
- FWriteBuffer.Write( Pointer(@buffer[offset])^, count );
+ FWriteBuffer.Write( PByteArray(pBuf)^[offset], count );
if FWriteBuffer.Size > FBufSize then begin
Flush;
end;
@@ -1043,22 +1068,22 @@
end;
-function TStreamTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
+function TStreamTransportImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
begin
if FInputStream = nil then begin
raise TTransportExceptionNotOpen.Create('Cannot read from null inputstream' );
end;
- Result := FInputStream.Read( buf, off, len );
+ Result := FInputStream.Read( pBuf,buflen, off, len );
end;
-procedure TStreamTransportImpl.Write(const buf: TBytes; off, len: Integer);
+procedure TStreamTransportImpl.Write( const pBuf : Pointer; off, len : Integer);
begin
if FOutputStream = nil then begin
raise TTransportExceptionNotOpen.Create('Cannot write to null outputstream' );
end;
- FOutputStream.Write( buf, off, len );
+ FOutputStream.Write( pBuf, off, len );
end;
{ TBufferedTransportImpl }
@@ -1114,18 +1139,18 @@
FTransport.Open
end;
-function TBufferedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
+function TBufferedTransportImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
begin
Result := 0;
if FInputBuffer <> nil then begin
- Result := FInputBuffer.Read( buf, off, len );
+ Result := FInputBuffer.Read( pBuf,buflen, off, len );
end;
end;
-procedure TBufferedTransportImpl.Write(const buf: TBytes; off, len: Integer);
+procedure TBufferedTransportImpl.Write( const pBuf : Pointer; off, len : Integer);
begin
if FOutputBuffer <> nil then begin
- FOutputBuffer.Write( buf, off, len );
+ FOutputBuffer.Write( pBuf, off, len );
end;
end;
@@ -1222,24 +1247,21 @@
FTransport.Open;
end;
-function TFramedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
-var
- got : Integer;
+function TFramedTransportImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
begin
- if FReadBuffer <> nil then begin
- if len > 0
- then got := FReadBuffer.Read( Pointer(@buf[off])^, len )
- else got := 0;
-
- if got > 0 then begin
- Result := got;
+ if len > (buflen-off)
+ then len := buflen-off;
+
+ if (FReadBuffer <> nil) and (len > 0) then begin
+ result := FReadBuffer.Read( PByteArray(pBuf)^[off], len);
+ if result > 0 then begin
Exit;
end;
end;
ReadFrame;
if len > 0
- then Result := FReadBuffer.Read( Pointer(@buf[off])^, len)
+ then Result := FReadBuffer.Read( PByteArray(pBuf)^[off], len)
else Result := 0;
end;
@@ -1264,10 +1286,10 @@
FReadBuffer.Position := 0;
end;
-procedure TFramedTransportImpl.Write(const buf: TBytes; off, len: Integer);
+procedure TFramedTransportImpl.Write( const pBuf : Pointer; off, len : Integer);
begin
if len > 0
- then FWriteBuffer.Write( Pointer(@buf[off])^, len );
+ then FWriteBuffer.Write( PByteArray(pBuf)^[off], len );
end;
{ TFramedTransport.TFactory }
@@ -1447,7 +1469,7 @@
{$ENDIF}
{$IFDEF OLD_SOCKETS}
-function TTcpSocketStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
+function TTcpSocketStreamImpl.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
// old sockets version
var wfd : TWaitForData;
wsaError,
@@ -1462,7 +1484,7 @@
else msecs := DEFAULT_THRIFT_TIMEOUT;
result := 0;
- pDest := Pointer(@buffer[offset]);
+ pDest := @(PByteArray(pBuf)^[offset]);
while count > 0 do begin
while TRUE do begin
@@ -1513,7 +1535,7 @@
end;
end;
-procedure TTcpSocketStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
+procedure TTcpSocketStreamImpl.Write( const pBuf : Pointer; offset, count: Integer);
// old sockets version
var bCanWrite, bError : Boolean;
retval, wsaError : Integer;
@@ -1537,12 +1559,12 @@
if bError or not bCanWrite
then raise TTransportExceptionUnknown.Create('unknown error');
- FTcpClient.SendBuf( Pointer(@buffer[offset])^, count);
+ FTcpClient.SendBuf( PByteArray(pBuf)^[offset], count);
end;
{$ELSE}
-function TTcpSocketStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
+function TTcpSocketStreamImpl.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
// new sockets version
var nBytes : Integer;
pDest : PByte;
@@ -1550,7 +1572,7 @@
inherited;
result := 0;
- pDest := Pointer(@buffer[offset]);
+ pDest := @(PByteArray(pBuf)^[offset]);
while count > 0 do begin
nBytes := FTcpClient.Read(pDest^, count);
if nBytes = 0 then Exit;
@@ -1579,7 +1601,7 @@
SetLength(Result, Length(Result) - 1024 + len);
end;
-procedure TTcpSocketStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
+procedure TTcpSocketStreamImpl.Write( const pBuf : Pointer; offset, count: Integer);
// new sockets version
begin
inherited;
@@ -1587,7 +1609,7 @@
if not FTcpClient.IsOpen
then raise TTransportExceptionNotOpen.Create('not open');
- FTcpClient.Write(buffer[offset], count);
+ FTcpClient.Write( PByteArray(pBuf)^[offset], count);
end;
{$ENDIF}
diff --git a/lib/delphi/src/Thrift.pas b/lib/delphi/src/Thrift.pas
index e969ebf..6eca3c9 100644
--- a/lib/delphi/src/Thrift.pas
+++ b/lib/delphi/src/Thrift.pas
@@ -172,10 +172,10 @@
class function TApplicationException.Read( const iprot: IProtocol): TApplicationException;
var
- field : IField;
+ field : TThriftField;
msg : string;
typ : TExceptionType;
- struc : IStruct;
+ struc : TThriftStruct;
begin
msg := '';
typ := TExceptionType.Unknown;
@@ -220,12 +220,11 @@
procedure TApplicationException.Write( const oprot: IProtocol);
var
- struc : IStruct;
- field : IField;
-
+ struc : TThriftStruct;
+ field : TThriftField;
begin
- struc := TStructImpl.Create( 'TApplicationException' );
- field := TFieldImpl.Create;
+ Init(struc, 'TApplicationException');
+ Init(field);
oprot.WriteStructBegin( struc );
if Message <> '' then