ridv/gorealis-v2
1
0
Fork 0
Code Issues Pull requests Projects Releases 13 Packages Wiki Activity Actions

Upgrading dependency to Thrift 0.12.0

Browse source
This commit is contained in:
Renan DelValle 2018-11-27 18:03:50 -08:00
parent 3e4590dcc0
commit 356978cb42
No known key found for this signature in database
GPG key ID: C240AD6D6F443EC9
1302 changed files with 101701 additions and 26784 deletions
Download patch file Download diff file Expand all files Collapse all files

133
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Console.pas generated vendored
View file

@ -1,133 +0,0 @@
(*
* 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.
*)
unit Thrift.Console;
interface
uses Classes;
type
TThriftConsole = class
public
procedure Write( const S: string); virtual;
procedure WriteLine( const S: string); virtual;
end;
TGUIConsole = class( TThriftConsole )
private
FLineBreak : Boolean;
FMemo : TStrings;
procedure InternalWrite( const S: string; bWriteLine: Boolean);
public
procedure Write( const S: string); override;
procedure WriteLine( const S: string); override;
constructor Create( AMemo: TStrings);
end;
function Console: TThriftConsole;
procedure ChangeConsole( AConsole: TThriftConsole );
procedure RestoreConsoleToDefault;
implementation
var
FDefaultConsole : TThriftConsole;
FConsole : TThriftConsole;
function Console: TThriftConsole;
begin
Result := FConsole;
end;
{ TThriftConsole }
procedure TThriftConsole.Write(const S: string);
begin
System.Write( S );
end;
procedure TThriftConsole.WriteLine(const S: string);
begin
System.Writeln( S );
end;
procedure ChangeConsole( AConsole: TThriftConsole );
begin
FConsole := AConsole;
end;
procedure RestoreConsoleToDefault;
begin
FConsole := FDefaultConsole;
end;
{ TGUIConsole }
constructor TGUIConsole.Create( AMemo: TStrings);
begin
inherited Create;
FMemo := AMemo;
FLineBreak := True;
end;
procedure TGUIConsole.InternalWrite(const S: string; bWriteLine: Boolean);
var
idx : Integer;
begin
if FLineBreak then
begin
FMemo.Add( S );
end else
begin
idx := FMemo.Count - 1;
if idx < 0 then
begin
FMemo.Add( S );
end;
FMemo[idx] := FMemo[idx] + S;
end;
FLineBreak := bWriteLine;
end;
procedure TGUIConsole.Write(const S: string);
begin
InternalWrite( S, False);
end;
procedure TGUIConsole.WriteLine(const S: string);
begin
InternalWrite( S, True);
end;
initialization
begin
FDefaultConsole := TThriftConsole.Create;
FConsole := FDefaultConsole;
end;
finalization
begin
FDefaultConsole.Free;
end;
end.

62
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Exception.pas generated vendored Normal file
View file

