procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: NativeInt; lengthVec: PNativeint);
var
  i,j: NativeInt;
  newLength, oldLength, minLength: NativeInt;
  elSize: NativeInt;
  neededSize: NativeInt;
  p, pp: Pointer;
begin
  p := a;

  // Fetch the new length of the array in this dimension, and the old length
  newLength := lengthVec^;
  if newLength <= 0 then
  begin
    if newLength < 0 then
      Error(reRangeError);
    DynArrayClear(a, typeInfo);
    exit;
  end;

  oldLength := 0;
  if p <> nil then
  begin
    Dec(PByte(p), SizeOf(TDynArrayRec));
    oldLength := PDynArrayRec(p).Length;
  end;

  // Calculate the needed size of the heap object
  Inc(PByte(typeInfo), PDynArrayTypeInfo(typeInfo).name);
  elSize := PDynArrayTypeInfo(typeInfo).elSize;
  if PDynArrayTypeInfo(typeInfo).elType <> nil then
    typeInfo := PDynArrayTypeInfo(typeInfo).elType^
  else
    typeInfo := nil;
  neededSize := newLength*elSize;
  if neededSize div newLength <> elSize then
    Error(reRangeError);
  Inc(neededSize, SizeOf(TDynArrayRec));
  if neededSize < 0 then
    Error(reRangeError);

  // If the heap object isn't shared (ref count = 1), just resize it. Otherwise, we make a copy
  if (p = nil) or (PDynArrayRec(p).RefCnt = 1) then
  begin
    pp := p;
{$IF not Defined(WEAKREF)}
    if (newLength < oldLength) and (typeInfo <> nil) then
      FinalizeArray(PByte(p) + SizeOf(TDynArrayRec) + newLength*elSize, typeInfo, oldLength - newLength);
{$ELSE}
    if typeInfo <> nil then
    begin
      if newLength < oldLength then
        minLength := newLength
      else
        minLength := oldLength;
      GetMem(pp, neededSize);
      FillChar((PByte(pp) + SizeOf(TDynArrayRec))^, minLength * elSize, 0);
      if p <> nil then
      begin
        CopyArray(PByte(pp) + SizeOf(TDynArrayRec), a, typeInfo, minLength);
        FinalizeArray(PByte(p) + SizeOf(TDynArrayRec), typeInfo, oldLength);
        FreeMem(p);
      end;
    end else
{$ENDIF}
      ReallocMem(pp, neededSize);
    p := pp;
  end
  else
  begin
    Dec(PDynArrayRec(p).RefCnt);
    GetMem(p, neededSize);
    minLength := oldLength;
    if minLength > newLength then
      minLength := newLength;
    if typeInfo <> nil then
    begin
      FillChar((PByte(p) + SizeOf(TDynArrayRec))^, minLength*elSize, 0);
      CopyArray(PByte(p) + SizeOf(TDynArrayRec), a, typeInfo, minLength)
    end
    else
      Move(PByte(a)^, (PByte(p) + SizeOf(TDynArrayRec))^, minLength*elSize);
  end;

  // The heap object will now have a ref count of 1 and the new length
  PDynArrayRec(p).RefCnt := 1;
  PDynArrayRec(p).Length := newLength;
  Inc(PByte(p), SizeOf(TDynArrayRec));

  // Set the new memory to all zero bits
  if newLength > oldLength then
    FillChar((PByte(p) + elSize * oldLength)^, elSize * (newLength - oldLength), 0);

  // Take care of the inner dimensions, if any
  if dimCnt > 1 then
  begin
    Inc(lengthVec);
    Dec(dimCnt);
    i := 0;
    try
      while i < newLength do
        begin
          DynArraySetLength(PPointerArray(p)[i], typeInfo, dimCnt, lengthVec);
          Inc(i);
        end;
    except
	  // Free arrays on exception
	  for j := 0 to i  do
		DynArrayClear(PPointerArray(p)[j],typeInfo);
	  DynArrayClear(p,typeinfo);
	  raise;
    end;
  end;
  a := p;
end;