FirebirdSQL logo
  • Anglaiskeyboard_arrow_down
 FactoriesDocument history 

Data recording in Blob

As an example of Blob recording, consider the function of thereader contents of the Blob from the file.

Note
Comment

This example is an adapted version of UDF functions for readingand recording BLOB from/to a file. Original UDF is available athttp://www.ibase.ru/files/download/blobsaveload.zip#blobsaveload.zip]

Blob read and record utilities from/to the file are issued in the form of a package

CREATE PACKAGE BlobFileUtils
AS
BEGIN
  PROCEDURE SaveBlobToFile(ABlob BLOB, AFileName VARCHAR(255) CHARACTER SET UTF8);

  FUNCTION LoadBlobFromFile(AFileName VARCHAR(255) CHARACTER SET UTF8) RETURNS BLOB;
END^

CREATE PACKAGE BODY BlobFileUtils
AS
BEGIN
  PROCEDURE SaveBlobToFile(ABlob BLOB, AFileName VARCHAR(255) CHARACTER SET UTF8)
  EXTERNAL NAME 'BlobFileUtils!SaveBlobToFile'
  ENGINE UDR;

  FUNCTION LoadBlobFromFile(AFileName VARCHAR(255) CHARACTER SET UTF8) RETURNS BLOB
  EXTERNAL NAME 'BlobFileUtils!LoadBlobFromFile'
  ENGINE UDR;
END^

Let’s register the factories of our procedures and functions:

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // registerable
  AUdrPlugin.registerProcedure(AStatus, 'SaveBlobToFile', TSaveBlobToFileProcFactory.Create());
  AUdrPlugin.registerFunction(AStatus, 'LoadBlobFromFile', TLoadBlobFromFileFuncFactory.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;

In this case, we give an example only for the feature readingBLOB from the file, the full example of udr you can download athttps://github.com/sim1984/uDr-book/Master/EXAMPles/06.%20BLOBLOBOLOODALOADX .The interface part of the module with a description of theLoadblobfromfile function is as follows:

interface

uses
  Firebird, Classes, SysUtils;

type

  // Input messages of the function
  TInput = record
    filename: record
      len: Smallint;
      str: array [0 .. 1019] of AnsiChar;
    end;
    filenameNull: WordBool;
  end;
  TInputPtr = ^TInput;

  // Output function
  TOutput = record
    blobData: ISC_QUAD;
    blobDataNull: WordBool;
  end;
  TOutputPtr = ^TOutput;

  // realization features Loadblobfromfile
  TLoadBlobFromFileFunc = class(IExternalFunctionImpl)
  public
    procedure dispose(); override;

    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;

  // Factory for creating a copy of the external function Loadblobfromfile
  TLoadBlobFromFileFuncFactory = class(IUdrFunctionFactoryImpl)
    procedure dispose(); override;

    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;

Let us only give the implementation of the basic Execute class tloadblobfromfile, the rest of the classes of classes are elementary.

procedure TLoadBlobFromFileFunc.execute(AStatus: IStatus;
  AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer);
const
  MaxBufSize = 16384;
var
  xInput: TInputPtr;
  xOutput: TOutputPtr;
  xFileName: string;
  xStream: TFileStream;
  att: IAttachment;
  trx: ITransaction;
  blob: IBlob;
  buffer: array [0 .. 32767] of Byte;
  xStreamSize: Integer;
  xBufferSize: Integer;
  xReadLength: Integer;
begin
  xInput := AInMsg;
  xOutput := AOutMsg;
  if xInput.filenameNull then
  begin
    xOutput.blobDataNull := True;
    Exit;
  end;
  xOutput.blobDataNull := False;
  // We get the file name
  xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0,
    xInput.filename.len * 4);
  SetLength(xFileName, xInput.filename.len);
  // We read the file in the stream
  xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone);
  att := AContext.getAttachment(AStatus);
  trx := AContext.getTransaction(AStatus);
  blob := nil;
  try
    xStreamSize := xStream.Size;
    // Determine the maximum size of the buffer (segment)
    if xStreamSize > MaxBufSize then
      xBufferSize := MaxBufSize
    else
      xBufferSize := xStreamSize;
    // We create a new Blob
    blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil);
    // We read the contents of the stream and write it in Blob
    while xStreamSize <> 0 do
    begin
      if xStreamSize > xBufferSize then
        xReadLength := xBufferSize
      else
        xReadLength := xStreamSize;
      xStream.ReadBuffer(buffer, xReadLength);

      blob.putSegment(AStatus, xReadLength, @buffer[0]);

      Dec(xStreamSize, xReadLength);
    end;
    // Close Blob
    // CLOSE method in case of success combines the IBLOB interface
    // Therefore, the subsequent call is not needed
    blob.close(AStatus);
    blob := nil;
  finally
    if Assigned(blob) then
      blob.release;
    trx.release;
    att.release;
    xStream.Free;
  end;
end;

First of all, it is necessary to create a new Blob and tie it inthe Blobid output using the createBlob method IAttachment.Since we write a temporary Blob for our database, we will createit in the context of the current connection. The context of thecurrent connection and the context of the current transaction canbe obtained from the context of the external procedure, functionor trigger (the IExternalContext).

