Browse Source

# revisions: 33347,33406,33548,33576,33577,33578,33579,33602,33603,33683

git-svn-id: branches/fixes_3_0@33752 -
marco 9 years ago
parent
commit
34e0fc0133

+ 8 - 1
.gitattributes

@@ -1954,7 +1954,6 @@ packages/fcl-base/examples/testbs.pp svneol=native#text/plain
 packages/fcl-base/examples/testcgi.html -text
 packages/fcl-base/examples/testcgi.pp svneol=native#text/plain
 packages/fcl-base/examples/testcont.pp svneol=native#text/plain
-packages/fcl-base/examples/testexprpars.pp svneol=native#text/plain
 packages/fcl-base/examples/testez.pp svneol=native#text/plain
 packages/fcl-base/examples/testhres.pp svneol=native#text/plain
 packages/fcl-base/examples/testini.pp svneol=native#text/plain
@@ -2040,6 +2039,7 @@ packages/fcl-base/src/wtex.pp svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
 packages/fcl-base/tests/tchashlist.pp svneol=native#text/plain
+packages/fcl-base/tests/testexprpars.pp svneol=native#text/plain
 packages/fcl-base/tests/tests_fptemplate.pp svneol=native#text/plain
 packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
@@ -3166,6 +3166,9 @@ packages/fcl-web/src/base/restcodegen.pp svneol=native#text/plain
 packages/fcl-web/src/base/webpage.pp svneol=native#text/plain
 packages/fcl-web/src/base/websession.pp svneol=native#text/plain
 packages/fcl-web/src/base/webutil.pp svneol=native#text/plain
+packages/fcl-web/src/hpack/uhpack.pp svneol=native#text/plain
+packages/fcl-web/src/hpack/uhpackimp.pp svneol=native#text/plain
+packages/fcl-web/src/hpack/uhpacktables.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/Makefile svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/fpdispextdirect.pp svneol=native#text/plain
@@ -3181,10 +3184,14 @@ packages/fcl-web/src/webdata/fpextjs.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/fpwebdata.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/readme.txt svneol=native#text/plain
 packages/fcl-web/src/webdata/sqldbwebdata.pp svneol=native#text/plain
+packages/fcl-web/tests/README.txt svneol=native#text/plain
 packages/fcl-web/tests/cgigateway.lpi svneol=native#text/plain
 packages/fcl-web/tests/cgigateway.pp svneol=native#text/plain
+packages/fcl-web/tests/fpcunithpack.lpi svneol=native#text/plain
+packages/fcl-web/tests/fpcunithpack.lpr svneol=native#text/plain
 packages/fcl-web/tests/testcgiapp.lpi svneol=native#text/plain
 packages/fcl-web/tests/testcgiapp.pp svneol=native#text/plain
+packages/fcl-web/tests/uhpacktest1.pas svneol=native#text/plain
 packages/fcl-xml/Makefile svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc.fpcmake svneol=native#text/plain

+ 2 - 1
packages/fcl-base/tests/fclbase-unittests.pp

@@ -3,7 +3,8 @@ program fclbase_unittests;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tests_fptemplate, tchashlist;
+  Classes, consoletestrunner, tests_fptemplate, tchashlist,
+  testexprpars;
 
 var
   Application: TTestRunner;

+ 0 - 0
packages/fcl-base/examples/testexprpars.pp → packages/fcl-base/tests/testexprpars.pp


+ 2 - 0
packages/fcl-db/src/base/sqlscript.pp

@@ -124,6 +124,8 @@ type
     property Aborted;
     property Line;
   published
+    Property UseDollarString;
+    Property DollarStrings;
     property Directives;
     property Defines;
     property Script;

+ 2 - 0
packages/fcl-db/src/sqldb/sqldb.pp

@@ -693,6 +693,8 @@ type
     Property DataBase : TDatabase Read FDatabase Write SetDatabase;
     Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
     property OnDirective: TSQLScriptDirectiveEvent read FOnDirective write FOnDirective;
+    Property UseDollarString; 
+    Property DollarStrings;     
     property Directives;
     property Defines;
     property Script;

+ 3 - 0
packages/fcl-web/src/base/custcgi.pp

@@ -373,6 +373,9 @@ begin
         end;
       end;
     end;
+  // Microsoft-IIS hack. IIS includes the script name in the PATH_INFO
+  if Pos('IIS', ServerSoftware) > 0 then
+    SetHTTPVariable(hvPathInfo,StringReplace(PathInfo, ScriptName, '', [rfReplaceAll, rfIgnoreCase]));
   R:=UpCase(Method);
   if (R='POST') or (R='PUT') or (ContentLength>0) then
     ReadContent;

+ 87 - 0
packages/fcl-web/src/hpack/uhpack.pp

@@ -0,0 +1,87 @@
+(*
+  HPACK: Header Compression for HTTP/2 (rfc7541)
+  ----------------------------------------------
+  Pascal implementation of HTTP/2 headers send and receive process.
+
+  Code based in Twitter's HPACK for java https://github.com/twitter/hpack
+
+  History:
+
+  2016.04.21 - Initial development by Jose Mejuto
+
+  Package source files
+
+    uhpackapi.pas (this file)
+    uhpack.pas
+    uhpacktables.pas
+    rfc7541.txt (rfc based on)
+
+  Basic API:
+
+  HPackDecoder.Create(MaxHeaderSize,MaxHeaderTableSize)
+    MaxHeaderSize: Each header block must not exceed this value (default: 8192)
+    MaxHeaderTableSize: Max size for the dynamic table (default: 4096)
+
+  HPackDecoder.Decode(DataStream)
+    This procedure receives a RawByteString or a Stream and decodes its headers.
+    If an OnAddHeader is created it will be called for each decoded header.
+    After all data has been sent to "Decode" the plain headers can be accessed
+    using "DecodedHeaders". After headers has been processed the function
+    "EndHeaderBlockTruncated" should be called to verify that the headers has
+    been successfully decoded.
+
+  HPackEncoder.Create(MaxHeaderTableSize)
+    Creates the Encoder with a MaxHeaderTableSize.
+
+  HPackEncoder.AddHeader(OutputStream,Name,Value,bSensitive)
+    Encodes a header pair Name/Value and also a sensitive flag (header should
+    not be stored in internal tables nor in encoder, nor in decoder) in the
+    OutputStream parameter.
+
+  THPACKException
+    Exception raised if some internal state do not work as expected, or sent
+    information does not meets the structure expected.
+    If the exception happens, even as some of the errors could be recovered, the
+    best approach is to free the object and recreate again and also drop the
+    http2 connection and restart it, as when this exception is raised is quite
+    sure that the connection is out of sync with remote end point.
+
+  License:
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+*)
+
+unit uhpack;
+
+(*
+  This file exposes only the needed symbols instead the whole
+  infrastructure to handle HPack.
+*)
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  uhpackimp;
+
+const
+  HPACK_MAX_HEADER_SIZE = uhpackimp.HPACK_MAX_HEADER_SIZE;
+  HPACK_MAX_HEADER_TABLE_SIZE = uhpackimp.HPACK_MAX_HEADER_TABLE_SIZE;
+
+type
+  THPackDecoder=uhpackimp.THPackDecoder;
+  THPackEncoder=uhpackimp.THPackEncoder;
+  THPackHeaderAddEvent = uhpackimp.THPackHeaderAddEvent;
+  THPACKException= uhpackimp.THPACKException;
+  THPackHeaderTextList = uhpackimp.THPackHeaderTextList;
+
+implementation
+
+end.
+

+ 1887 - 0
packages/fcl-web/src/hpack/uhpackimp.pp

