Thrift-1366: Delphi generator, lirbrary and unit test.
Client: delphi
Patch: Kenjiro Fukumitsu
Adding delphi XE generator, lib and unit tests.
git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1185688 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/delphi/src/Thrift.Collections.pas b/lib/delphi/src/Thrift.Collections.pas
new file mode 100644
index 0000000..abc401f
--- /dev/null
+++ b/lib/delphi/src/Thrift.Collections.pas
@@ -0,0 +1,618 @@
+(*
+ * 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.Collections;
+
+interface
+
+uses
+ Generics.Collections, Generics.Defaults, Thrift.Utils;
+
+type
+
+{$IF CompilerVersion < 21.0}
+ TArray<T> = array of T;
+{$IFEND}
+
+ IThriftContainer = interface
+ ['{93DEF5A0-D162-461A-AB22-5B4EE0734050}']
+ function ToString: string;
+ end;
+
+ IThriftDictionary<TKey,TValue> = interface(IThriftContainer)
+ ['{25EDD506-F9D1-4008-A40F-5940364B7E46}']
+ function GetEnumerator: TEnumerator<TPair<TKey,TValue>>;
+
+ function GetKeys: TDictionary<TKey,TValue>.TKeyCollection;
+ function GetValues: TDictionary<TKey,TValue>.TValueCollection;
+ function GetItem(const Key: TKey): TValue;
+ procedure SetItem(const Key: TKey; const Value: TValue);
+ function GetCount: Integer;
+
+ procedure Add(const Key: TKey; const Value: TValue);
+ procedure Remove(const Key: TKey);
+{$IF CompilerVersion >= 21.0}
+ function ExtractPair(const Key: TKey): TPair<TKey,TValue>;
+{$IFEND}
+ procedure Clear;
+ procedure TrimExcess;
+ function TryGetValue(const Key: TKey; out Value: TValue): Boolean;
+ procedure AddOrSetValue(const Key: TKey; const Value: TValue);
+ function ContainsKey(const Key: TKey): Boolean;
+ function ContainsValue(const Value: TValue): Boolean;
+ function ToArray: TArray<TPair<TKey,TValue>>;
+
+ property Items[const Key: TKey]: TValue read GetItem write SetItem; default;
+ property Count: Integer read GetCount;
+ property Keys: TDictionary<TKey,TValue>.TKeyCollection read GetKeys;
+ property Values: TDictionary<TKey,TValue>.TValueCollection read GetValues;
+ end;
+
+ TThriftDictionaryImpl<TKey,TValue> = class( TInterfacedObject, IThriftDictionary<TKey,TValue>)
+ private
+ FDictionaly : TDictionary<TKey,TValue>;
+ protected
+ function GetEnumerator: TEnumerator<TPair<TKey,TValue>>;
+
+ function GetKeys: TDictionary<TKey,TValue>.TKeyCollection;
+ function GetValues: TDictionary<TKey,TValue>.TValueCollection;
+ function GetItem(const Key: TKey): TValue;
+ procedure SetItem(const Key: TKey; const Value: TValue);
+ function GetCount: Integer;
+
+ procedure Add(const Key: TKey; const Value: TValue);
+ procedure Remove(const Key: TKey);
+{$IF CompilerVersion >= 21.0}
+ function ExtractPair(const Key: TKey): TPair<TKey,TValue>;
+{$IFEND}
+ procedure Clear;
+ procedure TrimExcess;
+ function TryGetValue(const Key: TKey; out Value: TValue): Boolean;
+ procedure AddOrSetValue(const Key: TKey; const Value: TValue);
+ function ContainsKey(const Key: TKey): Boolean;
+ function ContainsValue(const Value: TValue): Boolean;
+ function ToArray: TArray<TPair<TKey,TValue>>;
+ property Items[const Key: TKey]: TValue read GetItem write SetItem; default;
+ property Count: Integer read GetCount;
+ property Keys: TDictionary<TKey,TValue>.TKeyCollection read GetKeys;
+ property Values: TDictionary<TKey,TValue>.TValueCollection read GetValues;
+ public
+ constructor Create(ACapacity: Integer = 0);
+ destructor Destroy; override;
+ end;
+
+ IThriftList<T> = interface(IThriftContainer)
+ ['{29BEEE31-9CB4-401B-AA04-5148A75F473B}']
+ function GetEnumerator: TEnumerator<T>;
+ function GetCapacity: Integer;
+ procedure SetCapacity(Value: Integer);
+ function GetCount: Integer;
+ procedure SetCount(Value: Integer);
+ function GetItem(Index: Integer): T;
+ procedure SetItem(Index: Integer; const Value: T);
+ function Add(const Value: T): Integer;
+ procedure AddRange(const Values: array of T); overload;
+ procedure AddRange(const Collection: IEnumerable<T>); overload;
+ procedure AddRange(Collection: TEnumerable<T>); overload;
+ procedure Insert(Index: Integer; const Value: T);
+ procedure InsertRange(Index: Integer; const Values: array of T); overload;
+ procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;
+ procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;
+ function Remove(const Value: T): Integer;
+ procedure Delete(Index: Integer);
+ procedure DeleteRange(AIndex, ACount: Integer);
+ function Extract(const Value: T): T;
+{$IF CompilerVersion >= 21.0}
+ procedure Exchange(Index1, Index2: Integer);
+ procedure Move(CurIndex, NewIndex: Integer);
+ function First: T;
+ function Last: T;
+{$IFEND}
+ procedure Clear;
+ function Contains(const Value: T): Boolean;
+ function IndexOf(const Value: T): Integer;
+ function LastIndexOf(const Value: T): Integer;
+ procedure Reverse;
+ procedure Sort; overload;
+ procedure Sort(const AComparer: IComparer<T>); overload;
+ function BinarySearch(const Item: T; out Index: Integer): Boolean; overload;
+ function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload;
+ procedure TrimExcess;
+ function ToArray: TArray<T>;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property Count: Integer read GetCount write SetCount;
+ property Items[Index: Integer]: T read GetItem write SetItem; default;
+ end;
+
+ TThriftListImpl<T> = class( TInterfacedObject, IThriftList<T>)
+ private
+ FList : TList<T>;
+ protected
+ function GetEnumerator: TEnumerator<T>;
+ function GetCapacity: Integer;
+ procedure SetCapacity(Value: Integer);
+ function GetCount: Integer;
+ procedure SetCount(Value: Integer);
+ function GetItem(Index: Integer): T;
+ procedure SetItem(Index: Integer; const Value: T);
+ function Add(const Value: T): Integer;
+ procedure AddRange(const Values: array of T); overload;
+ procedure AddRange(const Collection: IEnumerable<T>); overload;
+ procedure AddRange(Collection: TEnumerable<T>); overload;
+ procedure Insert(Index: Integer; const Value: T);
+ procedure InsertRange(Index: Integer; const Values: array of T); overload;
+ procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;
+ procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;
+ function Remove(const Value: T): Integer;
+ procedure Delete(Index: Integer);
+ procedure DeleteRange(AIndex, ACount: Integer);
+ function Extract(const Value: T): T;
+{$IF CompilerVersion >= 21.0}
+ procedure Exchange(Index1, Index2: Integer);
+ procedure Move(CurIndex, NewIndex: Integer);
+ function First: T;
+ function Last: T;
+{$IFEND}
+ procedure Clear;
+ function Contains(const Value: T): Boolean;
+ function IndexOf(const Value: T): Integer;
+ function LastIndexOf(const Value: T): Integer;
+ procedure Reverse;
+ procedure Sort; overload;
+ procedure Sort(const AComparer: IComparer<T>); overload;
+ function BinarySearch(const Item: T; out Index: Integer): Boolean; overload;
+ function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload;
+ procedure TrimExcess;
+ function ToArray: TArray<T>;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property Count: Integer read GetCount write SetCount;
+ property Items[Index: Integer]: T read GetItem write SetItem; default;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+ IHashSet<TValue> = interface(IThriftContainer)
+ ['{0923A3B5-D4D4-48A8-91AD-40238E2EAD66}']
+ function GetEnumerator: TEnumerator<TValue>;
+ function GetIsReadOnly: Boolean;
+ function GetCount: Integer;
+ property Count: Integer read GetCount;
+ property IsReadOnly: Boolean read GetIsReadOnly;
+ procedure Add( item: TValue);
+ procedure Clear;
+ function Contains( item: TValue): Boolean;
+ procedure CopyTo(var A: TArray<TValue>; arrayIndex: Integer);
+ function Remove( item: TValue ): Boolean;
+ end;
+
+ THashSetImpl<TValue> = class( TInterfacedObject, IHashSet<TValue>)
+ private
+ FDictionary : IThriftDictionary<TValue,Integer>;
+ FIsReadOnly: Boolean;
+ protected
+ function GetEnumerator: TEnumerator<TValue>;
+ function GetIsReadOnly: Boolean;
+ function GetCount: Integer;
+ property Count: Integer read GetCount;
+ property IsReadOnly: Boolean read FIsReadOnly;
+ procedure Add( item: TValue);
+ procedure Clear;
+ function Contains( item: TValue): Boolean;
+ procedure CopyTo(var A: TArray<TValue>; arrayIndex: Integer);
+ function Remove( item: TValue ): Boolean;
+ public
+ constructor Create;
+ end;
+
+implementation
+
+{ THashSetImpl<TValue> }
+
+procedure THashSetImpl<TValue>.Add(item: TValue);
+begin
+ if not FDictionary.ContainsKey(item) then
+ begin
+ FDictionary.Add( item, 0);
+ end;
+end;
+
+procedure THashSetImpl<TValue>.Clear;
+begin
+ FDictionary.Clear;
+end;
+
+function THashSetImpl<TValue>.Contains(item: TValue): Boolean;
+begin
+ Result := FDictionary.ContainsKey(item);
+end;
+
+procedure THashSetImpl<TValue>.CopyTo(var A: TArray<TValue>; arrayIndex: Integer);
+var
+ i : Integer;
+ Enumlator : TEnumerator<TValue>;
+begin
+ Enumlator := GetEnumerator;
+ while Enumlator.MoveNext do
+ begin
+ A[arrayIndex] := Enumlator.Current;
+ Inc(arrayIndex);
+ end;
+end;
+
+constructor THashSetImpl<TValue>.Create;
+begin
+ inherited;
+ FDictionary := TThriftDictionaryImpl<TValue,Integer>.Create;
+end;
+
+function THashSetImpl<TValue>.GetCount: Integer;
+begin
+ Result := FDictionary.Count;
+end;
+
+function THashSetImpl<TValue>.GetEnumerator: TEnumerator<TValue>;
+begin
+ Result := FDictionary.Keys.GetEnumerator;
+end;
+
+function THashSetImpl<TValue>.GetIsReadOnly: Boolean;
+begin
+ Result := FIsReadOnly;
+end;
+
+function THashSetImpl<TValue>.Remove(item: TValue): Boolean;
+begin
+ Result := False;
+ if FDictionary.ContainsKey( item ) then
+ begin
+ FDictionary.Remove( item );
+ Result := not FDictionary.ContainsKey( item );
+ end;
+end;
+
+{ TThriftDictionaryImpl<TKey, TValue> }
+
+procedure TThriftDictionaryImpl<TKey, TValue>.Add(const Key: TKey;
+ const Value: TValue);
+begin
+ FDictionaly.Add( Key, Value);
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.AddOrSetValue(const Key: TKey;
+ const Value: TValue);
+begin
+ FDictionaly.AddOrSetValue( Key, Value);
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.Clear;
+begin
+ FDictionaly.Clear;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.ContainsKey(
+ const Key: TKey): Boolean;
+begin
+ Result := FDictionaly.ContainsKey( Key );
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.ContainsValue(
+ const Value: TValue): Boolean;
+begin
+ Result := FDictionaly.ContainsValue( Value );
+end;
+
+constructor TThriftDictionaryImpl<TKey, TValue>.Create(ACapacity: Integer);
+begin
+ FDictionaly := TDictionary<TKey,TValue>.Create( ACapacity );
+end;
+
+destructor TThriftDictionaryImpl<TKey, TValue>.Destroy;
+begin
+ FDictionaly.Free;
+ inherited;
+end;
+
+{$IF CompilerVersion >= 21.0}
+function TThriftDictionaryImpl<TKey, TValue>.ExtractPair(
+ const Key: TKey): TPair<TKey, TValue>;
+begin
+ Result := FDictionaly.ExtractPair( Key);
+end;
+{$IFEND}
+
+function TThriftDictionaryImpl<TKey, TValue>.GetCount: Integer;
+begin
+ Result := FDictionaly.Count;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.GetEnumerator: TEnumerator<TPair<TKey, TValue>>;
+begin
+ Result := FDictionaly.GetEnumerator;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.GetItem(const Key: TKey): TValue;
+begin
+ Result := FDictionaly.Items[Key];
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.GetKeys: TDictionary<TKey, TValue>.TKeyCollection;
+begin
+ Result := FDictionaly.Keys;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.GetValues: TDictionary<TKey, TValue>.TValueCollection;
+begin
+ Result := FDictionaly.Values;
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.Remove(const Key: TKey);
+begin
+ FDictionaly.Remove( Key );
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.SetItem(const Key: TKey;
+ const Value: TValue);
+begin
+ FDictionaly.AddOrSetValue( Key, Value);
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.ToArray: TArray<TPair<TKey, TValue>>;
+{$IF CompilerVersion < 22.0}
+var
+ x : TPair<TKey, TValue>;
+ i : Integer;
+{$IFEND}
+begin
+{$IF CompilerVersion < 22.0}
+ SetLength(Result, Count);
+ i := 0;
+ for x in FDictionaly do
+ begin
+ Result[i] := x;
+ Inc( i );
+ end;
+{$ELSE}
+ Result := FDictionaly.ToArray;
+{$IFEND}
+end;
+
+procedure TThriftDictionaryImpl<TKey, TValue>.TrimExcess;
+begin
+ FDictionaly.TrimExcess;
+end;
+
+function TThriftDictionaryImpl<TKey, TValue>.TryGetValue(const Key: TKey;
+ out Value: TValue): Boolean;
+begin
+ Result := FDictionaly.TryGetValue( Key, Value);
+end;
+
+{ TThriftListImpl<T> }
+
+function TThriftListImpl<T>.Add(const Value: T): Integer;
+begin
+ Result := FList.Add( Value );
+end;
+
+procedure TThriftListImpl<T>.AddRange(Collection: TEnumerable<T>);
+begin
+ FList.AddRange( Collection );
+end;
+
+procedure TThriftListImpl<T>.AddRange(const Collection: IEnumerable<T>);
+begin
+ FList.AddRange( Collection );
+end;
+
+procedure TThriftListImpl<T>.AddRange(const Values: array of T);
+begin
+ FList.AddRange( Values );
+end;
+
+function TThriftListImpl<T>.BinarySearch(const Item: T;
+ out Index: Integer): Boolean;
+begin
+ Result := FList.BinarySearch( Item, Index);
+end;
+
+function TThriftListImpl<T>.BinarySearch(const Item: T; out Index: Integer;
+ const AComparer: IComparer<T>): Boolean;
+begin
+ Result := FList.BinarySearch( Item, Index, AComparer);
+end;
+
+procedure TThriftListImpl<T>.Clear;
+begin
+ FList.Clear;
+end;
+
+function TThriftListImpl<T>.Contains(const Value: T): Boolean;
+begin
+ Result := FList.Contains( Value );
+end;
+
+constructor TThriftListImpl<T>.Create;
+begin
+ FList := TList<T>.Create;
+end;
+
+procedure TThriftListImpl<T>.Delete(Index: Integer);
+begin
+ FList.Delete( Index )
+end;
+
+procedure TThriftListImpl<T>.DeleteRange(AIndex, ACount: Integer);
+begin
+ FList.DeleteRange( AIndex, ACount)
+end;
+
+destructor TThriftListImpl<T>.Destroy;
+begin
+ FList.Free;
+ inherited;
+end;
+
+{$IF CompilerVersion >= 21.0}
+procedure TThriftListImpl<T>.Exchange(Index1, Index2: Integer);
+begin
+ FList.Exchange( Index1, Index2 )
+end;
+{$IFEND}
+
+function TThriftListImpl<T>.Extract(const Value: T): T;
+begin
+ Result := FList.Extract( Value )
+end;
+
+{$IF CompilerVersion >= 21.0}
+function TThriftListImpl<T>.First: T;
+begin
+ Result := FList.First;
+end;
+{$IFEND}
+
+function TThriftListImpl<T>.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+function TThriftListImpl<T>.GetCount: Integer;
+begin
+ Result := FList.Count;
+end;
+
+function TThriftListImpl<T>.GetEnumerator: TEnumerator<T>;
+begin
+ Result := FList.GetEnumerator;
+end;
+
+function TThriftListImpl<T>.GetItem(Index: Integer): T;
+begin
+ Result := FList[Index];
+end;
+
+function TThriftListImpl<T>.IndexOf(const Value: T): Integer;
+begin
+ Result := FList.IndexOf( Value );
+end;
+
+procedure TThriftListImpl<T>.Insert(Index: Integer; const Value: T);
+begin
+ FList.Insert( Index, Value);
+end;
+
+procedure TThriftListImpl<T>.InsertRange(Index: Integer;
+ const Collection: TEnumerable<T>);
+begin
+ FList.InsertRange( Index, Collection );
+end;
+
+procedure TThriftListImpl<T>.InsertRange(Index: Integer;
+ const Values: array of T);
+begin
+ FList.InsertRange( Index, Values);
+end;
+
+procedure TThriftListImpl<T>.InsertRange(Index: Integer;
+ const Collection: IEnumerable<T>);
+begin
+ FList.InsertRange( Index, Collection );
+end;
+
+{$IF CompilerVersion >= 21.0}
+function TThriftListImpl<T>.Last: T;
+begin
+ Result := FList.Last;
+end;
+{$IFEND}
+
+function TThriftListImpl<T>.LastIndexOf(const Value: T): Integer;
+begin
+ Result := FList.LastIndexOf( Value );
+end;
+
+{$IF CompilerVersion >= 21.0}
+procedure TThriftListImpl<T>.Move(CurIndex, NewIndex: Integer);
+begin
+ FList.Move( CurIndex, NewIndex);
+end;
+{$IFEND}
+
+function TThriftListImpl<T>.Remove(const Value: T): Integer;
+begin
+ Result := FList.Remove( Value );
+end;
+
+procedure TThriftListImpl<T>.Reverse;
+begin
+ FList.Reverse;
+end;
+
+procedure TThriftListImpl<T>.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+procedure TThriftListImpl<T>.SetCount(Value: Integer);
+begin
+ FList.Count := Value;
+end;
+
+procedure TThriftListImpl<T>.SetItem(Index: Integer; const Value: T);
+begin
+ FList[Index] := Value;
+end;
+
+procedure TThriftListImpl<T>.Sort;
+begin
+ FList.Sort;
+end;
+
+procedure TThriftListImpl<T>.Sort(const AComparer: IComparer<T>);
+begin
+ FList.Sort;
+end;
+
+function TThriftListImpl<T>.ToArray: TArray<T>;
+{$IF CompilerVersion < 22.0}
+var
+ x : T;
+ i : Integer;
+{$IFEND}
+begin
+{$IF CompilerVersion < 22.0}
+ SetLength(Result, Count);
+ i := 0;
+ for x in FList do
+ begin
+ Result[i] := x;
+ Inc( i );
+ end;
+{$ELSE}
+ Result := FList.ToArray;
+{$IFEND}
+end;
+
+procedure TThriftListImpl<T>.TrimExcess;
+begin
+ FList.TrimExcess;
+end;
+
+end.
diff --git a/lib/delphi/src/Thrift.Console.pas b/lib/delphi/src/Thrift.Console.pas
new file mode 100644
index 0000000..324efc3
--- /dev/null
+++ b/lib/delphi/src/Thrift.Console.pas
@@ -0,0 +1,132 @@
+(*
+ * 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
+ StdCtrls;
+
+type
+ TThriftConsole = class
+ public
+ procedure Write( const S: string); virtual;
+ procedure WriteLine( const S: string); virtual;
+ end;
+
+ TGUIConsole = class( TThriftConsole )
+ private
+ FLineBreak : Boolean;
+ FMemo : TMemo;
+
+ procedure InternalWrite( const S: string; bWriteLine: Boolean);
+ public
+ procedure Write( const S: string); override;
+ procedure WriteLine( const S: string); override;
+ constructor Create( AMemo: TMemo);
+ 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: TMemo);
+begin
+ FMemo := AMemo;
+ FLineBreak := True;
+end;
+
+procedure TGUIConsole.InternalWrite(const S: string; bWriteLine: Boolean);
+var
+ idx : Integer;
+begin
+ if FLineBreak then
+ begin
+ FMemo.Lines.Add( S );
+ end else
+ begin
+ idx := FMemo.Lines.Count - 1;
+ if idx < 0 then
+ begin
+ FMemo.Lines.Add( S );
+ end;
+ FMemo.Lines[idx] := FMemo.Lines[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.
+
diff --git a/lib/delphi/src/Thrift.Protocol.pas b/lib/delphi/src/Thrift.Protocol.pas
new file mode 100644
index 0000000..8fa6008
--- /dev/null
+++ b/lib/delphi/src/Thrift.Protocol.pas
@@ -0,0 +1,1178 @@
+(*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *)
+
+{$SCOPEDENUMS ON}
+
+unit Thrift.Protocol;
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ Contnrs,
+ Thrift.Stream,
+ Thrift.Collections,
+ Thrift.Transport;
+
+type
+
+ TType = (
+ Stop = 0,
+ Void = 1,
+ Bool_ = 2,
+ Byte_ = 3,
+ Double_ = 4,
+ I16 = 6,
+ I32 = 8,
+ I64 = 10,
+ String_ = 11,
+ Struct = 12,
+ Map = 13,
+ Set_ = 14,
+ List = 15
+ );
+
+ TMessageType = (
+ Call = 1,
+ Reply = 2,
+ Exception = 3,
+ Oneway = 4
+ );
+
+ IProtocol = interface;
+ IStruct = interface;
+
+ IProtocolFactory = interface
+ ['{7CD64A10-4E9F-4E99-93BF-708A31F4A67B}']
+ function GetProtocol( trans: ITransport): IProtocol;
+ end;
+
+ TThriftStringBuilder = class( TStringBuilder)
+ public
+ function Append(const Value: TBytes): TStringBuilder; overload;
+ function Append(const Value: IThriftContainer): TStringBuilder; overload;
+ end;
+
+ TProtocolException = class( Exception )
+ public
+ const
+ UNKNOWN : Integer = 0;
+ INVALID_DATA : Integer = 1;
+ NEGATIVE_SIZE : Integer = 2;
+ SIZE_LIMIT : Integer = 3;
+ BAD_VERSION : Integer = 4;
+ NOT_IMPLEMENTED : Integer = 5;
+ protected
+ FType : Integer;
+ public
+ constructor Create; overload;
+ constructor Create( type_: Integer ); overload;
+ constructor Create( type_: Integer; const msg: string); overload;
+ end;
+
+ IMap = interface
+ ['{30531D97-7E06-4233-B800-C3F53CCD23E7}']
+ function GetKeyType: TType;
+ procedure SetKeyType( Value: TType);
+ function GetValueType: TType;
+ procedure SetValueType( Value: TType);
+ function GetCount: Integer;
+ procedure SetCount( Value: Integer);
+ property KeyType: TType read GetKeyType write SetKeyType;
+ property ValueType: TType read GetValueType write SetValueType;
+ property Count: Integer read GetCount write SetCount;
+ end;
+
+ TMapImpl = class( TInterfacedObject, IMap)
+ private
+ FValueType: TType;
+ FKeyType: TType;
+ FCount: Integer;
+ protected
+ function GetKeyType: TType;
+ procedure SetKeyType( Value: TType);
+ function GetValueType: TType;
+ procedure SetValueType( Value: TType);
+ function GetCount: Integer;
+ procedure SetCount( Value: Integer);
+ public
+ constructor Create( AValueType: TType; AKeyType: TType; ACount: Integer); overload;
+ constructor Create; overload;
+ end;
+
+ IList = interface
+ ['{6763E1EA-A934-4472-904F-0083980B9B87}']
+ function GetElementType: TType;
+ procedure SetElementType( Value: TType);
+ function GetCount: Integer;
+ procedure SetCount( Value: Integer);
+ property ElementType: TType read GetElementType write SetElementType;
+ property Count: Integer read GetCount write SetCount;
+ end;
+
+ TListImpl = class( TInterfacedObject, IList)
+ private
+ FElementType: TType;
+ FCount : Integer;
+ protected
+ function GetElementType: TType;
+ procedure SetElementType( Value: TType);
+ function GetCount: Integer;
+ procedure SetCount( Value: Integer);
+ public
+ constructor Create( AElementType: TType; ACount: Integer); overload;
+ constructor Create; overload;
+ end;
+
+ ISet = interface
+ ['{A8671700-7514-4C1E-8A05-62786872005F}']
+ function GetElementType: TType;
+ procedure SetElementType( Value: TType);
+ function GetCount: Integer;
+ procedure SetCount( Value: Integer);
+ property ElementType: TType read GetElementType write SetElementType;
+ property Count: Integer read GetCount write SetCount;
+ end;
+
+ TSetImpl = class( TInterfacedObject, ISet)
+ private
+ FCount: Integer;
+ FElementType: TType;
+ protected
+ function GetElementType: TType;
+ procedure SetElementType( Value: TType);
+ function GetCount: Integer;
+ procedure SetCount( Value: Integer);
+ public
+ constructor Create( AElementType: TType; ACount: Integer); overload;
+ constructor Create; overload;
+ end;
+
+ IMessage = interface
+ ['{9E368B4A-B1FA-43E7-8CF5-56C66D256CA7}']
+ function GetName: string;
+ procedure SetName( const Value: string);
+ function GetType: TMessageType;
+ procedure SetType( Value: TMessageType);
+ function GetSeqID: Integer;
+ procedure SetSeqID( Value: Integer);
+ property Name: string read GetName write SetName;
+ property Type_: TMessageType read GetType write SetType;
+ property SeqID: Integer read GetSeqID write SetSeqID;
+ end;
+
+ TMessageImpl = class( TInterfacedObject, IMessage )
+ private
+ FName: string;
+ FMessageType: TMessageType;
+ FSeqID: Integer;
+ protected
+ function GetName: string;
+ procedure SetName( const Value: string);
+ function GetType: TMessageType;
+ procedure SetType( Value: TMessageType);
+ function GetSeqID: Integer;
+ procedure SetSeqID( Value: Integer);
+ public
+ property Name: string read FName write FName;
+ property Type_: TMessageType read FMessageType write FMessageType;
+ property SeqID: Integer read FSeqID write FSeqID;
+ constructor Create( AName: string; AMessageType: TMessageType; ASeqID: Integer); overload;
+ constructor Create; overload;
+ end;
+
+ IField = interface
+ ['{F0D43BE5-7883-442E-83FF-0580CC632B72}']
+ function GetName: string;
+ procedure SetName( const Value: string);
+ function GetType: TType;
+ procedure SetType( Value: TType);
+ function GetId: SmallInt;
+ procedure SetId( Value: SmallInt);
+ property Name: string read GetName write SetName;
+ property Type_: TType read GetType write SetType;
+ property Id: SmallInt read GetId write SetId;
+ end;
+
+ TFieldImpl = class( TInterfacedObject, IField)
+ private
+ FName : string;
+ FType : TType;
+ FId : SmallInt;
+ protected
+ function GetName: string;
+ procedure SetName( const Value: string);
+ function GetType: TType;
+ procedure SetType( Value: TType);
+ function GetId: SmallInt;
+ procedure SetId( Value: SmallInt);
+ public
+ constructor Create( const AName: string; const AType: TType; AId: SmallInt); overload;
+ constructor Create; overload;
+ end;
+
+ TProtocolUtil = class
+ public
+ class procedure Skip( prot: IProtocol; type_: TType);
+ end;
+
+ IProtocol = interface
+ ['{FD95C151-1527-4C96-8134-B902BFC4B4FC}']
+ function GetTransport: ITransport;
+ procedure WriteMessageBegin( message: IMessage);
+ procedure WriteMessageEnd;
+ procedure WriteStructBegin(struc: IStruct);
+ procedure WriteStructEnd;
+ procedure WriteFieldBegin(field: IField);
+ procedure WriteFieldEnd;
+ procedure WriteFieldStop;
+ procedure WriteMapBegin(map: IMap);
+ procedure WriteMapEnd;
+ procedure WriteListBegin( list: IList);
+ procedure WriteListEnd();
+ procedure WriteSetBegin( set_: ISet );
+ procedure WriteSetEnd();
+ procedure WriteBool( b: Boolean);
+ procedure WriteByte( b: ShortInt);
+ procedure WriteI16( i16: SmallInt);
+ procedure WriteI32( i32: Integer);
+ procedure WriteI64( i64: Int64);
+ procedure WriteDouble( d: Double);
+ procedure WriteString( const s: string );
+ procedure WriteAnsiString( const s: AnsiString);
+ procedure WriteBinary( const b: TBytes);
+
+ function ReadMessageBegin: IMessage;
+ procedure ReadMessageEnd();
+ function ReadStructBegin: IStruct;
+ procedure ReadStructEnd;
+ function ReadFieldBegin: IField;
+ procedure ReadFieldEnd();
+ function ReadMapBegin: IMap;
+ procedure ReadMapEnd();
+ function ReadListBegin: IList;
+ procedure ReadListEnd();
+ function ReadSetBegin: ISet;
+ procedure ReadSetEnd();
+ function ReadBool: Boolean;
+ function ReadByte: ShortInt;
+ function ReadI16: SmallInt;
+ function ReadI32: Integer;
+ function ReadI64: Int64;
+ function ReadDouble:Double;
+ function ReadBinary: TBytes;
+ function ReadString: string;
+ function ReadAnsiString: AnsiString;
+ property Transport: ITransport read GetTransport;
+ end;
+
+ TProtocolImpl = class abstract( TInterfacedObject, IProtocol)
+ protected
+ FTrans : ITransport;
+ function GetTransport: ITransport;
+ public
+ procedure WriteMessageBegin( message: IMessage); virtual; abstract;
+ procedure WriteMessageEnd; virtual; abstract;
+ procedure WriteStructBegin(struc: IStruct); virtual; abstract;
+ procedure WriteStructEnd; virtual; abstract;
+ procedure WriteFieldBegin(field: IField); virtual; abstract;
+ procedure WriteFieldEnd; virtual; abstract;
+ procedure WriteFieldStop; virtual; abstract;
+ procedure WriteMapBegin(map: IMap); virtual; abstract;
+ procedure WriteMapEnd; virtual; abstract;
+ procedure WriteListBegin( list: IList); virtual; abstract;
+ procedure WriteListEnd(); virtual; abstract;
+ procedure WriteSetBegin( set_: ISet ); virtual; abstract;
+ procedure WriteSetEnd(); virtual; abstract;
+ procedure WriteBool( b: Boolean); virtual; abstract;
+ procedure WriteByte( b: ShortInt); virtual; abstract;
+ procedure WriteI16( i16: SmallInt); virtual; abstract;
+ procedure WriteI32( i32: Integer); virtual; abstract;
+ procedure WriteI64( i64: Int64); virtual; abstract;
+ procedure WriteDouble( d: Double); virtual; abstract;
+ procedure WriteString( const s: string ); virtual;
+ procedure WriteAnsiString( const s: AnsiString); virtual;
+ procedure WriteBinary( const b: TBytes); virtual; abstract;
+
+ function ReadMessageBegin: IMessage; virtual; abstract;
+ procedure ReadMessageEnd(); virtual; abstract;
+ function ReadStructBegin: IStruct; virtual; abstract;
+ procedure ReadStructEnd; virtual; abstract;
+ function ReadFieldBegin: IField; virtual; abstract;
+ procedure ReadFieldEnd(); virtual; abstract;
+ function ReadMapBegin: IMap; virtual; abstract;
+ procedure ReadMapEnd(); virtual; abstract;
+ function ReadListBegin: IList; virtual; abstract;
+ procedure ReadListEnd(); virtual; abstract;
+ function ReadSetBegin: ISet; virtual; abstract;
+ procedure ReadSetEnd(); virtual; abstract;
+ function ReadBool: Boolean; virtual; abstract;
+ function ReadByte: ShortInt; virtual; abstract;
+ function ReadI16: SmallInt; virtual; abstract;
+ function ReadI32: Integer; virtual; abstract;
+ function ReadI64: Int64; virtual; abstract;
+ function ReadDouble:Double; virtual; abstract;
+ function ReadBinary: TBytes; virtual; abstract;
+ function ReadString: string; virtual;
+ function ReadAnsiString: AnsiString; virtual;
+
+ property Transport: ITransport read GetTransport;
+
+ constructor Create( trans: ITransport );
+ end;
+
+ IBase = interface
+ ['{08D9BAA8-5EAA-410F-B50B-AC2E6E5E4155}']
+ function ToString: string;
+ procedure Read( iprot: IProtocol);
+ procedure Write( iprot: IProtocol);
+ end;
+
+ IStruct = interface
+ ['{5DCE39AA-C916-4BC7-A79B-96A0C36B2220}']
+ procedure SetName(const Value: string);
+ function GetName: string;
+ property Name: string read GetName write SetName;
+ end;
+
+ TStructImpl = class( TInterfacedObject, IStruct )
+ private
+ FName: string;
+ protected
+ function GetName: string;
+ procedure SetName(const Value: string);
+ public
+ constructor Create( const AName: string);
+ end;
+
+ TBinaryProtocolImpl = class( TProtocolImpl )
+ protected
+ const
+ VERSION_MASK : Cardinal = $ffff0000;
+ VERSION_1 : Cardinal = $80010000;
+ protected
+ FStrictRead : Boolean;
+ FStrictWrite : Boolean;
+ FReadLength : Integer;
+ FCheckReadLength : Boolean;
+
+ private
+ function ReadAll( var buf: TBytes; off: Integer; len: Integer ): Integer;
+ function ReadStringBody( size: Integer): string;
+ procedure CheckReadLength( len: Integer );
+ public
+
+ type
+ TFactory = class( TInterfacedObject, IProtocolFactory)
+ protected
+ FStrictRead : Boolean;
+ FStrictWrite : Boolean;
+ public
+ function GetProtocol(trans: ITransport): IProtocol;
+ constructor Create( AStrictRead, AStrictWrite: Boolean ); overload;
+ constructor Create; overload;
+ end;
+
+ constructor Create( trans: ITransport); overload;
+ constructor Create( trans: ITransport; strictRead: Boolean; strictWrite: Boolean); overload;
+
+ procedure WriteMessageBegin( message: IMessage); override;
+ procedure WriteMessageEnd; override;
+ procedure WriteStructBegin(struc: IStruct); override;
+ procedure WriteStructEnd; override;
+ procedure WriteFieldBegin(field: IField); override;
+ procedure WriteFieldEnd; override;
+ procedure WriteFieldStop; override;
+ procedure WriteMapBegin(map: IMap); override;
+ procedure WriteMapEnd; override;
+ procedure WriteListBegin( list: IList); override;
+ procedure WriteListEnd(); override;
+ procedure WriteSetBegin( set_: ISet ); override;
+ procedure WriteSetEnd(); override;
+ procedure WriteBool( b: Boolean); override;
+ procedure WriteByte( b: ShortInt); override;
+ procedure WriteI16( i16: SmallInt); override;
+ procedure WriteI32( i32: Integer); override;
+ procedure WriteI64( i64: Int64); override;
+ procedure WriteDouble( d: Double); override;
+ procedure WriteBinary( const b: TBytes); override;
+
+ function ReadMessageBegin: IMessage; override;
+ procedure ReadMessageEnd(); override;
+ function ReadStructBegin: IStruct; override;
+ procedure ReadStructEnd; override;
+ function ReadFieldBegin: IField; override;
+ procedure ReadFieldEnd(); override;
+ function ReadMapBegin: IMap; override;
+ procedure ReadMapEnd(); override;
+ function ReadListBegin: IList; override;
+ procedure ReadListEnd(); override;
+ function ReadSetBegin: ISet; override;
+ procedure ReadSetEnd(); override;
+ function ReadBool: Boolean; override;
+ function ReadByte: ShortInt; override;
+ function ReadI16: SmallInt; override;
+ function ReadI32: Integer; override;
+ function ReadI64: Int64; override;
+ function ReadDouble:Double; override;
+ function ReadBinary: TBytes; override;
+
+ procedure SetReadLength( readLength: Integer );
+ end;
+
+implementation
+
+function ConvertInt64ToDouble( n: Int64): Double;
+begin
+ ASSERT( SizeOf(n) = SizeOf(Result));
+ System.Move( n, Result, SizeOf(Result));
+end;
+
+function ConvertDoubleToInt64( d: Double): Int64;
+begin
+ ASSERT( SizeOf(d) = SizeOf(Result));
+ System.Move( d, Result, SizeOf(Result));
+end;
+
+{ TFieldImpl }
+
+constructor TFieldImpl.Create(const AName: string; const AType: TType;
+ AId: SmallInt);
+begin
+ FName := AName;
+ FType := AType;
+ FId := AId;
+end;
+
+constructor TFieldImpl.Create;
+begin
+ 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;
+
+{ TProtocolImpl }
+
+constructor TProtocolImpl.Create(trans: ITransport);
+begin
+ inherited Create;
+ FTrans := trans;
+end;
+
+function TProtocolImpl.GetTransport: ITransport;
+begin
+ Result := FTrans;
+end;
+
+function TProtocolImpl.ReadAnsiString: AnsiString;
+var
+ b : TBytes;
+ len : Integer;
+begin
+ Result := '';
+ b := ReadBinary;
+ len := Length( b );
+ if len > 0 then
+ begin
+ SetLength( Result, len);
+ System.Move( b[0], Pointer(Result)^, len );
+ end;
+end;
+
+function TProtocolImpl.ReadString: string;
+begin
+ Result := TEncoding.UTF8.GetString( ReadBinary );
+end;
+
+procedure TProtocolImpl.WriteAnsiString(const s: AnsiString);
+var
+ b : TBytes;
+ len : Integer;
+begin
+ len := Length(s);
+ SetLength( b, len);
+ if len > 0 then
+ begin
+ System.Move( Pointer(s)^, b[0], len );
+ end;
+ WriteBinary( b );
+end;
+
+procedure TProtocolImpl.WriteString(const s: string);
+var
+ b : TBytes;
+begin
+ b := TEncoding.UTF8.GetBytes(s);
+ WriteBinary( b );
+end;
+
+{ TProtocolUtil }
+
+class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType);
+begin
+
+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(AValueType, AKeyType: TType; ACount: Integer);
+begin
+ inherited Create;
+ FValueType := AValueType;
+ FKeyType := AKeyType;
+ FCount := ACount;
+end;
+
+constructor TMapImpl.Create;
+begin
+
+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
+
+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
+
+end;
+
+function TListImpl.GetCount: Integer;
+begin
+ Result := FCount;
+end;
+
+function TListImpl.GetElementType: TType;
+begin
+ Result := FElementType;
+end;
+
+procedure TListImpl.SetCount(Value: Integer);
+begin
+ FCount := Value;
+end;
+
+procedure TListImpl.SetElementType(Value: TType);
+begin
+ FElementType := Value;
+end;
+
+{ TBinaryProtocolImpl }
+
+constructor TBinaryProtocolImpl.Create( trans: ITransport);
+begin
+ Create( trans, False, True);
+end;
+
+procedure TBinaryProtocolImpl.CheckReadLength(len: Integer);
+begin
+ if FCheckReadLength then
+ begin
+ Dec( FReadLength, len);
+ if FReadLength < 0 then
+ begin
+ raise Exception.Create( 'Message length exceeded: ' + IntToStr( len ) );
+ end;
+ end;
+end;
+
+constructor TBinaryProtocolImpl.Create(trans: ITransport; strictRead,
+ strictWrite: Boolean);
+begin
+ inherited Create( trans );
+ FStrictRead := strictRead;
+ FStrictWrite := strictWrite;
+end;
+
+function TBinaryProtocolImpl.ReadAll( var buf: TBytes; off,
+ len: Integer): Integer;
+begin
+ CheckReadLength( len );
+ Result := FTrans.ReadAll( buf, off, len );
+end;
+
+function TBinaryProtocolImpl.ReadBinary: TBytes;
+var
+ size : Integer;
+ buf : TBytes;
+begin
+ size := ReadI32;
+ CheckReadLength( size );
+ SetLength( buf, size );
+ FTrans.ReadAll( buf, 0, size);
+ Result := buf;
+end;
+
+function TBinaryProtocolImpl.ReadBool: Boolean;
+begin
+ Result := ReadByte = 1;
+end;
+
+function TBinaryProtocolImpl.ReadByte: ShortInt;
+var
+ bin : TBytes;
+begin
+ SetLength( bin, 1);
+ ReadAll( bin, 0, 1 );
+ Result := ShortInt( bin[0]);
+end;
+
+function TBinaryProtocolImpl.ReadDouble: Double;
+begin
+ Result := ConvertInt64ToDouble( ReadI64 )
+end;
+
+function TBinaryProtocolImpl.ReadFieldBegin: IField;
+var
+ field : IField;
+begin
+ field := TFieldImpl.Create;
+ field.Type_ := TType( ReadByte);
+ if ( field.Type_ <> TType.Stop ) then
+ begin
+ field.Id := ReadI16;
+ end;
+ Result := field;
+end;
+
+procedure TBinaryProtocolImpl.ReadFieldEnd;
+begin
+
+end;
+
+function TBinaryProtocolImpl.ReadI16: SmallInt;
+var
+ i16in : TBytes;
+begin
+ SetLength( i16in, 2 );
+ ReadAll( i16in, 0, 2);
+ Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF));
+end;
+
+function TBinaryProtocolImpl.ReadI32: Integer;
+var
+ i32in : TBytes;
+begin
+ SetLength( i32in, 4 );
+ ReadAll( i32in, 0, 4);
+
+ Result := Integer(
+ ((i32in[0] and $FF) shl 24) or
+ ((i32in[1] and $FF) shl 16) or
+ ((i32in[2] and $FF) shl 8) or
+ (i32in[3] and $FF));
+
+end;
+
+function TBinaryProtocolImpl.ReadI64: Int64;
+var
+ i64in : TBytes;
+begin
+ SetLength( i64in, 8);
+ ReadAll( i64in, 0, 8);
+ Result :=
+ (Int64( i64in[0] and $FF) shl 56) or
+ (Int64( i64in[1] and $FF) shl 48) or
+ (Int64( i64in[2] and $FF) shl 40) or
+ (Int64( i64in[3] and $FF) shl 32) or
+ (Int64( i64in[4] and $FF) shl 24) or
+ (Int64( i64in[5] and $FF) shl 16) or
+ (Int64( i64in[6] and $FF) shl 8) or
+ (Int64( i64in[7] and $FF));
+end;
+
+function TBinaryProtocolImpl.ReadListBegin: IList;
+var
+ list : IList;
+begin
+ list := TListImpl.Create;
+ list.ElementType := TType( ReadByte );
+ list.Count := ReadI32;
+ Result := list;
+end;
+
+procedure TBinaryProtocolImpl.ReadListEnd;
+begin
+
+end;
+
+function TBinaryProtocolImpl.ReadMapBegin: IMap;
+var
+ map : IMap;
+begin
+ map := TMapImpl.Create;
+ map.KeyType := TType( ReadByte );
+ map.ValueType := TType( ReadByte );
+ map.Count := ReadI32;
+ Result := map;
+end;
+
+procedure TBinaryProtocolImpl.ReadMapEnd;
+begin
+
+end;
+
+function TBinaryProtocolImpl.ReadMessageBegin: IMessage;
+var
+ size : Integer;
+ version : Integer;
+ message : IMessage;
+begin
+ message := TMessageImpl.Create;
+ size := ReadI32;
+ if (size < 0) then
+ begin
+ version := size and Integer( VERSION_MASK);
+ if ( version <> Integer( VERSION_1)) then
+ begin
+ raise TProtocolException.Create(TProtocolException.BAD_VERSION, 'Bad version in ReadMessageBegin: ' + IntToStr(version) );
+ end;
+ message.Type_ := TMessageType( size and $000000ff);
+ message.Name := ReadString;
+ message.SeqID := ReadI32;
+ end else
+ begin
+ if FStrictRead then
+ begin
+ raise TProtocolException.Create( TProtocolException.BAD_VERSION, 'Missing version in readMessageBegin, old client?' );
+ end;
+ message.Name := ReadStringBody( size );
+ message.Type_ := TMessageType( ReadByte );
+ message.SeqID := ReadI32;
+ end;
+ Result := message;
+end;
+
+procedure TBinaryProtocolImpl.ReadMessageEnd;
+begin
+ inherited;
+
+end;
+
+function TBinaryProtocolImpl.ReadSetBegin: ISet;
+var
+ set_ : ISet;
+begin
+ set_ := TSetImpl.Create;
+ set_.ElementType := TType( ReadByte );
+ set_.Count := ReadI32;
+ Result := set_;
+end;
+
+procedure TBinaryProtocolImpl.ReadSetEnd;
+begin
+
+end;
+
+function TBinaryProtocolImpl.ReadStringBody( size: Integer): string;
+var
+ buf : TBytes;
+begin
+ CheckReadLength( size );
+ SetLength( buf, size );
+ FTrans.ReadAll( buf, 0, size );
+ Result := TEncoding.UTF8.GetString( buf);
+end;
+
+function TBinaryProtocolImpl.ReadStructBegin: IStruct;
+begin
+ Result := TStructImpl.Create('');
+end;
+
+procedure TBinaryProtocolImpl.ReadStructEnd;
+begin
+ inherited;
+
+end;
+
+procedure TBinaryProtocolImpl.SetReadLength(readLength: Integer);
+begin
+ FReadLength := readLength;
+ FCheckReadLength := True;
+end;
+
+procedure TBinaryProtocolImpl.WriteBinary( const b: TBytes);
+begin
+ WriteI32( Length(b));
+ FTrans.Write(b, 0, Length( b));
+end;
+
+procedure TBinaryProtocolImpl.WriteBool(b: Boolean);
+begin
+ if b then
+ begin
+ WriteByte( 1 );
+ end else
+ begin
+ WriteByte( 0 );
+ end;
+end;
+
+procedure TBinaryProtocolImpl.WriteByte(b: ShortInt);
+var
+ a : TBytes;
+begin
+ SetLength( a, 1);
+ a[0] := Byte( b );
+ FTrans.Write( a, 0, 1 );
+end;
+
+procedure TBinaryProtocolImpl.WriteDouble(d: Double);
+begin
+ WriteI64(ConvertDoubleToInt64(d));
+end;
+
+procedure TBinaryProtocolImpl.WriteFieldBegin(field: IField);
+begin
+ WriteByte(ShortInt(field.Type_));
+ WriteI16(field.ID);
+end;
+
+procedure TBinaryProtocolImpl.WriteFieldEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteFieldStop;
+begin
+ WriteByte(ShortInt(TType.Stop));
+end;
+
+procedure TBinaryProtocolImpl.WriteI16(i16: SmallInt);
+var
+ i16out : TBytes;
+begin
+ SetLength( i16out, 2);
+ i16out[0] := Byte($FF and (i16 shr 8));
+ i16out[1] := Byte($FF and i16);
+ FTrans.Write( i16out );
+end;
+
+procedure TBinaryProtocolImpl.WriteI32(i32: Integer);
+var
+ i32out : TBytes;
+begin
+ SetLength( i32out, 4);
+ i32out[0] := Byte($FF and (i32 shr 24));
+ i32out[1] := Byte($FF and (i32 shr 16));
+ i32out[2] := Byte($FF and (i32 shr 8));
+ i32out[3] := Byte($FF and i32);
+ FTrans.Write( i32out, 0, 4);
+end;
+
+procedure TBinaryProtocolImpl.WriteI64(i64: Int64);
+var
+ i64out : TBytes;
+begin
+ SetLength( i64out, 8);
+ i64out[0] := Byte($FF and (i64 shr 56));
+ i64out[1] := Byte($FF and (i64 shr 48));
+ i64out[2] := Byte($FF and (i64 shr 40));
+ i64out[3] := Byte($FF and (i64 shr 32));
+ i64out[4] := Byte($FF and (i64 shr 24));
+ i64out[5] := Byte($FF and (i64 shr 16));
+ i64out[6] := Byte($FF and (i64 shr 8));
+ i64out[7] := Byte($FF and i64);
+ FTrans.Write( i64out, 0, 8);
+end;
+
+procedure TBinaryProtocolImpl.WriteListBegin(list: IList);
+begin
+ WriteByte(ShortInt(list.ElementType));
+ WriteI32(list.Count);
+end;
+
+procedure TBinaryProtocolImpl.WriteListEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteMapBegin(map: IMap);
+begin
+ WriteByte(ShortInt(map.KeyType));
+ WriteByte(ShortInt(map.ValueType));
+ WriteI32(map.Count);
+end;
+
+procedure TBinaryProtocolImpl.WriteMapEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteMessageBegin( message: IMessage);
+var
+ version : Cardinal;
+begin
+ if FStrictWrite then
+ begin
+ version := VERSION_1 or Cardinal( message.Type_);
+ WriteI32( Integer( version) );
+ WriteString( message.Name);
+ WriteI32(message.SeqID);
+ end else
+ begin
+ WriteString(message.Name);
+ WriteByte(ShortInt(message.Type_));
+ WriteI32(message.SeqID);
+ end;
+end;
+
+procedure TBinaryProtocolImpl.WriteMessageEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteSetBegin(set_: ISet);
+begin
+ WriteByte(ShortInt(set_.ElementType));
+ WriteI32(set_.Count);
+end;
+
+procedure TBinaryProtocolImpl.WriteSetEnd;
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteStructBegin(struc: IStruct);
+begin
+
+end;
+
+procedure TBinaryProtocolImpl.WriteStructEnd;
+begin
+
+end;
+
+{ TProtocolException }
+
+constructor TProtocolException.Create;
+begin
+ inherited Create('');
+ FType := UNKNOWN;
+end;
+
+constructor TProtocolException.Create(type_: Integer);
+begin
+ inherited Create('');
+ FType := type_;
+end;
+
+constructor TProtocolException.Create(type_: Integer; const msg: string);
+begin
+ inherited Create( msg );
+ FType := type_;
+end;
+
+{ TThriftStringBuilder }
+
+function TThriftStringBuilder.Append(const Value: TBytes): TStringBuilder;
+begin
+ Result := Append( string( RawByteString(Value)) );
+end;
+
+function TThriftStringBuilder.Append(
+ const Value: IThriftContainer): TStringBuilder;
+begin
+ Result := Append( Value.ToString );
+end;
+
+{ TBinaryProtocolImpl.TFactory }
+
+constructor TBinaryProtocolImpl.TFactory.Create(AStrictRead, AStrictWrite: Boolean);
+begin
+ FStrictRead := AStrictRead;
+ FStrictWrite := AStrictWrite;
+end;
+
+constructor TBinaryProtocolImpl.TFactory.Create;
+begin
+ Create( False, True )
+end;
+
+function TBinaryProtocolImpl.TFactory.GetProtocol(trans: ITransport): IProtocol;
+begin
+ Result := TBinaryProtocolImpl.Create( trans );
+end;
+
+end.
+
diff --git a/lib/delphi/src/Thrift.Server.pas b/lib/delphi/src/Thrift.Server.pas
new file mode 100644
index 0000000..0a7fdc6
--- /dev/null
+++ b/lib/delphi/src/Thrift.Server.pas
@@ -0,0 +1,325 @@
+(*
+ * 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.Server;
+
+interface
+
+uses
+ SysUtils,
+ Thrift,
+ Thrift.Protocol,
+ Thrift.Transport;
+
+type
+ IServer = interface
+ ['{CF9F56C6-BB39-4C7D-877B-43B416572CE6}']
+ procedure Serve;
+ procedure Stop;
+ end;
+
+ TServerImpl = class abstract( TInterfacedObject, IServer )
+ public
+ type
+ TLogDelegate = reference to procedure( str: string);
+ protected
+ FProcessor : IProcessor;
+ FServerTransport : IServerTransport;
+ FInputTransportFactory : ITransportFactory;
+ FOutputTransportFactory : ITransportFactory;
+ FInputProtocolFactory : IProtocolFactory;
+ FOutputProtocolFactory : IProtocolFactory;
+ FLogDelegate : TLogDelegate;
+
+ class procedure DefaultLogDelegate( str: string);
+
+ procedure Serve; virtual; abstract;
+ procedure Stop; virtual; abstract;
+ public
+ constructor Create(
+ AProcessor :IProcessor;
+ AServerTransport: IServerTransport;
+ AInputTransportFactory : ITransportFactory;
+ AOutputTransportFactory : ITransportFactory;
+ AInputProtocolFactory : IProtocolFactory;
+ AOutputProtocolFactory : IProtocolFactory;
+ ALogDelegate : TLogDelegate
+ ); overload;
+
+ constructor Create( AProcessor :IProcessor;
+ AServerTransport: IServerTransport); overload;
+
+ constructor Create(
+ AProcessor :IProcessor;
+ AServerTransport: IServerTransport;
+ ALogDelegate: TLogDelegate
+ ); overload;
+
+ constructor Create(
+ AProcessor :IProcessor;
+ AServerTransport: IServerTransport;
+ ATransportFactory : ITransportFactory
+ ); overload;
+
+ constructor Create(
+ AProcessor :IProcessor;
+ AServerTransport: IServerTransport;
+ ATransportFactory : ITransportFactory;
+ AProtocolFactory : IProtocolFactory
+ ); overload;
+ end;
+
+ TSimpleServer = class( TServerImpl)
+ private
+ FStop : Boolean;
+ public
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport); overload;
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport;
+ ALogDel: TServerImpl.TLogDelegate); overload;
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport;
+ ATransportFactory: ITransportFactory); overload;
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport;
+ ATransportFactory: ITransportFactory; AProtocolFactory: IProtocolFactory); overload;
+
+ procedure Serve; override;
+ procedure Stop; override;
+ end;
+
+
+implementation
+
+{ TServerImpl }
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ALogDelegate: TLogDelegate);
+var
+ InputFactory, OutputFactory : IProtocolFactory;
+ InputTransFactory, OutputTransFactory : ITransportFactory;
+
+begin
+ InputFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputFactory := TBinaryProtocolImpl.TFactory.Create;
+ InputTransFactory := TTransportFactoryImpl.Create;
+ OutputTransFactory := TTransportFactoryImpl.Create;
+
+ Create(
+ AProcessor,
+ AServerTransport,
+ InputTransFactory,
+ OutputTransFactory,
+ InputFactory,
+ OutputFactory,
+ ALogDelegate
+ );
+end;
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport);
+var
+ InputFactory, OutputFactory : IProtocolFactory;
+ InputTransFactory, OutputTransFactory : ITransportFactory;
+
+begin
+ InputFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputFactory := TBinaryProtocolImpl.TFactory.Create;
+ InputTransFactory := TTransportFactoryImpl.Create;
+ OutputTransFactory := TTransportFactoryImpl.Create;
+
+ Create(
+ AProcessor,
+ AServerTransport,
+ InputTransFactory,
+ OutputTransFactory,
+ InputFactory,
+ OutputFactory,
+ DefaultLogDelegate
+ );
+end;
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory);
+var
+ InputProtocolFactory : IProtocolFactory;
+ OutputProtocolFactory : IProtocolFactory;
+begin
+ InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+
+ Create( AProcessor, AServerTransport, ATransportFactory, ATransportFactory,
+ InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);
+end;
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; AInputTransportFactory,
+ AOutputTransportFactory: ITransportFactory; AInputProtocolFactory,
+ AOutputProtocolFactory: IProtocolFactory;
+ ALogDelegate : TLogDelegate);
+begin
+ FProcessor := AProcessor;
+ FServerTransport := AServerTransport;
+ FInputTransportFactory := AInputTransportFactory;
+ FOutputTransportFactory := AOutputTransportFactory;
+ FInputProtocolFactory := AInputProtocolFactory;
+ FOutputProtocolFactory := AOutputProtocolFactory;
+ FLogDelegate := ALogDelegate;
+end;
+
+class procedure TServerImpl.DefaultLogDelegate( str: string);
+begin
+ Writeln( str );
+end;
+
+constructor TServerImpl.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory;
+ AProtocolFactory: IProtocolFactory);
+begin
+
+end;
+
+{ TSimpleServer }
+
+constructor TSimpleServer.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport);
+var
+ InputProtocolFactory : IProtocolFactory;
+ OutputProtocolFactory : IProtocolFactory;
+ InputTransportFactory : ITransportFactory;
+ OutputTransportFactory : ITransportFactory;
+begin
+ InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ InputTransportFactory := TTransportFactoryImpl.Create;
+ OutputTransportFactory := TTransportFactoryImpl.Create;
+
+ inherited Create( AProcessor, AServerTransport, InputTransportFactory,
+ OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);
+end;
+
+constructor TSimpleServer.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ALogDel: TServerImpl.TLogDelegate);
+var
+ InputProtocolFactory : IProtocolFactory;
+ OutputProtocolFactory : IProtocolFactory;
+ InputTransportFactory : ITransportFactory;
+ OutputTransportFactory : ITransportFactory;
+begin
+ InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;
+ InputTransportFactory := TTransportFactoryImpl.Create;
+ OutputTransportFactory := TTransportFactoryImpl.Create;
+
+ inherited Create( AProcessor, AServerTransport, InputTransportFactory,
+ OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, ALogDel);
+end;
+
+constructor TSimpleServer.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory);
+begin
+ inherited Create( AProcessor, AServerTransport, ATransportFactory,
+ ATransportFactory, TBinaryProtocolImpl.TFactory.Create, TBinaryProtocolImpl.TFactory.Create, DefaultLogDelegate);
+end;
+
+constructor TSimpleServer.Create(AProcessor: IProcessor;
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory;
+ AProtocolFactory: IProtocolFactory);
+begin
+ inherited Create( AProcessor, AServerTransport, ATransportFactory,
+ ATransportFactory, AProtocolFactory, AProtocolFactory, DefaultLogDelegate);
+end;
+
+procedure TSimpleServer.Serve;
+var
+ client : ITransport;
+ InputTransport : ITransport;
+ OutputTransport : ITransport;
+ InputProtocol : IProtocol;
+ OutputProtocol : IProtocol;
+begin
+ try
+ FServerTransport.Listen;
+ except
+ on E: Exception do
+ begin
+ FLogDelegate( E.ToString);
+ end;
+ end;
+
+ client := nil;
+ InputTransport := nil;
+ OutputTransport := nil;
+ InputProtocol := nil;
+ OutputProtocol := nil;
+
+ while (not FStop) do
+ begin
+ try
+ client := FServerTransport.Accept;
+ FLogDelegate( 'Client Connected!');
+ InputTransport := FInputTransportFactory.GetTransport( client );
+ OutputTransport := FOutputTransportFactory.GetTransport( client );
+ InputProtocol := FInputProtocolFactory.GetProtocol( InputTransport );
+ OutputProtocol := FOutputProtocolFactory.GetProtocol( OutputTransport );
+ while ( FProcessor.Process( InputProtocol, OutputProtocol )) do
+ begin
+ if FStop then Break;
+ end;
+ except
+ on E: TTransportException do
+ begin
+ if FStop then
+ begin
+ FLogDelegate('TSimpleServer was shutting down, caught ' + E.ClassName);
+ end;
+ end;
+ on E: Exception do
+ begin
+ FLogDelegate( E.ToString );
+ end;
+ end;
+ if InputTransport <> nil then
+ begin
+ InputTransport.Close;
+ end;
+ if OutputTransport <> nil then
+ begin
+ OutputTransport.Close;
+ end;
+ end;
+
+ if FStop then
+ begin
+ try
+ FServerTransport.Close;
+ except
+ on E: TTransportException do
+ begin
+ FLogDelegate('TServerTranport failed on close: ' + E.Message);
+ end;
+ end;
+ FStop := False;
+ end;
+end;
+
+procedure TSimpleServer.Stop;
+begin
+ FStop := True;
+ FServerTransport.Close;
+end;
+
+end.
diff --git a/lib/delphi/src/Thrift.Stream.pas b/lib/delphi/src/Thrift.Stream.pas
new file mode 100644
index 0000000..a02677e
--- /dev/null
+++ b/lib/delphi/src/Thrift.Stream.pas
@@ -0,0 +1,298 @@
+(*
+ * 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.Stream;
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ SysConst,
+ RTLConsts,
+ Thrift.Utils,
+ ActiveX;
+
+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;
+ procedure Open;
+ procedure Close;
+ procedure Flush;
+ function IsOpen: Boolean;
+ function ToArray: TBytes;
+ end;
+
+ TThriftStreamImpl = class( TInterfacedObject, IThriftStream)
+ private
+ procedure CheckSizeAndOffset( const buffer: TBytes; offset: Integer; count: Integer);
+ protected
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); virtual;
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; virtual;
+ procedure Open; virtual; abstract;
+ procedure Close; virtual; abstract;
+ procedure Flush; virtual; abstract;
+ function IsOpen: Boolean; virtual; abstract;
+ function ToArray: TBytes; virtual; abstract;
+ end;
+
+ TThriftStreamAdapterDelphi = class( TThriftStreamImpl )
+ private
+ 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 Open; override;
+ procedure Close; override;
+ procedure Flush; override;
+ function IsOpen: Boolean; override;
+ function ToArray: TBytes; override;
+ public
+ constructor Create( AStream: TStream; AOwnsStream : Boolean);
+ destructor Destroy; override;
+ end;
+
+ TThriftStreamAdapterCOM = class( TThriftStreamImpl)
+ 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 Open; override;
+ procedure Close; override;
+ procedure Flush; override;
+ function IsOpen: Boolean; override;
+ function ToArray: TBytes; override;
+ public
+ constructor Create( AStream: IStream);
+ end;
+
+implementation
+
+{ TThriftStreamAdapterCOM }
+
+procedure TThriftStreamAdapterCOM.Close;
+begin
+ FStream := nil;
+end;
+
+constructor TThriftStreamAdapterCOM.Create(AStream: IStream);
+begin
+ FStream := AStream;
+end;
+
+procedure TThriftStreamAdapterCOM.Flush;
+begin
+ if IsOpen then
+ begin
+ if FStream <> nil then
+ begin
+ FStream.Commit( STGC_DEFAULT );
+ end;
+ end;
+end;
+
+function TThriftStreamAdapterCOM.IsOpen: Boolean;
+begin
+ Result := FStream <> nil;
+end;
+
+procedure TThriftStreamAdapterCOM.Open;
+begin
+
+end;
+
+function TThriftStreamAdapterCOM.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
+begin
+ inherited;
+ Result := 0;
+ if FStream <> nil then
+ begin
+ if count > 0 then
+ begin
+ FStream.Read( @buffer[offset], count, @Result);
+ end;
+ end;
+end;
+
+function TThriftStreamAdapterCOM.ToArray: TBytes;
+var
+ statstg: TStatStg;
+ len : Integer;
+ NewPos : Int64;
+ cbRead : Integer;
+begin
+ FillChar( statstg, SizeOf( statstg), 0);
+ len := 0;
+ if IsOpen then
+ begin
+ if Succeeded( FStream.Stat( statstg, STATFLAG_NONAME )) then
+ begin
+ len := statstg.cbSize;
+ end;
+ end;
+
+ SetLength( Result, len );
+
+ if len > 0 then
+ begin
+ if Succeeded( FStream.Seek( 0, STREAM_SEEK_SET, NewPos) ) then
+ begin
+ FStream.Read( @Result[0], len, @cbRead);
+ end;
+ end;
+end;
+
+procedure TThriftStreamAdapterCOM.Write( const buffer: TBytes; offset: Integer; count: Integer);
+var
+ nWritten : Integer;
+begin
+ inherited;
+ if IsOpen then
+ begin
+ if count > 0 then
+ begin
+ FStream.Write( @buffer[0], count, @nWritten);
+ end;
+ end;
+end;
+
+{ TThriftStreamImpl }
+
+procedure TThriftStreamImpl.CheckSizeAndOffset(const buffer: TBytes; offset,
+ count: Integer);
+var
+ len : Integer;
+begin
+ if count > 0 then
+ begin
+ len := Length( buffer );
+ if (offset < 0) or ( offset >= len) then
+ begin
+ raise ERangeError.Create( SBitsIndexError );
+ end;
+ if count > len then
+ begin
+ raise ERangeError.Create( SBitsIndexError );
+ end;
+ end;
+end;
+
+function TThriftStreamImpl.Read(var buffer: TBytes; offset,
+ count: Integer): Integer;
+begin
+ Result := 0;
+ CheckSizeAndOffset( buffer, offset, count );
+end;
+
+procedure TThriftStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
+begin
+ CheckSizeAndOffset( buffer, offset, count );
+end;
+
+{ TThriftStreamAdapterDelphi }
+
+procedure TThriftStreamAdapterDelphi.Close;
+begin
+ FStream.Free;
+ FStream := nil;
+ FOwnsStream := False;
+end;
+
+constructor TThriftStreamAdapterDelphi.Create(AStream: TStream; AOwnsStream: Boolean);
+begin
+ FStream := AStream;
+ FOwnsStream := AOwnsStream;
+end;
+
+destructor TThriftStreamAdapterDelphi.Destroy;
+begin
+ if FOwnsStream then
+ begin
+ FStream.Free;
+ end;
+ inherited;
+end;
+
+procedure TThriftStreamAdapterDelphi.Flush;
+begin
+
+end;
+
+function TThriftStreamAdapterDelphi.IsOpen: Boolean;
+begin
+ Result := FStream <> nil;
+end;
+
+procedure TThriftStreamAdapterDelphi.Open;
+begin
+
+end;
+
+function TThriftStreamAdapterDelphi.Read(var buffer: TBytes; offset,
+ count: Integer): Integer;
+begin
+ inherited;
+ Result := 0;
+ if count > 0 then
+ begin
+ Result := FStream.Read( Pointer(@buffer[offset])^, count)
+ end;
+end;
+
+function TThriftStreamAdapterDelphi.ToArray: TBytes;
+var
+ OrgPos : Integer;
+ len : Integer;
+begin
+ len := 0;
+ if FStream <> nil then
+ begin
+ len := FStream.Size;
+ end;
+
+ SetLength( Result, len );
+
+ if len > 0 then
+ begin
+ OrgPos := FStream.Position;
+ try
+ FStream.Position := 0;
+ FStream.ReadBuffer( Pointer(@Result[0])^, len );
+ finally
+ FStream.Position := OrgPos;
+ end;
+ end
+end;
+
+procedure TThriftStreamAdapterDelphi.Write(const buffer: TBytes; offset,
+ count: Integer);
+begin
+ inherited;
+ if count > 0 then
+ begin
+ FStream.Write( Pointer(@buffer[offset])^, count)
+ end;
+end;
+
+end.
diff --git a/lib/delphi/src/Thrift.Transport.pas b/lib/delphi/src/Thrift.Transport.pas
new file mode 100644
index 0000000..0e6f825
--- /dev/null
+++ b/lib/delphi/src/Thrift.Transport.pas
@@ -0,0 +1,1250 @@
+(*
+ * 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.Transport;
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ Sockets,
+ Generics.Collections,
+ Thrift.Collections,
+ Thrift.Utils,
+ Thrift.Stream,
+ ActiveX,
+ msxml;
+
+type
+ ITransport = interface
+ ['{A4A9FC37-D620-44DC-AD21-662D16364CE4}']
+ 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;
+ procedure Write( const buf: TBytes); overload;
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); overload;
+ procedure Flush;
+ end;
+
+ TTransportImpl = class( TInterfacedObject, ITransport)
+ protected
+ function GetIsOpen: Boolean; virtual; abstract;
+ property IsOpen: Boolean read GetIsOpen;
+ function Peek: Boolean;
+ 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;
+ procedure Flush; virtual;
+ end;
+
+ TTransportException = class( Exception )
+ public
+ type
+ TExceptionType = (
+ Unknown,
+ NotOpen,
+ AlreadyOpen,
+ TimedOut,
+ EndOfFile
+ );
+ private
+ FType : TExceptionType;
+ public
+ constructor Create( AType: TExceptionType); overload;
+ constructor Create( const msg: string); overload;
+ constructor Create( AType: TExceptionType; const msg: string); overload;
+ property Type_: TExceptionType read FType;
+ end;
+
+ IHTTPClient = interface( ITransport )
+ ['{0F5DB8AB-710D-4338-AAC9-46B5734C5057}']
+ procedure SetConnectionTimeout(const Value: Integer);
+ function GetConnectionTimeout: Integer;
+ procedure SetReadTimeout(const Value: Integer);
+ function GetReadTimeout: Integer;
+ function GetCustomHeaders: IThriftDictionary<string,string>;
+ procedure SendRequest;
+ property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
+ property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
+ property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
+ end;
+
+ THTTPClientImpl = class( TTransportImpl, IHTTPClient)
+ private
+ FUri : string;
+ FInputStream : IThriftStream;
+ FOutputStream : IThriftStream;
+ FConnectionTimeout : Integer;
+ FReadTimeout : Integer;
+ FCustomHeaders : IThriftDictionary<string,string>;
+
+ function CreateRequest: IXMLHTTPRequest;
+ protected
+ 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;
+ procedure Flush; override;
+
+ procedure SetConnectionTimeout(const Value: Integer);
+ function GetConnectionTimeout: Integer;
+ procedure SetReadTimeout(const Value: Integer);
+ function GetReadTimeout: Integer;
+ function GetCustomHeaders: IThriftDictionary<string,string>;
+ procedure SendRequest;
+ property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
+ property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
+ property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
+ public
+ constructor Create( const AUri: string);
+ destructor Destroy; override;
+ end;
+
+ IServerTransport = interface
+ ['{BF6B7043-DA22-47BF-8B11-2B88EC55FE12}']
+ procedure Listen;
+ procedure Close;
+ function Accept: ITransport;
+ end;
+
+ TServerTransportImpl = class( TInterfacedObject, IServerTransport)
+ protected
+ function AcceptImpl: ITransport; virtual; abstract;
+ public
+ procedure Listen; virtual; abstract;
+ procedure Close; virtual; abstract;
+ function Accept: ITransport;
+ end;
+
+ ITransportFactory = interface
+ ['{DD809446-000F-49E1-9BFF-E0D0DC76A9D7}']
+ function GetTransport( ATrans: ITransport): ITransport;
+ end;
+
+ TTransportFactoryImpl = class( TInterfacedObject, ITransportFactory)
+ function GetTransport( ATrans: ITransport): ITransport; virtual;
+ end;
+
+ TTcpSocketStreamImpl = class( TThriftStreamImpl )
+ private
+ FTcpClient : TCustomIpClient;
+ protected
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Open; override;
+ procedure Close; override;
+ procedure Flush; override;
+
+ function IsOpen: Boolean; override;
+ function ToArray: TBytes; override;
+ public
+ constructor Create( ATcpClient: TCustomIpClient);
+ end;
+
+ IStreamTransport = interface( ITransport )
+ ['{A8479B47-2A3E-4421-A9A0-D5A9EDCC634A}']
+ function GetInputStream: IThriftStream;
+ function GetOutputStream: IThriftStream;
+ property InputStream : IThriftStream read GetInputStream;
+ property OutputStream : IThriftStream read GetOutputStream;
+ end;
+
+ TStreamTransportImpl = class( TTransportImpl, IStreamTransport)
+ protected
+ FInputStream : IThriftStream;
+ FOutputStream : IThriftStream;
+ protected
+ function GetIsOpen: Boolean; override;
+
+ function GetInputStream: IThriftStream;
+ function GetOutputStream: IThriftStream;
+ public
+ property InputStream : IThriftStream read GetInputStream;
+ property OutputStream : IThriftStream read GetOutputStream;
+
+ 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;
+ constructor Create( AInputStream : IThriftStream; AOutputStream : IThriftStream);
+ destructor Destroy; override;
+ end;
+
+ TBufferedStreamImpl = class( TThriftStreamImpl)
+ private
+ FStream : IThriftStream;
+ FBufSize : Integer;
+ FBuffer : TMemoryStream;
+ protected
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;
+ procedure Open; override;
+ procedure Close; override;
+ procedure Flush; override;
+ function IsOpen: Boolean; override;
+ function ToArray: TBytes; override;
+ public
+ constructor Create( AStream: IThriftStream; ABufSize: Integer);
+ destructor Destroy; override;
+ end;
+
+ TServerSocketImpl = class( TServerTransportImpl)
+ private
+ FServer : TTcpServer;
+ FPort : Integer;
+ FClientTimeout : Integer;
+ FUseBufferedSocket : Boolean;
+ FOwnsServer : Boolean;
+ protected
+ function AcceptImpl: ITransport; override;
+ public
+ constructor Create( AServer: TTcpServer ); overload;
+ constructor Create( AServer: TTcpServer; AClientTimeout: Integer); overload;
+ constructor Create( APort: Integer); overload;
+ constructor Create( APort: Integer; AClientTimeout: Integer); overload;
+ constructor Create( APort: Integer; AClientTimeout: Integer;
+ AUseBufferedSockets: Boolean); overload;
+ destructor Destroy; override;
+ procedure Listen; override;
+ procedure Close; override;
+ end;
+
+ TBufferedTransportImpl = class( TTransportImpl )
+ private
+ FInputBuffer : IThriftStream;
+ FOutputBuffer : IThriftStream;
+ FTransport : IStreamTransport;
+ FBufSize : Integer;
+
+ procedure InitBuffers;
+ function GetUnderlyingTransport: ITransport;
+ protected
+ function GetIsOpen: Boolean; override;
+ procedure Flush; override;
+ 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;
+ constructor Create( ATransport : IStreamTransport ); overload;
+ constructor Create( ATransport : IStreamTransport; ABufSize: Integer); overload;
+ property UnderlyingTransport: ITransport read GetUnderlyingTransport;
+ property IsOpen: Boolean read GetIsOpen;
+ end;
+
+ TSocketImpl = class(TStreamTransportImpl)
+ private
+ FClient : TCustomIpClient;
+ FOwnsClient : Boolean;
+ FHost : string;
+ FPort : Integer;
+ FTimeout : Integer;
+
+ procedure InitSocket;
+ protected
+ function GetIsOpen: Boolean; override;
+ public
+ procedure Open; override;
+ constructor Create( AClient : TCustomIpClient); overload;
+ constructor Create( const AHost: string; APort: Integer); overload;
+ constructor Create( const AHost: string; APort: Integer; ATimeout: Integer); overload;
+ destructor Destroy; override;
+ procedure Close; override;
+ property TcpClient: TCustomIpClient read FClient;
+ property Host : string read FHost;
+ property Port: Integer read FPort;
+ end;
+
+ TFramedTransportImpl = class( TTransportImpl)
+ private const
+ FHeaderSize : Integer = 4;
+ private class var
+ FHeader_Dummy : array of Byte;
+ protected
+ FTransport : ITransport;
+ FWriteBuffer : TMemoryStream;
+ FReadBuffer : TMemoryStream;
+
+ procedure InitWriteBuffer;
+ procedure ReadFrame;
+ public
+ type
+ TFactory = class( TTransportFactoryImpl )
+ public
+ function GetTransport( ATrans: ITransport): ITransport; override;
+ end;
+
+{$IF CompilerVersion >= 21.0}
+ class constructor Create;
+{$IFEND}
+ constructor Create; overload;
+ constructor Create( ATrans: ITransport); overload;
+ destructor Destroy; override;
+
+ procedure Open(); override;
+ 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;
+ procedure Flush; override;
+ end;
+
+{$IF CompilerVersion < 21.0}
+procedure TFramedTransportImpl_Initialize;
+{$IFEND}
+
+implementation
+
+{ TTransportImpl }
+
+procedure TTransportImpl.Flush;
+begin
+
+end;
+
+function TTransportImpl.Peek: Boolean;
+begin
+ Result := IsOpen;
+end;
+
+function TTransportImpl.ReadAll( var buf: TBytes; off, len: Integer): Integer;
+var
+ got : Integer;
+ ret : Integer;
+begin
+ got := 0;
+ while ( got < len) do
+ begin
+ ret := Read( buf, off + got, len - got);
+ if ( ret <= 0 ) then
+ begin
+ raise TTransportException.Create( 'Cannot read, Remote side has closed' );
+ end;
+ got := got + ret;
+ end;
+ Result := got;
+end;
+
+procedure TTransportImpl.Write( const buf: TBytes);
+begin
+ Self.Write( buf, 0, Length(buf) );
+end;
+
+{ THTTPClientImpl }
+
+procedure THTTPClientImpl.Close;
+begin
+ FInputStream := nil;
+ FOutputStream := nil;
+end;
+
+constructor THTTPClientImpl.Create(const AUri: string);
+begin
+ inherited Create;
+ FUri := AUri;
+ FCustomHeaders := TThriftDictionaryImpl<string,string>.Create;
+ FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
+end;
+
+function THTTPClientImpl.CreateRequest: IXMLHTTPRequest;
+var
+ pair : TPair<string,string>;
+begin
+{$IF CompilerVersion >= 21.0}
+ Result := CoXMLHTTP.Create;
+{$ELSE}
+ Result := CoXMLHTTPRequest.Create;
+{$IFEND}
+
+ Result.open('POST', FUri, False, '', '');
+ Result.setRequestHeader( 'Content-Type', 'application/x-thrift');
+ Result.setRequestHeader( 'Accept', 'application/x-thrift');
+ Result.setRequestHeader( 'User-Agent', 'Delphi/IHTTPClient');
+
+ for pair in FCustomHeaders do
+ begin
+ Result.setRequestHeader( pair.Key, pair.Value );
+ end;
+end;
+
+destructor THTTPClientImpl.Destroy;
+begin
+ Close;
+ inherited;
+end;
+
+procedure THTTPClientImpl.Flush;
+begin
+ try
+ SendRequest;
+ finally
+ FOutputStream := nil;
+ FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
+ end;
+end;
+
+function THTTPClientImpl.GetConnectionTimeout: Integer;
+begin
+ Result := FConnectionTimeout;
+end;
+
+function THTTPClientImpl.GetCustomHeaders: IThriftDictionary<string,string>;
+begin
+ Result := FCustomHeaders;
+end;
+
+function THTTPClientImpl.GetIsOpen: Boolean;
+begin
+ Result := True;
+end;
+
+function THTTPClientImpl.GetReadTimeout: Integer;
+begin
+ Result := FReadTimeout;
+end;
+
+procedure THTTPClientImpl.Open;
+begin
+
+end;
+
+function THTTPClientImpl.Read( var buf: TBytes; off, len: Integer): Integer;
+begin
+ if FInputStream = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'No request has been sent');
+ end;
+ try
+ Result := FInputStream.Read( buf, off, len )
+ except
+ on E: Exception do
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.Unknown,
+ E.Message);
+ end;
+ end;
+end;
+
+procedure THTTPClientImpl.SendRequest;
+var
+ xmlhttp : IXMLHTTPRequest;
+ ms : TMemoryStream;
+ a : TBytes;
+ len : Integer;
+begin
+ xmlhttp := CreateRequest;
+
+ ms := TMemoryStream.Create;
+ try
+ a := FOutputStream.ToArray;
+ len := Length(a);
+ if len > 0 then
+ begin
+ ms.WriteBuffer( Pointer(@a[0])^, len);
+ end;
+ ms.Position := 0;
+ xmlhttp.send( IUnknown( TStreamAdapter.Create( ms, soReference )));
+ FInputStream := nil;
+ FInputStream := TThriftStreamAdapterCOM.Create( IUnknown( xmlhttp.responseStream) as IStream);
+ finally
+ ms.Free;
+ end;
+end;
+
+procedure THTTPClientImpl.SetConnectionTimeout(const Value: 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);
+end;
+
+{ TTransportException }
+
+constructor TTransportException.Create(AType: TExceptionType);
+begin
+ Create( AType, '' )
+end;
+
+constructor TTransportException.Create(AType: TExceptionType;
+ const msg: string);
+begin
+ inherited Create(msg);
+ FType := AType;
+end;
+
+constructor TTransportException.Create(const msg: string);
+begin
+ inherited Create(msg);
+end;
+
+{ TServerTransportImpl }
+
+function TServerTransportImpl.Accept: ITransport;
+begin
+ Result := AcceptImpl;
+ if Result = nil then
+ begin
+ raise TTransportException.Create( 'accept() may not return NULL' );
+ end;
+end;
+
+{ TTransportFactoryImpl }
+
+function TTransportFactoryImpl.GetTransport(ATrans: ITransport): ITransport;
+begin
+ Result := ATrans;
+end;
+
+{ TServerSocket }
+
+constructor TServerSocketImpl.Create(AServer: TTcpServer; AClientTimeout: Integer);
+begin
+ FServer := AServer;
+ FClientTimeout := AClientTimeout;
+end;
+
+constructor TServerSocketImpl.Create(AServer: TTcpServer);
+begin
+ Create( AServer, 0 );
+end;
+
+constructor TServerSocketImpl.Create(APort: Integer);
+begin
+ Create( APort, 0 );
+end;
+
+function TServerSocketImpl.AcceptImpl: ITransport;
+var
+ ret : TCustomIpClient;
+ ret2 : IStreamTransport;
+ ret3 : ITransport;
+begin
+ if FServer = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'No underlying server socket.');
+ end;
+
+ try
+ ret := TCustomIpClient.Create(nil);
+ if ( not FServer.Accept( ret )) then
+ begin
+ ret.Free;
+ Result := nil;
+ Exit;
+ end;
+
+ if ret = nil then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ ret2 := TSocketImpl.Create( ret );
+ if FUseBufferedSocket then
+ begin
+ ret3 := TBufferedTransportImpl.Create(ret2);
+ Result := ret3;
+ end else
+ begin
+ Result := ret2;
+ end;
+
+ except
+ on E: Exception do
+ begin
+ raise TTransportException.Create( E.ToString );
+ end;
+ end;
+end;
+
+procedure TServerSocketImpl.Close;
+begin
+ if FServer <> nil then
+ begin
+ try
+ FServer.Active := False;
+ except
+ on E: Exception do
+ begin
+ raise TTransportException.Create('Error on closing socket : ' + E.Message);
+ end;
+ end;
+ end;
+end;
+
+constructor TServerSocketImpl.Create(APort, AClientTimeout: Integer;
+ AUseBufferedSockets: Boolean);
+begin
+ FPort := APort;
+ FClientTimeout := AClientTimeout;
+ FUseBufferedSocket := AUseBufferedSockets;
+ FOwnsServer := True;
+ FServer := TTcpServer.Create( nil );
+ FServer.BlockMode := bmBlocking;
+{$IF CompilerVersion >= 21.0}
+ FServer.LocalPort := AnsiString( IntToStr( FPort));
+{$ELSE}
+ FServer.LocalPort := IntToStr( FPort);
+{$IFEND}
+end;
+
+destructor TServerSocketImpl.Destroy;
+begin
+ if FOwnsServer then
+ begin
+ FServer.Free;
+ end;
+ inherited;
+end;
+
+procedure TServerSocketImpl.Listen;
+begin
+ if FServer <> nil then
+ begin
+ try
+ FServer.Active := True;
+ except
+ on E: Exception do
+ begin
+ raise TTransportException.Create('Could not accept on listening socket: ' + E.Message);
+ end;
+ end;
+ end;
+end;
+
+constructor TServerSocketImpl.Create(APort, AClientTimeout: Integer);
+begin
+ Create( APort, AClientTimeout, False );
+end;
+
+{ TSocket }
+
+constructor TSocketImpl.Create(AClient : TCustomIpClient);
+var
+ stream : IThriftStream;
+begin
+ FClient := AClient;
+ stream := TTcpSocketStreamImpl.Create( FClient);
+ FInputStream := stream;
+ FOutputStream := stream;
+end;
+
+constructor TSocketImpl.Create(const AHost: string; APort: Integer);
+begin
+ Create( AHost, APort, 0);
+end;
+
+procedure TSocketImpl.Close;
+begin
+ inherited Close;
+ if FClient <> nil then
+ begin
+ FClient.Free;
+ FClient := nil;
+ end;
+end;
+
+constructor TSocketImpl.Create(const AHost: string; APort, ATimeout: Integer);
+begin
+ FHost := AHost;
+ FPort := APort;
+ FTimeout := ATimeout;
+ InitSocket;
+end;
+
+destructor TSocketImpl.Destroy;
+begin
+ if FOwnsClient then
+ begin
+ FClient.Free;
+ end;
+ inherited;
+end;
+
+function TSocketImpl.GetIsOpen: Boolean;
+begin
+ Result := False;
+ if FClient <> nil then
+ begin
+ Result := FClient.Connected;
+ end;
+end;
+
+procedure TSocketImpl.InitSocket;
+var
+ stream : IThriftStream;
+begin
+ if FClient <> nil then
+ begin
+ if FOwnsClient then
+ begin
+ FClient.Free;
+ FClient := nil;
+ end;
+ end;
+ FClient := TTcpClient.Create( nil );
+ FOwnsClient := True;
+
+ stream := TTcpSocketStreamImpl.Create( FClient);
+ FInputStream := stream;
+ FOutputStream := stream;
+
+end;
+
+procedure TSocketImpl.Open;
+begin
+ if IsOpen then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.AlreadyOpen,
+ 'Socket already connected');
+ end;
+
+ if FHost = '' then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Cannot open null host');
+ end;
+
+ if Port <= 0 then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,
+ 'Cannot open without port');
+ end;
+
+ if FClient = nil then
+ begin
+ InitSocket;
+ end;
+
+ FClient.RemoteHost := TSocketHost( Host);
+ FClient.RemotePort := TSocketPort( IntToStr( Port));
+ FClient.Connect;
+
+ FInputStream := TTcpSocketStreamImpl.Create( FClient);
+ FOutputStream := FInputStream;
+end;
+
+{ TBufferedStream }
+
+procedure TBufferedStreamImpl.Close;
+begin
+ Flush;
+ FStream := nil;
+ FBuffer.Free;
+ FBuffer := nil;
+end;
+
+constructor TBufferedStreamImpl.Create(AStream: IThriftStream; ABufSize: Integer);
+begin
+ FStream := AStream;
+ FBufSize := ABufSize;
+ FBuffer := TMemoryStream.Create;
+end;
+
+destructor TBufferedStreamImpl.Destroy;
+begin
+ Close;
+ inherited;
+end;
+
+procedure TBufferedStreamImpl.Flush;
+var
+ buf : TBytes;
+ len : Integer;
+begin
+ if IsOpen then
+ begin
+ len := FBuffer.Size;
+ if len > 0 then
+ begin
+ SetLength( buf, len );
+ FBuffer.Position := 0;
+ FBuffer.Read( Pointer(@buf[0])^, len );
+ FStream.Write( buf, 0, len );
+ end;
+ FBuffer.Clear;
+ end;
+end;
+
+function TBufferedStreamImpl.IsOpen: Boolean;
+begin
+ Result := (FBuffer <> nil) and ( FStream <> nil);
+end;
+
+procedure TBufferedStreamImpl.Open;
+begin
+
+end;
+
+function TBufferedStreamImpl.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
+var
+ nRead : Integer;
+ tempbuf : TBytes;
+begin
+ inherited;
+ Result := 0;
+ if count > 0 then
+ begin
+ if IsOpen then
+ begin
+ if FBuffer.Position >= FBuffer.Size then
+ begin
+ FBuffer.Clear;
+ SetLength( tempbuf, FBufSize);
+ nRead := FStream.Read( tempbuf, 0, FBufSize );
+ if nRead > 0 then
+ begin
+ FBuffer.WriteBuffer( Pointer(@tempbuf[0])^, nRead );
+ FBuffer.Position := 0;
+ end;
+ end;
+
+ if FBuffer.Position < FBuffer.Size then
+ begin
+ Result := FBuffer.Read( Pointer(@buffer[offset])^, count );
+ end;
+ end;
+ end;
+end;
+
+function TBufferedStreamImpl.ToArray: TBytes;
+var
+ len : Integer;
+begin
+ len := 0;
+
+ if IsOpen then
+ begin
+ len := FBuffer.Size;
+ end;
+
+ SetLength( Result, len);
+
+ if len > 0 then
+ begin
+ FBuffer.Position := 0;
+ FBuffer.Read( Pointer(@Result[0])^, len );
+ end;
+end;
+
+procedure TBufferedStreamImpl.Write( const buffer: TBytes; offset: Integer; count: Integer);
+begin
+ inherited;
+ if count > 0 then
+ begin
+ if IsOpen then
+ begin
+ FBuffer.Write( Pointer(@buffer[offset])^, count );
+ if FBuffer.Size > FBufSize then
+ begin
+ Flush;
+ end;
+ end;
+ end;
+end;
+
+{ TStreamTransportImpl }
+
+procedure TStreamTransportImpl.Close;
+begin
+ if FInputStream <> FOutputStream then
+ begin
+ if FInputStream <> nil then
+ begin
+ FInputStream := nil;
+ end;
+ if FOutputStream <> nil then
+ begin
+ FOutputStream := nil;
+ end;
+ end else
+ begin
+ FInputStream := nil;
+ FOutputStream := nil;
+ end;
+end;
+
+constructor TStreamTransportImpl.Create( AInputStream : IThriftStream; AOutputStream : IThriftStream);
+begin
+ FInputStream := AInputStream;
+ FOutputStream := AOutputStream;
+end;
+
+destructor TStreamTransportImpl.Destroy;
+begin
+ FInputStream := nil;
+ FOutputStream := nil;
+ inherited;
+end;
+
+procedure TStreamTransportImpl.Flush;
+begin
+ if FOutputStream = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot flush null outputstream' );
+ end;
+
+ FOutputStream.Flush;
+end;
+
+function TStreamTransportImpl.GetInputStream: IThriftStream;
+begin
+ Result := FInputStream;
+end;
+
+function TStreamTransportImpl.GetIsOpen: Boolean;
+begin
+ Result := True;
+end;
+
+function TStreamTransportImpl.GetOutputStream: IThriftStream;
+begin
+ Result := FInputStream;
+end;
+
+procedure TStreamTransportImpl.Open;
+begin
+
+end;
+
+function TStreamTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
+begin
+ if FInputStream = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot read from null inputstream' );
+ end;
+ Result := FInputStream.Read( buf, off, len );
+end;
+
+procedure TStreamTransportImpl.Write(const buf: TBytes; off, len: Integer);
+begin
+ if FOutputStream = nil then
+ begin
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot read from null outputstream' );
+ end;
+
+ FOutputStream.Write( buf, off, len );
+end;
+
+{ TBufferedTransportImpl }
+
+constructor TBufferedTransportImpl.Create(ATransport: IStreamTransport);
+begin
+ Create( ATransport, 1024 );
+end;
+
+procedure TBufferedTransportImpl.Close;
+begin
+ FTransport.Close;
+end;
+
+constructor TBufferedTransportImpl.Create(ATransport: IStreamTransport;
+ ABufSize: Integer);
+begin
+ FTransport := ATransport;
+ FBufSize := ABufSize;
+ InitBuffers;
+end;
+
+procedure TBufferedTransportImpl.Flush;
+begin
+ if FOutputBuffer <> nil then
+ begin
+ FOutputBuffer.Flush;
+ end;
+end;
+
+function TBufferedTransportImpl.GetIsOpen: Boolean;
+begin
+ Result := FTransport.IsOpen;
+end;
+
+function TBufferedTransportImpl.GetUnderlyingTransport: ITransport;
+begin
+ Result := FTransport;
+end;
+
+procedure TBufferedTransportImpl.InitBuffers;
+begin
+ if FTransport.InputStream <> nil then
+ begin
+ FInputBuffer := TBufferedStreamImpl.Create( FTransport.InputStream, FBufSize );
+ end;
+ if FTransport.OutputStream <> nil then
+ begin
+ FOutputBuffer := TBufferedStreamImpl.Create( FTransport.OutputStream, FBufSize );
+ end;
+end;
+
+procedure TBufferedTransportImpl.Open;
+begin
+ FTransport.Open
+end;
+
+function TBufferedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
+begin
+ Result := 0;
+ if FInputBuffer <> nil then
+ begin
+ Result := FInputBuffer.Read( buf, off, len );
+ end;
+end;
+
+procedure TBufferedTransportImpl.Write(const buf: TBytes; off, len: Integer);
+begin
+ if FOutputBuffer <> nil then
+ begin
+ FOutputBuffer.Write( buf, off, len );
+ end;
+end;
+
+{ TFramedTransportImpl }
+
+{$IF CompilerVersion < 21.0}
+procedure TFramedTransportImpl_Initialize;
+begin
+ SetLength( TFramedTransportImpl.FHeader_Dummy, TFramedTransportImpl.FHeaderSize);
+ FillChar( TFramedTransportImpl.FHeader_Dummy[0],
+ Length( TFramedTransportImpl.FHeader_Dummy) * SizeOf( Byte ), 0);
+end;
+{$ELSE}
+class constructor TFramedTransportImpl.Create;
+begin
+ SetLength( FHeader_Dummy, FHeaderSize);
+ FillChar( FHeader_Dummy[0], Length( FHeader_Dummy) * SizeOf( Byte ), 0);
+end;
+{$IFEND}
+
+constructor TFramedTransportImpl.Create;
+begin
+ InitWriteBuffer;
+end;
+
+procedure TFramedTransportImpl.Close;
+begin
+ FTransport.Close;
+end;
+
+constructor TFramedTransportImpl.Create(ATrans: ITransport);
+begin
+ InitWriteBuffer;
+ FTransport := ATrans;
+end;
+
+destructor TFramedTransportImpl.Destroy;
+begin
+ FWriteBuffer.Free;
+ FReadBuffer.Free;
+ inherited;
+end;
+
+procedure TFramedTransportImpl.Flush;
+var
+ buf : TBytes;
+ len : Integer;
+ data_len : Integer;
+
+begin
+ len := FWriteBuffer.Size;
+ SetLength( buf, len);
+ if len > 0 then
+ begin
+ System.Move( FWriteBuffer.Memory^, buf[0], len );
+ end;
+
+ data_len := len - FHeaderSize;
+ if (data_len < 0) then
+ begin
+ raise Exception.Create( 'TFramedTransport.Flush: data_len < 0' );
+ end;
+
+ InitWriteBuffer;
+
+ buf[0] := Byte($FF and (data_len shr 24));
+ buf[1] := Byte($FF and (data_len shr 16));
+ buf[2] := Byte($FF and (data_len shr 8));
+ buf[3] := Byte($FF and data_len);
+
+ FTransport.Write( buf, 0, len );
+ FTransport.Flush;
+end;
+
+function TFramedTransportImpl.GetIsOpen: Boolean;
+begin
+ Result := FTransport.IsOpen;
+end;
+
+type
+ TAccessMemoryStream = class(TMemoryStream)
+ end;
+
+procedure TFramedTransportImpl.InitWriteBuffer;
+begin
+ FWriteBuffer.Free;
+ FWriteBuffer := TMemoryStream.Create;
+ TAccessMemoryStream(FWriteBuffer).Capacity := 1024;
+ FWriteBuffer.Write( Pointer(@FHeader_Dummy[0])^, FHeaderSize);
+end;
+
+procedure TFramedTransportImpl.Open;
+begin
+ FTransport.Open;
+end;
+
+function TFramedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
+var
+ got : Integer;
+begin
+ if FReadBuffer <> nil then
+ begin
+ got := FReadBuffer.Read( Pointer(@buf[0])^, len );
+ if got > 0 then
+ begin
+ Result := got;
+ Exit;
+ end;
+ end;
+
+ ReadFrame;
+ Result := FReadBuffer.Read( Pointer(@buf[0])^, len );
+end;
+
+procedure TFramedTransportImpl.ReadFrame;
+var
+ i32rd : TBytes;
+ size : Integer;
+ buff : TBytes;
+begin
+ SetLength( i32rd, FHeaderSize );
+ FTransport.ReadAll( i32rd, 0, FHeaderSize);
+ size :=
+ ((i32rd[0] and $FF) shl 24) or
+ ((i32rd[1] and $FF) shl 16) or
+ ((i32rd[2] and $FF) shl 8) or
+ (i32rd[3] and $FF);
+ SetLength( buff, size );
+ FTransport.ReadAll( buff, 0, size );
+ FReadBuffer.Free;
+ FReadBuffer := TMemoryStream.Create;
+ FReadBuffer.Write( Pointer(@buff[0])^, size );
+ FReadBuffer.Position := 0;
+end;
+
+procedure TFramedTransportImpl.Write(const buf: TBytes; off, len: Integer);
+begin
+ FWriteBuffer.Write( Pointer(@buf[0])^, len );
+end;
+
+{ TFramedTransport.TFactory }
+
+function TFramedTransportImpl.TFactory.GetTransport(ATrans: ITransport): ITransport;
+begin
+ Result := TFramedTransportImpl.Create( ATrans );
+end;
+
+{ TTcpSocketStreamImpl }
+
+procedure TTcpSocketStreamImpl.Close;
+begin
+ FTcpClient.Close;
+end;
+
+constructor TTcpSocketStreamImpl.Create(ATcpClient: TCustomIpClient);
+begin
+ FTcpClient := ATcpClient;
+end;
+
+procedure TTcpSocketStreamImpl.Flush;
+begin
+
+end;
+
+function TTcpSocketStreamImpl.IsOpen: Boolean;
+begin
+ Result := FTcpClient.Active;
+end;
+
+procedure TTcpSocketStreamImpl.Open;
+begin
+ FTcpClient.Open;
+end;
+
+function TTcpSocketStreamImpl.Read(var buffer: TBytes; offset,
+ count: Integer): Integer;
+begin
+ inherited;
+ Result := FTcpClient.ReceiveBuf( Pointer(@buffer[offset])^, count);
+end;
+
+function TTcpSocketStreamImpl.ToArray: TBytes;
+var
+ len : Integer;
+begin
+ len := 0;
+ if IsOpen then
+ begin
+ len := FTcpClient.BytesReceived;
+ end;
+
+ SetLength( Result, len );
+
+ if len > 0 then
+ begin
+ FTcpClient.ReceiveBuf( Pointer(@Result[0])^, len);
+ end;
+end;
+
+procedure TTcpSocketStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
+begin
+ inherited;
+ FTcpClient.SendBuf( Pointer(@buffer[offset])^, count);
+end;
+
+{$IF CompilerVersion < 21.0}
+initialization
+begin
+ TFramedTransportImpl_Initialize;
+end;
+{$IFEND}
+
+
+end.
diff --git a/lib/delphi/src/Thrift.Utils.pas b/lib/delphi/src/Thrift.Utils.pas
new file mode 100644
index 0000000..72c0dc1
--- /dev/null
+++ b/lib/delphi/src/Thrift.Utils.pas
@@ -0,0 +1,36 @@
+(*
+ * 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.Utils;
+
+interface
+
+function IfValue(B: Boolean; const TrueValue, FalseValue: WideString): string;
+
+implementation
+
+function IfValue(B: Boolean; const TrueValue, FalseValue: WideString): string;
+begin
+ if B then
+ Result := TrueValue
+ else
+ Result := FalseValue;
+end;
+
+end.
diff --git a/lib/delphi/src/Thrift.pas b/lib/delphi/src/Thrift.pas
new file mode 100644
index 0000000..6f352b1
--- /dev/null
+++ b/lib/delphi/src/Thrift.pas
@@ -0,0 +1,156 @@
+(*
+ * 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;
+
+interface
+
+uses
+ SysUtils, Thrift.Protocol;
+
+type
+ IProcessor = interface
+ ['{B1538A07-6CAC-4406-8A4C-AFED07C70A89}']
+ function Process( iprot :IProtocol; oprot: IProtocol): Boolean;
+ end;
+
+ TApplicationException = class( SysUtils.Exception )
+ public
+ type
+{$SCOPEDENUMS ON}
+ TExceptionType = (
+ Unknown,
+ UnknownMethod,
+ InvalidMessageType,
+ WrongMethodName,
+ BadSequenceID,
+ MissingResult
+ );
+{$SCOPEDENUMS OFF}
+ private
+ FType : TExceptionType;
+ public
+ constructor Create; overload;
+ constructor Create( AType: TExceptionType); overload;
+ constructor Create( AType: TExceptionType; const msg: string); overload;
+
+ class function Read( iprot: IProtocol): TApplicationException;
+ procedure Write( oprot: IProtocol );
+ end;
+
+implementation
+
+{ TApplicationException }
+
+constructor TApplicationException.Create;
+begin
+ inherited Create( '' );
+end;
+
+constructor TApplicationException.Create(AType: TExceptionType;
+ const msg: string);
+begin
+ inherited Create( msg );
+ FType := AType;
+end;
+
+constructor TApplicationException.Create(AType: TExceptionType);
+begin
+ inherited Create('');
+ FType := AType;
+end;
+
+class function TApplicationException.Read(
+ iprot: IProtocol): TApplicationException;
+var
+ field : IField;
+ msg : string;
+ typ : TExceptionType;
+begin
+ msg := '';
+ typ := TExceptionType.Unknown;
+ while ( True ) do
+ begin
+ field := iprot.ReadFieldBegin;
+ if ( field.Type_ = TType.Stop) then
+ begin
+ Break;
+ end;
+
+ case field.Id of
+ 1 : begin
+ if ( field.Type_ = TType.String_) then
+ begin
+ msg := iprot.ReadString;
+ end else
+ begin
+ TProtocolUtil.Skip( iprot, field.Type_ );
+ end;
+ end;
+
+ 2 : begin
+ if ( field.Type_ = TType.I32) then
+ begin
+ typ := TExceptionType( iprot.ReadI32 );
+ end else
+ begin
+ TProtocolUtil.Skip( iprot, field.Type_ );
+ end;
+ end else
+ begin
+ TProtocolUtil.Skip( iprot, field.Type_);
+ end;
+ end;
+ iprot.ReadFieldEnd;
+ end;
+ iprot.ReadStructEnd;
+ Result := TApplicationException.Create( typ, msg );
+end;
+
+procedure TApplicationException.Write(oprot: IProtocol);
+var
+ struc : IStruct;
+ field : IField;
+
+begin
+ struc := TStructImpl.Create( 'TApplicationException' );
+ field := TFieldImpl.Create;
+
+ oprot.WriteStructBegin( struc );
+ if Message <> '' then
+ begin
+ field.Name := 'message';
+ field.Type_ := TType.String_;
+ field.Id := 1;
+ oprot.WriteFieldBegin( field );
+ oprot.WriteString( Message );
+ oprot.WriteFieldEnd;
+ end;
+
+ field.Name := 'type';
+ field.Type_ := TType.I32;
+ field.Id := 2;
+ oprot.WriteFieldBegin(field);
+ oprot.WriteI32(Integer(FType));
+ oprot.WriteFieldEnd();
+ oprot.WriteFieldStop();
+ oprot.WriteStructEnd();
+end;
+
+end.