As in the case of reading data from Blob, the record is carriedout by segmented using the putSegment method IBlob until thedata in the file flow is completed. Upon completion of the datarecording in Blob, it is necessary to close it using the closemethod.

Important
Important

The close method of the` IBlob` interface in case of successful execution frees the interface.Therefore, there is no need to call the `Release 'method.

Helper for working with the Blob type

In the described examples, we used the preservation of BLOBcontents into the flow, as well as the loading of the contents ofBLOB into the stream. This is a rather frequent operation whenworking with the BLOB type, so it would be good to write aspecial set of utilities for reuse of code.

Modern versions of Delphi and Free Pascal allow you to expandexisting classes and types without inheritance using the socalled Halper. Add the methods to the IBlob interface to saveand load the contents of the flow from/to Blob.

Create a special module FbBlob, where our Halper will be placed.

unit FbBlob;

interface

uses Classes, SysUtils, Firebird;

const
  MAX_SEGMENT_SIZE = $7FFF;

type
  TFbBlobHelper = class helper for IBlob
    { Loads in Blob the contents of the stream

      @param(AStatus Статус вектор)
      @param(AStream Поток)
    }
    procedure LoadFromStream(AStatus: IStatus; AStream: TStream);
    { Loads BLOB contents into the stream

      @param(AStatus Статус вектор)
      @param(AStream Поток)
    }
    procedure SaveToStream(AStatus: IStatus; AStream: TStream);
  end;

implementation

uses Math;

procedure TFbBlobHelper.LoadFromStream(AStatus: IStatus; AStream: TStream);
var
  xStreamSize: Integer;
  xReadLength: Integer;
  xBuffer: array [0 .. MAX_SEGMENT_SIZE] of Byte;
begin
  xStreamSize := AStream.Size;
  AStream.Position := 0;
  while xStreamSize <> 0 do
  begin
    xReadLength := Min(xStreamSize, MAX_SEGMENT_SIZE);
    AStream.ReadBuffer(xBuffer, xReadLength);
    Self.putSegment(AStatus, xReadLength, @xBuffer[0]);
    Dec(xStreamSize, xReadLength);
  end;
end;

procedure TFbBlobHelper.SaveToStream(AStatus: IStatus; AStream: TStream);
var
  xInfo: TFbBlobInfo;
  Buffer: array [0 .. MAX_SEGMENT_SIZE] of Byte;
  xBytesRead: Cardinal;
  xBufferSize: Cardinal;
begin
  AStream.Position := 0;
  xBufferSize := Min(SizeOf(Buffer), MAX_SEGMENT_SIZE);
  while True do
  begin
    case Self.getSegment(AStatus, xBufferSize, @Buffer[0], @xBytesRead) of
      IStatus.RESULT_OK:
        AStream.WriteBuffer(Buffer, xBytesRead);
      IStatus.RESULT_SEGMENT:
        AStream.WriteBuffer(Buffer, xBytesRead);
    else
      break;
    end;
  end;
end;

end.

Now you can greatly simplify operations with the BLOB type, forexample, the above function of saving Blob to the file can berewritten as follows:

procedure TLoadBlobFromFileFunc.execute(AStatus: IStatus;
  AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer);
var
  xInput: TInputPtr;
  xOutput: TOutputPtr;
  xFileName: string;
  xStream: TFileStream;
  att: IAttachment;
  trx: ITransaction;
  blob: IBlob;
begin
  xInput := AInMsg;
  xOutput := AOutMsg;
  if xInput.filenameNull then
  begin
    xOutput.blobDataNull := True;
    Exit;
  end;
  xOutput.blobDataNull := False;
  // We get the file name
  xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0,
    xInput.filename.len * 4);
  SetLength(xFileName, xInput.filename.len);
  // We read the file in the stream
  xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone);
  att := AContext.getAttachment(AStatus);
  trx := AContext.getTransaction(AStatus);
  blob := nil;
  try
    // We create a new Blob
    blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil);
    // We load the contents of the flow into Blob
    blob.LoadFromStream(AStatus, xStream);
    // Close Blob
    // CLOSE method in case of success combines the IBLOB interface
    // Therefore, the subsequent call is not needed
    blob.close(AStatus);
    blob := nil;
  finally
    if Assigned(blob) then
      blob.release;
    att.release;
    trx.release;
    xStream.Free;
  end;
end;

docnext count = 3

Connection and transaction context

If your external procedure, function or trigger should receivedata from your own database not through input arguments, but forexample through a request, then you will need to receive thecontext of the current connection and/or transactions. Inaddition, the context of the connection and transaction isnecessary if you work with the BLOB type.

The context of the current procedure, function or trigger istransmitted as a parameter with the type of IExternalContextinto the execute trigger method or function, or in the openprocedure method. The IExternalContext interface allows you toget the current connection using the getAttachment method, andthe current transaction using the getTransaction method. Thisgives greater flexibility to your UDR, for example, you canfulfill the current database requests while maintaining thecurrent session environment, in the same transaction or in a newtransaction created using the StartTransactionIExternalContext interface method. In the latter case, therequest will be made as if it is executed in an autonomoustransaction. In addition, you can comply with the externaldatabase using the transaction attached to the currenttransaction, i.e. Transactions with two phase confirmation (2PC).

As an example of working with the context of the function of thefunction, we will write a function that will serialize the resultof the execution of SELECT request in JSON format. It isdeclared as follows:

create function GetJson (
    sql_text blob sub_type text character set utf8,
    sql_dialect smallint not null default 3
)
returns returns blob sub_type text character set utf8
external name 'JsonUtils!getJson'
engine udr;

Since we allow us to execute an arbitrary SQL request, we do notknow in advance the format of the output fields, and we will notbe able to use a structure with fixed fields. In this case, wewill have to work with the IMessageMetadata interface. We havealready encountered it earlier, but this time we will have towork with it more thoroughly, since we must process all theexisting Firebird types.

Note
Comment

In JSON, you can encode almost any type of data except binary.For coding the types of char, varchar with octets none andblob sub_type binary we will encode binary contents usingbase64 coding, which can already be placed in JSON.

We will register the factory of our function:

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // We register a function
  AUdrPlugin.registerFunction(AStatus, 'getJson', TFunctionSimpleFactory<TJsonFunction>.Create());

  theirUnloadFlag := AUnloadFlagLocal;
  Result := @myUnloadFlag;
end;

Now we will declare structures for the input and output message, as well as the interface part of our function:

unit JsonFunc;

{$IFDEF FPC}
{$MODE objfpc}{$H+}
{$DEFINE DEBUGFPC}
{$ENDIF}

interface

uses
  Firebird,
  UdrFactories,
  FbTypes,
  FbCharsets,
  SysUtils,
  System.NetEncoding,
  System.Json;

{ *********************************************************
 create function GetJson (
   sql_text blob sub_type text,
   sql_dialect smallint not null default 3
 ) returns blob sub_type text character set utf8
 external name 'JsonUtils!getJson'
 engine udr;
 ********************************************************* }

type

  TInput = record
    SqlText: ISC_QUAD;
    SqlNull: WordBool;
    SqlDialect: Smallint;
    SqlDialectNull: WordBool;
  end;

  InputPtr = ^TInput;

  TOutput = record
    Json: ISC_QUAD;
    NullFlag: WordBool;
  end;

  OutputPtr = ^TOutput;

  // External Tsumargsfunction function.
  TJsonFunction = class(IExternalFunctionImpl)
  public
    procedure dispose(); override;

    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { Converts the whole into a line in accordance with the scale

      @param(AValue Meaning)
      @param(Scale Scale)
      @returns(Strokal representation of a scaled whole)
    }
    function MakeScaleInteger(AValue: Int64; Scale: Smallint): string;

    { Adds an encoded entry to an array of JSON objects

      @param(AStatus Vecto statusр)
      @param(AContext The context of external function)
      @param(AJson An array of JSON objects)
      @param(ABuffer Buffer records)
      @param(AMeta Metadata cursor)
      @param(AFormatSetting Setting date and time)
    }
    procedure writeJson(AStatus: IStatus; AContext: IExternalContext;
      AJson: TJsonArray; ABuffer: PByte; AMeta: IMessageMetadata;
      AFormatSettings: TFormatSettings);

    { External function

      @param (AStatus status vector)
      @PARAM (ACONTEXT Context of external function)
      @param (AINMSG input message)
      @PARAM (AUTMSG Office for output)
    }
    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;

The additional method of MakeScaleInteger is designed toconvert scalable numbers into a line, the` Writejson methodencods the next recording of the object selected from the cursorto Json and adds it to the massif of such objects.