@@ -0,0 +1,1887 @@
+unit uhpackimp;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, uhpacktables;
+
+const
+  HPACK_MAX_HEADER_SIZE = 8192;
+  HPACK_MAX_HEADER_TABLE_SIZE = 4096;
+
+(*
+ * Tries to "inline" some specific and short time critical functions.
+ *)
+{$DEFINE USEINLINE}
+
+(*
+ * This setting applies a bit manual optimizations here and there, but most
+ * of them could stop correctly working if static information is changed in a
+ * future, like THPackStaticTable fields (count and order). This optimizations
+ * only gain around 0.50% in speed time.
+ *)
+{$DEFINE MANUALOPTIMIZATIONS}
+
+type
+
+  THPackHeaderAddEvent = procedure (aName,aValue: RawByteString; aSensitive: Boolean) of object;
+  THPACKException=class (Exception);
+
+  THPackHeaderTextItem=record
+    HeaderName: RawByteString;
+    HeaderValue: RawByteString;
+    IsSensitive: Boolean;
+  end;
+  PHPackHeaderTextItem=^THPackHeaderTextItem;
+
+  { THPackHeaderTextList }
+
+  THPackHeaderTextList=class(TObject)
+  private
+    function Get(Index: integer): PHPackHeaderTextItem; overload;
+    function GetAsText: string;
+    function GetCount: integer;
+  protected
+    FList: TFPList;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    function Add(const aName, aValue: RawByteString; const aSensitive: Boolean=false
+      ): integer;
+    procedure Clear;
+    function  GetHeaderValue(const aName: String; out aValue: String): Boolean;
+    property  Count: integer read GetCount;
+    property  Item[Index: integer]: PHPackHeaderTextItem read Get; default;
+    property  Text: string read GetAsText;
+  end;
+
+  { THPackHeaderField }
+
+  THPackHeaderField=class
+  private
+  protected
+    FName: RawByteString;
+    FValue: RawByteString;
+  public
+    const
+      HEADER_ENTRY_OVERHEAD = 32;
+  public
+    // Section 4.1. Calculating Table Size
+    // The additional 32 octets account for an estimated
+    // overhead associated with the structure.
+    class function SizeOf(const aName, aValue: RawByteString): Integer;
+
+    constructor Create(const aName,aValue: RawByteString);
+    function Size: Integer;
+
+  end;
+
+  { THPackHuffmanEncoder }
+
+  THPackHuffmanEncoder=class
+  private
+  protected
+    FCodes: PDWORD;
+    FLengths: PByte;
+  public
+    constructor Create;
+    constructor Create(const aCodes: PDWORD; const aLengths: PByte);
+    function  GetEncodedLength(aData: RawByteString): integer;
+    procedure Encode(aOutputStream: TStream; aData: RawByteString);
+    procedure Encode(aOutputStream: TStream; aData: RawByteString; aOff,aLen: integer);
+  end;
+
+  { THPackHuffmanNode }
+
+  THPackHuffmanNode=class
+  private
+  protected
+    FSymbol: integer;      // terminal nodes have a symbol
+    FBits: integer;        // number of bits matched by the node
+    FChildren: array of THPackHuffmanNode; // internal nodes have children
+    class procedure Insert(aRoot: THPackHuffmanNode; aSymbol: integer; aCode: integer; aLength: BYTE);
+    class function BuildTree(const aCodes: PDWORD; const aLengths: PByte): THPackHuffmanNode;
+  public
+    constructor Create;
+    constructor Create(aSymbol: Integer; aBits: Integer);
+    destructor Destroy; override;
+    function  isTerminal: Boolean;{$IFDEF USEINLINE}inline;{$ENDIF}
+  end;
+
+  { THPackHuffmanDecoder }
+
+  THPackHuffmanDecoder=class
+  private
+  protected
+    FCodes: PDWORD;
+    FLengths: PByte;
+    FRoot: THPackHuffmanNode;
+  public
+    constructor Create;
+    constructor Create(const aCodes: PDWORD; const aLengths: PByte);
+    destructor Destroy; override;
+    function Decode(aBuf: RawByteString): RawByteString;
+  end;
+
+  THPackHuffman=class
+  private
+  protected
+    class var
+    FRefCount: Integer;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    class var Encoder: THPackHuffmanEncoder;
+    class var Decoder: THPackHuffmanDecoder;
+  end;
+
+  { THPackDynamicTable }
+
+  THPackDynamicTable=class
+  private
+    FSize: integer;
+    FCapacity: integer;
+  protected
+    // a circular queue of header fields
+    FHeaderFields: array of THPackHeaderField;
+    FHead: integer;
+    FTail: integer;
+    procedure SetCapacity(aCapacity: integer);
+    procedure Clear;
+    function  Remove: THPackHeaderField;
+    function  EntriesCount: integer; {$IFDEF USEINLINE}inline;{$ENDIF}
+  public
+    constructor Create(aInitialCapacity: integer);
+    destructor Destroy; override;
+    procedure Add(aHeaderField: THPackHeaderField);
+    function  GetEntry(aIndex: integer): THPackHeaderField; {$IFDEF USEINLINE}inline;{$ENDIF}
+    function  GetNameIndex(const aName: RawByteString): integer;
+    function  GetEntry(const aName, aValue: RawByteString): THPackHeaderField;
+    function  GetEntryIndex(const aName, aValue: RawByteString): integer;
+    function  GetEntryIndex(const aHeader: THPackHeaderField): integer;
+    procedure EnsureCapacityToHold(const aHeaderSize: integer);
+    property  Size: integer read FSize;
+    property  Capacity: integer read FCapacity;
+  end;
+
+  { THPackStaticTable }
+
+  THPackStaticTable=class
+  private
+    HPackStaticTable: array [1..61] of THPackHeaderField; static;
+  protected
+  public
+    class procedure InitializeStaticTable;
+    class procedure DestroyStaticTable;
+    class function  GetEntry(aIndex: integer): THPackHeaderField;
+    (**
+     * Returns the lowest index value for the given header field name in the static table.
+     * Returns -1 if the header field name is not in the static table.
+     *)
+    class function  GetIndex(const aName: RawByteString): Integer;
+    (**
+     * Returns the index value for the given header field in the static table.
+     * Returns -1 if the header field is not in the static table.
+     *)
+    class function GetIndex(const aName,aValue: RawByteString): integer;
+    class function TableLength: integer; {$IFDEF USEINLINE}inline;{$ENDIF}
+  end;
+
+  { THPackDecoder }
+
+  THPackDecoder=class
+  private
+    DynamicTable: THPackDynamicTable;
+    MaxHeaderSize: integer;
+    MaxDynamicTableSize: integer;
+    EncoderMaxDynamicTableSize: integer;
+    MaxDynamicTableSizeChangeRequired: Boolean;
+    HeaderSize: integer;
+    State: THPackState;
+    IndexType: THPackIndexType;
+    FIndex: integer;
+    HuffmanEncoded: Boolean;
+    SkipLength: integer;
+    NameLength: integer;
+    ValueLength: integer;
+    FName: RawByteString;
+    FMustReset: Boolean;
+  protected
+    FHeaderListenerAddHeader: THPackHeaderAddEvent;
+    FDecodedHeaders: THPackHeaderTextList;
+    Huffman: THPackHuffman;
+
+    procedure Reset;
+    function  GetHeaderField(aIndex: integer): THPackHeaderField;
+    procedure SetDynamicTableSize(aDynamicTableSize: integer);
+    procedure ReadName (aIndex: integer);
+    function  ReadStringLiteral(aStream: TStream; aLength: integer): RawByteString;
+    procedure AddHeader(aName,aValue: RawByteString; aSensitive: Boolean);
+    procedure InsertHeader(aName,aValue: RawByteString; aIndexType: THPackIndexType);
+    function  DecodeULE128(aStream: TStream): integer;
+    procedure IndexHeader(aIndex: integer);
+    function  ExceedsMaxHeaderSize(aSize: integer): Boolean;
+
+    procedure DoAddHeader(aName,aValue: RawByteString; aSensitive: Boolean); virtual;
+
+  public
+    constructor Create;
+    constructor Create(aMaxHeaderSize, aMaxHeaderTableSize: integer);
+    destructor Destroy; override;
+    procedure Decode(aStream: TStream);
+    procedure Decode(aString: RawByteString);
+    function  GetMaxHeaderTableSize: Integer;
+    procedure SetMaxHeaderTableSize(aMaxHeaderTableSize: integer);
+    function  EndHeaderBlockTruncated: Boolean;
+    property  OnAddHeader: THPackHeaderAddEvent read FHeaderListenerAddHeader write FHeaderListenerAddHeader;
+    property  DecodedHeaders: THPackHeaderTextList read FDecodedHeaders;
+  end;
+
+  { THPackEncoder }
+
+  THPackEncoder=class
+  private
+  private
+    // Used for debugging purposes, modifies class behaviour using or not
+    // indexing, or Huffman compression.
+    UseIndexing: Boolean;
+    ForceHuffmanOn: Boolean;
+    ForceHuffmanOff: Boolean;
+
+    procedure EncodeLiteral(aOutStream: TStream; const aName: RawByteString; const aValue: RawByteString; const aIndexType: THPackIndexType; const aNameIndex: Integer);
+    procedure EncodeInteger(aOutStream: TStream; const aMask: integer; const n: integer; const i: integer);
+    procedure EncodeStringLiteral(aOutStream: TStream; const aString: RawByteString);
+    function  GetNameIndex(const aName: RawByteString): integer;
+    procedure Add(const aName, aValue: RawByteString);
+    procedure Clear;
+
+  protected
+    DynamicTable: THPackDynamicTable;
+    Huffman: THPackHuffman;
+  public
+    constructor Create;
+    constructor Create(const aMaxHeaderTableSize: Integer);
+    constructor Create(const aMaxHeaderTableSize: Integer;
+                       const aUseIndexing: Boolean;
+                       const aForceHuffmanOn: Boolean;
+                       const aForceHuffmanOff: Boolean);
+    destructor Destroy; override;
+    procedure EncodeHeader(aOutStream: TStream; const aName: RawByteString; const aValue: RawByteString; const aSensitive: Boolean);
+    procedure SetMaxHeaderTableSize(aOutStream: TStream; const aNewMaxHeaderTableSize: Integer);
+
+  end;
+
+implementation
+
+const
+    NOT_FOUND=-1;
+
+{ THPackHeaderTextList }
+
+function THPackHeaderTextList.Get(Index: integer): PHPackHeaderTextItem;
+begin
+  Result:=PHPackHeaderTextItem(FList[Index]);
+end;
+
+function THPackHeaderTextList.GetAsText: string;
+const
+  HEADER_SEPARATOR_MARK: char=':';
+var
+  j: integer;
+  P: PHPackHeaderTextItem;
+  O: string;
+  w: integer;
+  wl, lle: integer;
+  Allocated: integer;
+  LE : string;
+  procedure EnsureSpace(const aNeeded: integer);{$IFDEF USEINLINE}inline;{$ENDIF}
+  begin
+    if (w+aNeeded)>Allocated then begin
+      Allocated:=Allocated+aNeeded;
+      SetLength(O,Allocated);
+    end;
+  end;
+  
+begin
+  LE:=LineEnding;
+  LLE:=Length(LE);
+  Allocated:=HPACK_MAX_HEADER_SIZE*2;
+  SetLength(O,Allocated);
+  w:=1;
+  for j := 0 to Pred(FList.Count) do begin
+    P:=PHPackHeaderTextItem(FList[j]);
+    wl:=Length(P^.HeaderName);
+    if wl=0 then begin
+      Raise THPACKException.Create('Header name is empty');
+    end;
+    EnsureSpace(wl);
+    move(P^.HeaderName[1],O[w],wl);
+    inc(w,wl);
+    wl:=1;
+    EnsureSpace(wl);
+    move(HEADER_SEPARATOR_MARK,O[w],wl);
+    inc(w,wl);
+    wl:=Length(P^.HeaderValue);
+    if wl>0 then begin
+      EnsureSpace(wl);
+      move(P^.HeaderValue[1],O[w],wl);
+      inc(w,wl);
+    end;
+    EnsureSpace(lle);
+    move(LE[1],O[w],lle);
+    inc(w,lle);
+  end;
+  SetLength(O,w-1);
+  Result:=O;
+end;
+
+function THPackHeaderTextList.GetCount: integer;
+begin
+  Result:=FList.Count;
+end;
+
+constructor THPackHeaderTextList.Create;
+begin
+  FList:=TFPList.Create;
+end;
+
+destructor THPackHeaderTextList.Destroy;
+begin
+  Clear;
+  FList.Free;
+end;
+
+function THPackHeaderTextList.Add(const aName, aValue: RawByteString;
+  const aSensitive: Boolean=false): integer;
+var
+  P: PHPackHeaderTextItem;
+begin
+  New(P);
+  P^.HeaderName:=aName;
+  P^.HeaderValue:=aValue;
+  P^.IsSensitive:=aSensitive;
+  Result:=FList.Add(P);
+end;
+
+procedure THPackHeaderTextList.Clear;
+var
+  j: integer;
+begin
+  for j := 0 to Pred(FList.Count) do begin
+    Dispose(PHPackHeaderTextItem(FList[j]));
+  end;
+  FList.Clear;
+end;
+
+function THPackHeaderTextList.GetHeaderValue(const aName: String; out
+  aValue: String): Boolean;
+var
+  j: integer;
+  p: PHPackHeaderTextItem;
+begin
+  for j := 0 to Pred(FList.Count) do begin
+    P:=PHPackHeaderTextItem(FList[j]);
+    if p^.HeaderName=aName then begin
+      aValue:=p^.HeaderValue;
+      Result:=true;
+      exit;
+    end;
+  end;
+  aValue:='';
+  Result:=false;
+end;
+
+{ THPackEncoder }
+
+constructor THPackEncoder.Create(const aMaxHeaderTableSize: Integer);
+begin
+  Create(aMaxHeaderTableSize,true,false,false);
+end;
+
+constructor THPackEncoder.Create(const aMaxHeaderTableSize: Integer;
+  const aUseIndexing: Boolean; const aForceHuffmanOn: Boolean;
+  const aForceHuffmanOff: Boolean);
+begin
+  if aMaxHeaderTableSize < 0 then begin
+    Raise THPACKException.CreateFmt('Illegal capacity: %d',[aMaxHeaderTableSize]);
+  end;
+  DynamicTable:=THPackDynamicTable.Create(aMaxHeaderTableSize);
+  UseIndexing := aUseIndexing;
+  ForceHuffmanOn := aForceHuffmanOn;
+  ForceHuffmanOff := aForceHuffmanOff;
+  Huffman:=THPackHuffman.Create;
+end;
+
+destructor THPackEncoder.Destroy;
+begin
+  Clear;
+  FreeAndNil(Huffman);
+  FreeAndNil(DynamicTable);
+  inherited Destroy;
+end;
+
+procedure THPackEncoder.EncodeHeader(aOutStream: TStream;
+  const aName: RawByteString; const aValue: RawByteString;
+  const aSensitive: Boolean);
+var
+  NameIndex: integer;
+  StaticTableIndex: integer;
+  HeaderSize: integer;
+  ThisHeaderField: THPackHeaderField;
+  Index: integer;
+  IndexType: THPackIndexType;
+begin
+  // If the header value is sensitive then it must never be indexed
+  if aSensitive then begin
+    NameIndex := GetNameIndex(aName);
+    EncodeLiteral(aOutStream, aName, aValue, THPackIndexType.eHPackNEVER, NameIndex);
+    exit;
+  end;
+
+  // If the peer will only use the static table
+  if DynamicTable.Capacity = 0 then begin
+    StaticTableIndex := THPackStaticTable.GetIndex(aName, aValue);
+    if StaticTableIndex = NOT_FOUND then begin
+      NameIndex := THPackStaticTable.GetIndex(aName);
+      EncodeLiteral(aOutStream, aName, aValue, THPackIndexType.eHPackNONE, NameIndex);
+    end else begin
+      EncodeInteger(aOutStream, $80, 7, StaticTableIndex);
+    end;
+    exit;
+  end;
+
+  HeaderSize := THPackHeaderField.sizeOf(aName, aValue);
+
+  // If the headerSize is greater than the max table size then it must be encoded literally
+  if HeaderSize > DynamicTable.Capacity then begin
+    NameIndex := GetNameIndex(aName);
+    EncodeLiteral(aOutStream, aName, aValue, THPackIndexType.eHPackNONE, NameIndex);
+    Exit;
+  end;
+
+  ThisHeaderField := DynamicTable.GetEntry(aName, aValue);
+  if Assigned(ThisHeaderField) then begin
+    Index := DynamicTable.GetEntryIndex(ThisHeaderField) + THPackStaticTable.TableLength;
+    // Section 6.1. Indexed Header Field Representation
+    EncodeInteger(aOutStream, $80, 7, Index);
+  end else begin
+    StaticTableIndex := THPackStaticTable.GetIndex(aName, aValue);
+    if StaticTableIndex <> NOT_FOUND then begin
+      // Section 6.1. Indexed Header Field Representation
+      EncodeInteger(aOutStream, $80, 7, StaticTableIndex);
+    end else begin
+      NameIndex := GetNameIndex(aName);
+      if UseIndexing then begin
+        DynamicTable.EnsureCapacityToHold(HeaderSize);
+      end;
+      if UseIndexing then begin
+        IndexType:=THPackIndexType.eHPackINCREMENTAL;
+      end else begin
+        IndexType:=THPackIndexType.eHPackNONE;
+      end;
+      EncodeLiteral(aOutStream, aName, aValue, IndexType, NameIndex);
+      if UseIndexing then begin
+        Add(aName, aValue);
+      end;
+    end;
+  end;
+end;
+
+procedure THPackEncoder.SetMaxHeaderTableSize(aOutStream: TStream;
+  const aNewMaxHeaderTableSize: Integer);
+begin
+  if aNewMaxHeaderTableSize < 0 then begin
+    Raise THPACKException.CreateFmt('Illegal Capacity %d',[aNewMaxHeaderTableSize]);
+  end;
+  if DynamicTable.Capacity = aNewMaxHeaderTableSize then begin
+    //No change needed
+    exit;
+  end;
+  DynamicTable.SetCapacity(aNewMaxHeaderTableSize);
+  //DynamicTable.EnsureCapacityToHold(0);
+  EncodeInteger(aOutStream, $20, 5, aNewMaxHeaderTableSize);
+end;
+
+procedure THPackEncoder.EncodeLiteral(aOutStream: TStream;
+  const aName: RawByteString; const aValue: RawByteString;
+  const aIndexType: THPackIndexType; const aNameIndex: Integer);
+(**
+ * Encode literal header field according to Section 6.2.
+ *)
+var
+  Mask: Integer;
+  PrefixBits: Integer;
+  v: integer;
+begin
+  case aIndexType of
+    eHPackINCREMENTAL:
+      begin
+        Mask := $40;
+        PrefixBits := 6;
+      end;
+    eHPackNONE:
+      begin
+        Mask := $00;
+        PrefixBits := 4;
+      end;
+    eHPackNEVER:
+      begin
+        Mask := $10;
+        PrefixBits := 4;
+      end;
+    else
+      Raise THPACKException.Create('Should not reach here');
+  end;
+  if aNameIndex=NOT_FOUND then begin
+    v:=0;
+  end else begin
+    v:=aNameIndex;
+  end;
+  EncodeInteger(aOutStream, Mask, PrefixBits, v);
+  if aNameIndex = NOT_FOUND then begin
+    EncodeStringLiteral(aOutStream, aName);
+  end;
+  EncodeStringLiteral(aOutStream, aValue);
+end;
+
+procedure THPackEncoder.EncodeInteger(aOutStream: TStream; const aMask: integer;
+  const n: integer; const i: integer);
+var
+  nBits: Integer;
+  Len: DWORD;
+begin
+  if (n < 0) or (n > 8) then begin
+    Raise THPACKException.CreateFmt('Encode Integer Illegal Argument Exception ("N<0|N>8": %d)',[n]);
+  end;
+  nBits := $FF shr (8 - n);
+  if i < nBits then begin
+    aOutStream.WriteByte(BYTE(aMask or i));
+  end else begin
+    aOutStream.WriteByte(BYTE(aMask or nBits));
+    Len := i - nBits;
+    while (true) do begin
+      if (Len and  (not $7F)) = 0 then begin
+        aOutStream.WriteByte(BYTE(Len));
+        exit;
+      end else begin
+        aOutStream.WriteByte(Byte((Len and $7F) or $80));
+        Len:=Len shr 7;
+      end;
+    end;
+  end;
+end;
+
+procedure THPackEncoder.EncodeStringLiteral(aOutStream: TStream;
+  const aString: RawByteString);
+var
+  HuffmanLength: integer;
+begin
+  if Length(aString)=0 then begin
+    EncodeInteger(aOutStream, $00, 7, 0);
+    exit;
+  end;
+  HuffmanLength := THpackHuffman.Encoder.GetEncodedLength(aString);
+  if ((HuffmanLength < Length(aString)) and not forceHuffmanOff) or forceHuffmanOn then begin
+    EncodeInteger(aOutStream, $80, 7, HuffmanLength);
+    if Length(aString)>0 then begin
+      THPackHuffman.Encoder.Encode(aOutStream, aString);
+    end;
+  end else begin
+    EncodeInteger(aOutStream, $00, 7, Length(aString));
+    if Length(aString)>0 then begin
+      aOutStream.Write(aString[1],Length(aString));
+    end;
+  end;
+end;
+
+function THPackEncoder.GetNameIndex(const aName: RawByteString): integer;
+var
+  Index: integer;
+begin
+  Index := THPackStaticTable.GetIndex(aName);
+  if Index = NOT_FOUND then begin
+    Index := DynamicTable.GetNameIndex(aName);
+    if Index >= 0 then begin
+      inc(Index,THPackStaticTable.TableLength);
+    end;
+  end;
+  Result:=Index;
+end;
+
+procedure THPackEncoder.Add(const aName, aValue: RawByteString);
+(**
+ * Add the header field to the dynamic table.
+ * Entries are evicted from the dynamic table until the size of the table
+ * and the new header field is less than the table's capacity.
+ * If the size of the new entry is larger than the table's capacity,
+ * the dynamic table will be cleared.
+ *)
+var
+//  HeaderSize: Integer;
+  Header: THPackHeaderField;
+begin
+  (*
+  HeaderSize := THPackHeaderField.SizeOf(aName, aValue);
+
+  // Clear the table if the header field size is larger than the capacity.
+  if HeaderSize > Capacity then begin
+    Clear;
+    // Do not add this entry to the DynamicTable
+    exit;
+  end;
+
+  // Evict oldest entries until we have enough capacity.
+  while (Size + HeaderSize) > Capacity do begin
+    Remove().Free;
+  end;
+  *)
+  // Copy name and value that modifications of original do not affect the dynamic table.
+
+  Header:=THPackHeaderField.Create(aName,aValue);
+  DynamicTable.Add(Header);
+
+  //Inc(Size,HeaderSize);
+end;
+
+procedure THPackEncoder.Clear;
+(**
+ * Remove all entries from the dynamic table.
+ *)
+begin
+  DynamicTable.Clear;
+end;
+
+constructor THPackEncoder.Create;
+begin
+  Create(HPACK_MAX_HEADER_TABLE_SIZE,true,false,false);
+end;
+
+{ THPackHuffman }
+
+constructor THPackHuffman.Create;
+begin
+  if FRefCount=0 then begin
+    Encoder:=THPackHuffmanEncoder.Create;
+    Decoder:=THPackHuffmanDecoder.Create;
+  end;
+  inc(FRefCount);
+end;
+
+destructor THPackHuffman.Destroy;
+begin
+  dec(FRefCount);
+  if FRefCount=0 then begin
+    FreeAndNil(Encoder);
+    FreeAndNil(Decoder);
+  end;
+  inherited Destroy;
+end;
+
+{ THPackStaticTable }
+
+class function THPackStaticTable.TableLength: integer;
+begin
+  Result:=Length(HPackStaticTable);
+end;
+
+class procedure THPackStaticTable.InitializeStaticTable;
+const
+  EMPTY='';
+begin
+  // Appendix A: Static Table
+  // http://tools.ietf.org/html/rfc7541#appendix-A
+  HPackStaticTable[01]:=THPackHeaderField.Create(':authority',EMPTY);
+  HPackStaticTable[02]:=THPackHeaderField.Create(':method', 'GET');
+  HPackStaticTable[03]:=THPackHeaderField.Create(':method', 'POST');
+  HPackStaticTable[04]:=THPackHeaderField.Create(':path', '/');
+  HPackStaticTable[05]:=THPackHeaderField.Create(':path', '/index.html');
+  HPackStaticTable[06]:=THPackHeaderField.Create(':scheme', 'http');
+  HPackStaticTable[07]:=THPackHeaderField.Create(':scheme', 'https');
+  HPackStaticTable[08]:=THPackHeaderField.Create(':status', '200');
+  HPackStaticTable[09]:=THPackHeaderField.Create(':status', '204');
+  HPackStaticTable[10]:=THPackHeaderField.Create(':status', '206');
+  HPackStaticTable[11]:=THPackHeaderField.Create(':status', '304');
+  HPackStaticTable[12]:=THPackHeaderField.Create(':status', '400');
+  HPackStaticTable[13]:=THPackHeaderField.Create(':status', '404');
+  HPackStaticTable[14]:=THPackHeaderField.Create(':status', '500');
+  HPackStaticTable[15]:=THPackHeaderField.Create('accept-charset', EMPTY);
+  HPackStaticTable[16]:=THPackHeaderField.Create('accept-encoding', 'gzip, deflate');
+  HPackStaticTable[17]:=THPackHeaderField.Create('accept-language', EMPTY);
+  HPackStaticTable[18]:=THPackHeaderField.Create('accept-ranges', EMPTY);
+  HPackStaticTable[19]:=THPackHeaderField.Create('accept', EMPTY);
+  HPackStaticTable[20]:=THPackHeaderField.Create('access-control-allow-origin', EMPTY);
+  HPackStaticTable[21]:=THPackHeaderField.Create('age', EMPTY);
+  HPackStaticTable[22]:=THPackHeaderField.Create('allow', EMPTY);
+  HPackStaticTable[23]:=THPackHeaderField.Create('authorization', EMPTY);
+  HPackStaticTable[24]:=THPackHeaderField.Create('cache-control', EMPTY);
+  HPackStaticTable[25]:=THPackHeaderField.Create('content-disposition', EMPTY);
+  HPackStaticTable[26]:=THPackHeaderField.Create('content-encoding', EMPTY);
+  HPackStaticTable[27]:=THPackHeaderField.Create('content-language', EMPTY);
+  HPackStaticTable[28]:=THPackHeaderField.Create('content-length', EMPTY);
+  HPackStaticTable[29]:=THPackHeaderField.Create('content-location', EMPTY);
+  HPackStaticTable[30]:=THPackHeaderField.Create('content-range', EMPTY);
+  HPackStaticTable[31]:=THPackHeaderField.Create('content-type', EMPTY);
+  HPackStaticTable[32]:=THPackHeaderField.Create('cookie', EMPTY);
+  HPackStaticTable[33]:=THPackHeaderField.Create('date', EMPTY);
+  HPackStaticTable[34]:=THPackHeaderField.Create('etag', EMPTY);
+  HPackStaticTable[35]:=THPackHeaderField.Create('expect', EMPTY);
+  HPackStaticTable[36]:=THPackHeaderField.Create('expires', EMPTY);
+  HPackStaticTable[37]:=THPackHeaderField.Create('from', EMPTY);
+  HPackStaticTable[38]:=THPackHeaderField.Create('host', EMPTY);
+  HPackStaticTable[39]:=THPackHeaderField.Create('if-match', EMPTY);
+  HPackStaticTable[40]:=THPackHeaderField.Create('if-modified-since', EMPTY);
+  HPackStaticTable[41]:=THPackHeaderField.Create('if-none-match', EMPTY);
+  HPackStaticTable[42]:=THPackHeaderField.Create('if-range', EMPTY);
+  HPackStaticTable[43]:=THPackHeaderField.Create('if-unmodified-since', EMPTY);
+  HPackStaticTable[44]:=THPackHeaderField.Create('last-modified', EMPTY);
+  HPackStaticTable[45]:=THPackHeaderField.Create('link', EMPTY);
+  HPackStaticTable[46]:=THPackHeaderField.Create('location', EMPTY);
+  HPackStaticTable[47]:=THPackHeaderField.Create('max-forwards', EMPTY);
+  HPackStaticTable[48]:=THPackHeaderField.Create('proxy-authenticate', EMPTY);
+  HPackStaticTable[49]:=THPackHeaderField.Create('proxy-authorization', EMPTY);
+  HPackStaticTable[50]:=THPackHeaderField.Create('range', EMPTY);
+  HPackStaticTable[51]:=THPackHeaderField.Create('referer', EMPTY);
+  HPackStaticTable[52]:=THPackHeaderField.Create('refresh', EMPTY);
+  HPackStaticTable[53]:=THPackHeaderField.Create('retry-after', EMPTY);
+  HPackStaticTable[54]:=THPackHeaderField.Create('server', EMPTY);
+  HPackStaticTable[55]:=THPackHeaderField.Create('set-cookie', EMPTY);
+  HPackStaticTable[56]:=THPackHeaderField.Create('strict-transport-security', EMPTY);
+  HPackStaticTable[57]:=THPackHeaderField.Create('transfer-encoding', EMPTY);
+  HPackStaticTable[58]:=THPackHeaderField.Create('user-agent', EMPTY);
+  HPackStaticTable[59]:=THPackHeaderField.Create('vary', EMPTY);
+  HPackStaticTable[60]:=THPackHeaderField.Create('via', EMPTY);
+  HPackStaticTable[61]:=THPackHeaderField.Create('www-authenticate', EMPTY);
+end;
+
+class procedure THPackStaticTable.DestroyStaticTable;
+var
+  j: integer;
+begin
+  for j := Low(HPackStaticTable) to High(HPackStaticTable) do begin
+    HPackStaticTable[j].Free;
+    HPackStaticTable[j]:=nil;
+  end;
+end;
+
+class function THPackStaticTable.GetEntry(aIndex: integer): THPackHeaderField;
+begin
+  Result:=HPackStaticTable[aIndex];
+end;
+
+class function THPackStaticTable.GetIndex(const aName: RawByteString
+  ): Integer;
+var
+  lLeft,lRight: integer;
+  Half: integer;
+  c: integer;
+begin
+  lLeft:=Low(HPackStaticTable);
+  lRight:=High(HPackStaticTable);
+  {$IFDEF MANUALOPTIMIZATIONS}
+  // Manual optimization
+  if aName[1]>'c' then begin
+    lLeft:=33;
+  end;
+  {$ENDIF}
+  while lLeft<=lRight do begin
+    Half:=(lLeft+lRight) div 2; // No overflow problem, low amount of elements
+    c:=CompareStr(aName,HPackStaticTable[Half].FName);
+    if c=0 then begin
+      dec(Half);
+      while Half>=lLeft do begin
+        if HPackStaticTable[Half].FName<>aName then begin
+          break;
+        end;
+        dec(Half);
+      end;
+      Result:=Half+1;
+      exit;
+    end else if c<0 then begin
+      lRight:=Half-1;
+    end else begin
+      // c > 0
+      lLeft:=Half+1;
+    end;
+  end;
+  Result:=NOT_FOUND;
+end;
+
+class function THPackStaticTable.GetIndex(const aName, aValue: RawByteString): Integer;
+var
+  lLeft,lRight: integer;
+  Half: integer;
+  c: integer;
+begin
+  lLeft:=Low(HPackStaticTable);
+  lRight:=High(HPackStaticTable);
+  {$IFDEF MANUALOPTIMIZATIONS}
+  // Manual optimization
+  if aName[1]>'c' then begin
+    lLeft:=33;
+  end;
+  {$ENDIF}
+  while lLeft<=lRight do begin
+    Half:=(lLeft+lRight) div 2; // No overflow problem, low amount of elements
+    c:=CompareStr(aName,HPackStaticTable[Half].FName);
+    if c=0 then begin
+      c:=CompareStr(aValue,HPackStaticTable[Half].FValue);
+      if c=0 then begin
+        Result:=Half;
+        exit;
+      end else if c<0 then begin
+        lRight:=Half-1;
+      end else begin
+        // c > 0
+        lLeft:=Half+1;
+      end;
+    end else if c<0 then begin
+      lRight:=Half-1;
+    end else begin
+      // c > 0
+      lLeft:=Half+1;
+    end;
+  end;
+  Result:=NOT_FOUND;
+end;
+
+{ THPackDecoder }
+
+procedure THPackDecoder.Reset;
+begin
+  HeaderSize := 0;
+  State := THPackState.READ_HEADER_REPRESENTATION;
+  IndexType := THPackIndexType.eHPackNONE;
+  FDecodedHeaders.Clear;
+  FMustReset:=false;
+end;
+
+function THPackDecoder.EndHeaderBlockTruncated: Boolean;
+begin
+  Result:= HeaderSize > MaxHeaderSize;
+  FMustReset:=true;
+end;
+
+procedure THPackDecoder.SetMaxHeaderTableSize(aMaxHeaderTableSize: integer);
+begin
+  if FMustReset then Reset;
+  MaxDynamicTableSize := aMaxHeaderTableSize;
+  if (MaxDynamicTableSize < EncoderMaxDynamicTableSize) then begin
+    // decoder requires less space than encoder
+    // encoder MUST signal this change
+    MaxDynamicTableSizeChangeRequired := true;
+    DynamicTable.SetCapacity(MaxDynamicTableSize);
+  end;
+end;
+
+function THPackDecoder.GetHeaderField(aIndex: integer): THPackHeaderField;
+begin
+  Result:=DynamicTable.GetEntry(aIndex + 1);
+end;
+
+procedure THPackDecoder.SetDynamicTableSize(aDynamicTableSize: integer);
+begin
+  if aDynamicTableSize > MaxDynamicTableSize then begin
+    Raise THPACKException.Create('Invalid MAX_DYNAMIC_TABLE_SIZE');
+  end;
+  EncoderMaxDynamicTableSize := aDynamicTableSize;
+  MaxDynamicTableSizeChangeRequired := false;
+  DynamicTable.SetCapacity(aDynamicTableSize);
+end;
+
+procedure THPackDecoder.ReadName(aIndex: integer);
+var
+  HeaderField: THPackHeaderField;
+begin
+  if aIndex <= THPackStaticTable.TableLength then begin
+    HeaderField:= THPackStaticTable.GetEntry(aIndex);
+    FName := HeaderField.FName;
+  end else if (aIndex - THPackStaticTable.TableLength <= DynamicTable.EntriesCount) then begin
+    HeaderField := DynamicTable.GetEntry(aIndex - THPackStaticTable.TableLength);
+    FName := HeaderField.FName;
+  end else begin
+    Raise THPACKException.Create('Illegal index value');
+  end;
+end;
+
+function THPackDecoder.ReadStringLiteral(aStream: TStream; aLength: integer
+  ): RawByteString;
+var
+  buf: RawByteString;
+begin
+  SetLength(buf,aLength);
+  if (aStream.Read(buf[1],aLength) <> aLength) then begin
+    Raise THPACKException.Create('Decompression exception in ReadStringLiteral');
+  end;
+
+  if (HuffmanEncoded) then begin
+    Result:=Huffman.Decoder.Decode(buf);
+  end else begin
+    Result:=buf;
+  end;
+end;
+
+procedure THPackDecoder.AddHeader(aName, aValue: RawByteString; aSensitive: Boolean);
+var
+  NewSize: Integer;
+begin
+  if aName='' then begin
+    Raise THPACKException.Create('Header name is empty');
+  end;
+  NewSize := HeaderSize + Length(aName) + Length(aValue);
+  if NewSize <= MaxHeaderSize then begin
+    DoAddHeader(aName, aValue, aSensitive);
+    HeaderSize := newSize;
+  end else begin
+    // truncation will be reported during EndHeaderBlockTruncated
+    HeaderSize := MaxHeaderSize + 1;
+  end;
+end;
+
+procedure THPackDecoder.InsertHeader(aName, aValue: RawByteString;
+  aIndexType: THPackIndexType);
+begin
+  AddHeader(aName, aValue, aIndexType = THPackIndexType.eHPackNEVER);
+
+  case (aIndexType) of
+    eHPackNONE,
+    eHPackNEVER: exit;
+    eHPackINCREMENTAL: begin
+        DynamicTable.Add(THPackHeaderField.Create(aName, aValue));
+      end;
+    else
+      Raise THPACKException.Create('Should not reach here');
+  end;
+end;
+
+function THPackDecoder.DecodeULE128(aStream: TStream): integer;
+var
+  EntryMark: int64;
+  Shift: integer;
+  b: BYTE;
+  function InAvailable(): int64; inline;
+  begin
+    Result:=aStream.Size-aStream.Position;
+  end;
+begin
+  Shift:=0;
+  Result:=0;
+  EntryMark:=aStream.Position;
+  while (Shift < 32) do begin
+    if (InAvailable() = 0) then begin
+      // Buffer does not contain entire integer,
+      // reset reader index and return -1.
+      aStream.Position:=EntryMark;
+      exit(-1);
+    end;
+    b := aStream.ReadByte;
+    if ((Shift = 28) and ((b and $F8) <> 0)) then begin
+      break;
+    end;
+
+    Result:=Result or ((b and $7F) shl Shift);
+
+    if ((b and $80) = 0) then begin
+      exit;
+    end;
+    Inc(shift,7);
+  end;
+
+  // Value exceeds Integer.MAX_VALUE
+  aStream.Position:=EntryMark;
+  Raise THPACKException.Create('Decompression error DecodeULE128');
+end;
+
+procedure THPackDecoder.IndexHeader(aIndex: integer);
+var
+  HeaderField: THPackHeaderField;
+begin
+  if (aIndex <= THPackStaticTable.TableLength) then begin
+    HeaderField := THPackStaticTable.GetEntry(aIndex);
+    //addHeader(headerListener, headerField.name, headerField.value, false);
+    AddHeader(HeaderField.FName, HeaderField.FValue, False);
+  end else if (aIndex - THPackStaticTable.TableLength <= DynamicTable.EntriesCount) then begin
+    HeaderField := DynamicTable.GetEntry(aIndex - THPackStaticTable.TableLength);
+    //addHeader(headerListener, headerField.name, headerField.value, false);
+    AddHeader(HeaderField.FName, HeaderField.FValue, False);
+  end else begin
+    Raise THPACKException.Create('Illegal index value');
+  end;
+end;
+
+function THPackDecoder.ExceedsMaxHeaderSize(aSize: integer): Boolean;
+begin
+  // Check new header size against max header size
+  if aSize + HeaderSize <= MaxHeaderSize then begin
+    exit(False);
+  end;
+  // truncation will be reported during EndHeaderBlockTruncated
+  HeaderSize := MaxHeaderSize + 1;
+  Result:=true;
+end;
+
+procedure THPackDecoder.DoAddHeader(aName, aValue: RawByteString; aSensitive: Boolean);
+begin
+  if Assigned(FHeaderListenerAddHeader) then begin
+    FHeaderListenerAddHeader(aName,aValue,aSensitive);
+  end;
+  FDecodedHeaders.Add(aName,aValue,aSensitive);
+end;
+
+constructor THPackDecoder.Create;
+begin
+  Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
+end;
+
+constructor THPackDecoder.Create(aMaxHeaderSize, aMaxHeaderTableSize: integer);
+begin
+  Huffman:=THPackHuffman.Create;
+  DynamicTable := THPackDynamicTable.Create(aMaxHeaderTableSize);
+  MaxHeaderSize := aMaxHeaderSize;
+  MaxDynamicTableSize := aMaxHeaderTableSize;
+  EncoderMaxDynamicTableSize := aMaxHeaderTableSize;
+  MaxDynamicTableSizeChangeRequired := false;
+  FDecodedHeaders:=THPackHeaderTextList.Create;
+  Reset();
+end;
+
+destructor THPackDecoder.Destroy;
+begin
+  FreeAndNil(Huffman);
+  FreeAndNil(DynamicTable);
+  FreeAndNil(FDecodedHeaders);
+  inherited Destroy;
+end;
+
+procedure THPackDecoder.Decode(aStream: TStream);
+  function InAvailable(): int64; inline;
+  begin
+    Result:=aStream.Size-aStream.Position;
+  end;
+var
+  b: BYTE;
+  MaxSize: integer;
+  HeaderIndex: integer;
+  NameIndex: integer;
+  NewHeaderSize: integer;
+  tmpbuffer: RawByteString;
+  Value: RawByteString;
+begin
+  if FMustReset then Reset;
+  while InAvailable() > 0 do begin
+    case State of
+    READ_HEADER_REPRESENTATION: begin
+        b := aStream.ReadByte;
+        if MaxDynamicTableSizeChangeRequired and ((b and $E0) <> $20) then begin
+          // Encoder MUST signal maximum dynamic table size change
+          Raise THPACKException.Create('Max dynamic table size change not notified');
+        end;
+        if (b > 127) then begin
+          // Indexed Header Field
+          FIndex := b and $7F;
+          if (Findex = 0) then begin
+            Raise THPACKException.Create('Illegal index value in Decode');
+          end else if (Findex = $7F) then begin
+            State := THPackState.READ_INDEXED_HEADER;
+          end else begin
+            IndexHeader(Findex);
+          end;
+        end else if ((b and $40) = $40) then begin
+          // Literal Header Field with Incremental Indexing
+          IndexType := THPackIndexType.eHPackINCREMENTAL;
+          FIndex := b and $3F;
+          if (Findex = 0) then begin
+            State := THPackState.READ_LITERAL_HEADER_NAME_LENGTH_PREFIX;
+          end else if (findex = $3F) then begin
+            State := THPackState.READ_INDEXED_HEADER_NAME;
+          end else begin
+            // Index was stored as the prefix
+            ReadName(Findex);
+            State := THPackState.READ_LITERAL_HEADER_VALUE_LENGTH_PREFIX;
+          end;
+        end else if ((b and $20) = $20) then begin
+          // Dynamic Table Size Update
+          Findex := b and $1F;
+          if (Findex = $1F) then begin
+            State := THPackState.READ_MAX_DYNAMIC_TABLE_SIZE;
+          end else begin
+            SetDynamicTableSize(Findex);
+            State := THPackState.READ_HEADER_REPRESENTATION;
+          end;
+        end else begin
+          // Literal Header Field without Indexing / never Indexed
+          if (b and $10) = $10 then begin
+            IndexType:=THPackIndexType.eHPackNEVER;
+          end else begin
+            IndexType:=THPackIndexType.eHPackNONE;
+          end;
+          Findex := b and $0F;
+          if (Findex = 0) then begin
+            State := THPackState.READ_LITERAL_HEADER_NAME_LENGTH_PREFIX;
+          end else if (Findex = $0F) then begin
+            State := THpackState.READ_INDEXED_HEADER_NAME;
+          end else begin
+            // Index was stored as the prefix
+            ReadName(FIndex);
+            State := THpackState.READ_LITERAL_HEADER_VALUE_LENGTH_PREFIX;
+          end;
+        end;
+      end;
+    READ_MAX_DYNAMIC_TABLE_SIZE: begin
+        MaxSize := decodeULE128(aStream);
+        if (MaxSize = -1) then begin
+          exit;
+        end;
+        // Check for numerical overflow
+        if (MaxSize > High(Integer) - Findex) then begin
+          Raise THPACKException.Create('Decompression exception in Decode-READ_MAX_DYNAMIC_TABLE_SIZE');
+        end;
+        SetDynamicTableSize(Findex + MaxSize);
+        State := THPackState.READ_HEADER_REPRESENTATION;
+      end;
+    READ_INDEXED_HEADER: begin
+        HeaderIndex := decodeULE128(aStream);
+        if (HeaderIndex = -1) then begin
+          exit;
+        end;
+        // Check for numerical overflow
+        if (HeaderIndex > High(Integer) - Findex) then begin
+          Raise THPACKException.Create('Decompression exception in Decode-READ_INDEXED_HEADER');
+        end;
+
+        IndexHeader(Findex + HeaderIndex);
+        State := THPackState.READ_HEADER_REPRESENTATION;
+      end;
+    READ_INDEXED_HEADER_NAME: begin
+        // Header Name matches an entry in the Header Table
+        NameIndex := decodeULE128(aStream);
+        if (NameIndex = -1) then begin
+          Exit;
+        end;
+
+        // Check for numerical overflow
+        if (NameIndex > High(Integer) - Findex) then begin
+          Raise THPACKException.Create('Decompression exception in Decode-READ_INDEXED_HEADER_NAME');
+        end;
+
+        ReadName(Findex + NameIndex);
+        State := THPackState.READ_LITERAL_HEADER_VALUE_LENGTH_PREFIX;
+      end;
+    READ_LITERAL_HEADER_NAME_LENGTH_PREFIX: begin
+        b := aStream.ReadByte;
+        HuffmanEncoded := (b and $80) = $80;
+        Findex := b and $7F;
+        if (Findex = $7f) then begin
+          State := THPackState.READ_LITERAL_HEADER_NAME_LENGTH;
+        end else begin
+          NameLength := Findex;
+
+          // Disallow empty names -- they cannot be represented in HTTP/1.x
+          if (NameLength = 0) then begin
+            Raise THPACKException.Create('Empty name');
+          end;
+
+          // Check name length against max header size
+          if ExceedsMaxHeaderSize(NameLength) then begin
+            if (IndexType = THPackIndexType.eHPackNONE) then begin
+              // Name is unused so skip bytes
+              FName := '';
+              SkipLength := NameLength;
+              State := THPackState.SKIP_LITERAL_HEADER_NAME;
+              break;
+            end;
+
+            // Check name length against max dynamic table size
+            if (NameLength + HPACK_HEADER_ENTRY_OVERHEAD > DynamicTable.Capacity) then begin
+              DynamicTable.Clear();
+              Fname := '';
+              SkipLength := NameLength;
+              State := THPackState.SKIP_LITERAL_HEADER_NAME;
+              break;
+            end;
+          end;
+          State := THPackState.READ_LITERAL_HEADER_NAME;
+        end;
+      end;
+    READ_LITERAL_HEADER_NAME_LENGTH: begin
+        // Header Name is a Literal String
+        NameLength := decodeULE128(aStream);
+        if (NameLength = -1) then begin
+          exit;
+        end;
+
+        // Check for numerical overflow
+        if (NameLength > High(Integer) - Findex) then begin
+          Raise THPACKException.Create('Decompression exception in Decode-READ_LITERAL_HEADER_NAME_LENGTH');
+        end;
+        inc(NameLength,Findex);
+
+        // Check name length against max header size
+        if ExceedsMaxHeaderSize(NameLength) then begin
+          if (IndexType = THPackIndexType.eHPackNONE) then begin
+            // Name is unused so skip bytes
+            Fname := '';
+            SkipLength := NameLength;
+            State := THPackState.SKIP_LITERAL_HEADER_NAME;
+            break;
+          end;
+
+          // Check name length against max dynamic table size
+          if (NameLength + HPACK_HEADER_ENTRY_OVERHEAD > DynamicTable.Capacity) then begin
+            DynamicTable.Clear();
+            Fname := '';
+            SkipLength := NameLength;
+            State := THPackState.SKIP_LITERAL_HEADER_NAME;
+            break;
+          end;
+          State := THPackState.READ_LITERAL_HEADER_NAME;
+        end;
+      end;
+    READ_LITERAL_HEADER_NAME: begin
+        // Wait until entire name is readable
+        if (InAvailable() < NameLength) then begin
+          exit;
+        end;
+
+        FName := ReadStringLiteral(aStream, NameLength);
+
+        State := THPackState.READ_LITERAL_HEADER_VALUE_LENGTH_PREFIX;
+      end;
+    SKIP_LITERAL_HEADER_NAME: begin
+        SetLength(tmpbuffer,SkipLength);
+        dec(SkipLength, aStream.Read(tmpbuffer[1],SkipLength));
+
+        if (SkipLength = 0) then begin
+          State := THPackState.READ_LITERAL_HEADER_VALUE_LENGTH_PREFIX;
+        end;
+      end;
+    READ_LITERAL_HEADER_VALUE_LENGTH_PREFIX: begin
+        b := aStream.ReadByte;
+        HuffmanEncoded := (b and $80) = $80;
+        Findex := b and $7F;
+        if (Findex = $7f) then begin
+          State := THPackState.READ_LITERAL_HEADER_VALUE_LENGTH;
+        end else begin
+          ValueLength := Findex;
+
+          // Check new header size against max header size
+          NewHeaderSize := NameLength + ValueLength;
+          if ExceedsMaxHeaderSize(NewHeaderSize) then begin
+            // truncation will be reported during EndHeaderBlockTruncated
+            HeaderSize := MaxHeaderSize + 1;
+
+            if (IndexType = THPackIndexType.eHPackNONE) then begin
+              // Value is unused so skip bytes
+              State := THPackState.SKIP_LITERAL_HEADER_VALUE;
+              break;
+            end;
+
+            // Check new header size against max dynamic table size
+            if NewHeaderSize + HPACK_HEADER_ENTRY_OVERHEAD > DynamicTable.Capacity then begin
+              DynamicTable.Clear();
+              State := THPackState.SKIP_LITERAL_HEADER_VALUE;
+              break;
+            end;
+          end;
+
+          if (ValueLength = 0) then begin
+            InsertHeader(FName, '', IndexType);
+            State := THPackState.READ_HEADER_REPRESENTATION;
+          end else begin
+            State := THPackState.READ_LITERAL_HEADER_VALUE;
+          end;
+        end;
+      end;
+    READ_LITERAL_HEADER_VALUE_LENGTH: begin
+        // Header Value is a Literal String
+        ValueLength := decodeULE128(aStream);
+        if (ValueLength = -1) then begin
+          Exit;
+        end;
+
+        // Check for numerical overflow
+        if (ValueLength > High(Integer) - Findex) then begin
+          Raise THPACKException.Create('Decompression exception in Decode-READ_LITERAL_HEADER_VALUE_LENGTH');
+        end;
+
+        inc(ValueLength,Findex);
+
+        // Check new header size against max header size
+        NewHeaderSize := NameLength + ValueLength;
+        if (NewHeaderSize + HeaderSize > MaxHeaderSize) then begin
+          // truncation will be reported during EndHeaderBlockTruncated
+          HeaderSize := MaxHeaderSize + 1;
+
+          if (IndexType = THPackIndexType.eHPackNONE) then begin
+            // Value is unused so skip bytes
+            State := THPackState.SKIP_LITERAL_HEADER_VALUE;
+            break;
+          end;
+
+          // Check new header size against max dynamic table size
+          if (NewHeaderSize + HPACK_HEADER_ENTRY_OVERHEAD > DynamicTable.Capacity) then begin
+            DynamicTable.Clear();
+            State := THPackState.SKIP_LITERAL_HEADER_VALUE;
+            break;
+          end;
+        end;
+        State := THPackState.READ_LITERAL_HEADER_VALUE;
+      end;
+    READ_LITERAL_HEADER_VALUE: begin
+        // Wait until entire value is readable
+        if (InAvailable() < ValueLength) then begin
+          Exit;
+        end;
+
+        Value := ReadStringLiteral(aStream, ValueLength);
+        InsertHeader(FName, value, IndexType);
+        State := THPackState.READ_HEADER_REPRESENTATION;
+      end;
+    SKIP_LITERAL_HEADER_VALUE: begin
+        SetLength(tmpbuffer,ValueLength);
+        dec(ValueLength, aStream.Read(tmpbuffer[1],ValueLength));
+
+        if (ValueLength = 0) then begin
+          State := THPackState.READ_HEADER_REPRESENTATION;
+        end;
+      end;
+    end;
+  end;
+end;
+
+procedure THPackDecoder.Decode(aString: RawByteString);
+var
+  Stream: TStringStream;
+begin
+  Stream:=TStringStream.Create(aString);
+  try
+    Decode(Stream);
+  finally
+    Stream.Free;
+  end;
+end;
+
+function THPackDecoder.GetMaxHeaderTableSize: Integer;
+begin
+  Result:=DynamicTable.Capacity;
+end;
+
+{ THPackDynamicTable }
+
+procedure THPackDynamicTable.SetCapacity(aCapacity: integer);
+(*
+ * Set the maximum Size of the dynamic table.
+ * Entries are evicted from the dynamic table until the Size of the table
+ * is less than or equal to the maximum Size.
+ *)
+var
+  tmp: array of THPackHeaderField;
+  MaxEntries: integer;
+  Len,Cursor, i: integer;
+  Entry: THPackHeaderField;
+begin
+  if aCapacity < 0 then begin
+    Raise THPACKException.Create('Illegal Capacity: '+ inttostr(acapacity));
+  end;
+
+  // initially FCapacity will be -1 so init won't return here
+  if FCapacity = aCapacity then begin
+    exit;
+  end;
+  FCapacity := aCapacity;
+
+  if FCapacity = 0 then begin
+    Clear;
+  end else begin
+    // initially FSize will be 0 so remove won't be called
+    while (FSize > FCapacity) do begin
+      Remove().Free;
+    end;
+  end;
+  MaxEntries := aCapacity div HPACK_HEADER_ENTRY_OVERHEAD;
+  if (Acapacity mod HPACK_HEADER_ENTRY_OVERHEAD <> 0) then begin
+    inc(MaxEntries);
+  end;
+
+  // check if FCapacity change requires us to reallocate the array
+  if (Length(FHeaderFields)<>0) and (Length(FHeaderFields) = MaxEntries) then begin
+    exit;
+  end;
+
+  SetLength(tmp,MaxEntries);
+
+  // initially length will be 0 so there will be no copy
+  Len := EntriesCount();
+  Cursor := Ftail;
+  for i := 0 to Pred(Len) do begin
+    Entry:=FHeaderFields[Cursor];
+    inc(Cursor);
+    tmp[i]:=Entry;
+    if Cursor=Length(FHeaderFields) then begin
+      Cursor:=0;
+    end;
+  end;
+
+  Ftail := 0;
+  Fhead := Ftail + Len;
+  FheaderFields := tmp;
+
+end;
+
+procedure THPackDynamicTable.Clear;
+begin
+  while (FTail <> FHead) do begin
+    FHeaderFields[Ftail].Free;
+    FHeaderFields[Ftail]:=nil;
+    inc(FTail);
+    if FTail = Length(FheaderFields) then begin
+      FTail := 0;
+    end;
+  end;
+  FHead := 0;
+  FTail := 0;
+  FSize := 0;
+end;
+
+function THPackDynamicTable.Remove: THPackHeaderField;
+var
+  Removed: THPackHeaderField;
+begin
+  Removed := FHeaderFields[Ftail];
+  if (Removed = nil) then begin
+    exit(nil);
+  end;
+  dec(FSize,Removed.Size());
+  FHeaderFields[Ftail] := nil;
+  inc(FTail);
+  if FTail = Length(FheaderFields) then begin
+    FTail := 0;
+  end;
+  Result:= Removed;
+end;
+
+function THPackDynamicTable.EntriesCount: integer;{$IFDEF USEINLINE}inline;{$ENDIF}
+begin
+  if FHead < FTail then begin
+    Result:= Length(FHeaderFields) - FTail + FHead;
+  end else begin
+    Result:= FHead - FTail;
+  end;
+end;
+
+constructor THPackDynamicTable.Create(aInitialCapacity: integer);
+begin
+  SetCapacity(aInitialCapacity);
+end;
+
+destructor THPackDynamicTable.Destroy;
+var
+  j: integer;
+begin
+  for j := Low(FHeaderFields) to High(FHeaderFields) do begin
+    FHeaderFields[j].Free;
+    FHeaderFields[j]:=nil;
+  end;
+  inherited Destroy;
+end;
+
+procedure THPackDynamicTable.Add(aHeaderField: THPackHeaderField);
+var
+  HeaderSize: integer;
+begin
+  HeaderSize := aHeaderField.size;
+  if HeaderSize > Fcapacity then begin
+    Clear;
+    exit;
+  end;
+  while (Fsize + HeaderSize > FCapacity) do begin
+    Remove().Free;
+  end;
+  FHeaderFields[FHead] := aHeaderField;
+  inc(FHead);
+  inc(FSize,aHeaderField.Size);
+  if FHead = Length(FHeaderFields) then begin
+    FHead := 0;
+  end;
+end;
+
+function THPackDynamicTable.GetEntry(aIndex: integer): THPackHeaderField; {$IFDEF USEINLINE}inline;{$ENDIF}
+var
+  i: integer;
+begin
+  if (aIndex <= 0) or (aIndex > EntriesCount()) then begin
+    Raise THPACKException.Create('Index out of bounds in GetEntry');
+  end;
+  i := FHead - aIndex;
+  if i < 0 then begin
+    Result:= FHeaderFields[i + Length(FHeaderFields)];
+  end else begin
+    Result:= FHeaderFields[i];
+  end;
+end;
+
+function THPackDynamicTable.GetNameIndex(const aName: RawByteString): integer;
+var
+  j: integer;
+  H: THPackHeaderField;
+begin
+  for j := 1 to Pred(EntriesCount()) do begin
+    H:=GetEntry(j);
+    if H.FName=aName then begin
+      Result:=j;
+      Exit;
+    end;
+  end;
+  Result:=NOT_FOUND;
+end;
+
+function THPackDynamicTable.GetEntry(const aName, aValue: RawByteString
+  ): THPackHeaderField;
+var
+  j: integer;
+  H: THPackHeaderField;
+begin
+  for j := 1 to Pred(EntriesCount()) do begin
+    H:=GetEntry(j);
+    if (H.FName=aName) and (H.FValue=aValue) then begin
+      Result:=H;
+      Exit;
+    end;
+  end;
+  Result:=nil;
+end;
+
+function THPackDynamicTable.GetEntryIndex(const aName, aValue: RawByteString
+  ): integer;
+var
+  j: integer;
+  H: THPackHeaderField;
+begin
+  for j := 1 to Pred(EntriesCount()) do begin
+    H:=GetEntry(j);
+    if (H.FName=aName) and (H.FValue=aValue) then begin
+      Result:=j;
+      Exit;
+    end;
+  end;
+  Result:=NOT_FOUND;
+end;
+
+function THPackDynamicTable.GetEntryIndex(const aHeader: THPackHeaderField
+  ): integer;
+var
+  j: integer;
+  H: THPackHeaderField;
+begin
+  for j := 1 to Pred(EntriesCount()) do begin
+    H:=GetEntry(j);
+    if H=aHeader then begin
+      Result:=j;
+      Exit;
+    end;
+  end;
+  Result:=NOT_FOUND;
+end;
+
+procedure THPackDynamicTable.EnsureCapacityToHold(const aHeaderSize: integer);
+var
+  Index: integer;
+begin
+  while (Size + aHeaderSize > FCapacity) do begin
+    Index := EntriesCount;
+    if Index = 0 then begin
+      break;
+    end;
+    Remove.Free;
+  end;
+end;
+
+{ THPackHuffmanNode }
+
+class procedure THPackHuffmanNode.Insert(aRoot: THPackHuffmanNode;
+  aSymbol: integer; aCode: integer; aLength: BYTE);
+var
+  Current: THPackHuffmanNode;
+  Terminal: THPackHuffmanNode;
+  i: integer;
+  Shift,Start,iEnd: integer;
+begin
+  // traverse tree using the most significant bytes of code
+  Current:=aRoot;
+  while (aLength > 8) do begin
+    if (Current.isTerminal) then begin
+      Raise THPACKException.Create('Invalid Huffman code: prefix not unique');
+    end;
+    dec(aLength,8);
+    i := integer((DWORD(aCode) {Unsigned Shift} shr aLength) and DWORD($FF));
+    if (Current.FChildren[i] = Nil) then begin
+      Current.FChildren[i] := THPackHuffmanNode.Create;
+    end;
+    Current := Current.FChildren[i];
+  end;
+
+  Terminal := THPackHuffmanNode.Create(aSymbol, aLength);
+  Shift := 8 - aLength;
+  Start := (aCode shl Shift) and $FF;
+  iEnd := 1 << Shift;
+  for i := Start to Pred(Start + iEnd) do begin
+    Current.FChildren[i]:=Terminal;
+  end;
+end;
+
+class function THPackHuffmanNode.BuildTree(const aCodes: PDWORD;
+  const aLengths: PByte): THPackHuffmanNode;
+var
+  Root: THPackHuffmanNode;
+  i: integer;
+begin
+    Root := THPackHuffmanNode.Create;
+    for i := 0 to Pred(HPACK_HUFFMAN_CODES_LENGTH) do begin
+      Insert(Root,i,aCodes[i],aLengths[i]);
+    end;
+    Result:=Root;
+end;
+
+constructor THPackHuffmanNode.Create;
+begin
+  FSymbol := 0;
+  FBits := 8;
+  SetLength(FChildren,256);
+end;
+
+constructor THPackHuffmanNode.Create(aSymbol: integer; aBits: integer);
+begin
+  //assert(FBits > 0 && FBits <= 8);
+  if (aBits<1) or (aBits > 8) then begin
+    Raise THPACKException.Create('BUG');
+  end;
+  FSymbol := aSymbol;
+  FBits := aBits;
+  SetLength(FChildren,0);
+end;
+
+destructor THPackHuffmanNode.Destroy;
+var
+  j,i: Integer;
+  Node: THPackHuffmanNode;
+begin
+  for j := Low(FChildren) to high(FChildren) do begin
+    Node:=FChildren[j];
+    if Assigned(Node) then begin
+      for i := j to High(FChildren) do begin
+        if Node=FChildren[i] then begin
+          FChildren[i]:=nil;
+        end;
+      end;
+    end;
+    Node.Free;
+  end;
+  inherited Destroy;
+end;
+
+function THPackHuffmanNode.isTerminal: Boolean;
+begin
+  if Length(FChildren)=0 then begin
+    Result:=true;
+  end else begin
+    Result:=false;
+  end;
+end;
+
+{ THPackHuffmanDecoder }
+
+constructor THPackHuffmanDecoder.Create;
+begin
+  Create(HPackHuffmanCodes,HPackHuffmanCodeLength);
+end;
+
+constructor THPackHuffmanDecoder.Create(const aCodes: PDWORD;
+  const aLengths: PByte);
+begin
+  FCodes:=aCodes;
+  FLengths:=aLengths;
+  FRoot:=THPackHuffmanNode.BuildTree(aCodes,aLengths);
+end;
+
+destructor THPackHuffmanDecoder.Destroy;
+begin
+  FreeAndNil(FRoot);
+  inherited Destroy;
+end;
+
+function THPackHuffmanDecoder.Decode(aBuf: RawByteString): RawByteString;
+var
+  WritePoint: integer;
+  RealSize: integer;
+  Node: THPackHuffmanNode;
+  Current: integer;
+  Bits: Integer;
+  i,b,c: Integer;
+  Mask: integer;
+  OutputBuffer: RawByteString;
+  procedure WriteByte(const aByte: Byte); {$IFDEF USEINLINE}inline;{$ENDIF}
+  begin
+    if WritePoint>RealSize then begin
+      SetLength(OutputBuffer,RealSize*2);
+      RealSize:=RealSize*2;
+    end;
+    Byte(OutputBuffer[WritePoint]):=aByte;
+    inc(WritePoint);
+  end;
+begin
+  if aBuf='' then begin
+    Result:='';
+    exit;
+  end;
+  WritePoint:=1;
+  RealSize:=Length(aBuf)*2; //Huffman usually reach a 50% compress at best.
+  SetLength(OutputBuffer,RealSize);
+  Node := FRoot;
+  Current := 0;
+  Bits := 0;
+  for i := 0 to Pred(Length(aBuf)) do begin
+    b := Byte(aBuf[i+1]);
+    Current := (current shl 8) or b;
+    inc(Bits,8);
+    while (Bits >= 8) do begin
+      c := integer((DWORD(Current) {unsigned shift} shr (Bits - 8)) and DWORD($FF));
+      Node := Node.FChildren[c];
+      dec(Bits,Node.FBits);
+      if (Node.isTerminal) then begin
+        if (Node.FSymbol = HPACK_HUFFMAN_EOS) then begin
+          Raise THPACKException.Create('EOS_DECODED');
+        end;
+        WriteByte(Byte(Node.FSymbol));
+        Node := Froot;
+      end;
+    end;
+  end;
+  while (Bits > 0) do begin
+    c := (current shl (8 - Bits)) and $FF;
+    Node := Node.FChildren[c];
+    if (Node.isTerminal and (Node.FBits <= Bits)) then begin
+      dec(Bits,Node.FBits);
+      WriteByte(Byte(Node.FSymbol));
+      Node := Froot;
+    end else begin
+      break;
+    end;
+  end;
+
+  // Section 5.2. String Literal Representation
+  // Padding not corresponding to the most significant Bits of the code
+  // for the EOS symbol (0xFF) MUST be treated as a decoding error.
+  Mask := (1 shl Bits) - 1;
+  if (current and Mask) <> Mask then begin
+    Raise THPACKException.Create('INVALID_PADDING');
+  end;
+  SetLength(OutputBuffer,WritePoint-1);
+  Result:=OutputBuffer;
+end;
+
+{ THPackHuffmanEncoder }
+
+constructor THPackHuffmanEncoder.Create;
+begin
+  Create(HPackHuffmanCodes,HPackHuffmanCodeLength);
+end;
+
+constructor THPackHuffmanEncoder.Create(const aCodes: PDWORD;
+  const aLengths: PByte);
+begin
+  FCodes:=aCodes;
+  FLengths:=aLengths;
+end;
+
+procedure THPackHuffmanEncoder.Encode(aOutputStream: TStream; aData: RawByteString);
+begin
+  Encode(aOutputStream, aData, 0, Length(aData));
+end;
+
+procedure THPackHuffmanEncoder.Encode(aOutputStream: TStream;
+  aData: RawByteString; aOff, aLen: integer);
+var
+  Current: DWORD=0;
+  n: integer=0;
+  i: integer;
+  Code: DWORD;
+  b,nBits: integer;
+  v: DWORD;
+begin
+  if not Assigned(aOutputStream) then begin
+    Raise THPACKException.Create('Output stream is nil');
+  end else if aData = '' then begin
+    Raise THPACKException.Create('Data is empty');
+  end else if ((aOff < 0) or (aLen < 0) or ((aOff + aLen) < 0) or (aOff > Length(aData)) or ((aOff + aLen) > Length(aData))) then begin
+    Raise THPACKException.Create('Index out of bounds');
+  end else if aLen = 0 then begin
+    exit;
+  end;
+
+  for i := 0 to Pred(aLen) do begin
+    b := BYTE(aData[aOff + i + 1]) and $FF;
+    Code := FCodes[b];
+    nBits := FLengths[b];
+
+    Current := Current shl nBits;
+    Current := Current or Code;
+    inc(n,nBits);
+
+    while (n >= 8) do begin
+      dec(n,8);
+      v:=Current shr n;
+      aOutputStream.WriteByte(Byte(v));
+    end;
+  end;
+
+  if (n > 0) then begin
+    Current := Current shl (8-n);
+    Current:=Current or (DWORD($FF) {unsigned shift} shr n); // this should be EOS symbol
+    aOutputStream.WriteByte(Byte(Current));
+  end;
+end;
+
+function THPackHuffmanEncoder.GetEncodedLength(aData: RawByteString
+  ): integer;
+var
+  Len: integer;
+  i: integer;
+begin
+  if aData = '' then begin
+    Raise THPACKException.Create('Data is empty');
+  end;
+
+  Len := 0;
+  for i := 1 to Length(aData) do begin
+    inc(Len,FLengths[BYTE(aData[i])]);
+  end;
+  Result:=(Len + 7) shr 3;
+end;
+
+{ THPackHeaderField }
+
+class function THPackHeaderField.SizeOf(const aName, aValue: RawByteString
+  ): Integer;
+begin
+  Result:=Length(aName) + Length(aValue) + HEADER_ENTRY_OVERHEAD;
+end;
+
+constructor THPackHeaderField.Create(const aName, aValue: RawByteString);
+begin
+  FName:=aName;
+  FValue:=aValue;
+end;
+
+function THPackHeaderField.Size: Integer;
+begin
+  Result:=Length(FName) + Length(FValue) + HEADER_ENTRY_OVERHEAD;
+end;
+
+initialization
+  THPackStaticTable.InitializeStaticTable;
+finalization;
+  THPackStaticTable.DestroyStaticTable;
+
+end.
+

