TIBDataSetEx = class(TIBDataSet)
  strict private
    class function IsBinaryField(AField: TField): Boolean; static;
    class function GetVarBytesLenPtr(const ABuffer: TValueBuffer): PWord; static;
    procedure SetFieldBinaryData(AField: TField; const ABuffer: TValueBuffer);
    function GetMappedFieldPositionPtr: PInteger;
    function GetMappedFieldPosition(AIdx: Integer): Integer;
  protected
    procedure InternalInitFieldDefs; override;
    procedure SetFieldData(AField: TField; ABuffer: TValueBuffer); override;
    procedure DataConvert(AField: TField; ASource, ADest: TValueBuffer; AToNative: Boolean); override;
  end;

{ TIBDataSetEx }

class function TIBDataSetEx.IsBinaryField(AField: TField): Boolean;
begin
  Result := (AField.FieldNo >= 0) and (AField.DataType in [ftVarBytes, ftBytes]);
end;

class function TIBDataSetEx.GetVarBytesLenPtr(const ABuffer: TValueBuffer): PWord;
begin
  Result := @ABuffer[Length(ABuffer) - SizeOf(Word)];
end;

procedure TIBDataSetEx.SetFieldBinaryData(AField: TField; const ABuffer: TValueBuffer);
var
  LRecData: PRecordData;
  LFldData: PFieldData;
begin
  LRecData := PRecordData(GetActiveBuf);
  LFldData := @LRecData^.rdFields[GetMappedFieldPosition(AField.FieldNo - 1)];
  if not LFldData^.fdIsNull then begin
    if AField.DataType = ftVarBytes then
      LFldData^.fdDataLength := GetVarBytesLenPtr(ABuffer)^
    else
      LFldData^.fdDataLength := Length(ABuffer);
  end;
end;

function TIBDataSetEx.GetMappedFieldPositionPtr: PInteger;
const
  {$IF IBXConst.IBX_Version = 17.17}
  CMappedFieldPositionOffset = 512;
  {$ELSE}
    {$MESSAGE ERROR 'Check TIBCustomDataSet.MappedFieldPosition Offset'}
  {$ENDIF}
begin
  Result := PPointer(OffsetPtr(Self, CMappedFieldPositionOffset))^;
end;

function TIBDataSetEx.GetMappedFieldPosition(AIdx: Integer): Integer;
var
  LBasePtr: PIntegerArray;
begin
  LBasePtr := PIntegerArray(GetMappedFieldPositionPtr);
  Result := LBasePtr^[AIdx];
end;

procedure TIBDataSetEx.InternalInitFieldDefs;
var
  LMappedFieldPosition: PInteger;
  Li: Integer;
  LVar: TSQLVAR;
  LSqlType: SmallInt;
  LSubType: SmallInt;
  LSize: Integer;
begin
  FieldDefs.BeginUpdate;
  try
    inherited InternalInitFieldDefs;
    LMappedFieldPosition := GetMappedFieldPositionPtr;
    for Li := 0 to FieldDefs.Count - 1 do begin
      LVar := QSelect.Current[LMappedFieldPosition^ - 1].Data;
      Inc(LMappedFieldPosition);
      LSqlType := LVar.sqltype and not 1;
      if (LSqlType = SQL_VARYING) or (LSqlType = SQL_TEXT) then begin
        LSubType := LVar.SqlSubtype and $FF;
        if LSubType = 1 then begin // CHARSET OCTETS
          LSize := FieldDefs[Li].Size;
          if LSqlType = SQL_VARYING then
            FieldDefs[Li].DataType := ftVarBytes
          else
            FieldDefs[Li].DataType := ftBytes;
          FieldDefs[Li].Size := LSize;
        end;
      end;
    end;
  finally
    FieldDefs.EndUpdate;
  end;
end;

procedure TIBDataSetEx.SetFieldData(AField: TField; ABuffer: TValueBuffer);
begin
  inherited SetFieldData(AField, ABuffer);
  if IsBinaryField(AField) then
    SetFieldBinaryData(AField, ABuffer);
end;

procedure TIBDataSetEx.DataConvert(AField: TField; ASource, ADest: TValueBuffer;
  AToNative: Boolean);
var
  LDataSizePtr: PWord;
  LDataSize: Word;
begin
  case AField.DataType of
    ftBytes: begin
      if AToNative then begin
        Move(ASource[0], ADest[0], Length(ASource));
        FillChar(ADest[Length(ASource)], Length(ADest) - Length(ASource), 0);
      end else
        Move(ASource[0], ADest[0], AField.DataSize);
    end;
    ftVarBytes: begin
      if AToNative then begin
        LDataSize := Length(ASource);
        Move(ASource[0], ADest[0], LDataSize);
        LDataSizePtr := GetVarBytesLenPtr(ADest);
        LDataSizePtr^ := LDataSize;
      end else begin
        LDataSizePtr := GetVarBytesLenPtr(ASource);
        LDataSize := LDataSizePtr^;
        Move(ASource[0], ADest[0], LDataSize);
      end;
    end
  else
    inherited DataConvert(AField, ASource, ADest, AToNative);
  end;
end;