In this example, we will need to implement the getCharSetmethod to indicate the desired encoding of the request for therequest of the current connection within the external function.By default, this internal request will be carried out in theencoding of the current connection. However, this is not entirelyconvenient. We do not know in advance what encoding the clientwill work, so we will have to determine the encoding of eachreturned string field and transcode into UTF8. To simplify thetask, we will immediately indicate to the context that we aregoing to work inside the procedure in UTF8 encoding.

procedure TJsonFunction.getCharSet(AStatus: IStatus; AContext: IExternalContext;
  AName: PAnsiChar; ANameSize: Cardinal);
begin
  // grind the previous encoding
  Fillchar (aname, anamesize, #0);
  // put the desired encoding
  Strcopy (aname, 'UTF8');
end;

We will describe these methods later, but for now we will givethe main method of execute to perform an external function.

procedure TJsonFunction.execute(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer);
var
  xFormatSettings: TFormatSettings;
  xInput: InputPtr;
  xOutput: OutputPtr;
  att: IAttachment;
  tra: ITransaction;
  stmt: IStatement;
  inBlob, outBlob: IBlob;
  inStream: TBytesStream;
  outStream: TStringStream;
  cursorMetaData: IMessageMetadata;
  rs: IResultSet;
  msgLen: Cardinal;
  msg: Pointer;
  jsonArray: TJsonArray;
begin
  xInput := AInMsg;
  xOutput := AOutMsg;
  // If one of the input arguments is null, then the result is null
  if xInput.SqlNull or xInput.SqlDialectNull then
  begin
    xOutput.NullFlag := True;
    Exit;
  end;
  xOutput.NullFlag := False;
  // setting date and time formatting
{$IFNDEF FPC}
  xFormatSettings := TFormatSettings.Create;
{$ELSE}
  xFormatSettings := DefaultFormatSettings;
{$ENDIF}
  xFormatSettings.DateSeparator := '-';
  xFormatSettings.TimeSeparator := ':';
  // We create a byte stream for Blob reading
  inStream := TBytesStream.Create(nil);
{$IFNDEF FPC}
  outStream := TStringStream.Create('', 65001);
{$ELSE}
  outStream := TStringStream.Create('');
{$ENDIF}
  jsonArray := TJsonArray.Create;
  // obtaining the current connection and transaction
  att := AContext.getAttachment(AStatus);
  tra := AContext.getTransaction(AStatus);
  stmt := nil;
  rs := nil;
  inBlob := nil;
  outBlob := nil;
  try
    // We read Blob in a stream
    inBlob := att.openBlob(AStatus, tra, @xInput.SqlText, 0, nil);
    inBlob.SaveToStream(AStatus, inStream);
    // The Close method, if successful, combines the IBLOB interface
    // Therefore, the subsequent call is not needed
    inBlob.close(AStatus);
    inBlob := nil;
    // Prepare the operator
    stmt := att.prepare(AStatus, tra, inStream.Size, @inStream.Bytes[0],
      xInput.SqlDialect, IStatement.PREPARE_PREFETCH_METADATA);
    // We get a weekend of metadata cursor
    cursorMetaData := stmt.getOutputMetadata(AStatus);
    // We’re getting off the cursor
    rs := stmt.openCursor(AStatus, tra, nil, nil, nil, 0);
    // We highlight the buffer of the desired size
    msgLen := cursorMetaData.getMessageLength(AStatus);
    msg := AllocMem(msgLen);
    try
      // We read each cursor record
      while rs.fetchNext(AStatus, msg) = IStatus.RESULT_OK do
      begin
        // and write it in json
        writeJson(AStatus, AContext, jsonArray, msg, cursorMetaData,
          xFormatSettings);
      end;
    finally
      // We release the buffer
      FreeMem(msg);
    end;
    // Close the cursor
    // CLOSE method in case of success combines the IRESULTSET interface
    // Therefore, the subsequent call is not needed
    rs.close(AStatus);
    rs := nil;
    // We release the prepared request
    // Free method, in case of success, combines the ISTATEMENT interface
    // Therefore, the subsequent call is not needed
    stmt.free(AStatus);
    stmt := nil;
    // We write json in stream
{$IFNDEF FPC}
    outStream.WriteString(jsonArray.ToJSON);
{$ELSE}
    outStream.WriteString(jsonArray.AsJSON);
{$ENDIF}
    // We write json on the blany Blob
    outBlob := att.createBlob(AStatus, tra, @xOutput.Json, 0, nil);
    outBlob.LoadFromStream(AStatus, outStream);
    // CLOSE method in case of success combines the IBLOB interface
    // Therefore, the subsequent call is not needed
    outBlob.close(AStatus);
    outBlob := nil;
  finally
    if Assigned(inBlob) then
      inBlob.release;
    if Assigned(stmt) then
      stmt.release;
    if Assigned(rs) then
      rs.release;
    if Assigned(outBlob) then
      outBlob.release;
    tra.release;
    att.release;
    jsonArray.Free;
    inStream.Free;
    outStream.Free;
  end;
end;

First of all, we get a current connection from the context of thefunction and the current transaction using the getAttachment andgetTransaction methods of interface IExternalContext. Then weread the contents of the BLOB for obtaining the text of the SQLrequest. The request is prepared using the Prepare method of the`IAttachment interface. The fifth parameter is transmitted bySQL dialect obtained from the input parameter of our function.The sixth parameter we convey the flagIStatement.PREPARE_PREFETCH_METADATA,which means that we want to get ametadata cursor along with the result of the preparation of therequest. We get the weekend of the metadata cursor using thegetOutputMetadata interface` IStatement`.

Note
Comment

In fact, the getoutPutmetadata method will return the weekendmetadata in any case. The flagIStatement.PREPARE_PREFETCH_METADATA will force metadata alongwith the result of preparing a request for one network package.Since we comply with a request within the current connection ofany network exchange, and this is not fundamentally.

Next, open the cursor using the openCursor method as part ofthe current transaction (parameter 2). We get the size of theoutput buffer to the result of the cursor using thegetMessageLength interface` IMessageMetadata`. This allows youto highlight the memory under the buffer, which we will freeimmediately after the latching of the last recording of thecursor.

The cursor records are read using the fetchNext method fromIResultSet. This method fills the msg buffer with the valuesof the cursor fields and returns IStatus.RESULT_OK until thecursor records are over. Each record read is transmitted to theWritejson method, which adds an object like TJsonObject with aserialized cursor recording in the TJsonArray array.

After completing the work with the cursor, we close it by theclose method, convert an array of json objects into a line,write it to the output stream, which we write down in the Bloboutput.

Now let’s analyze the writeJson method. The IUtil object willneed us in order to receive functions to decode the date andtime. This method actively involves working with metadata outputfields of the cursor using the IMessageMetadata interface.First of all, we create an object type TJsonObject into whichwe will record the values of the fields of the current record. Asthe names of the keys, we will use the alias of fields from thecursor. If Nullflag is installed, then we write the value of NULLfor the key and go to the next field, otherwise we analyze thefield type and write its value in JSON.

function TJsonFunction.MakeScaleInteger(AValue: Int64; Scale: Smallint): string;
var
  L: Integer;
begin
  Result := AValue.ToString;
  L := Result.Length;
  if (-Scale >= L) then
    Result := '0.' + Result.PadLeft(-Scale, '0')
  else
    Result := Result.Insert(Scale + L, '.');
end;


procedure TJsonFunction.writeJson(AStatus: IStatus; AContext: IExternalContext;
  AJson: TJsonArray; ABuffer: PByte; AMeta: IMessageMetadata;
  AFormatSettings: TFormatSettings);
var
  jsonObject: TJsonObject;
  i: Integer;
  FieldName: string;
  NullFlag: WordBool;
  fieldType: Cardinal;
  pData: PByte;
  util: IUtil;
  metaLength: Integer;
  // types
  CharBuffer: TBytes;
  charLength: Smallint;
  charset: TFBCharSet;
  StringValue: string;
  SmallintValue: Smallint;
  IntegerValue: Integer;
  BigintValue: Int64;
  Scale: Smallint;
  SingleValue: Single;
  DoubleValue: Double;
  Dec16Value: FB_DEC16Ptr;
  xDec16Buf: array[0..IDecFloat16.STRING_SIZE-1] of AnsiChar;
  xDecFloat16: IDecFloat16;
  Dec34Value: FB_DEC34Ptr;
  xDec34Buf: array[0..IDecFloat34.STRING_SIZE-1] of AnsiChar;
  xDecFloat34: IDecFloat34;
  BooleanValue: Boolean;
  DateValue: ISC_DATE;
  TimeValue: ISC_TIME;
  TimeValueTz: ISC_TIME_TZPtr;
  TimestampValue: ISC_TIMESTAMP;
  TimestampValueTz: ISC_TIMESTAMP_TZPtr;
  tzBuffer: array[0..63] of AnsiChar;
  DateTimeValue: TDateTime;
  year, month, day: Cardinal;
  hours, minutes, seconds, fractions: Cardinal;
  blobId: ISC_QUADPtr;
  BlobSubtype: Smallint;
  att: IAttachment;
  tra: ITransaction;
  blob: IBlob;
  textStream: TStringStream;
  binaryStream: TBytesStream;
{$IFDEF FPC}
  base64Stream: TBase64EncodingStream;
  xFloatJson: TJSONFloatNumber;
{$ENDIF}
  xInt128: IInt128;
  Int128Value: FB_I128Ptr;
  xInt128Buf: array[0..IInt128.STRING_SIZE-1] of AnsiChar;
begin
  // We get ITIL
  util := AContext.getMaster().getUtilInterface();
  // We create an object of Tjsonobject in which we will
  // Write the value of the recording fields
  jsonObject := TJsonObject.Create;
  for i := 0 to AMeta.getCount(AStatus) - 1 do
  begin
    // We get Alias Fields in the request
    FieldName := AMeta.getAlias(AStatus, i);
    NullFlag := PWordBool(ABuffer + AMeta.getNullOffset(AStatus, i))^;
    if NullFlag then
    begin
      // If Null we write it in json and move on to the next field
{$IFNDEF FPC}
      jsonObject.AddPair(FieldName, TJsonNull.Create);
{$ELSE}
      jsonObject.Add(FieldName, TJsonNull.Create);
{$ENDIF}
      continue;
    end;
    // We get a pointer to these fields
    pData := ABuffer + AMeta.getOffset(AStatus, i);
    // аналог AMeta->getType(AStatus, i) & ~1
    fieldType := AMeta.getType(AStatus, i) and not 1;
    case fieldType of
      // VARCHAR
      SQL_VARYING:
        begin
          // Boofer size for Varchar
          metaLength := AMeta.getLength(AStatus, i);
          SetLength(CharBuffer, metaLength);
          charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
          charLength := PSmallint(pData)^;
          // Binary data is encoded in Base64
          if charset = CS_BINARY then
          begin
{$IFNDEF FPC}
            StringValue := TNetEncoding.base64.EncodeBytesToString((pData + 2),
              charLength);
{$ELSE}
            // For Varchar first 2 bytes - length in bytes
            // therefore copy to the buffer starting with 3 bytes
            Move((pData + 2)^, CharBuffer[0], metaLength);
            StringValue := charset.GetString(CharBuffer, 0, charLength);
            StringValue := EncodeStringBase64(StringValue);
{$ENDIF}
          end
          else
          begin
            // For Varchar first 2 bytes - length in bytes
            // therefore copy to the buffer starting with 3 bytes
            Move((pData + 2)^, CharBuffer[0], metaLength);
            StringValue := charset.GetString(CharBuffer, 0, charLength);
          end;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // CHAR
      SQL_TEXT:
        begin
          // Boofer size for Char
          metaLength := AMeta.getLength(AStatus, i);
          SetLength(CharBuffer, metaLength);
          charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
          Move(pData^, CharBuffer[0], metaLength);
          // Binary data encoded in Base64
          if charset = CS_BINARY then
          begin
{$IFNDEF FPC}
            StringValue := TNetEncoding.base64.EncodeBytesToString(pData,
              metaLength);
{$ELSE}
            StringValue := charset.GetString(CharBuffer, 0, metaLength);
            StringValue := EncodeStringBase64(StringValue);
{$ENDIF}
          end
          else
          begin
            StringValue := charset.GetString(CharBuffer, 0, metaLength);
            charLength := metaLength div charset.GetCharWidth;
            SetLength(StringValue, charLength);
          end;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // FLOAT
      SQL_FLOAT:
        begin
          SingleValue := PSingle(pData)^;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, TJSONNumber.Create(SingleValue));
{$ELSE}
          jsonObject.Add(FieldName, TJSONFloatNumber.Create(SingleValue));
{$ENDIF}
        end;
      // DOUBLE PRECISION
      // DECIMAL(p, s), where p = 10..15 in 1 dialect
      SQL_DOUBLE, SQL_D_FLOAT:
        begin
          DoubleValue := PDouble(pData)^;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, TJSONNumber.Create(DoubleValue));
{$ELSE}
          jsonObject.Add(FieldName, TJSONFloatNumber.Create(DoubleValue));
{$ENDIF}
        end;
      // DECFLOAT(16)
      SQL_DEC16:
        begin
          Dec16Value := FB_Dec16Ptr(pData);
          xDecFloat16 := util.getDecFloat16(AStatus);
          xDecFloat16.toString(AStatus, Dec16Value, IDecFloat16.STRING_SIZE, @xDec16Buf[0]);
          StringValue := AnsiString(@xDec16Buf[0]);
          StringValue := Trim(StringValue);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // DECFLOAT(34)
      SQL_DEC34:
        begin
          Dec34Value := FB_Dec34Ptr(pData);
          xDecFloat34 := util.getDecFloat34(AStatus);
          xDecFloat34.toString(AStatus, Dec34Value, IDecFloat34.STRING_SIZE, @xDec34Buf[0]);
          StringValue := AnsiString(@xDec34Buf[0]);
          StringValue := Trim(StringValue);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // INTEGER
      // NUMERIC(p, s), где p = 1..4
      SQL_SHORT:
        begin
          Scale := AMeta.getScale(AStatus, i);
          SmallintValue := PSmallint(pData)^;
          if (Scale = 0) then
          begin
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(SmallintValue));
{$ELSE}
            jsonObject.Add(FieldName, SmallintValue);
{$ENDIF}
          end
          else
          begin
            StringValue := MakeScaleInteger(SmallintValue, Scale);
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(StringValue));
{$ELSE}
            xFloatJson := TJSONFloatNumber.Create(0);
            xFloatJson.AsString := StringValue;
            jsonObject.Add(FieldName, xFloatJson);
{$ENDIF}
          end;
        end;
      // INTEGER
      // NUMERIC(p, s), где p = 5..9
      // DECIMAL(p, s), где p = 1..9
      SQL_LONG:
        begin
          Scale := AMeta.getScale(AStatus, i);
          IntegerValue := PInteger(pData)^;
          if (Scale = 0) then
          begin
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(IntegerValue));
{$ELSE}
            jsonObject.Add(FieldName, IntegerValue);
{$ENDIF}
          end
          else
          begin
            StringValue := MakeScaleInteger(IntegerValue, Scale);
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(StringValue));
{$ELSE}
            xFloatJson := TJSONFloatNumber.Create(0);
            xFloatJson.AsString := StringValue;
            jsonObject.Add(FieldName, xFloatJson);
{$ENDIF}
          end;
        end;
      // BIGINT
      // NUMERIC(p, s), where p = 10..18 in dialect 3
      // DECIMAL(p, s), where p = 10..18 in dialect 3
      SQL_INT64:
        begin
          Scale := AMeta.getScale(AStatus, i);
          BigintValue := Pint64(pData)^;
          if (Scale = 0) then
          begin
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(BigintValue));
{$ELSE}
            jsonObject.Add(FieldName, BigintValue);
{$ENDIF}
          end
          else
          begin
            StringValue := MakeScaleInteger(BigintValue, Scale);
{$IFNDEF FPC}
            jsonObject.AddPair(FieldName, TJSONNumber.Create(StringValue));
{$ELSE}
            xFloatJson := TJSONFloatNumber.Create(0);
            xFloatJson.AsString := StringValue;
            jsonObject.Add(FieldName, xFloatJson);
{$ENDIF}
          end;
        end;
      SQL_INT128:
        begin
          Scale := AMeta.getScale(AStatus, i);
          Int128Value := FB_I128Ptr(pData);
          xInt128 := util.getInt128(AStatus);
          xInt128.toString(AStatus, Int128Value, Scale, IInt128.STRING_SIZE, @xInt128Buf[0]);
          StringValue := AnsiString(@xInt128Buf[0]);
          StringValue := Trim(StringValue);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // TIMESTAMP
      SQL_TIMESTAMP:
        begin
          TimestampValue := PISC_TIMESTAMP(pData)^;
          // we get the components of the date-time
          util.decodeDate(TimestampValue.timestamp_date, @year, @month, @day);
          util.decodeTime(TimestampValue.timestamp_time, @hours, @minutes, @seconds,
            @fractions);
          // We get a date-time in our delphi type
          DateTimeValue := EncodeDate(year, month, day) +
            EncodeTime(hours, minutes, seconds, fractions div 10);
          // We format a date-time according to a given format
          StringValue := FormatDateTime('yyyy/mm/dd hh:nn:ss', DateTimeValue,
            AFormatSettings);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // TIMESTAMP WITH TIME_ZONE
      SQL_TIMESTAMP_TZ:
        begin
          TimestampValueTz := ISC_TIMESTAMP_TZPtr(pData);
          // We get the components of the date-time and the time zone
          util.decodeTimeStampTz(AStatus, TimestampValueTz, @year, @month, @day, @hours, @minutes, @seconds,
            @fractions, 64, @tzBuffer[0]);

          // We get a date-time in our delphi type
          DateTimeValue := EncodeDate(year, month, day) +
            EncodeTime(hours, minutes, seconds, fractions div 10);
          // Format the date-time according to the given format + time zone
          StringValue := FormatDateTime('yyyy/mm/dd hh:nn:ss', DateTimeValue,
            AFormatSettings) + ' ' + AnsiString(@tzBuffer[0]);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // DATE
      SQL_DATE:
        begin
          DateValue := PISC_DATE(pData)^;
          // We get the components of the date
          util.decodeDate(DateValue, @year, @month, @day);
          // We get a date in the native type Delphi
          DateTimeValue := EncodeDate(year, month, day);
          // We format the date according to the given format
          StringValue := FormatDateTime('yyyy/mm/dd', DateTimeValue,
            AFormatSettings);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // TIME
      SQL_TIME:
        begin
          TimeValue := PISC_TIME(pData)^;
          // We get the components of the time
          util.decodeTime(TimeValue, @hours, @minutes, @seconds, @fractions);
          // We get time in the native type Delphi
          DateTimeValue := EncodeTime(hours, minutes, seconds,
            fractions div 10);
          // We format the time according to a given format
          StringValue := FormatDateTime('hh:nn:ss', DateTimeValue,
            AFormatSettings);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // TIME WITH TIME ZONE
      SQL_TIME_TZ:
        begin
          TimeValueTz := ISC_TIME_TZPtr(pData);
          // We get the components of the time and the time zone
          util.decodeTimeTz(AStatus, TimeValueTz, @hours, @minutes, @seconds,
            @fractions, 64, @tzBuffer[0]);
          // We get time in the native type Delphi
          DateTimeValue := EncodeTime(hours, minutes, seconds,
            fractions div 10);
          // We format the time according to a given format + time zone
          StringValue := FormatDateTime('hh:nn:ss', DateTimeValue,
            AFormatSettings) + ' ' + AnsiString(@tzBuffer[0]);
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
      // BOOLEAN
      SQL_BOOLEAN:
        begin
          BooleanValue := PBoolean(pData)^;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, TJsonBool.Create(BooleanValue));
{$ELSE}
          jsonObject.Add(FieldName, BooleanValue);
{$ENDIF}
        end;
      // BLOB
      SQL_BLOB, SQL_QUAD:
        begin
          BlobSubtype := AMeta.getSubType(AStatus, i);
          blobId := ISC_QUADPtr(pData);
          att := AContext.getAttachment(AStatus);
          tra := AContext.getTransaction(AStatus);
          blob := att.openBlob(AStatus, tra, blobId, 0, nil);
          try
            if BlobSubtype = 1 then
            begin
              // lyrics
              charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
              // Create a stream with a given encoding
{$IFNDEF FPC}
              textStream := TStringStream.Create('', charset.GetCodePage);
              try
                blob.SaveToStream(AStatus, textStream);
                blob.close(AStatus);
                blob := nil;
                StringValue := textStream.DataString;
              finally
                textStream.Free;
              end;
{$ELSE}
              binaryStream := TBytesStream.Create(nil);
              try
                blob.SaveToStream(AStatus, binaryStream);
                blob.close(AStatus);
                blob := nil;
                StringValue := TEncoding.UTF8.GetString(binaryStream.Bytes, 0,
                  binaryStream.Size);
              finally
                binaryStream.Free;
              end;
{$ENDIF}
            end
            else
            begin
{$IFNDEF FPC}
              // all other subtypes are considered binary
              binaryStream := TBytesStream.Create;
              try
                blob.SaveToStream(AStatus, binaryStream);
                blob.close(AStatus);
                blob := nil;
                // encode the string in base64
                StringValue := TNetEncoding.base64.EncodeBytesToString
                  (binaryStream.Memory, binaryStream.Size);
              finally
                binaryStream.Free;
              end
{$ELSE}
              textStream := TStringStream.Create('');
              base64Stream := TBase64EncodingStream.Create(textStream);
              try
                blob.SaveToStream(AStatus, base64Stream);
                blob.close(AStatus);
                blob := nil;
                StringValue := textStream.DataString;
              finally
                base64Stream.Free;
                textStream.Free;
              end;
{$ENDIF}
            end;
          finally
            if Assigned(blob) then blob.release;
            if Assigned(tra) then tra.release;
            if Assigned(att) then att.release;
          end;
{$IFNDEF FPC}
          jsonObject.AddPair(FieldName, StringValue);
{$ELSE}
          jsonObject.Add(FieldName, StringValue);
{$ENDIF}
        end;
    end;
  end;
  // Adding an entry in json format to array
{$IFNDEF FPC}
  AJson.AddElement(jsonObject);
{$ELSE}
  AJson.Add(jsonObject);
{$ENDIF}
end;
Note
Comment

Listing the type TFbType is absent in the standard moduleFirebird.pas. However, it is not convenient to use numericalvalues, so I wrote a special module FbTypesin which I placed some additional types for convenience.

The enumeration of TFBCharSet is also absent in the Firebird.pas module.I wrote a separate module FbCharsetsin which this transfer is posted. In addition, for this type, aspecial helper is written, which contains functions for obtainingthe name of the set of characters, the code page, the size of thesymbol in bytes, obtaining the TEncoding class in the necessaryencoding, as well as the function for converting the byte massifinto the Delphi unicode line.

For lines of the type CHAR and VARCHAR, check the encoding,if its encoding is OCTETS, then we encode the line with thebase64 algorithm, otherwise we convert data from the buffer tothe Delphi line. Please note that for the type of VARCHAR thefirst 2 bytes contain the length of the line in the characters.

Types of SMALLINT, INTEGER, BIGINT can be as ordinaryintegers, so scalable. The scale of the number can be obtained bythe getScale interface IMessageMetadata. If the scale is notequal to 0, then a special processing of the number is required,which is carried out by the MakeScaleInteger.

Types DATE,` TIME` and TIMESTAMP are decoded on thecomponents of the date and time using the methods decodeDateand decodeTime of interface IUtil. We use parts of the date andtime to receive the date-time in the standard Delphi typeTDateTime.

With the BLOB type, we work through Delphi flows. If Blob isbinary, then we create a stream like TBytesStream. Theresulting an array of byte is encoded using the base64 algorithm.If BLOB is textual, then we use a specialized streamTStringStream for lines, which allows you to take into accountthe code page. We get the code page from the BLOB field encoding.

To work with the data of INT128 there is a special interfaceIInt128. It can be obtained by calling the getInt128 ofinterface IUtil interface. This type appeared in Firebird 4.0and is designed to accurately represent very large numbers. Thereis no direct type of data in Delphi, which could work with thistype, so we simply display its string performance.

To work with the types of DECFLOAT(16) and DECFLOAT(34)there are special interfaces IDecFloat16 and` IDecFloat34`.They can be obtained by calling getDecFloat16 orgetDecFloat34 of interface IUtil. These types are available fromFirebird 4.0. There are no direct types of data in Delphi thatcould work with these types. These types can be displayed in BCDor presented in the form of a string.

Types of TIME WITH TIME ZONE and TIMESTAMP WITH TIME ZONE aredecoded on the components of the date and time, as well as thename of the time zone, using the decodeTimeStampTz anddecodeTimeTz methods. We use parts of the date and time to receivethe date-time in the standard Delphi type TDateTime. Next, weconvert the value of this type into the line and add the name ofthe time zone to it.

Appendices

License notice

The contents of this Documentation are subject to PublicDocumentation License Version 1.0 (hereinafter referred to as the"License");you may use this Documentation only if you comply with the termsof this License.Copies of the license are available at https://www.firebirdsql.org/pdfmanual/pdl.pdf (PDF) and https://www.firebirdsql.org/manual/pdl.html (HTML).

The original documentation is called Writing UDR Firebird in Pascal.

The original authors of the original documentation are: DenisSimonov.The authors of the text in Russian are Denis Simonov.

Author(s): Denis Simonov.

Portions created by Denis Simonov are copyright © 2018–2023.All rights reserved.

(Author contacts: sim-mail at list dot ru).

Contributor(s): Martin Köditz.

Translation into English. Portions created by Martin Köditz are copyright © 2023.All rights reserved.

(Author contacts: martin koeditz at it syn dot de).

Document history

The exact file history is recorded in the firebird-documentation git repository; see https://github.com/FirebirdSQL/firebird-documentation

Revision History

1.0.0

22 Sep 2023

MK

English translation of the Russian document by Martin Köditz.

1.0.0-ru

21 Sep 2023

DS

Document’s first version. The original was contributed by Denis Simonov in Russian language.