+ 94 - 0
packages/fcl-web/src/hpack/uhpacktables.pp

@@ -0,0 +1,94 @@
+unit uhpacktables;
+
+interface
+
+const
+
+  HPACK_HUFFMAN_CODES_LENGTH=257;
+
+  HPackHuffmanCodes: array [0..HPACK_HUFFMAN_CODES_LENGTH-1] of DWORD =(
+       $1ff8,  $7fffd8,    $fffffe2,    $fffffe3,    $fffffe4,    $fffffe5,    $fffffe6,    $fffffe7,
+    $fffffe8,  $ffffea,   $3ffffffc,    $fffffe9,    $fffffea,   $3ffffffd,    $fffffeb,    $fffffec,
+    $fffffed, $fffffee,    $fffffef,    $ffffff0,    $ffffff1,    $ffffff2,   $3ffffffe,    $ffffff3,
+    $ffffff4, $ffffff5,    $ffffff6,    $ffffff7,    $ffffff8,    $ffffff9,    $ffffffa,    $ffffffb,
+         $14,     $3f8,        $3f9,        $ffa,       $1ff9,         $15,         $f8,        $7fa,
+        $3fa,     $3fb,         $f9,        $7fb,         $fa,         $16,         $17,         $18,
+          $0,       $1,          $2,         $19,         $1a,         $1b,         $1c,         $1d,
+         $1e,      $1f,         $5c,         $fb,       $7ffc,         $20,        $ffb,        $3fc,
+       $1ffa,      $21,         $5d,         $5e,         $5f,         $60,         $61,         $62,
+         $63,      $64,         $65,         $66,         $67,         $68,         $69,         $6a,
+         $6b,      $6c,         $6d,         $6e,         $6f,         $70,         $71,         $72,
+         $fc,      $73,         $fd,       $1ffb,      $7fff0,       $1ffc,       $3ffc,         $22,
+       $7ffd,       $3,         $23,          $4,         $24,          $5,         $25,         $26,
+         $27,       $6,         $74,         $75,         $28,         $29,         $2a,          $7,
+         $2b,      $76,         $2c,          $8,          $9,         $2d,         $77,         $78,
+         $79,      $7a,         $7b,       $7ffe,        $7fc,       $3ffd,       $1ffd,    $ffffffc,
+      $fffe6,  $3fffd2,      $fffe7,      $fffe8,     $3fffd3,     $3fffd4,     $3fffd5,     $7fffd9,
+     $3fffd6,  $7fffda,     $7fffdb,     $7fffdc,     $7fffdd,     $7fffde,     $ffffeb,     $7fffdf,
+     $ffffec,  $ffffed,     $3fffd7,     $7fffe0,     $ffffee,     $7fffe1,     $7fffe2,     $7fffe3,
+     $7fffe4,  $1fffdc,     $3fffd8,     $7fffe5,     $3fffd9,     $7fffe6,     $7fffe7,     $ffffef,
+     $3fffda,  $1fffdd,      $fffe9,     $3fffdb,     $3fffdc,     $7fffe8,     $7fffe9,     $1fffde,
+     $7fffea,  $3fffdd,     $3fffde,     $fffff0,     $1fffdf,     $3fffdf,     $7fffeb,     $7fffec,
+     $1fffe0,  $1fffe1,     $3fffe0,     $1fffe2,     $7fffed,     $3fffe1,     $7fffee,     $7fffef,
+      $fffea,  $3fffe2,     $3fffe3,     $3fffe4,     $7ffff0,     $3fffe5,     $3fffe6,     $7ffff1,
+    $3ffffe0, $3ffffe1,      $fffeb,      $7fff1,     $3fffe7,     $7ffff2,     $3fffe8,    $1ffffec,
+    $3ffffe2, $3ffffe3,    $3ffffe4,    $7ffffde,    $7ffffdf,    $3ffffe5,     $fffff1,    $1ffffed,
+      $7fff2,  $1fffe3,    $3ffffe6,    $7ffffe0,    $7ffffe1,    $3ffffe7,    $7ffffe2,     $fffff2,
+     $1fffe4,  $1fffe5,    $3ffffe8,    $3ffffe9,    $ffffffd,    $7ffffe3,    $7ffffe4,    $7ffffe5,
+      $fffec,  $fffff3,      $fffed,     $1fffe6,     $3fffe9,     $1fffe7,     $1fffe8,     $7ffff3,
+     $3fffea,  $3fffeb,    $1ffffee,    $1ffffef,     $fffff4,     $fffff5,    $3ffffea,     $7ffff4,
+    $3ffffeb, $7ffffe6,    $3ffffec,    $3ffffed,    $7ffffe7,    $7ffffe8,    $7ffffe9,    $7ffffea,
+    $7ffffeb, $ffffffe,    $7ffffec,    $7ffffed,    $7ffffee,    $7ffffef,    $7fffff0,    $3ffffee,
+   $3fffffff // EOS
+  );
+
+  HPackHuffmanCodeLength: array [0..256] of byte =(
+     13, 23, 28, 28, 28, 28, 28, 28, 28, 24, 30, 28, 28, 30, 28, 28,
+     28, 28, 28, 28, 28, 28, 30, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+      6, 10, 10, 12, 13,  6,  8, 11, 10, 10,  8, 11,  8,  6,  6,  6,
+      5,  5,  5,  6,  6,  6,  6,  6,  6,  6,  7,  8, 15,  6, 12, 10,
+     13,  6,  7,  7,  7,  7,  7,  7,  7,  7,  7,  7,  7,  7,  7,  7,
+      7,  7,  7,  7,  7,  7,  7,  7,  8,  7,  8, 13, 19, 13, 14,  6,
+     15,  5,  6,  5,  6,  5,  6,  6,  6,  5,  7,  7,  6,  6,  6,  5,
+      6,  7,  6,  5,  5,  6,  7,  7,  7,  7,  7, 15, 11, 14, 13, 28,
+     20, 22, 20, 20, 22, 22, 22, 23, 22, 23, 23, 23, 23, 23, 24, 23,
+     24, 24, 22, 23, 24, 23, 23, 23, 23, 21, 22, 23, 22, 23, 23, 24,
+     22, 21, 20, 22, 22, 23, 23, 21, 23, 22, 22, 24, 21, 22, 23, 23,
+     21, 21, 22, 21, 23, 22, 23, 23, 20, 22, 22, 22, 23, 22, 22, 23,
+     26, 26, 20, 19, 22, 23, 22, 25, 26, 26, 26, 27, 27, 26, 24, 25,
+     19, 21, 26, 27, 27, 26, 27, 24, 21, 21, 26, 26, 28, 27, 27, 27,
+     20, 24, 20, 21, 22, 21, 21, 23, 22, 22, 25, 25, 24, 24, 26, 23,
+     26, 27, 26, 26, 27, 27, 27, 27, 27, 28, 27, 27, 27, 27, 27, 26,
+     30 // EOS
+  );
+
+  HPACK_HUFFMAN_EOS: integer = 256;
+
+  HPACK_HEADER_ENTRY_OVERHEAD = 32;
+
+type
+  THPackIndexType=(
+    eHPackINCREMENTAL, // Section 6.2.1. Literal Header Field with Incremental Indexing
+    eHPackNONE,        // Section 6.2.2. Literal Header Field without Indexing
+    eHPackNEVER        // Section 6.2.3. Literal Header Field never Indexed
+  );
+
+  THPackState =(
+    READ_HEADER_REPRESENTATION,
+    READ_MAX_DYNAMIC_TABLE_SIZE,
+    READ_INDEXED_HEADER,
+    READ_INDEXED_HEADER_NAME,
+    READ_LITERAL_HEADER_NAME_LENGTH_PREFIX,
+    READ_LITERAL_HEADER_NAME_LENGTH,
+    READ_LITERAL_HEADER_NAME,
+    SKIP_LITERAL_HEADER_NAME,
+    READ_LITERAL_HEADER_VALUE_LENGTH_PREFIX,
+    READ_LITERAL_HEADER_VALUE_LENGTH,
+    READ_LITERAL_HEADER_VALUE,
+    SKIP_LITERAL_HEADER_VALUE
+  );
+
+implementation
+
+end.
+