@ -0,0 +1,62 @@
(*
* 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.Exception;
interface
uses
Classes, SysUtils;
type
// base class for all Thrift exceptions
TException = class( SysUtils.Exception)
public
function Message : string; // hide inherited property: allow read, but prevent accidental writes
procedure UpdateMessageProperty; // update inherited message property with toString()
end;
implementation
{ TException }
function TException.Message;
// allow read (exception summary), but prevent accidental writes
// read will return the exception summary
begin
result := Self.ToString;
end;
procedure TException.UpdateMessageProperty;
// Update the inherited Message property to better conform to standard behaviour.
// Nice benefit: The IDE is now able to show the exception message again.
begin
inherited Message := Self.ToString; // produces a summary text
end;
end.

75
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Processor.Multiplex.pas generated vendored
View file

@ -53,11 +53,11 @@ uses
type
IMultiplexedProcessor = interface( IProcessor)
['{810FF32D-22A2-4D58-B129-B0590703ECEC}']
['{807F9D19-6CF4-4789-840E-93E87A12EB63}']
// Register a service with this TMultiplexedProcessor. This allows us
// to broker requests to individual services by using the service name
// to select them at request time.
procedure RegisterProcessor( const serviceName : String; const processor : IProcessor);
procedure RegisterProcessor( const serviceName : String; const processor : IProcessor; const asDefault : Boolean = FALSE);
end;
@ -68,16 +68,17 @@ type
// 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>;
FDefaultProcessor : IProcessor;
procedure Error( const oprot : IProtocol; const msg : IMessage;
procedure Error( const oprot : IProtocol; const msg : TThriftMessage;
extype : TApplicationExceptionSpecializedClass; const etxt : string);
public
@ -87,7 +88,7 @@ type
// Register a service with this TMultiplexedProcessorImpl. This allows us
// to broker requests to individual services by using the service name
// to select them at request time.
procedure RegisterProcessor( const serviceName : String; const processor : IProcessor);
procedure RegisterProcessor( const serviceName : String; const processor : IProcessor; const asDefault : Boolean = FALSE);
{ This implementation of process performs the following steps:
- Read the beginning of the message.
@ -105,14 +106,14 @@ type
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;
@ -135,21 +136,27 @@ begin
end;
procedure TMultiplexedProcessorImpl.RegisterProcessor( const serviceName : String; const processor : IProcessor);
procedure TMultiplexedProcessorImpl.RegisterProcessor( const serviceName : String; const processor : IProcessor; const asDefault : Boolean);
begin
FServiceProcessorMap.Add( serviceName, processor);
if asDefault then begin
if FDefaultProcessor = nil
then FDefaultProcessor := processor
else raise TApplicationExceptionInternalError.Create('Only one default service allowed');
end;
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 +170,7 @@ end;
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;
@ -184,28 +191,37 @@ begin
end;
// Extract the service name
// use FDefaultProcessor as fallback if there is no separator
idx := Pos( TMultiplexedProtocol.SEPARATOR, msg.Name);
if idx < 1 then begin
if idx > 0 then begin
// Create a new TMessage, something that can be consumed by any TProtocol
sService := Copy( msg.Name, 1, idx-1);
if not FServiceProcessorMap.TryGetValue( sService, processor)
then begin
Error( oprot, msg,
TApplicationExceptionInternalError,
Format(ERROR_UNKNOWN_SERVICE,[sService]));
Exit( FALSE);
end;
// Create a new TMessage, removing the service name
Inc( idx, Length(TMultiplexedProtocol.SEPARATOR));
Init( newMsg, Copy( msg.Name, idx, MAXINT), msg.Type_, msg.SeqID);
end
else if FDefaultProcessor <> nil then begin
processor := FDefaultProcessor;
newMsg := msg; // no need to change
end
else begin
Error( oprot, msg,
TApplicationExceptionInvalidProtocol,
Format(ERROR_INCOMPATIBLE_PROT,[msg.Name]));
Exit( FALSE);
end;
// Create a new TMessage, something that can be consumed by any TProtocol
sService := Copy( msg.Name, 1, idx-1);
if not FServiceProcessorMap.TryGetValue( sService, processor)
then begin
Error( oprot, msg,
TApplicationExceptionInternalError,
Format(ERROR_UNKNOWN_SERVICE,[sService]));
Exit( FALSE);
end;
// 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);
// Dispatch processing to the stored processor
protocol := TStoredMessageProtocol.Create( iprot, newMsg);
result := processor.process( protocol, oprot, events);
@ -213,4 +229,3 @@ end;
end.

110
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.Compact.pas generated vendored
View file

@ -123,7 +123,7 @@ type
// 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 @@ type
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 @@ type
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 @@ begin
lastFieldId_ := 0;
lastField_ := TStack<Integer>.Create;
booleanField_ := nil;
Init( booleanField_, '', TType.Stop, 0);
boolValue_ := unused;
end;
@ -293,7 +293,7 @@ procedure TCompactProtocolImpl.Reset;
begin
lastField_.Clear();
lastFieldId_ := 0;
booleanField_ := nil;
Init( booleanField_, '', TType.Stop, 0);
boolValue_ := unused;
end;
@ -301,11 +301,8 @@ end;
// 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 @@ end;
// 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 @@ end;
// 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 @@ end;
// 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 @@ end;
// 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 @@ end;
// 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 @@ end;
// 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 @@ begin
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 @@ end;
// 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 @@ begin
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 @@ end;
// 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 @@ begin
// 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 @@ begin
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 @@ end;
// 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 @@ begin
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 @@ end;
// 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 @@ begin
then size := Integer( ReadVarint32);
type_ := getTType( size_and_type);
result := TListImpl.Create( type_, size);
Init( result, type_, size);
end;
@ -764,7 +761,7 @@ end;
// 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 @@ begin
then size := Integer( ReadVarint32);
type_ := getTType( size_and_type);
result := TSetImpl.Create( type_, size);
Init( result, type_, size);
end;
@ -797,11 +794,8 @@ end;
// 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;
@ -1094,11 +1088,29 @@ end;
{$ENDIF}
{$IFDEF Debug}
procedure UnitTest;
var w : WORD;
const FPU_CW_DENORMALIZED = $0002;
begin
w := Get8087CW;
try
Set8087CW( w or FPU_CW_DENORMALIZED);
TestDoubleToInt64Bits;
TestZigZag;
TestLongBytes;
finally
Set8087CW( w);
end;
end;
{$ENDIF}
initialization
{$IFDEF Debug}
TestDoubleToInt64Bits;
TestZigZag;
TestLongBytes;
UnitTest;
{$ENDIF}
end.

72
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.JSON.pas generated vendored
View file

@ -103,7 +103,7 @@ type
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 @@ type
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 @@ type
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 @@ begin
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 @@ begin
end;
procedure TJSONProtocolImpl.WriteMessageBegin( const aMsg : IMessage);
procedure TJSONProtocolImpl.WriteMessageBegin( const aMsg : TThriftMessage);
begin
ResetContextStack; // THRIFT-1473
@ -700,7 +698,7 @@ begin
end;
procedure TJSONProtocolImpl.WriteStructBegin( const struc: IStruct);
procedure TJSONProtocolImpl.WriteStructBegin( const struc: TThriftStruct);
begin
WriteJSONObjectStart;
end;
@ -712,7 +710,7 @@ begin
end;
procedure TJSONProtocolImpl.WriteFieldBegin( const field : IField);
procedure TJSONProtocolImpl.WriteFieldBegin( const field : TThriftField);
begin
WriteJSONInteger(field.ID);
WriteJSONObjectStart;
@ -731,7 +729,7 @@ begin
// 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 @@ begin
end;
procedure TJSONProtocolImpl.WriteListBegin( const list: IList);
procedure TJSONProtocolImpl.WriteListBegin( const list: TThriftList);
begin
WriteJSONArrayStart;
WriteJSONString( GetTypeNameForTypeID( list.ElementType));
@ -762,7 +760,7 @@ begin
end;
procedure TJSONProtocolImpl.WriteSetBegin( const set_: ISet);
procedure TJSONProtocolImpl.WriteSetBegin( const set_: TThriftSet);
begin
WriteJSONArrayStart;
WriteJSONString( GetTypeNameForTypeID( set_.ElementType));
@ -1051,11 +1049,11 @@ begin
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 @@ begin
end;
function TJSONProtocolImpl.ReadStructBegin : IStruct ;
function TJSONProtocolImpl.ReadStructBegin : TThriftStruct ;
begin
ReadJSONObjectStart;
result := TStructImpl.Create('');
Init( result);
end;
@ -1086,11 +1084,11 @@ begin
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 @@ begin
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 @@ begin
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 @@ begin
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));

8
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.Multiplex.pas generated vendored
View file

@ -71,7 +71,7 @@ type
{ 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 @@ begin
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;

757
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Protocol.pas generated vendored
View file

File diff suppressed because it is too large Load diff

93
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Stream.pas generated vendored
View file

@ -38,9 +38,11 @@ uses
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 @@ type
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 @@ type
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 @@ type
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,20 @@ begin
// 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;
var pTmp : PByte;
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);
pTmp := pBuf;
Inc( pTmp, offset);
FStream.Read( pTmp, count, @Result);
end;
end;
end;
@ -162,44 +173,56 @@ begin
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;
pTmp : PByte;
begin
inherited;
if IsOpen then begin
if count > 0 then begin
FStream.Write( @buffer[0], count, @nWritten);
pTmp := pBuf;
Inc( pTmp, offset);
FStream.Write( pTmp, 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;
end;
function TThriftStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
begin
if Length(buffer) > 0
then Result := Read( @buffer[0], Length(buffer), offset, count)
else Result := 0;
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 );
if Length(buffer) > 0
then 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 +264,20 @@ begin
// 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;
var pTmp : PByte;
begin
inherited;
Result := 0;
if count >= buflen-offset
then count := buflen-offset;
if count > 0 then begin
Result := FStream.Read( Pointer(@buffer[offset])^, count)
end;
pTmp := pBuf;
Inc( pTmp, offset);
Result := FStream.Read( pTmp^, count)
end
else Result := 0;
end;
function TThriftStreamAdapterDelphi.ToArray: TBytes;
@ -276,12 +305,14 @@ begin
end
end;
procedure TThriftStreamAdapterDelphi.Write(const buffer: TBytes; offset,
count: Integer);
procedure TThriftStreamAdapterDelphi.Write(const pBuf : Pointer; offset, count: Integer);
var pTmp : PByte;
begin
inherited;
if count > 0 then begin
FStream.Write( Pointer(@buffer[offset])^, count)
pTmp := pBuf;
Inc( pTmp, offset);
FStream.Write( pTmp^, count)
end;
end;

217
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Transport.Pipes.pas generated vendored
View file

@ -48,16 +48,16 @@ type
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,37 +310,98 @@ begin
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);
var cbWritten : DWORD;
procedure TPipeStreamBase.WriteDirect( const pBuf : Pointer; offset: Integer; count: Integer);
var cbWritten, nBytes : DWORD;
pData : PByte;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
if not WriteFile( FPipe, buffer[offset], count, cbWritten, nil)
then raise TTransportExceptionNotOpen.Create('Write to pipe failed');
// if necessary, send the data in chunks
// there's a system limit around 0x10000 bytes that we hit otherwise
// MSDN: "Pipe write operations across a network are limited to 65,535 bytes per write. For more information regarding pipes, see the Remarks section."
nBytes := Min( 15*4096, count); // 16 would exceed the limit
pData := pBuf;
Inc( pData, offset);
while nBytes > 0 do begin
if not WriteFile( FPipe, pData^, nBytes, cbWritten, nil)
then raise TTransportExceptionNotOpen.Create('Write to pipe failed');
Inc( pData, cbWritten);
Dec( count, cbWritten);
nBytes := Min( nBytes, count);
end;
end;
function TPipeStreamBase.ReadDirect( var buffer: TBytes; offset, count: Integer): Integer;
var cbRead, dwErr : DWORD;
procedure TPipeStreamBase.WriteOverlapped( const pBuf : Pointer; offset: Integer; count: Integer);
var cbWritten, dwWait, dwError, nBytes : DWORD;
overlapped : IOverlappedHelper;
pData : PByte;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called write on non-open pipe');
// if necessary, send the data in chunks
// there's a system limit around 0x10000 bytes that we hit otherwise
// MSDN: "Pipe write operations across a network are limited to 65,535 bytes per write. For more information regarding pipes, see the Remarks section."
nBytes := Min( 15*4096, count); // 16 would exceed the limit
pData := pBuf;
Inc( pData, offset);
while nBytes > 0 do begin
overlapped := TOverlappedHelperImpl.Create;
if not WriteFile( FPipe, pData^, nBytes, cbWritten, overlapped.OverlappedPtr)
then begin
dwError := GetLastError;
case dwError of
ERROR_IO_PENDING : begin
dwWait := overlapped.WaitFor(FTimeout);
if (dwWait = WAIT_TIMEOUT) then begin
CancelIo( FPipe); // prevents possible AV on invalid overlapped ptr
raise TTransportExceptionTimedOut.Create('Pipe write timed out');
end;
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(nBytes) = cbWritten);
Inc( pData, cbWritten);
Dec( count, cbWritten);
nBytes := Min( nBytes, count);
end;
end;
function TPipeStreamBase.ReadDirect( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
var cbRead, dwErr, nRemaining : DWORD;
bytes, retries : LongInt;
bOk : Boolean;
pData : PByte;
const INTERVAL = 10; // ms
begin
if not IsOpen
@ -373,81 +434,68 @@ begin
end;
end;
// read the data (or block INFINITE-ly)
bOk := ReadFile( FPipe, buffer[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;
result := 0;
nRemaining := count;
pData := pBuf;
Inc( pData, offset);
while nRemaining > 0 do begin
// read the data (or block INFINITE-ly)
bOk := ReadFile( FPipe, pData^, nRemaining, cbRead, nil);
if (not bOk) and (GetLastError() <> ERROR_MORE_DATA)
then Break; // No more data, possibly because client disconnected.
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;
Dec( nRemaining, cbRead);
Inc( pData, cbRead);
Inc( result, cbRead);
end;
ASSERT( DWORD(count) = cbWritten);
end;
function TPipeStreamBase.ReadOverlapped( var buffer: TBytes; offset, count: Integer): Integer;
var cbRead, dwWait, dwError : DWORD;
function TPipeStreamBase.ReadOverlapped( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
var cbRead, dwWait, dwError, nRemaining : DWORD;
bOk : Boolean;
overlapped : IOverlappedHelper;
pData : PByte;
begin
if not IsOpen
then raise TTransportExceptionNotOpen.Create('Called read on non-open pipe');
overlapped := TOverlappedHelperImpl.Create;
result := 0;
nRemaining := count;
pData := pBuf;
Inc( pData, offset);
while nRemaining > 0 do begin
overlapped := TOverlappedHelperImpl.Create;
// read the data
bOk := ReadFile( FPipe, buffer[offset], count, cbRead, overlapped.OverlappedPtr);
if not bOk then begin
dwError := GetLastError;
case dwError of
ERROR_IO_PENDING : begin
dwWait := overlapped.WaitFor(FTimeout);
// read the data
bOk := ReadFile( FPipe, pData^, nRemaining, cbRead, overlapped.OverlappedPtr);
if not bOk then begin
dwError := GetLastError;
case dwError of
ERROR_IO_PENDING : begin
dwWait := overlapped.WaitFor(FTimeout);
if (dwWait = WAIT_TIMEOUT)
then raise TTransportExceptionTimedOut.Create('Pipe read timed out');
if (dwWait = WAIT_TIMEOUT) then begin
CancelIo( FPipe); // prevents possible AV on invalid overlapped ptr
raise TTransportExceptionTimedOut.Create('Pipe read timed out');
end;
if (dwWait <> WAIT_OBJECT_0)
or not GetOverlappedResult( FPipe, overlapped.Overlapped, cbRead, TRUE)
then raise TTransportExceptionUnknown.Create('Pipe read error');
if (dwWait <> WAIT_OBJECT_0)
or not GetOverlappedResult( FPipe, overlapped.Overlapped, cbRead, TRUE)
then raise TTransportExceptionUnknown.Create('Pipe read error');
end;
else
raise TTransportExceptionUnknown.Create(SysErrorMessage(dwError));
end;
else
raise TTransportExceptionUnknown.Create(SysErrorMessage(dwError));
end;
end;
ASSERT( cbRead > 0); // see TTransportImpl.ReadAll()
ASSERT( cbRead = DWORD(count));
result := cbRead;
ASSERT( cbRead > 0); // see TTransportImpl.ReadAll()
ASSERT( cbRead <= DWORD(nRemaining));
Dec( nRemaining, cbRead);
Inc( pData, cbRead);
Inc( result, cbRead);
end;
end;
@ -768,8 +816,6 @@ var sd : PSECURITY_DESCRIPTOR;
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 +825,14 @@ begin
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 +843,6 @@ begin
FClientAnonWrite := hCAW;
FReadHandle := hPipe;
FWriteHandle := hPipeW;
result := TRUE;
finally
if sd <> nil then LocalFree( Cardinal(sd));
end;
@ -835,8 +880,10 @@ begin
CreateNamedPipe;
while not FConnected do begin
if QueryStopServer
then Abort;
if QueryStopServer then begin
InternalClose;
Abort;
end;
if Assigned(fnAccepting)
then fnAccepting();

367
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Transport.pas generated vendored
View file

@ -39,21 +39,26 @@ uses
{$ENDIF}
{$ENDIF}
Thrift.Collections,
Thrift.Exception,
Thrift.Utils,
Thrift.Stream;
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,14 +69,18 @@ type
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;
TTransportException = class( Exception )
TTransportException = class( TException)
public
type
TExceptionType = (
@ -109,14 +118,21 @@ type
TTransportExceptionInterrupted = class (TTransportExceptionSpecialized);
IHTTPClient = interface( ITransport )
['{0F5DB8AB-710D-4338-AAC9-46B5734C5057}']
['{BA142D12-8AE6-4B50-9E33-6B7843B21D73}']
procedure SetDnsResolveTimeout(const Value: Integer);
function GetDnsResolveTimeout: Integer;
procedure SetConnectionTimeout(const Value: Integer);
function GetConnectionTimeout: Integer;
procedure SetSendTimeout(const Value: Integer);
function GetSendTimeout: Integer;
procedure SetReadTimeout(const Value: Integer);
function GetReadTimeout: Integer;
function GetCustomHeaders: IThriftDictionary<string,string>;
procedure SendRequest;
property DnsResolveTimeout: Integer read GetDnsResolveTimeout write SetDnsResolveTimeout;
property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
property SendTimeout: Integer read GetSendTimeout write SetSendTimeout;
property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
end;
@ -126,7 +142,9 @@ type
FUri : string;
FInputStream : IThriftStream;
FOutputStream : IThriftStream;
FDnsResolveTimeout : Integer;
FConnectionTimeout : Integer;
FSendTimeout : Integer;
FReadTimeout : Integer;
FCustomHeaders : IThriftDictionary<string,string>;
@ -135,17 +153,24 @@ type
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 SetDnsResolveTimeout(const Value: Integer);
function GetDnsResolveTimeout: Integer;
procedure SetConnectionTimeout(const Value: Integer);
function GetConnectionTimeout: Integer;
procedure SetSendTimeout(const Value: Integer);
function GetSendTimeout: Integer;
procedure SetReadTimeout(const Value: Integer);
function GetReadTimeout: Integer;
function GetCustomHeaders: IThriftDictionary<string,string>;
procedure SendRequest;
property DnsResolveTimeout: Integer read GetDnsResolveTimeout write SetDnsResolveTimeout;
property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
property SendTimeout: Integer read GetSendTimeout write SetSendTimeout;
property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
public
@ -193,8 +218,8 @@ type
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 +258,8 @@ type
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 +271,8 @@ type
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 +324,8 @@ type
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 +402,8 @@ type
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,38 +429,62 @@ begin
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;
if Length(buf) > 0
then result := Read( @buf[0], Length(buf), off, len)
else result := 0;
end;
function TTransportImpl.ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer;
begin
if Length(buf) > 0
then result := ReadAll( @buf[0], Length(buf), off, len)
else result := 0;
end;
procedure TTransportImpl.Write( const buf: TBytes);
begin
Self.Write( buf, 0, Length(buf) );
if Length(buf) > 0
then Write( @buf[0], 0, Length(buf));
end;
procedure TTransportImpl.Write( const buf: TBytes; off: Integer; len: Integer);
begin
if Length(buf) > 0
then 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 }
procedure THTTPClientImpl.Close;
begin
FInputStream := nil;
FOutputStream := nil;
end;
constructor THTTPClientImpl.Create(const AUri: string);
begin
inherited Create;
FUri := AUri;
// defaults according to MSDN
FDnsResolveTimeout := 0; // no timeout
FConnectionTimeout := 60 * 1000;
FSendTimeout := 30 * 1000;
FReadTimeout := 30 * 1000;
FCustomHeaders := TThriftDictionaryImpl<string,string>.Create;
FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
end;
@ -443,13 +492,18 @@ end;
function THTTPClientImpl.CreateRequest: IXMLHTTPRequest;
var
pair : TPair<string,string>;
srvHttp : IServerXMLHTTPRequest;
begin
{$IF CompilerVersion >= 21.0}
Result := CoXMLHTTP.Create;
Result := CoServerXMLHTTP.Create;
{$ELSE}
Result := CoXMLHTTPRequest.Create;
{$IFEND}
// setting a timeout value to 0 (zero) means "no timeout" for that setting
if Supports( result, IServerXMLHTTPRequest, srvHttp)
then srvHttp.setTimeouts( DnsResolveTimeout, ConnectionTimeout, SendTimeout, ReadTimeout);
Result.open('POST', FUri, False, '', '');
Result.setRequestHeader( 'Content-Type', 'application/x-thrift');
Result.setRequestHeader( 'Accept', 'application/x-thrift');
@ -466,14 +520,14 @@ begin
inherited;
end;
procedure THTTPClientImpl.Flush;
function THTTPClientImpl.GetDnsResolveTimeout: Integer;
begin
try
SendRequest;
finally
FOutputStream := nil;
FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
end;
Result := FDnsResolveTimeout;
end;
procedure THTTPClientImpl.SetDnsResolveTimeout(const Value: Integer);
begin
FDnsResolveTimeout := Value;
end;
function THTTPClientImpl.GetConnectionTimeout: Integer;
@ -481,6 +535,31 @@ begin
Result := FConnectionTimeout;
end;
procedure THTTPClientImpl.SetConnectionTimeout(const Value: Integer);
begin
FConnectionTimeout := Value;
end;
function THTTPClientImpl.GetSendTimeout: Integer;
begin
Result := FSendTimeout;
end;
procedure THTTPClientImpl.SetSendTimeout(const Value: Integer);
begin
FSendTimeout := Value;
end;
function THTTPClientImpl.GetReadTimeout: Integer;
begin
Result := FReadTimeout;
end;
procedure THTTPClientImpl.SetReadTimeout(const Value: Integer);
begin
FReadTimeout := Value;
end;
function THTTPClientImpl.GetCustomHeaders: IThriftDictionary<string,string>;
begin
Result := FCustomHeaders;
@ -491,24 +570,36 @@ begin
Result := True;
end;
function THTTPClientImpl.GetReadTimeout: Integer;
begin
Result := FReadTimeout;
end;
procedure THTTPClientImpl.Open;
begin
// nothing to do
FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
end;
function THTTPClientImpl.Read( var buf: TBytes; off, len: Integer): Integer;
procedure THTTPClientImpl.Close;
begin
FInputStream := nil;
FOutputStream := nil;
end;
procedure THTTPClientImpl.Flush;
begin
try
SendRequest;
finally
FOutputStream := nil;
FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
ASSERT( FOutputStream <> nil);
end;
end;
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);
@ -540,19 +631,9 @@ begin
end;
end;
procedure THTTPClientImpl.SetConnectionTimeout(const Value: Integer);
procedure THTTPClientImpl.Write( const pBuf : Pointer; off, len : Integer);
begin
FConnectionTimeout := Value;
end;
procedure THTTPClientImpl.SetReadTimeout(const Value: Integer);
begin
FReadTimeout := Value
end;
procedure THTTPClientImpl.Write( const buf: TBytes; off, len: Integer);
begin
FOutputStream.Write( buf, off, len);
FOutputStream.Write( pBuf, off, len);
end;
{ TTransportException }
@ -811,8 +892,13 @@ end;
procedure TSocketImpl.Close;
begin
inherited Close;
FInputStream := nil;
FOutputStream := nil;
if FOwnsClient
then FreeAndNil( FClient);
then FreeAndNil( FClient)
else FClient := nil;
end;
function TSocketImpl.GetIsOpen: Boolean;
@ -923,22 +1009,24 @@ function TBufferedStreamImpl.IsOpen: Boolean;
begin
Result := (FWriteBuffer <> nil)
and (FReadBuffer <> nil)
and (FStream <> nil);
and (FStream <> nil)
and FStream.IsOpen;
end;
procedure TBufferedStreamImpl.Open;
begin
// nothing to do
FStream.Open;
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;
pTmp : PByte;
begin
inherited;
Result := 0;
if IsOpen then begin
while count > 0 do begin
@ -953,8 +1041,10 @@ begin
end;
if FReadBuffer.Position < FReadBuffer.Size then begin
nRead := Min( FReadBuffer.Size - FReadBuffer.Position, count);
Inc( Result, FReadBuffer.Read( Pointer(@buffer[offset])^, nRead));
nRead := Min( FReadBuffer.Size - FReadBuffer.Position, count);
pTmp := pBuf;
Inc( pTmp, offset);
Inc( Result, FReadBuffer.Read( pTmp^, nRead));
Dec( count, nRead);
Inc( offset, nRead);
end;
@ -979,12 +1069,15 @@ begin
end;
end;
procedure TBufferedStreamImpl.Write( const buffer: TBytes; offset: Integer; count: Integer);
procedure TBufferedStreamImpl.Write( const pBuf : Pointer; offset: Integer; count: Integer);
var pTmp : PByte;
begin
inherited;
if count > 0 then begin
if IsOpen then begin
FWriteBuffer.Write( Pointer(@buffer[offset])^, count );
pTmp := pBuf;
Inc( pTmp, offset);
FWriteBuffer.Write( pTmp^, count );
if FWriteBuffer.Size > FBufSize then begin
Flush;
end;
@ -994,12 +1087,6 @@ end;
{ TStreamTransportImpl }
procedure TStreamTransportImpl.Close;
begin
FInputStream := nil;
FOutputStream := nil;
end;
constructor TStreamTransportImpl.Create( const AInputStream : IThriftStream; const AOutputStream : IThriftStream);
begin
inherited Create;
@ -1014,6 +1101,12 @@ begin
inherited;
end;
procedure TStreamTransportImpl.Close;
begin
FInputStream := nil;
FOutputStream := nil;
end;
procedure TStreamTransportImpl.Flush;
begin
if FOutputStream = nil then begin
@ -1035,7 +1128,7 @@ end;
function TStreamTransportImpl.GetOutputStream: IThriftStream;
begin
Result := FInputStream;
Result := FOutputStream;
end;
procedure TStreamTransportImpl.Open;
@ -1043,22 +1136,22 @@ begin
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 }
@ -1069,11 +1162,6 @@ begin
Create( ATransport, 1024 );
end;
procedure TBufferedTransportImpl.Close;
begin
FTransport.Close;
end;
constructor TBufferedTransportImpl.Create( const ATransport: IStreamTransport; ABufSize: Integer);
begin
inherited Create;
@ -1082,6 +1170,13 @@ begin
InitBuffers;
end;
procedure TBufferedTransportImpl.Close;
begin
FTransport.Close;
FInputBuffer := nil;
FOutputBuffer := nil;
end;
procedure TBufferedTransportImpl.Flush;
begin
if FOutputBuffer <> nil then begin
@ -1111,21 +1206,22 @@ end;
procedure TBufferedTransportImpl.Open;
begin
FTransport.Open
FTransport.Open;
InitBuffers; // we need to get the buffers to match FTransport substreams again
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 +1318,25 @@ begin
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;
var pTmp : PByte;
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;
pTmp := pBuf;
Inc( pTmp, off);
if (FReadBuffer <> nil) and (len > 0) then begin
result := FReadBuffer.Read( pTmp^, 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( pTmp^, len)
else Result := 0;
end;
@ -1260,14 +1357,20 @@ begin
FTransport.ReadAll( buff, 0, size );
FReadBuffer.Free;
FReadBuffer := TMemoryStream.Create;
FReadBuffer.Write( Pointer(@buff[0])^, size );
if Length(buff) > 0
then FReadBuffer.Write( Pointer(@buff[0])^, size );
FReadBuffer.Position := 0;
end;
procedure TFramedTransportImpl.Write(const buf: TBytes; off, len: Integer);
procedure TFramedTransportImpl.Write( const pBuf : Pointer; off, len : Integer);
var pTmp : PByte;
begin
if len > 0
then FWriteBuffer.Write( Pointer(@buf[off])^, len );
if len > 0 then begin
pTmp := pBuf;
Inc( pTmp, off);
FWriteBuffer.Write( pTmp^, len );
end;
end;
{ TFramedTransport.TFactory }
@ -1447,13 +1550,13 @@ end;
{$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,
msecs : Integer;
nBytes : Integer;
pDest : PByte;
pTmp : PByte;
begin
inherited;
@ -1462,11 +1565,12 @@ begin
else msecs := DEFAULT_THRIFT_TIMEOUT;
result := 0;
pDest := Pointer(@buffer[offset]);
pTmp := pBuf;
Inc( pTmp, offset);
while count > 0 do begin
while TRUE do begin
wfd := WaitForData( msecs, pDest, count, wsaError, nBytes);
wfd := WaitForData( msecs, pTmp, count, wsaError, nBytes);
case wfd of
TWaitForData.wfd_Error : Exit;
TWaitForData.wfd_HaveData : Break;
@ -1490,8 +1594,8 @@ begin
msecs := Max( msecs, 200);
ASSERT( nBytes <= count);
nBytes := FTcpClient.ReceiveBuf( pDest^, nBytes);
Inc( pDest, nBytes);
nBytes := FTcpClient.ReceiveBuf( pTmp^, nBytes);
Inc( pTmp, nBytes);
Dec( count, nBytes);
Inc( result, nBytes);
end;
@ -1513,10 +1617,11 @@ begin
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;
pTmp : PByte;
begin
inherited;
@ -1537,24 +1642,27 @@ begin
if bError or not bCanWrite
then raise TTransportExceptionUnknown.Create('unknown error');
FTcpClient.SendBuf( Pointer(@buffer[offset])^, count);
pTmp := pBuf;
Inc( pTmp, offset);
FTcpClient.SendBuf( pTmp^, 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;
pTmp : PByte;
begin
inherited;
result := 0;
pDest := Pointer(@buffer[offset]);
pTmp := pBuf;
Inc( pTmp, offset);
while count > 0 do begin
nBytes := FTcpClient.Read(pDest^, count);
nBytes := FTcpClient.Read( pTmp^, count);
if nBytes = 0 then Exit;
Inc( pDest, nBytes);
Inc( pTmp, nBytes);
Dec( count, nBytes);
Inc( result, nBytes);
end;
@ -1579,15 +1687,18 @@ begin
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
var pTmp : PByte;
begin
inherited;
if not FTcpClient.IsOpen
then raise TTransportExceptionNotOpen.Create('not open');
FTcpClient.Write(buffer[offset], count);
pTmp := pBuf;
Inc( pTmp, offset);
FTcpClient.Write( pTmp^, count);
end;
{$ENDIF}

41
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.Utils.pas generated vendored
View file

@ -69,8 +69,9 @@ type
end;
function InterlockedCompareExchange64( var Target : Int64; Exchange, Comparand : Int64) : Int64; stdcall;
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
{$IFDEF Win64}
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64;
{$ENDIF}
implementation
@ -205,8 +206,12 @@ end;
class function CharUtils.IsHighSurrogate( const c : Char) : Boolean;
begin
{$IF CompilerVersion < 23.0}
result := Character.IsHighSurrogate( c);
{$IF CompilerVersion < 25.0}
{$IFDEF OLD_UNIT_NAMES}
result := Character.IsHighSurrogate(c);
{$ELSE}
result := System.Character.IsHighSurrogate(c);
{$ENDIF}
{$ELSE}
result := c.IsHighSurrogate();
{$IFEND}
@ -215,22 +220,31 @@ end;
class function CharUtils.IsLowSurrogate( const c : Char) : Boolean;
begin
{$IF CompilerVersion < 23.0}
result := Character.IsLowSurrogate( c);
{$IF CompilerVersion < 25.0}
{$IFDEF OLD_UNIT_NAMES}
result := Character.IsLowSurrogate(c);
{$ELSE}
result := System.Character.IsLowSurrogate(c);
{$ENDIF}
{$ELSE}
result := c.IsLowSurrogate;
result := c.IsLowSurrogate();
{$IFEND}
end;
// natively available since stone age
function InterlockedCompareExchange64;
external KERNEL32 name 'InterlockedCompareExchange64';
{$IFDEF Win64}
function InterlockedCompareExchange64( var Target : Int64; Exchange, Comparand : Int64) : Int64; inline;
begin
{$IFDEF OLD_UNIT_NAMES}
result := Windows.InterlockedCompareExchange64( Target, Exchange, Comparand);
{$ELSE}
result := WinApi.Windows.InterlockedCompareExchange64( Target, Exchange, Comparand);
{$ENDIF}
end;
// natively available >= Vista
// implemented this way since there are still some people running Windows XP :-(
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64; stdcall;
function InterlockedExchangeAdd64( var Addend : Int64; Value : Int64) : Int64;
var old : Int64;
begin
repeat
@ -239,6 +253,7 @@ begin
result := Old;
end;
{$ENDIF}
end.

45
vendor/git.apache.org/thrift.git/lib/delphi/src/Thrift.pas generated vendored
View file

@ -22,15 +22,19 @@ unit Thrift;
interface
uses
SysUtils, Thrift.Protocol;
SysUtils,
Thrift.Exception,
Thrift.Protocol;
const
Version = '0.10.0';
Version = '1.0.0-dev';
type
TException = Thrift.Exception.TException; // compatibility alias
TApplicationExceptionSpecializedClass = class of TApplicationExceptionSpecialized;
TApplicationException = class( SysUtils.Exception )
TApplicationException = class( TException)
public
type
{$SCOPEDENUMS ON}
@ -83,31 +87,9 @@ type
TApplicationExceptionInvalidProtocol = class (TApplicationExceptionSpecialized);
TApplicationExceptionUnsupportedClientType = class (TApplicationExceptionSpecialized);
// base class for IDL-generated exceptions
TException = class( SysUtils.Exception)
public
function Message : string; // hide inherited property: allow read, but prevent accidental writes
procedure UpdateMessageProperty; // update inherited message property with toString()
end;
implementation
{ TException }
function TException.Message;
// allow read (exception summary), but prevent accidental writes
// read will return the exception summary
begin
result := Self.ToString;
end;
procedure TException.UpdateMessageProperty;
// Update the inherited Message property to better conform to standard behaviour.
// Nice benefit: The IDE is now able to show the exception message again.
begin
inherited Message := Self.ToString; // produces a summary text
end;
{ TApplicationException }
function TApplicationException.GetType: TExceptionType;
@ -172,10 +154,10 @@ end;
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 +202,11 @@ end;
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