+ 5 - 0
packages/fcl-web/tests/README.txt

@@ -0,0 +1,5 @@
+In order to run the HPACK testcase, you must download and unzip the HPACK testsuite:
+
+https://github.com/http2jp/hpack-test-case
+
+The test code expects to find it under the 'hpack-test-case-master' directory.

+ 122 - 0
packages/fcl-web/tests/fpcunithpack.lpi

@@ -0,0 +1,122 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="fpcunithpack"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="3">
+      <Item1 Name="Default" Default="True"/>
+      <Item2 Name="Debug">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="fpcunithpack"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="..\src"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <IncludeAssertionCode Value="True"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <IOChecks Value="True"/>
+              <RangeChecks Value="True"/>
+              <OverflowChecks Value="True"/>
+              <StackChecks Value="True"/>
+            </Checks>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <UseHeaptrc Value="True"/>
+              <UseExternalDbgSyms Value="True"/>
+            </Debugging>
+          </Linking>
+        </CompilerOptions>
+      </Item2>
+      <Item3 Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <OtherUnitFiles Value="..\src"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+          </Linking>
+        </CompilerOptions>
+      </Item3>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="--all"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="FCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="fpcunithpack.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="uhpacktest1.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\src"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 27 - 0
packages/fcl-web/tests/fpcunithpack.lpr

@@ -0,0 +1,27 @@
+program fpcunithpack;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, uhpacktest1,sysutils;
+
+type
+
+  { TLazTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+  // override the protected methods of TTestRunner to customize its behavior
+  end;
+
+var
+  Application: TMyTestRunner;
+
+begin
+  DefaultFormat:=fPlain;
+  DefaultRunAllTests:=True;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.

+ 889 - 0
packages/fcl-web/tests/uhpacktest1.pas

@@ -0,0 +1,889 @@
+(*
+ * Test program for pascal HPack for http2
+ *
+ * This test code uses sample headers from https://github.com/http2jp/hpack-test-case
+ * to test decoding of available samples and then reencode and decode again
+ * using plain only, indexing only, huffman only, and both at same time.
+ *
+ * The JSON parsing adds around a 15% speed penalty.
+ *
+ *)
+
+unit uhpacktest1;
+
+{$mode objfpc}{$H+}
+
+{$DEFINE QUIET}
+{$DEFINE FULL_QUIET}
+
+{$IFDEF FULL_QUIET}
+  {$DEFINE QUIET}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, uhpack, fpjson, jsonparser, jsonscanner;
+
+type
+
+  { THPackTestCaseCycle }
+
+  THPackTestCaseCycle= class(TTestCase)
+  private
+    HPDecoder: THPackDecoder;
+    HPIntfDecoderPlain: THPackDecoder;
+    HPIntfDecoderPlainIndexed: THPackDecoder;
+    HPIntfDecoderHuffman: THPackDecoder;
+    HPIntfDecoderHuffmanIndexed: THPackDecoder;
+    HPIntfEncoderPlain: THPackEncoder;
+    HPIntfEncoderPlainIndexed: THPackEncoder;
+    HPIntfEncoderHuffman: THPackEncoder;
+    HPIntfEncoderHuffmanIndexed: THPackEncoder;
+    SequenceCounter: integer;
+    StoryCounter: integer;
+    GroupsCounter: integer;
+    WireBytes: integer;
+    DecodedBytes: integer;
+    procedure TestThisSequence(const aGroup: integer; const aStory: integer; const aJSon: TJSONData);
+    procedure TestCaseStory(const aGroup: integer; const aStory: integer; const aJSon: TJSONData);
+    procedure RunSampleHeadersTest;
+  protected
+    function  GetTestName: string; override;
+  published
+    procedure TestHookUp;
+  end;
+
+  { THPackTestDecoder }
+
+  THPackTestDecoder= class(TTestCase)
+  private
+    HPDecoder: THPackDecoder;
+    DummyDecoder: THPackDecoder;
+    DummyEncoder: THPackEncoder;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    procedure VerifyIncompleteIndexRead;
+    procedure InvalidTableIndexZero;
+    procedure IndexShiftOverflow;
+    procedure DynamicTableSizeUpdate;
+    procedure DynamicTableSizeUpdateRequired;
+    procedure IllegalDynamicTableSizeUpdate;
+    procedure MaxDynamicTableSizeSignOverflow;
+    procedure ReduceMaxDynamicTableSize;
+    procedure TooLargeDynamicTableSizeUpdate;
+    procedure MissingDynamicTableSizeUpdate;
+    procedure LiteralWithIncrementalIndexingWithEmptyName;
+    procedure LiteralWithIncrementalIndexingCompleteEviction;
+    procedure LiteralWithIncrementalIndexingWithLargeName;
+    procedure LiteralWithIncrementalIndexingWithLargeValue;
+    procedure LiteralWithoutIndexingWithEmptyName;
+    procedure LiteralWithoutIndexingWithLargeName;
+    procedure LiteralWithoutIndexingWithLargeValue;
+    procedure LiteralNeverIndexedWithEmptyName;
+    procedure LiteralNeverIndexedWithLargeName;
+    procedure LiteralNeverIndexedWithLargeValue;
+  end;
+
+implementation
+
+function HexToBinString(aHex: RawByteString): RawByteString;
+var
+  j: integer;
+  t: integer;
+begin
+  t:=0;
+  for j := 1 to Length(aHex) do begin
+    if (aHex[j] in ['a'..'f','A'..'F','0'..'9']) then begin
+      inc(t);
+      if t<>j then begin
+        aHex[t]:=aHex[j];
+      end;
+    end else begin
+      if (aHex[j]<>#32) and (aHex[j]<>'-') then begin
+        Raise Exception.Create('Internal: Invalid hex format character');
+      end;
+    end;
+  end;
+  if t<>j then SetLength(aHex,t);
+  if t mod 2 <>0 then begin
+    Raise Exception.Create('Internal: Invalid hex chars count (odd)');
+  end;
+  SetLength(Result,Length(aHex) div 2);
+  HexToBin(@aHex[1],@Result[1],Length(Result));
+end;
+
+function BinStringToHex(const aBinString: string): string;
+begin
+  Result:='';
+  SetLength(Result,Length(aBinString)*2);
+  BinToHex(@aBinString[1],@Result[1],Length(aBinString));
+end;
+
+function ErrorHeader(const aString: string): string;
+begin
+  if Length(aString)<38 then begin
+    Result:='**'+aString+StringOfChar('*',38-Length(aString));
+  end else begin
+    Result:='**'+aString+'**';
+  end;
+end;
+
+{ THPackTestDecoder }
+
+procedure THPackTestDecoder.SetUp;
+begin
+  //Setup 2 dummy encoder & decoder to avoid multiple
+  //creation of internal tables. This should be fixed some
+  //way in the future.
+  DummyDecoder:=THPackDecoder.Create;
+  DummyEncoder:=THPackEncoder.Create;
+  inherited SetUp;
+end;
+
+procedure THPackTestDecoder.TearDown;
+begin
+  FreeAndNil(DummyEncoder);
+  FreeAndNil(DummyDecoder);
+  inherited TearDown;
+end;
+
+procedure THPackTestDecoder.VerifyIncompleteIndexRead;
+var
+  Data: TStringStream;
+begin
+  Data:=TStringStream.Create(HexToBinString('FFF0'));
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.Decode(Data);
+    AssertEquals(Data.Size-Data.Position,1);
+    HPDecoder.Decode(Data);
+    AssertEquals(Data.Size-Data.Position,1);
+  finally
+    Data.Free;
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.InvalidTableIndexZero;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    try
+      HPDecoder.Decode(HexToBinString('80'));
+      FAIL('Exception missing');
+    except
+      on e: Exception do begin
+        if not (e is THPACKException) then begin
+          Raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.IndexShiftOverflow;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    try
+      HPDecoder.Decode(HexToBinString('FF8080808008'));
+      FAIL('Exception missing');
+    except
+      on e: Exception do begin
+        if not (e is THPACKException) then begin
+          Raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.DynamicTableSizeUpdate;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.Decode(HexToBinString('20'));
+    AssertEquals(0,HPDecoder.GetMaxHeaderTableSize);
+    HPDecoder.Decode(HexToBinString('3FE11F'));
+    assertEquals(4096, HPDecoder.GetMaxHeaderTableSize);
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.DynamicTableSizeUpdateRequired;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.SetMaxHeaderTableSize(32);
+    HPDecoder.Decode(HexToBinString('3F00'));
+    assertEquals(31, HPDecoder.GetMaxHeaderTableSize);
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.IllegalDynamicTableSizeUpdate;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    try
+      HPDecoder.Decode(HexToBinString('3FE21F'));
+      FAIL('Exception missing');
+    except
+      on e: Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.MaxDynamicTableSizeSignOverflow;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    try
+      HPDecoder.Decode(HexToBinString('3FE1FFFFFF07'));
+    except
+      on e: Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.ReduceMaxDynamicTableSize;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.SetMaxHeaderTableSize(0);
+    AssertEquals(0, HPDecoder.GetMaxHeaderTableSize());
+    HPDecoder.Decode(HexToBinString('2081'));
+    AssertEquals(0, HPDecoder.GetMaxHeaderTableSize());
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.TooLargeDynamicTableSizeUpdate;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.SetMaxHeaderTableSize(0);
+    AssertEquals(0, HPDecoder.GetMaxHeaderTableSize());
+    try
+      HPDecoder.Decode(HexToBinString('21'));
+      FAIL('Exception missing');
+    except
+      on E:Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.MissingDynamicTableSizeUpdate;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.SetMaxHeaderTableSize(0);
+    AssertEquals(0, HPDecoder.GetMaxHeaderTableSize());
+    try
+      HPDecoder.Decode(HexToBinString('81'));
+      FAIL('Exception missing');
+    except
+      on E:Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralWithIncrementalIndexingWithEmptyName;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    try
+      HPDecoder.Decode(HexToBinString('000005')+'value');
+      FAIL('Exception missing');
+    except
+      on E:Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralWithIncrementalIndexingCompleteEviction;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.Decode(HexToBinString('4004')+'name'+HexToBinString('05')+'value');
+    AssertFalse(HPDecoder.EndHeaderBlockTruncated);
+    HPDecoder.Decode(HexToBinString('417F811F')+StringOfChar('a',4096));
+    AssertFalse(HPDecoder.EndHeaderBlockTruncated);
+    HPDecoder.Decode(HexToBinString('4004')+'name'+ HexToBinString('05')+'value'+HexToBinString('BE'));
+    AssertEquals('name',HPDecoder.DecodedHeaders[0]^.HeaderName);
+    AssertEquals('value',HPDecoder.DecodedHeaders[0]^.HeaderValue);
+    AssertEquals('name',HPDecoder.DecodedHeaders[1]^.HeaderName);
+    AssertEquals('value',HPDecoder.DecodedHeaders[1]^.HeaderValue);
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralWithIncrementalIndexingWithLargeName;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.Decode(HexToBinString('417F811F')+StringOfChar('a',16384)+HexToBinString('00'));
+    // Verify header block is reported as truncated
+    AssertTrue(HPDecoder.EndHeaderBlockTruncated);
+    // Verify next header is inserted at index 62
+    HPDecoder.Decode(HexToBinString('4004')+'name'+ HexToBinString('05')+'value'+HexToBinString('BE'));
+    AssertEquals('name',HPDecoder.DecodedHeaders[0]^.HeaderName);
+    AssertEquals('value',HPDecoder.DecodedHeaders[0]^.HeaderValue);
+    AssertEquals('name',HPDecoder.DecodedHeaders[1]^.HeaderName);
+    AssertEquals('value',HPDecoder.DecodedHeaders[1]^.HeaderValue);
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralWithIncrementalIndexingWithLargeValue;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.Decode(HexToBinString('4004')+'name'+HexToBinString('7F813F')+StringOfChar('a',8192));
+    // Verify header block is reported as truncated
+    AssertTrue(HPDecoder.EndHeaderBlockTruncated);
+    // Verify next header is inserted at index 62
+    HPDecoder.Decode(HexToBinString('4004')+'name'+ HexToBinString('05')+'value'+HexToBinString('BE'));
+    AssertEquals('name',HPDecoder.DecodedHeaders[0]^.HeaderName);
+    AssertEquals('value',HPDecoder.DecodedHeaders[0]^.HeaderValue);
+    AssertEquals('name',HPDecoder.DecodedHeaders[1]^.HeaderName);
+    AssertEquals('value',HPDecoder.DecodedHeaders[1]^.HeaderValue);
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralWithoutIndexingWithEmptyName;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    try
+      HPDecoder.Decode(HexToBinString('000005')+'value');
+      FAIL('Exception missing');
+    except
+      on E:Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralWithoutIndexingWithLargeName;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.Decode(HexToBinString('007F817F')+StringOfChar('a',16384)+HexToBinString('00'));
+    // Verify header block is reported as truncated
+    AssertTrue(HPDecoder.EndHeaderBlockTruncated);
+    try
+      HPDecoder.Decode(HexToBinString('BE'));
+      FAIL('Exception missing');
+    except
+      on E:Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralWithoutIndexingWithLargeValue;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.Decode(HexToBinString('0004')+'name'+HexToBinString('7F813F')+StringOfChar('a',8192));
+    // Verify header block is reported as truncated
+    AssertTrue(HPDecoder.EndHeaderBlockTruncated);
+    try
+      HPDecoder.Decode(HexToBinString('BE'));
+      FAIL('Exception missing');
+    except
+      on E:Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralNeverIndexedWithEmptyName;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    try
+      HPDecoder.Decode(HexToBinString('100005')+'value');
+      FAIL('Exception missing');
+    except
+      on E:Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralNeverIndexedWithLargeName;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.Decode(HexToBinString('107F817F')+StringOfChar('a',16384)+HexToBinString('00'));
+    // Verify header block is reported as truncated
+    AssertTrue(HPDecoder.EndHeaderBlockTruncated);
+    try
+      HPDecoder.Decode(HexToBinString('BE'));
+      FAIL('Exception missing');
+    except
+      on E:Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestDecoder.LiteralNeverIndexedWithLargeValue;
+begin
+  HPDecoder:=THPackDecoder.Create;
+  try
+    HPDecoder.Decode(HexToBinString('1004')+'name'+HexToBinString('7F813F')+StringOfChar('a',8192));
+    // Verify header block is reported as truncated
+    AssertTrue(HPDecoder.EndHeaderBlockTruncated);
+    try
+      HPDecoder.Decode(HexToBinString('BE'));
+      FAIL('Exception missing');
+    except
+      on E:Exception do begin
+        if not (e is THPACKException) then begin
+          raise;
+        end;
+      end;
+    end;
+  finally
+    FreeAndNil(HPDecoder);
+  end;
+end;
+
+procedure THPackTestCaseCycle.TestHookUp;
+begin
+  RunSampleHeadersTest;
+end;
+
+function THPackTestCaseCycle.GetTestName: string;
+begin
+  Result:='Sample headers cycled';
+end;
+
+procedure THPackTestCaseCycle.TestThisSequence(const aGroup: integer; const aStory: integer; const aJSon: TJSONData);
+var
+  HeadersPath: TJSonData;
+  HexWire: string;
+  BinWire: RawByteString;
+  BinWire2: RawByteString;
+  Sequence: integer;
+  ExpectedHeaders: THPackHeaderTextList;
+  j, HeaderTableSize: integer;
+  lName,lValue: string;
+  TestPassed: integer;
+  function GetInteger(const aPath: string; const aOptional: Boolean=false): integer;
+  var
+    tmp: TJSonData;
+  begin
+    tmp:=aJSon.FindPath(aPath);
+    if Assigned(tmp) then begin
+      Result:=tmp.AsInteger;
+    end else begin
+      if not aOptional then begin
+        Raise Exception.Create('Missing '+aPath);
+      end else begin
+        Result:=-1;
+      end;
+    end;
+  end;
+  function GetString(const aPath: string): String;
+  var
+    tmp: TJSonData;
+  begin
+    tmp:=aJSon.FindPath(aPath);
+    if Assigned(tmp) then begin
+      Result:=tmp.AsString;
+    end else begin
+      Raise Exception.Create('Missing '+aPath);
+    end;
+  end;
+  procedure GetHeadersPair(const aHeaders: TJSonData; out aName,aValue: string);
+  var
+    Enumerator: TBaseJSONEnumerator;
+  begin
+    aName:='';
+    aValue:='';
+    if aHeaders.Count<>1 then begin
+      Raise Exception.Create('Unexpected headers count = '+aHeaders.AsJSON);
+    end;
+    Enumerator:=aHeaders.GetEnumerator;
+    try
+      if Assigned(Enumerator) then begin
+        if Enumerator.MoveNext then begin
+          aName:=Enumerator.Current.Key;
+          aValue:=Enumerator.Current.Value.AsString;
+          if Enumerator.MoveNext then begin
+            Raise Exception.Create('Too many header parts, expected A=B');
+          end;
+          Exit;
+        end;
+      end;
+      Raise Exception.Create('Unexpected reach');
+    finally
+      Enumerator.Free;
+    end;
+  end;
+
+  function EncodeHeaders(const aEncoder: THPackEncoder; const aHeadersList: THPackHeaderTextList): String;
+  var
+    OutStream: TStringStream;
+    j: integer;
+  begin
+    Result:='';
+    OutStream:=TStringStream.Create('');
+    try
+      for j := 0 to Pred(aHeadersList.Count) do begin
+        aEncoder.EncodeHeader(OutStream,aHeadersList[j]^.HeaderName,aHeadersList[j]^.HeaderValue,aHeadersList[j]^.IsSensitive);
+      end;
+      Result:=OutStream.DataString;
+    finally
+      FreeAndNil(OutStream);
+    end;
+  end;
+
+begin
+  TestPassed:=0;
+  Sequence:=GetInteger('seqno');
+  HexWire:=GetString('wire');
+  HeaderTableSize:=GetInteger('header_table_size',true);
+  if HeaderTableSize=-1 then begin
+    HeaderTableSize:=HPACK_MAX_HEADER_TABLE_SIZE;
+  end;
+  if HeaderTableSize<>HPDecoder.GetMaxHeaderTableSize then begin
+    {$IFNDEF QUIET}
+    writeln('Max header table size changed from ',HPDecoder.GetMaxHeaderTableSize,' to ',HeaderTableSize);
+    {$ENDIF}
+    HPDecoder.SetMaxHeaderTableSize(HeaderTableSize);
+  end;
+  ExpectedHeaders:=THPackHeaderTextList.Create;
+  {$IFNDEF QUIET}
+  write('SEQ: ',aGroup,'-',aStory,'-',Sequence,#13);
+  {$ENDIF}
+  try
+    HeadersPath:=aJSon.FindPath('headers');
+    if not Assigned(HeadersPath) then begin
+      Raise Exception.Create('Missing headers');
+    end;
+    for j := 0 to Pred(HeadersPath.Count) do begin
+      GetHeadersPair(HeadersPath.Items[j],lName,lValue);
+      ExpectedHeaders.Add(lName,lValue);
+    end;
+    BinWire:=HexToBinString(HexWire);
+    HPDecoder.Decode(BinWire);
+    if HPDecoder.EndHeaderBlockTruncated then begin
+      raise Exception.Create('FAIL EndHeaderBlock');
+    end;
+    if HPDecoder.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
+      raise Exception.Create('Expected headers different than decoded ones.');
+    end;
+
+    TestPassed:=1;
+
+    // Now reencode with our engine and decode again, result must be the same.
+    BinWire2:=EncodeHeaders(HPIntfEncoderPlain,ExpectedHeaders);
+    HPIntfDecoderPlain.Decode(BinWire2);
+    if HPIntfDecoderPlain.EndHeaderBlockTruncated then begin
+      raise Exception.Create('FAIL EndHeaderBlock REcoded (Plain).');
+    end;
+    if HPIntfDecoderPlain.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
+      raise Exception.Create('Expected headers different than REcoded ones (Plain).');
+    end;
+
+    TestPassed:=2;
+
+    // Now reencode with our engine and decode again, result must be the same.
+    BinWire2:=EncodeHeaders(HPIntfEncoderPlainIndexed,ExpectedHeaders);
+    HPIntfDecoderPlainIndexed.Decode(BinWire2);
+    if HPIntfDecoderPlainIndexed.EndHeaderBlockTruncated then begin
+      raise Exception.Create('FAIL EndHeaderBlock REcoded (Plain & Indexed).');
+    end;
+    if HPIntfDecoderPlainIndexed.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
+      raise Exception.Create('Expected headers different than REcoded ones (Plain & Indexed).');
+    end;
+
+    TestPassed:=3;
+
+    // Now reencode with our engine using huffman and decode again, result must be the same.
+    BinWire2:=EncodeHeaders(HPIntfEncoderHuffman,ExpectedHeaders);
+    HPIntfDecoderHuffman.Decode(BinWire2);
+    if HPIntfDecoderHuffman.EndHeaderBlockTruncated then begin
+      raise Exception.Create('FAIL EndHeaderBlock REcoded (Huffman).');
+    end;
+    if HPIntfDecoderHuffman.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
+      raise Exception.Create('Expected headers different than REcoded ones (Huffman).');
+    end;
+
+    TestPassed:=4;
+
+    // Now reencode with our engine using huffman & indexed and decode again, result must be the same.
+    BinWire2:=EncodeHeaders(HPIntfEncoderHuffmanIndexed,ExpectedHeaders);
+    HPIntfDecoderHuffmanIndexed.Decode(BinWire2);
+    if HPIntfDecoderHuffmanIndexed.EndHeaderBlockTruncated then begin
+      raise Exception.Create('FAIL EndHeaderBlock REcoded (Huffman & Indexed).');
+    end;
+    if HPIntfDecoderHuffmanIndexed.DecodedHeaders.Text<>ExpectedHeaders.Text then begin
+      raise Exception.Create('Expected headers different than REcoded ones (Huffman & Indexed).');
+    end;
+    inc(DecodedBytes,Length(HPIntfDecoderHuffmanIndexed.DecodedHeaders.Text));
+    inc(WireBytes,Length(BinWire2));
+
+    TestPassed:=1000;
+  finally
+    if TestPassed<1000 then begin
+      {$IFNDEF FULL_QUIET}
+      writeln(StdErr,ErrorHeader('TEST FAIL - Section passed '+inttostr(TestPassed)));
+      writeln(StdErr,ErrorHeader('Expected headers'));
+      writeln(StdErr,ExpectedHeaders.Text);
+      writeln(StdErr,ErrorHeader('Got headers'));
+      case TestPassed of
+        0: writeln(StdErr,HPDecoder.DecodedHeaders.Text);
+        1: writeln(StdErr,HPIntfDecoderPlain.DecodedHeaders.Text);
+        2: writeln(StdErr,HPIntfDecoderPlainIndexed.DecodedHeaders.Text);
+        3: writeln(StdErr,HPIntfDecoderHuffman.DecodedHeaders.Text);
+        4: writeln(StdErr,HPIntfDecoderHuffmanIndexed.DecodedHeaders.Text);
+      else
+        writeln(StdErr,'Unknown decoder in use.');
+      end;
+      writeln(StdErr,ErrorHeader('Location'));
+      writeln(StdErr,'SEQ: ',aGroup,'-',aStory,'-',Sequence);
+      {$ENDIF}
+    end else begin
+      inc(SequenceCounter);
+    end;
+    ExpectedHeaders.Free;
+  end;
+end;
+
+procedure THPackTestCaseCycle.TestCaseStory(const aGroup: integer; const aStory: integer;
+  const aJSon: TJSONData);
+var
+  JSonData: TJSONData;
+  CaseData: TJSonData;
+  CaseCounter,Cases: integer;
+  TestPass: Boolean;
+begin
+  TestPass:=false;
+  JSonData:=ajSon.FindPath('description');
+  if Assigned(JSonData) then begin
+    {$IFNDEF QUIET}
+    writeln(JSonData.AsString);
+    {$ENDIF}
+  end;
+  JSonData:=ajSon.FindPath('cases');
+  if Assigned(JSonData) then begin
+    Cases:=JSonData.Count;
+    {$IFNDEF QUIET}
+    writeln('Sequences in case ',Cases);
+    {$ENDIF}
+    HPDecoder:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
+
+    // This encoders, decoders are for cycle compress, decompress tests.
+    HPIntfDecoderPlain:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
+    HPIntfDecoderPlainIndexed:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
+    HPIntfDecoderHuffman:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
+    HPIntfDecoderHuffmanIndexed:=THPackDecoder.Create(HPACK_MAX_HEADER_SIZE,HPACK_MAX_HEADER_TABLE_SIZE);
+
+    HPIntfEncoderPlain:=THPackEncoder.Create(HPACK_MAX_HEADER_TABLE_SIZE,false,false,true);
+    HPIntfEncoderPlainIndexed:=THPackEncoder.Create(HPACK_MAX_HEADER_TABLE_SIZE,true,false,true);
+    HPIntfEncoderHuffman:=THPackEncoder.Create(HPACK_MAX_HEADER_TABLE_SIZE,false,true,false);
+    HPIntfEncoderHuffmanIndexed:=THPackEncoder.Create(HPACK_MAX_HEADER_TABLE_SIZE,true,true,false);
+    try
+      CaseCounter:=0;
+      while CaseCounter<Cases do begin
+        CaseData:=JSonData.Items[CaseCounter];
+        TestThisSequence(aGroup,aStory,CaseData);
+        inc(CaseCounter);
+      end;
+      TestPass:=true;
+    finally
+      if not TestPass then begin
+        {$IFNDEF FULL_QUIET}
+        writeln(StdErr,ErrorHeader('Sequence failed'));
+        writeln(StdErr,'Seq expected: ',CaseCounter);
+        {$ENDIF}
+      end else begin
+        inc(StoryCounter);
+      end;
+      FreeAndNil(HPDecoder);
+      FreeAndNil(HPIntfDecoderPlain);
+      FreeAndNil(HPIntfDecoderPlainIndexed);
+      FreeAndNil(HPIntfDecoderHuffman);
+      FreeAndNil(HPIntfDecoderHuffmanIndexed);
+      FreeAndNil(HPIntfEncoderPlain);
+      FreeAndNil(HPIntfEncoderPlainIndexed);
+      FreeAndNil(HPIntfEncoderHuffman);
+      FreeAndNil(HPIntfEncoderHuffmanIndexed);
+    end;
+  end;
+end;
+
+procedure THPackTestCaseCycle.RunSampleHeadersTest;
+const
+  TestCaseBase: string ='hpack-test-case-master'+PathDelim;
+  TestCaseGroups: array [0..10] of string =
+      (
+      'go-hpack',
+      'haskell-http2-linear',
+      'haskell-http2-linear-huffman',
+      'haskell-http2-naive',
+      'haskell-http2-naive-huffman',
+      'haskell-http2-static',
+      'haskell-http2-static-huffman',
+      'nghttp2',
+      'nghttp2-16384-4096',
+      'nghttp2-change-table-size',
+      'node-http2-hpack'
+      );
+  TestCaseStoryMask: string ='story_%.2d.json';
+var
+  TheFile: string;
+  JSonParser: TJSONParser;
+  JSonData: TJSonData;
+  MyStream: TFileStream;
+  j: integer;
+  FolderCounter: integer;
+  FailCounter: Integer=0;
+  ElapsedTime: QWord;
+begin
+  SequenceCounter:=0;
+  StoryCounter:=0;
+  GroupsCounter:=0;
+  WireBytes:=0;
+  DecodedBytes:=0;
+  ElapsedTime:=GetTickCount64;
+  FolderCounter:=0;
+  while FolderCounter<=High(TestCaseGroups) do begin
+    j:=0;
+    while true do begin
+      TheFile:=IncludeTrailingPathDelimiter(TestCaseBase)+IncludeTrailingPathDelimiter(TestCaseGroups[FolderCounter])+format(TestCaseStoryMask,[j]);
+      if not FileExists(TheFile) then begin
+        break;
+      end;
+      MyStream:=TFileStream.Create(TheFile,fmOpenRead or fmShareDenyWrite);
+      JSonParser:=TJSONParser.Create(MyStream,[]);
+      JSonData:=JSonParser.Parse;
+      {$IFNDEF QUIET}
+      writeln('Check story ',Thefile);
+      {$ENDIF}
+      try
+        try
+          TestCaseStory(FolderCounter,j,JSonData);
+        finally
+          FreeAndNil(JSonData);
+          FreeAndNil(JSonParser);
+          FreeAndNil(MyStream);
+        end;
+      except
+        on e: exception do begin
+          {$IFNDEF FULL_QUIET}
+          writeln(StdErr,ErrorHeader('Story failed'));
+          writeln(StdErr,TheFile);
+          writeln(StdErr,ErrorHeader('Fail condition'));
+          writeln(StdErr,e.Message);
+          inc(FailCounter);
+          {$ENDIF}
+          break;
+        end;
+      end;
+      inc(j);
+    end;
+    inc(GroupsCounter);
+    inc(FolderCounter);
+  end;
+  ElapsedTime:=GetTickCount64-ElapsedTime;
+  {$IFNDEF QUIET}
+  writeln;
+  writeln;
+  {$ENDIF}
+  {$IFNDEF FULL_QUIET}
+  writeln(ErrorHeader('Summary'));
+  writeln('Groups: ',GroupsCounter);
+  writeln('Stories: ',StoryCounter);
+  writeln('Sequences: ',SequenceCounter);
+  writeln('Time: ',ElapsedTime/1000:1:3,' seconds.');
+  writeln('Wire bytes / Decoded bytes: ',WireBytes,' / ',DecodedBytes);
+  writeln('Compression ratio: ',WireBytes/DecodedBytes:1:3);
+  writeln('Failed tests: ',FailCounter);
+  {$ENDIF}
+  if FailCounter>0 then begin
+    Fail('Failed cycle tests: %d',[FailCounter]);
+  end;
+end;
+
+initialization
+
+  RegisterTest(THPackTestCaseCycle);
+  RegisterTest(THPackTestDecoder);
+end.
+

+ 1 - 1
packages/hash/Makefile.fpc

@@ -7,7 +7,7 @@ name=hash
 version=3.0.1
 
 [require]
-packages=rtl
+packages=rtl 
 
 [install]
 fpcpackage=y

+ 2 - 1
packages/hash/fpmake.pp

@@ -36,7 +36,8 @@ begin
     T:=P.Targets.AddUnit('src/uuid.pas');
     T:=P.Targets.AddUnit('src/hmac.pp');
     T:=P.Targets.AddUnit('src/unixcrypt.pas');
-      T.OSes:=[Linux];
+    
+    T.OSes:=[Linux];
     T:=P.Targets.AddExampleunit('examples/mdtest.pas');
     T:=P.Targets.AddExampleunit('examples/crctest.pas');
     T:=P.Targets.AddExampleunit('examples/sha1test.pp');

+ 2 - 1
packages/ibase/src/ibase60.inc

@@ -92,6 +92,7 @@ Type
    ISC_INT64     = int64;
    ISC_UINT64    = qword;
    ISC_LONG      = Longint;
+   ISC_ULONG     = dword;
 
    PISC_USHORT = ^ISC_USHORT;
    PISC_STATUS = ^ISC_STATUS;
@@ -155,7 +156,7 @@ Type
 
    GDS_QUAD = record
       gds_quad_high : ISC_LONG;
-      gds_quad_low : ISC_LONG;
+      gds_quad_low : ISC_ULONG;
    end;
    TGDS_QUAD = GDS_QUAD;
    PGDS_QUAD = ^GDS_QUAD;

+ 380 - 12
packages/pastojs/src/fppas2js.pp

@@ -54,6 +54,14 @@ Type
     Function TransFormFunctionName(El : TPasElement; AContext : TConvertContext) : String;
     Function GetExceptionObjectname(AContext : TConvertContext) : String;
     Function ResolveType(El : TPasElement; AContext : TConvertContext) : TPasType;
+    Function CreateCallStatement(const caltname: string;para: array of string): TJSCallExpression;
+    Function CreateCallStatement(const pex2: TJSElement;para: array of string): TJSCallExpression;
+    Function CreateProcedureDeclaration(const El: TPasElement):TJSFunctionDeclarationStatement;
+    Function CreateUnary(ms: array of string; E: TJSElement): TJSUnary;
+    Function CreateMemberExpression(ms: array of string): TJSDotMemberExpression;
+    Procedure Addproceduretoclass(sl: TJSStatementList; E: TJSElement;const P: TPasProcedure);
+    Function GetFunctionDefinitionInUnary(const fd: TJSFunctionDeclarationStatement;const funname: string; inunary: boolean): TJSFunctionDeclarationStatement;
+    Function GetFunctionUnaryName(var je: TJSElement;var fundec: TJSFunctionDeclarationStatement): TJSString;
     // Statements
     Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext): TJSElement;virtual;
     Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext): TJSElement;virtual;
@@ -106,7 +114,9 @@ Type
     Function ConvertType(El: TPasElement; AContext : TConvertContext): TJSElement;virtual;
     Function ConvertVariable(El: TPasVariable; AContext : TConvertContext): TJSElement;virtual;
     Function ConvertElement(El : TPasElement; AContext : TConvertContext) : TJSElement; virtual;
-
+    function ConvertClassType(const EL: TPasClassType;const AContext: TConvertContext): TJSElement;
+    Function ConvertClassMember(El: TPasElement;AContext: TConvertContext): TJSElement;
+    Function ConvertClassconstructor(El: TPasConstructor;AContext: TConvertContext): TJSElement;
     Property CurrentContext : TJSElement Read FCurrentContext Write SetCurrentContext;
   Public
     Function ConvertElement(El : TPasElement) : TJSElement;
@@ -343,7 +353,8 @@ Var
   R : TJSBinary;
   C : TJSBinaryClass;
   A,B : TJSElement;
-
+  funname:String;
+  pex : TJSPrimaryExpressionIdent;
 begin
   Result:=Nil;
   C:=BinClasses[EL.OpCode];
@@ -379,14 +390,51 @@ begin
         end;
       eopSubIdent :
         begin
-        Result:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
-        TJSDotMemberExpression(Result).Mexpr:=A;
-        if Not (B is TJSPrimaryExpressionIdent) then
-          DOError('Member expression must be an identifier');
-        TJSDotMemberExpression(Result).Name:=TJSPrimaryExpressionIdent(B).Name;
-        FreeAndNil(B);
+        if (B is TJSPrimaryExpressionIdent) then
+        begin
+          Result := TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
+          TJSDotMemberExpression(Result).Mexpr := A;
+          TJSDotMemberExpression(Result).Name := TJSPrimaryExpressionIdent(B).Name;
+          FreeAndNil(B);
+        end;
+        if (B is TJSCallExpression) then
+        begin
+          Result := B;
+          funname := TJSPrimaryExpressionIdent(TJSCallExpression(B).Expr).Name;
+          TJSCallExpression(B).Expr :=
+            TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
+          TJSDotMemberExpression(TJSCallExpression(B).Expr).Mexpr := A;
+          TJSDotMemberExpression(TJSCallExpression(B).Expr).Name := funname;
+        end;
+        if not ((B is TJSPrimaryExpressionIdent) or (B is TJSCallExpression)) then;
+        // DOError('Member expression must be an identifier');
+      end
+      else
+        if (A is TJSPrimaryExpressionIdent) and
+          (TJSPrimaryExpressionIdent(A).Name = '_super') then
+        begin
+          Result := B;
+          funname := TJSPrimaryExpressionIdent(TJSCallExpression(b).Expr).Name;
+          pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
+          pex.Name := 'self';
+          TJSCallExpression(b).Args.Elements.AddElement.Expr := pex;
+          if TJSCallExpression(b).Args.Elements.Count > 1 then
+            TJSCallExpression(b).Args.Elements.Exchange(
+              0, TJSCallExpression(b).Args.Elements.Count - 1);
+          if CompareText(funname, 'Create') = 0 then
+          begin
+            TJSCallExpression(B).Expr :=
+              TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
+            TJSDotMemberExpression(TJSCallExpression(b).Expr).Mexpr := A;
+            TJSDotMemberExpression(TJSCallExpression(b).Expr).Name := funname;
+          end
+          else
+          begin
+            TJSCallExpression(B).Expr :=
+              CreateMemberExpression(['call', funname, 'prototype', '_super']);
+          end;
         end
-    else
+        else
       DoError('Unknown/Unsupported operand type for binary expression');
     end;
   if (Result=Nil) and (C<>Nil) then
@@ -474,9 +522,12 @@ begin
 end;
 
 Function TPasToJSConverter.ConvertInheritedExpression(El: TInheritedExpr; AContext : TConvertContext): TJSElement;
-
+var
+   je: TJSPrimaryExpressionIdent;
 begin
-  Result:=Nil;
+ je := TJSPrimaryExpressionIdent.Create(0, 0, '');
+  je.Name := '_super';
+  Result := je;
 //  TInheritedExpr = class(TPasExpr)
 end;
 
@@ -612,6 +663,8 @@ Function TPasToJSConverter.CreateTypeDecl(El: TPasElement; AContext : TConvertCo
 
 begin
   Result:=Nil;
+  if (El is TPasClassType) then
+    Result := convertclassType(TPasClassType(El), AContext);
   // Need to do something for classes and records.
 end;
 
@@ -668,6 +721,9 @@ begin
       E:=ConvertElement(P as TPasProcedure,AContext)
     else
       DoError('Unknown class: "%s" ',[P.ClassName]);
+    if (Pos('.', P.Name) > 0) then
+      Addproceduretoclass(TJSStatementList(Result), E, P as TPasProcedure)
+    else
     AddToSL;
     end;
   if (El is TProcedureBody) then
@@ -716,18 +772,146 @@ TPasTypeRef = class(TPasUnresolvedTypeRef)
 }
 end;
 
+function TPasToJSConverter.ConvertClassType(const El: TPasClassType;
+  const AContext: TConvertContext): TJSElement;
+var
+  call: TJSCallExpression;
+  pex: TJSPrimaryExpressionIdent;
+  asi: TJSSimpleAssignStatement;
+  unary2: TJSUnary;
+  unary: TJSUnary;
+  je: TJSElement;
+  FD: TJSFuncDef;
+  cons: TJSFunctionDeclarationStatement;
+  FS: TJSFunctionDeclarationStatement;
+  memname: string;
+  ctname: string;
+  tmember: TPasElement;
+  j: integer;
+  ret: TJSReturnStatement;
+begin
+  ctname := El.FullName;
+  unary := TJSUnary(CreateElement(TJSUnary,El));
+  asi := TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+  unary.A := asi;
+  pex := TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El));
+  pex.Name := El.Name;
+  asi.LHS := pex;
+  FS := TJSFunctionDeclarationStatement(
+    CreateElement(TJSFunctionDeclarationStatement, EL));
+  call := CreateCallStatement(FS, []);
+  asi.Expr := call;
+  Result := unary;
+  FD := TJSFuncDef.Create;
+  FS.AFunction := FD;
+  FD.Body := TJSFunctionBody(CreateElement(TJSFunctionBody, El));
+  FD.Body.A := TJSSourceElements(CreateElement(TJSSourceElements, El));
+  if Assigned(El.AncestorType) then
+  begin
+    pex := TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent, El));
+    call.Args := TJSArguments(CreateElement(TJSArguments, El));
+    pex.Name := El.AncestorType.Name;
+    call.Args.Elements.AddElement.Expr := pex;
+    FD.Params.Add('_super');
+    unary2 := TJSUnary(CreateElement(TJSUnary, El));
+    call := CreateCallStatement('__extends', [El.Name, '_super']);
+    unary2.A := call;
+    TJSSourceElements(FD.Body.A).Statements.AddNode.Node := unary2;
+  end;
+  //create default onstructor
+  cons := CreateProcedureDeclaration(El);
+  TJSSourceElements(FD.Body.A).Statements.AddNode.Node := cons;
+  cons.AFunction.Name := El.Name;
+
+  //convert class member
+  for j := 0 to El.Members.Count - 1 do
+  begin
+    tmember := TPasElement(El.Members[j]);
+    memname := tmember.FullName;
+    je := ConvertClassMember(tmember, AContext);
+    if Assigned(je) then
+      TJSSourceElements(FD.Body.A).Statements.AddNode.Node := je;
+  end;
+
+  //add return statment
+  ret := TJSReturnStatement(CreateElement(TJSReturnStatement, El));
+  TJSSourceElements(FD.Body.A).Statements.AddNode.Node := ret;
+  pex := TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent, El));
+  ret.Expr := pex;
+  pex.Name := el.Name;
+  Result := unary;
+end;
+
+function TPasToJSConverter.ConvertClassMember(El: TPasElement;
+  AContext: TConvertContext): TJSElement;
+var
+  FS: TJSFunctionDeclarationStatement;
+  par: string;
+begin
+  Result := nil;
+  if (El is TPasProcedure) and (not (El is TPasConstructor)) then
+  begin
+    FS := CreateProcedureDeclaration(El);
+    Result := CreateUnary([TPasProcedure(El).Name, 'prototype',
+      El.Parent.FullName], FS);
+  end;
+  if (El is TPasConstructor)then
+  begin
+    Result:=ConvertClassconstructor(TPasClassConstructor(El),AContext);
+  end;
+  if (el is TPasProperty) then
+    ConvertProperty(TPasProperty(El), AContext);
+
+end;
+
+Function TPasToJSConverter.ConvertClassconstructor(El: TPasConstructor;
+   AContext: TConvertContext): TJSElement;
+var
+  FS: TJSFunctionDeclarationStatement;
+  n: integer;
+  fun1sourceele: TJSSourceElements;
+  ret: TJSReturnStatement;
+  nmem: TJSNewMemberExpression;
+  pex: TJSPrimaryExpressionIdent;
+begin
+  FS := CreateProcedureDeclaration(El);
+  FS.AFunction.Name := El.Name;
+  Fs.AFunction.Body := TJSFunctionBody(CreateElement(TJSFunctionBody, EL.Body));
+  fun1sourceele := TJSSourceElements.Create(0, 0, '');
+  fs.AFunction.Body.A := fun1sourceele;
+  ret := TJSReturnStatement.Create(0, 0, '');
+  fun1sourceele.Statements.AddNode.Node := ret;
+  nmem := TJSNewMemberExpression.Create(0, 0, '');
+  ret.Expr := nmem;
+  pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
+  nmem.Mexpr := pex;
+  pex.Name := El.Parent.FullName;
+  for n := 0 to El.ProcType.Args.Count - 1 do
+  begin
+    if n = 0 then
+      nmem.Args := TJSArguments.Create(0, 0, '');
+    fs.AFunction.Params.Add(TPasArgument(El.ProcType.Args[n]).Name);
+    pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
+    pex.Name := TPasArgument(El.ProcType.Args[n]).Name;
+    nmem.Args.Elements.AddElement.Expr := pex;
+  end;
+  Result := CreateUnary([TPasProcedure(El).Name, El.Parent.FullName], FS);
+end;
+
 Function TPasToJSConverter.ConvertProcedure(El: TPasProcedure; AContext : TConvertContext): TJSElement;
 
 Var
   FS : TJSFunctionDeclarationStatement;
   FD : TJSFuncDef;
-
+  n:Integer;
 begin
   FS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,EL));
   Result:=FS;
   FD:=TJSFuncDef.Create;
   FD.Name:=TransFormFunctionName(El,AContext);
   FS.AFunction:=FD;
+  for n := 0 to El.ProcType.Args.Count - 1 do
+    FD.Params.Add(TPasArgument(El.ProcType.Args[0]).Name);
   FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,EL.Body));
   FD.Body.A:=ConvertElement(El.Body,AContext);
   {
@@ -1220,7 +1404,190 @@ begin
   else
     Result:=Nil;
 end;
+function TPasToJSConverter.CreateCallStatement(const caltname: string;
+  para: array of string): TJSCallExpression;
+var
+  call: TJSCallExpression;
+  pex2: TJSPrimaryExpressionIdent;
+begin
+  pex2 := TJSPrimaryExpressionIdent.Create(0, 0, '');
+  pex2.Name := caltname;
+  call := CreateCallStatement(pex2, para);
+  Result := call;
+end;
 
+function TPasToJSConverter.CreateCallStatement(const pex2: TJSElement;
+  para: array of string): TJSCallExpression;
+var
+  p: string;
+  pex3: TJSPrimaryExpressionIdent;
+  call: TJSCallExpression;
+  argarray: TJSArguments;
+begin
+  call := TJSCallExpression.Create(0, 0, '');
+  call.Expr := pex2;
+  argarray := TJSArguments.Create(0, 0, '');
+  call.Args := argarray;
+  for p in para do
+  begin
+    pex3 := TJSPrimaryExpressionIdent.Create(0, 0, '');
+    pex3.Name := p;
+    argarray.Elements.AddElement.Expr := pex3;
+  end;
+  Result := call;
+end;
+
+function TPasToJSConverter.CreateUnary(ms: array of string; E: TJSElement): TJSUnary;
+var
+  unary: TJSUnary;
+  asi: TJSSimpleAssignStatement;
+  mem1: TJSDotMemberExpression;
+begin
+  unary := TJSUnary.Create(0, 0, '');
+  //mainbody.A:=unary;
+  asi := TJSSimpleAssignStatement.Create(0, 0, '');
+  unary.A := asi;
+  asi.Expr := E;
+  asi.LHS := CreateMemberExpression(ms);
+  Result := unary;
+end;
+
+function TPasToJSConverter.CreateMemberExpression(ms: array of string): TJSDotMemberExpression;
+var
+  pex: TJSPrimaryExpressionIdent;
+  mem2: TJSDotMemberExpression;
+  mem1: TJSDotMemberExpression;
+  k: integer;
+  m: string;
+begin
+  if Length(ms) < 2 then
+    DoError('member exprision with les than two member');
+  k := 0;
+  for m in ms do
+  begin
+    mem1 := mem2;
+    mem2 := TJSDotMemberExpression.Create(0, 0, '');
+    mem2.Name := ms[k];
+    if k = 0 then
+      Result := mem2
+    else
+      mem1.Mexpr := mem2;
+    Inc(k);
+  end;
+  mem2.Free;
+  pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
+  pex.Name := ms[k - 1];
+  mem1.Mexpr := pex;
+end;
+Procedure TPasToJSConverter.Addproceduretoclass(sl: TJSStatementList;
+  E: TJSElement; const P: TPasProcedure);
+var
+  clname, funname, varname: string;
+  classfound: boolean;
+  fundec, fd, main_const: TJSFunctionDeclarationStatement;
+  SL2: TJSStatementList;
+  un1: TJSUnary;
+  asi: TJSAssignStatement;
+begin
+  SL2 := TJSStatementList(sl);
+  clname := Copy(p.Name, 1, Pos('.', P.Name) - 1);
+  funname := Copy(p.Name, Pos('.', P.Name) + 1, Length(p.Name) - Pos('.', P.Name));
+  classfound := False;
+  while Assigned(SL2) and (not classfound) do
+  begin
+    if SL2.A is TJSUnary then
+    begin
+      un1 := TJSUnary(SL2.A);
+      asi := TJSAssignStatement(un1.A);
+      varname := TJSPrimaryExpressionIdent(asi.LHS).Name;
+      if varname = (clname) then
+      begin
+        classfound := True;
+        fd := TJSFunctionDeclarationStatement(TJSCallExpression(asi.Expr).Expr);
+      end;
+    end;
+    SL2 := TJSStatementList(SL2.B);
+  end;
+
+  if not (classfound) then
+    Exit;
+
+  fundec := GetFunctionDefinitionInUnary(fd, funname, True);
+  if Assigned(fundec) then
+  begin
+    if (p is TPasConstructor) then
+    begin
+      main_const := GetFunctionDefinitionInUnary(fd, clname, False);
+      main_const.AFunction := TJSFunctionDeclarationStatement(E).AFunction;
+      main_const.AFunction.Name := clname;
+    end
+    else
+    begin
+      fundec.AFunction := TJSFunctionDeclarationStatement(E).AFunction;
+      fundec.AFunction.Name := '';
+    end;
+  end;
+end;
+
+function TPasToJSConverter.GetFunctionDefinitionInUnary(
+  const fd: TJSFunctionDeclarationStatement; const funname: string;
+  inunary: boolean): TJSFunctionDeclarationStatement;
+var
+  k: integer;
+  fundec: TJSFunctionDeclarationStatement;
+  je: TJSElement;
+  cname: TJSString;
+begin
+  Result := nil;
+  for k := 0 to TJSSourceElements(FD.AFunction.Body.A).Statements.Count - 1 do
+  begin
+    je := TJSSourceElements(FD.AFunction.Body.A).Statements.Nodes[k].Node;
+    if inunary then
+      cname := GetFunctionUnaryName(je, fundec)
+    else
+    begin
+      if je is TJSFunctionDeclarationStatement then
+      begin
+        cname := TJSFunctionDeclarationStatement(je).AFunction.Name;
+        fundec := TJSFunctionDeclarationStatement(je);
+      end;
+    end;
+    if funname = cname then
+      Result := fundec;
+  end;
+end;
+
+Function TPasToJSConverter.GetFunctionUnaryName(var je: TJSElement;
+  var fundec: TJSFunctionDeclarationStatement): TJSString;
+var
+  cname: TJSString;
+  asi: TJSAssignStatement;
+  un1: TJSUnary;
+begin
+  if not (je is TJSUnary) then
+    Exit;
+  un1 := TJSUnary(je);
+  asi := TJSAssignStatement(un1.A);
+  if not (asi.Expr is TJSFunctionDeclarationStatement) then
+    Exit;
+  fundec := TJSFunctionDeclarationStatement(asi.Expr);
+  cname := TJSDotMemberExpression(asi.LHS).Name;
+  Result := cname;
+end;
+
+function TPasToJSConverter.CreateProcedureDeclaration(const El: TPasElement):
+TJSFunctionDeclarationStatement;
+var
+  FD: TJSFuncDef;
+  FS: TJSFunctionDeclarationStatement;
+begin
+  FS := TJSFunctionDeclarationStatement(
+    CreateElement(TJSFunctionDeclarationStatement, EL));
+  Result := FS;
+  FD := TJSFuncDef.Create;
+  FS.AFunction := FD;
+  Result := FS;
+end;
 Function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn; AContext : TConvertContext): TJSElement;
 
 Var
@@ -1379,3 +1746,4 @@ end;
 
 end.
 
+

+ 16 - 0
packages/rtl-extra/src/unix/ipc.pp

@@ -508,6 +508,8 @@ type
 {$elseif defined(Linux)}
   PMSQid_ds = ^TMSQid_ds;
   TMSQid_ds = record
+{ 32 bit }
+{$IFNDEF CPU64}
     msg_perm   : TIPC_perm;
     msg_first  : PMsg;
     msg_last   : PMsg;
@@ -519,6 +521,20 @@ type
     msg_qbytes : word;
     msg_lspid  : ipc_pid_t;
     msg_lrpid  : ipc_pid_t;
+{$ELSE cpu64}
+{ 64 bit }
+    msg_perm   : TIPC_perm;
+    msg_stime  : time_t;
+    msg_rtime  : time_t;
+    msg_ctime  : time_t;
+    msg_cbytes : qword;
+    msg_qnum   : qword;
+    msg_qbytes : qword;
+    msg_lspid  : ipc_pid_t;
+    msg_lrpid  : ipc_pid_t;
+    pad1 : qword;
+    pad2 : qword;
+{$ENDIF}    
   end;
 {$else}
   {$if defined(Darwin)}

+ 93 - 43
rtl/win/windirs.pp

@@ -1,5 +1,18 @@
 unit windirs;
 
+{*******************************************************************************
+
+IMPORTANT NOTES:
+
+SHGetFolderPath function is deprecated. Only some CSIDL values are supported.
+
+As of Windows Vista, this function is merely a wrapper for SHGetKnownFolderPath.
+The CSIDL value is translated to its associated KNOWNFOLDERID and then SHGetKnownFolderPath
+is called. New applications should use the known folder system rather than the older
+CSIDL system, which is supported only for backward compatibility.
+
+*******************************************************************************}
+
 {$mode objfpc}
 {$H+}
 
@@ -8,7 +21,8 @@ interface
 uses
   windows;
 
-Const
+// CSIDL_* contants are also declared in "ShellApi" and "shfolder" units.
+const
   CSIDL_PROGRAMS                = $0002; { %SYSTEMDRIVE%\Program Files                                      }
   CSIDL_PERSONAL                = $0005; { %USERPROFILE%\My Documents                                       }
   CSIDL_FAVORITES               = $0006; { %USERPROFILE%\Favorites                                          }
@@ -51,68 +65,104 @@ Const
 
   CSIDL_FLAG_CREATE             = $8000; { (force creation of requested folder if it doesn't exist yet)     }
 
-Function GetWindowsSpecialDir(ID :  Integer) : String;
+
+function GetWindowsSpecialDir(ID: Integer; CreateIfNotExists: Boolean = True): String;
+function GetWindowsSpecialDirUnicode(ID: Integer; CreateIfNotExists: Boolean = True): UnicodeString;
+
+function GetWindowsSystemDirectory: String;
+function GetWindowsSystemDirectoryUnicode: UnicodeString;
 
 implementation
 
 uses
   sysutils;
 
-Type
-  PFNSHGetFolderPath = Function(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: {$ifdef FPC_UNICODE_RTL}PWideChar{$ELSE}PChar{$ENDIF}): HRESULT; stdcall;
+type
+  // HRESULT SHGetFolderPath(
+  //  _In_  HWND   hwndOwner,
+  //  _In_  int    nFolder,
+  //  _In_  HANDLE hToken,
+  //  _In_  DWORD  dwFlags,
+  //  _Out_ LPTSTR pszPath
+  // );
+  TSHGetFolderPathW = function(Ahwnd: HWND; Csidl: Integer; Token: THandle;
+    Flags: DWORD; Path: PWideChar): HRESULT; stdcall;
+
+const
+  SSHGetFolderPathW = 'SHGetFolderPathW';
+  SLibName = 'shell32.dll';
 
 var
-  SHGetFolderPath : PFNSHGetFolderPath = Nil;
-  CFGDLLHandle : THandle = 0;
+  _SHGetFolderPathW : TSHGetFolderPathW = nil;
+  DLLHandle: THandle = 0;
 
-Procedure InitDLL;
-
-Var
-  pathBuf: array[0..MAX_PATH-1] of {$ifdef FPC_UNICODE_RTL}WideChar{$else}Ansichar{$endif};
-  pathLength: Integer;
+procedure InitDLL;
+var
+  DLLPath: UnicodeString;
 begin
-  { Load shfolder.dll using a full path, in order to prevent spoofing (Mantis #18185)
-    Don't bother loading shell32.dll because shfolder.dll itself redirects SHGetFolderPath
-    to shell32.dll whenever possible. }
-  pathLength:=GetSystemDirectory(pathBuf, MAX_PATH);
-  if (pathLength>0) and (pathLength<MAX_PATH-14) then { 14=length('\shfolder.dll'#0) }
+  if DLLHandle = 0 then
   begin
-    StrLCopy(@pathBuf[pathLength],'\shfolder.dll',MAX_PATH-pathLength-1);
-    CFGDLLHandle:=LoadLibrary(pathBuf);
-
-    if (CFGDLLHandle<>0) then
+    // Load DLL using a full path, in order to prevent spoofing (Mantis #18185)
+    DLLPath := GetWindowsSystemDirectoryUnicode;
+    if Length(DLLPath) > 0 then
     begin
-      Pointer(ShGetFolderPath):=GetProcAddress(CFGDLLHandle,{$ifdef FPC_UNICODE_RTL}'SHGetFolderPathW'{$else}'SHGetFolderPathA'{$endif});
-      If @ShGetFolderPath=nil then
-      begin
-        FreeLibrary(CFGDLLHandle);
-        CFGDllHandle:=0;
-      end;
+      DLLPath := IncludeTrailingPathDelimiter(DLLPath) + SLibName;
+      DLLHandle := LoadLibraryW(PWideChar(DLLPath));
+      if DLLHandle <> 0 then
+        Pointer(_SHGetFolderPathW) := GetProcAddress(DLLHandle, SSHGetFolderPathW);
     end;
   end;
-  If (@ShGetFolderPath=Nil) then
-    Raise Exception.Create('Could not determine SHGetFolderPath Function');
+  if @_SHGetFolderPathW = nil then
+    raise Exception.Create('Could not locate SHGetFolderPath function');
 end;
 
-Function GetWindowsSpecialDir(ID :  Integer) : String;
+procedure FinitDLL;
+begin
+  if DLLHandle <> 0 then
+  begin
+    FreeLibrary(DLLHandle);
+    DLLHandle := 0;
+  end;
+end;
 
-Var
-  APath : Array[0..MAX_PATH] of char;
+function GetWindowsSystemDirectoryUnicode: UnicodeString;
+var
+  Buffer: array [0..MAX_PATH] of WideChar;
+  CharCount: Integer;
+begin
+  CharCount := GetSystemDirectoryW(@Buffer[0], MAX_PATH);
+  // CharCount is length in TCHARs not including the terminating null character.
+  // If result did not fit, CharCount will be bigger than buffer size.
+  if (CharCount > 0) and (CharCount < MAX_PATH) then
+    Result := StrPas(Buffer)
+  else
+    Result := '';
+end;
 
+function GetWindowsSystemDirectory: String;
 begin
-  Result:='';
-  if (CFGDLLHandle=0) then
-    InitDLL;
-  If (SHGetFolderPath<>Nil) then
-    begin
-    if SHGetFolderPath(0,ID or CSIDL_FLAG_CREATE,0,0,@APATH[0])=S_OK then
-      Result:=IncludeTrailingPathDelimiter(StrPas(@APath[0]));
-    end;
+  Result := String(GetWindowsSystemDirectoryUnicode);
 end;
 
-Initialization
-Finalization
-  if CFGDLLHandle<>0 then
-   FreeLibrary(CFGDllHandle);
+function GetWindowsSpecialDirUnicode(ID: Integer; CreateIfNotExists: Boolean = True): UnicodeString;
+var
+  Buffer: array [0..MAX_PATH] of WideChar;
+begin
+  InitDLL;
+  Result := '';
+  if CreateIfNotExists then
+    ID := ID or CSIDL_FLAG_CREATE;
+  if _SHGetFolderPathW(0, ID, 0, 0, @Buffer[0]) = S_OK then
+    Result := IncludeTrailingPathDelimiter(StrPas(Buffer));
+end;
+
+function GetWindowsSpecialDir(ID: Integer; CreateIfNotExists: Boolean = True): String;
+begin
+  Result := String(GetWindowsSpecialDirUnicode(ID, CreateIfNotExists));
+end;
+
+finalization
+  FinitDLL;
+
 end.
 

+ 24 - 24
utils/fpdoc/dw_latex.pp

@@ -169,30 +169,30 @@ Function TLaTeXWriter.SplitLine (ALine : String): String;
      InString : Boolean;
     
   begin
-    Result:=0;
-    L:=Length(S);
-    if (L>MaxVerbatimLength) then
-      begin
-      InString:=False;
-      Result:=0;
-      I:=1;
-      C:=@S[1];
-      While (I<=MaxVerbatimLength) do
-        begin
-        If C^='''' then
-          InString:=Not Instring
-        else if Not InString then
-          begin
-          if Not (C^ in NonSplit) then  
-            Result:=I;
-          end;  
-        Inc(I);
-        Inc(C);
-        end;    
-      end;  
-    If Result=0 then
-      Result:=L+1;
-  end;
+     Result:=0;
+     L:=Length(S);
+     if (L>MaxVerbatimLength) then
+       begin
+       InString:=False;
+       Result:=0;
+       I:=1;
+       C:=@S[1];
+       While (I<=L) and (Result<=MaxVerbatimLength) do
+         begin
+         If C^='''' then
+           InString:=Not Instring
+         else if Not InString then
+           begin
+           if Not (C^ in NonSplit) then
+             Result:=I;
+           end;
+         Inc(I);
+         Inc(C);
+         end;
+       end;
+     If (Result=0) or (Result=1) then
+       Result:=L+1;
+   end;
    
 Var
   SP : Integer;