FirebirdSQL logo
  • Anglaiskeyboard_arrow_down
 Structure UDRFactories 

Getting and Using IMessageMetadata

Instances of objects that implement the IMessageMetadata interface for input andoutput variables can be obtained from the IRoutineMetadata interface. It is notpassed directly to an instance of a procedure, function, or trigger. This must be doneexplicitly in the factory of the appropriate type. For example:

  // Factory for instantiating the external function TSumArgsFunction
  TSumArgsFunctionFactory = class(IUdrFunctionFactoryImpl)
    // Called when the factory is destroyed
    procedure dispose(); override;

    { Executed each time an external function is loaded into the metadata cache

      @param(AStatus Status vector)
      @param(AContext External function execution context)
      @param(AMetadata External function metadata)
      @param(AInBuilder Message builder for input metadata)
      @param(AOutBuilder Message builder for output metadata)
    }
    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    { Creating a new instance of the external function TSumArgsFunction

      @param(AStatus Status vector)
      @param(AContext External function execution context)
      @param(AMetadata External function metadata)
      @returns(External function instance)
    }
    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;

  // External function TSumArgsFunction.
  TSumArgsFunction = class(IExternalFunctionImpl)
  private
    FMetadata: IRoutineMetadata;
  public
    property Metadata: IRoutineMetadata read FMetadata write FMetadata;
  public
    // Called when the function instance is destroyed
    procedure dispose(); override;

    { This method is called just before execute and tells the kernel
      our requested character set to communicate within this method.
      During this call, the context uses the character set obtained
      from ExternalEngine::getCharSet.

      @param(AStatus Status vector)
      @param(AContext External function execution context)
      @param(AName Character set name)
      @param(AName Character set name length)
    }
    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { Executing an external function

      @param(AStatus Status vector)
      @param(AContext External function execution context)
      @param(AInMsg Pointer to input message)
      @param(AOutMsg Pointer to output message)
    }
    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;
........................

{ TSumArgsFunctionFactory }

procedure TSumArgsFunctionFactory.dispose;
begin
  Destroy;
end;

function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := TSumArgsFunction.Create();
  with Result as TSumArgsFunction do
  begin
    Metadata := AMetadata;
  end;
end;

procedure TSumArgsFunctionFactory.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

Instances of IMessageMetadata for input and output variables can be obtained usingthe getInputMetadata and getOutputMetadata methods from IRoutineMetadata.Metadata for the fields of the table on which the trigger is written can be obtainedusing the getTriggerMetadata method.

Important
Important

Please note that the lifecycle of IMessageMetadata interface objects is controlledusing reference counting. It inherits the IReferenceCounted interface. ThegetInputMetadata and getOutputMetadata methods increase the reference count by 1for the returned objects, so after finishing using these objects you need to decreasethe reference count for the xInputMetadata and xOutputMetadata variables by callingthe release method.

To obtain the value of the corresponding input argument, we need to use addressarithmetic. To do this, we get the offset from IMessageMetadata using the getOffsetmethod and add it to the buffer address for the input message. Then we reduce theresulting result to the corresponding typed pointer. Approximately the same scheme ofwork for obtaining null indicators of arguments, only the getNullOffset method isused to obtain offsets.

........................

procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer);
var
  n1, n2, n3: Integer;
  n1Null, n2Null, n3Null: WordBool;
  Result: Integer;
  resultNull: WordBool;
  xInputMetadata, xOutputMetadata: IMessageMetadata;
begin
  xInputMetadata := FMetadata.getInputMetadata(AStatus);
  xOutputMetadata := FMetadata.getOutputMetadata(AStatus);
  try
    // get the values of the input arguments by their offsets
    n1 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 0))^;
    n2 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 1))^;
    n3 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 2))^;
    // get values of null indicators of input arguments by their offsets
    n1Null := PWordBool(PByte(AInMsg) +
      xInputMetadata.getNullOffset(AStatus, 0))^;
    n2Null := PWordBool(PByte(AInMsg) +
      xInputMetadata.getNullOffset(AStatus, 1))^;
    n3Null := PWordBool(PByte(AInMsg) +
      xInputMetadata.getNullOffset(AStatus, 2))^;
    //by default, the output argument is NULL, so we set it to nullFlag
    resultNull := True;
    Result := 0;
    // if one of the arguments is NULL, then the result is NULL
    // otherwise, we calculate the sum of the arguments
    if not(n1Null or n2Null or n3Null) then
    begin
      Result := n1 + n2 + n3;
      // once there is a result, then reset the NULL flag
      resultNull := False;
    end;
    PWordBool(PByte(AInMsg) + xOutputMetadata.getNullOffset(AStatus, 0))^ :=
      resultNull;
    PInteger(PByte(AInMsg) + xOutputMetadata.getOffset(AStatus, 0))^ := Result;
  finally
    xInputMetadata.release;
    xOutputMetadata.release;
  end;
end;
Note
Comment

In the Connection and Transaction Context chapter,great example to work with various SQL types usinginterface IMessageMetadata.

Factories

You have already encountered factories before. It’s time to consider themin detail.

Factories are designed to create instances of procedures, functions,or triggers. The factory class must inherit from one of the IUdrProcedureFactory,IUdrFunctionFactory or IUdrTriggerFactory interfaces depending on the UDR type.Instances of these must be registered as UDR entry points in the firebird_udr_pluginfunction.

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // register our function
  AUdrPlugin.registerFunction(AStatus, 'sum_args',
    TSumArgsFunctionFactory.Create());
  // register our procedure
  AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create());
  // register our trigger
  AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
    TMyTriggerFactory.Create());

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

In this example, the TSumArgsFunctionFactory class inherits theIUdrFunctionFactory interface, TGenRowsFactory inherits theIUdrProcedureFactory interface, and TMyTriggerFactory inheritsthe IUdrTriggerFactory interface.

Factory instances are created and bound to entry points the first time an externalprocedure, function, or trigger is loaded. This happens once per Firebird processcreation. Thus, for the SuperServer architecture, for all connections there will beexactly one factory instance associated with each entry point; for Classic, this numberof instances will be multiplied by the number of connections.

When writing factory classes, you need to implement the setup and newItem methodsfrom the IUdrProcedureFactory, IUdrFunctionFactory or IUdrTriggerFactoryinterfaces.

  IUdrFunctionFactory = class(IDisposable)
    const VERSION = 3;

    procedure setup(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata; inBuilder: IMetadataBuilder;
        outBuilder: IMetadataBuilder);

    function newItem(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata): IExternalFunction;
  end;

  IUdrProcedureFactory = class(IDisposable)
    const VERSION = 3;

    procedure setup(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata; inBuilder: IMetadataBuilder;
        outBuilder: IMetadataBuilder);

    function newItem(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata): IExternalProcedure;
  end;

  IUdrTriggerFactory = class(IDisposable)
    const VERSION = 3;

    procedure setup(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata; fieldsBuilder: IMetadataBuilder);

    function newItem(status: IStatus; context: IExternalContext;
      metadata: IRoutineMetadata): IExternalTrigger;
  end;

Also, since these interfaces inherit the IDisposable interface, you must alsoimplement the dispose method. This means that Firebird will unload the factory itselfwhen needed. In the dispose method, you need to place code that releases resourceswhen the factory instance is destroyed. To simplify the implementation of interfacemethods, it is convenient to use the classes IUdrProcedureFactoryImpl,IUdrFunctionFactoryImpl, IUdrTriggerFactoryImpl. Let’s consider each of the methodsin more detail.

docnext count = 11

Method newItem

The newItem method is called to instantiate an external procedure, function, ortrigger. A UDR is instantiated when it is loaded into the metadata cache, i.e.the first time a procedure, function, or trigger is called. Currently, themetadata cache is per-connection per-connection cache for all serverarchitectures.

The procedure and function metadata cache is associated with their names in thedatabase. For example, two external functions with different names but the sameentry points will be different instances of IUdrFunctionFactory. The entrypoint consists of the name of the external module and the name under which thefactory is registered. How this can be used will be shown later.

The newItem method is passed a pointer to the status vector, the UDR executioncontext, and UDR metadata.

In the simplest case, the implementation of this method is trivial

function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  // create an instance of an external function
  Result := TSumArgsFunction.Create();
end;

With IRoutineMetadata you can get the input and output message format, UDR bodyand other metadata. Metadata can be passed to the created UDR instance. In thiscase, you need to add a field for storing metadata to an instance of the classthat implements your UDR.

  // External function TSumArgsFunction.
  TSumArgsFunction = class(IExternalFunctionImpl)
  private
    FMetadata: IRoutineMetadata;
  public
    property Metadata: IRoutineMetadata read FMetadata write FMetadata;
  public
  ...
  end;

In this case, the implementation of the newItem method looks like this:

function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := TSumArgsFunction.Create();
  with Result as TSumArgsFunction do
  begin
    Metadata := AMetadata;
  end;
end;

Creating instances of UDRs depending on their declaration

In the newItem method, you can create different instances of an externalprocedure or function, depending on its declaration in PSQL. To do this, you canuse the information obtained from IMessageMetadata.

Suppose we want to implement a PSQL package with the same set of externalfunctions for squaring a number for various data types and a singleentry point.

SET TERM ^ ;

CREATE OR ALTER PACKAGE MYUDR2
AS
begin
  function SqrSmallint(AInput SMALLINT) RETURNS INTEGER;
  function SqrInteger(AInput INTEGER) RETURNS BIGINT;
  function SqrBigint(AInput BIGINT) RETURNS BIGINT;
  function SqrFloat(AInput FLOAT) RETURNS DOUBLE PRECISION;
  function SqrDouble(AInput DOUBLE PRECISION) RETURNS DOUBLE PRECISION;
end^

RECREATE PACKAGE BODY MYUDR2
AS
begin
  function SqrSmallint(AInput SMALLINT) RETURNS INTEGER
  external name 'myudr2!sqrt_func'
  engine udr;

  function SqrInteger(AInput INTEGER) RETURNS BIGINT
  external name 'myudr2!sqrt_func'
  engine udr;

  function SqrBigint(AInput BIGINT) RETURNS BIGINT
  external name 'myudr2!sqrt_func'
  engine udr;

  function SqrFloat(AInput FLOAT) RETURNS DOUBLE PRECISION
  external name 'myudr2!sqrt_func'
  engine udr;

  function SqrDouble(AInput DOUBLE PRECISION) RETURNS DOUBLE PRECISION
  external name 'myudr2!sqrt_func'
  engine udr;

end
^

SET TERM ; ^

To test the functions, we will use the following query

select
  myudr2.SqrSmallint(1) as n1,
  myudr2.SqrInteger(2) as n2,
  myudr2.SqrBigint(3) as n3,
  myudr2.SqrFloat(3.1) as n4,
  myudr2.SqrDouble(3.2) as n5
from rdb$database

To make it easier to work with IMessageMetadata and buffers, you can write aconvenient wrapper or try to use IMessageMetadata and structures to displaymessages together. Here we will show the use of the second method.

The implementation of this idea is quite simple: in the function factory, we willcreate different function instances depending on the type of the input argument.In modern versions of Delphi, you can use generics to generalize code.

.......................
type
  // the structure to which the input message will be mapped
  TSqrInMsg<T> = record
    n1: T;
    n1Null: WordBool;
  end;

  // the structure to which the output message will be mapped
  TSqrOutMsg<T> = record
    result: T;
    resultNull: WordBool;
  end;

  // Factory for instantiating external function TSqrFunction
  TSqrFunctionFactory = class(IUdrFunctionFactoryImpl)
    // Called when the factory is destroyed
    procedure dispose(); override;

    { Executed each time an external function is loaded into the metadata cache.
      Used to change the format of the input and output messages.

      @param(AStatus Status vector)
      @param(AContext External function execution context)
      @param(AMetadata External function metadata)
      @param(AInBuilder Message builder for input metadata)
      @param(AOutBuilder Message builder for output metadata)
    }
    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    { Creating a new instance of an external TSqrFunction

      @param(AStatus Status vector)
      @param(AContext External function execution context)
      @param(AMetadata External function metadata)
      @returns(External function instance)
    }
    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;


  // External function TSqrFunction.
  TSqrFunction<TIn, TOut> = class(IExternalFunctionImpl)
  private
    function sqrExec(AIn: TIn): TOut; virtual; abstract;
  public
    type
      TInput = TSqrInMsg<TIn>;
      TOutput = TSqrOutMsg<TOut>;
      PInput = ^TInput;
      POutput = ^TOutput;
    // Called when the function instance is destroyed
    procedure dispose(); override;

    { This method is called just before execute and
      tells the kernel our requested character set to communicate within this
      method. During this call, the context uses the character set obtained from
      ExternalEngine::getCharSet.

      @param(AStatus Status vector)
      @param(AContext External function execution context)
      @param(AName Character set name)
      @param(AName Character set name length)
    }
    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { Executing an external function

      @param(AStatus Status vector)
      @param(AContext External function execution context)
      @param(AInMsg Pointer to input message)
      @param(AOutMsg Pointer to output message)
    }
    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;

  TSqrExecSmallint = class(TSqrFunction<Smallint, Integer>)
  public
    function sqrExec(AIn: Smallint): Integer; override;
  end;

  TSqrExecInteger = class(TSqrFunction<Integer, Int64>)
  public
    function sqrExec(AIn: Integer): Int64; override;
  end;

  TSqrExecInt64 = class(TSqrFunction<Int64, Int64>)
  public
    function sqrExec(AIn: Int64): Int64; override;
  end;

  TSqrExecFloat = class(TSqrFunction<Single, Double>)
  public
    function sqrExec(AIn: Single): Double; override;
  end;

  TSqrExecDouble = class(TSqrFunction<Double, Double>)
  public
    function sqrExec(AIn: Double): Double; override;
  end;

implementation

uses
  SysUtils, FbTypes, System.TypInfo;

{ TSqrFunctionFactory }

procedure TSqrFunctionFactory.dispose;
begin
  Destroy;
end;

function TSqrFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
var
  xInputMetadata: IMessageMetadata;
  xInputType: TFBType;
begin
  // get the type of the input argument
  xInputMetadata := AMetadata.getInputMetadata(AStatus);
  xInputType := TFBType(xInputMetadata.getType(AStatus, 0));
  xInputMetadata.release;
  // create an instance of a function depending on the type
  case xInputType of
    SQL_SHORT:
      result := TSqrExecSmallint.Create();

    SQL_LONG:
      result := TSqrExecInteger.Create();
    SQL_INT64:
      result := TSqrExecInt64.Create();

    SQL_FLOAT:
      result := TSqrExecFloat.Create();
    SQL_DOUBLE, SQL_D_FLOAT:
      result := TSqrExecDouble.Create();
  else
    result := TSqrExecInt64.Create();
  end;

end;

procedure TSqrFunctionFactory.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TSqrFunction }

procedure TSqrFunction<TIn, TOut>.dispose;
begin
  Destroy;
end;

procedure TSqrFunction<TIn, TOut>.execute(AStatus: IStatus;
  AContext: IExternalContext; AInMsg, AOutMsg: Pointer);
var
  xInput: PInput;
  xOutput: POutput;
begin
  xInput := PInput(AInMsg);
  xOutput := POutput(AOutMsg);
  xOutput.resultNull := True;
  if (not xInput.n1Null) then
  begin
    xOutput.resultNull := False;
    xOutput.result := Self.sqrExec(xInput.n1);
  end;
end;

procedure TSqrFunction<TIn, TOut>.getCharSet(AStatus: IStatus;
  AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal);
begin
end;


{ TSqrtExecSmallint }

function TSqrExecSmallint.sqrExec(AIn: Smallint): Integer;
begin
  Result := AIn * AIn;
end;

{ TSqrExecInteger }

function TSqrExecInteger.sqrExec(AIn: Integer): Int64;
begin
  Result := AIn * AIn;
end;

{ TSqrExecInt64 }

function TSqrExecInt64.sqrExec(AIn: Int64): Int64;
begin
  Result := AIn * AIn;
end;

{ TSqrExecFloat }

function TSqrExecFloat.sqrExec(AIn: Single): Double;
begin
  Result := AIn * AIn;
end;

{ TSqrExecDouble }

function TSqrExecDouble.sqrExec(AIn: Double): Double;
begin
  Result := AIn * AIn;
end;

.................

setup method

The setup method allows you to change the types of inputparameters and output variables for external procedures andfunctions or fields for triggers. For this, theiMetadatabuilder interface is used, which allows you to buildinput and output messages with specified types, dimension and aset of characters. Entrance messages will be rebuilt into theformat set in the setup method, and the weekend is rebuilt fromthe format set in the` setup` format to the format of the messageformat in the DLL procedure, function or trigger. Types of fieldsor parameters should be compatible for transformation.

This method allows you to simplify the creation of generalizedfor different types of parameters and functions by bringing themto the most general type. A more complicated and useful examplewill be considered later, but for now, we will slightly changethe existing example of the external function of sumargs.

Our function will work with messages described by the followingstructure

type
  // the structure to which the input message will be mapped
  TSumArgsInMsg = record
    n1: Integer;
    n1Null: WordBool;
    n2: Integer;
    n2Null: WordBool;
    n3: Integer;
    n3Null: WordBool;
  end;

  PSumArgsInMsg = ^TSumArgsInMsg;

  // the structure to which the output message will be mapped
  TSumArgsOutMsg = record
    result: Integer;
    resultNull: WordBool;
  end;

  PSumArgsOutMsg = ^TSumArgsOutMsg;

Now let’s create a function factory, in the setup method we setthe format messages that match the above structures.

{ TSumArgsFunctionFactory }

procedure TSumArgsFunctionFactory.dispose;
begin
  Destroy;
end;

function TSumArgsFunctionFactory.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := TSumArgsFunction.Create();
end;

procedure TSumArgsFunctionFactory.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin
  // building a message for the input parameters
  AInBuilder.setType(AStatus, 0, Cardinal(SQL_LONG));
  AInBuilder.setLength(AStatus, 0, sizeof(Int32));
  AInBuilder.setType(AStatus, 1, Cardinal(SQL_LONG));
  AInBuilder.setLength(AStatus, 1, sizeof(Int32));
  AInBuilder.setType(AStatus, 2, Cardinal(SQL_LONG));
  AInBuilder.setLength(AStatus, 2, sizeof(Int32));
  // building a message for output parameters
  AOutBuilder.setType(AStatus, 0, Cardinal(SQL_LONG));
  AOutBuilder.setLength(AStatus, 0, sizeof(Int32));
end;

Implementation functions trivial

procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer);
var
  xInput: PSumArgsInMsg;
  xOutput: PSumArgsOutMsg;
begin
  // convert pointers to input and output to typed
  xInput := PSumArgsInMsg(AInMsg);
  xOutput := PSumArgsOutMsg(AOutMsg);
  // by default, the output argument is NULL, so we set it to nullFlag
  xOutput^.resultNull := True;
  // if one of the arguments is NULL, then the result is NULL
   // otherwise, we calculate the sum of the arguments
  with xInput^ do
  begin
    if not(n1Null or n2Null or n3Null) then
    begin
      xOutput^.result := n1 + n2 + n3;
      // once there is a result, then reset the NULL flag
      xOutput^.resultNull := False;
    end;
  end;
end;

Now, even if we declare the functions as follows, it stillwill remain operational, since the input and output messageswill be converted to the format we set in the setup method.

CREATE OR ALTER FUNCTION FN_SUM_ARGS (
    N1 VARCHAR(15),
    N2 VARCHAR(15),
    N3 VARCHAR(15))
RETURNS VARCHAR(15)
EXTERNAL NAME 'MyUdrSetup!sum_args'
ENGINE UDR;

You can check the above statement by running the followingrequest

select FN_SUM_ARGS('15', '21', '35') from rdb$database

Generic factories

In the process of developing UDR, it is necessary for eachexternal procedure, function or trigger to write your factorycreating an instance is UDR. This task can be simplified bywriting generalized factories using the so -called generics. Theyare available starting with Delphi 2009, in Free Pascal startingwith the FPC 2.2 version.

Note
Comment

In Free Pascal, the syntax for creating generic types isdifferent from Delphi.Since version FPC 2.6.0 the syntax compatible with Delphi isdeclared.

Consider the two main cases for which generalized factories willbe written:

  • copies of external procedures, functions and triggers do notrequire any information about metadata, do not need specialactions in the logic of creating UDR copies, fixed structures areused to work with messages;

  • Corps of external procedures,functions and triggers require information about metadata,special actions are not needed in the logic of creating UDRcopies, and instances of messages IMessagemetadata are used towork with messages.

In the first case, it is enough to simply create the desired copyof the class in the Newitem method without additional actions.To do this, we will use the restriction of the designer in theclassrooms of the classes IUdrFunctionFactoryImpl,IUdrProcedureFactoryImpl, IUdrTriggerFactoryImpl. The ads of such factories are as follows:

unit UdrFactories;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses SysUtils, Firebird;

type

  // A simple external function factory
  TFunctionSimpleFactory<T: IExternalFunctionImpl, constructor> = 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;

  // A simple external procedure factory
  TProcedureSimpleFactory<T: IExternalProcedureImpl, constructor> = class
    (IUdrProcedureFactoryImpl)
    procedure dispose(); override;

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

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

  // A simple external trigger factory
  TTriggerSimpleFactory<T: IExternalTriggerImpl, constructor> = class
    (IUdrTriggerFactoryImpl)
    procedure dispose(); override;

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

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

In the implementation section, the body of the setup method canbe left empty, nothing is done in them, in the body of the`dispose 'method, just call the destructor. And in the body of theNewitem method, you just need to call the default designer forthe substitution type` t`.

implementation

{ TProcedureSimpleFactory<T> }

procedure TProcedureSimpleFactory<T>.dispose;
begin
  Destroy;
end;

function TProcedureSimpleFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure;
begin
  Result := T.Create;
end;

procedure TProcedureSimpleFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;


{ TFunctionFactory<T> }

procedure TFunctionSimpleFactory<T>.dispose;
begin
  Destroy;
end;

function TFunctionSimpleFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := T.Create;
end;

procedure TFunctionSimpleFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TTriggerSimpleFactory<T> }

procedure TTriggerSimpleFactory<T>.dispose;
begin
  Destroy;
end;

function TTriggerSimpleFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalTrigger;
begin
  Result := T.Create;
end;

procedure TTriggerSimpleFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AFieldsBuilder: IMetadataBuilder);
begin

end;

Now for case 1, you can not write factories for each procedure,function or trigger. Instead, register them with genericfactories as follows:

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // register our function
  AUdrPlugin.registerFunction(AStatus, 'sum_args',
    TFunctionSimpleFactory<TSumArgsFunction>.Create());
  // register our procedure
  AUdrPlugin.registerProcedure(AStatus, 'gen_rows',
    TProcedureSimpleFactory<TGenRowsProcedure>.Create());
  // register our trigger
  AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
    TTriggerSimpleFactory<TMyTrigger>.Create());

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

The second case is more complicated. By default, metadatainformation is not transmitted into copies of procedures,functions and triggers. However, metadata is transmitted as aparameter in the method of newitem factories. UDR metadata hasthe type of IRoutineMetadata, the life cycle of which iscontrolled by the Firebird engine itself, so it can be safelytransferred to UDR copies. From it you can get copies ofinterfaces for the input and output message, metadata and triggertype, UDR name, package, entrance points and UDR body. Theclasses themselves for the implementation of external procedures,functions and triggers do not have fields for storing metadata,so we will have to make their heirs.

unit UdrFactories;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses SysUtils, Firebird;

type
...

  // External function with metadata
  TExternalFunction = class(IExternalFunctionImpl)
    Metadata: IRoutineMetadata;
  end;

  // External procedure with metadata
  TExternalProcedure = class(IExternalProcedureImpl)
    Metadata: IRoutineMetadata;
  end;

  // External trigger with metadata
  TExternalTrigger = class(IExternalTriggerImpl)
    Metadata: IRoutineMetadata;
  end;

In this case, your own stored procedures, functions, and triggersshould be inherited from new classes with metadata.

Now let’s declare the factories that will create the UDR andinitialize metadata.

unit UdrFactories;

{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses SysUtils, Firebird;

type
...

  // Factory of external functions with metadata
  TFunctionFactory<T: TExternalFunction, constructor> = 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;

  // Factory of external procedures with metadata
  TProcedureFactory<T: TExternalProcedure, constructor> = class
    (IUdrProcedureFactoryImpl)
    procedure dispose(); override;

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

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

  // Factory of external triggers with metadata
  TTriggerFactory<T: TExternalTrigger, constructor> = class
    (IUdrTriggerFactoryImpl)
    procedure dispose(); override;

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

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

The implementation of the method newitem is trivial and issimilar to the first case, except that it is necessary toinitialize the field with metadan.

implementation
...

{ TFunctionFactory<T> }

procedure TFunctionFactory<T>.dispose;
begin
  Destroy;
end;

function TFunctionFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction;
begin
  Result := T.Create;
  (Result as T).Metadata := AMetadata;
end;

procedure TFunctionFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TProcedureFactory<T> }

procedure TProcedureFactory<T>.dispose;
begin
  Destroy;
end;

function TProcedureFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure;
begin
  Result := T.Create;
  (Result as T).Metadata := AMetadata;
end;

procedure TProcedureFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata;
  AInBuilder, AOutBuilder: IMetadataBuilder);
begin

end;

{ TTriggerFactory<T> }

procedure TTriggerFactory<T>.dispose;
begin
  Destroy;
end;

function TTriggerFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalTrigger;
begin
  Result := T.Create;
  (Result as T).Metadata := AMetadata;
end;

procedure TTriggerFactory<T>.setup(AStatus: IStatus; AContext: IExternalContext;
  AMetadata: IRoutineMetadata; AFieldsBuilder: IMetadataBuilder);
begin

end;

A ready-made module with generic factories can be downloaded athttps://github.com/sim1984/udr-book/blob/master/examples/Common/UdrFactories.pas.

Working with the BLOB type

Unlike other BLOB data types are transmitted by the link (BLOBidentifier), and not by value. This is logical, Blob can beenormous, and therefore it is impossible to place them in a fixedwidth buffer. Instead, the so called BLOB identifier is placedin the message buffer, and working with data of the BLOB type iscarried out through the IBlob interface.

Another important feature of the BLOB type is that Blob is anunchanged type, you cannot change the contents of the BLOB with agiven identifier, instead you need to create BLOB with newcontents and the identifier.

Since the size of the BLOB type can be very large, the BLOB datais read and written in portions (segments), the maximum segmentsize is 64 KB. The segment is read by the getSegment interface`Iblob`. The segment is recorded by the putSegment interface`Iblob`.

Reading data from BLOB

As an example of reading a BLOB, consider a procedure that splitsstring by delimiter (reverse procedure for the built-in aggregateLIST functions). It is declared like this

create procedure split (
    txt blob sub_type text character set utf8,
    delimiter char(1) character set utf8 = ','
)
returns (
    id integer
)
external name 'myudr!split'
engine udr;

Let’s register our procedure factory:

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // register our procedure
  AUdrPlugin.registerProcedure(AStatus, 'split', TProcedureSimpleFactory<TSplitProcedure>.Create());

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

Here I used a generalized factory for simple cases when thefactory simply creates a copy of the procedure without the use ofmetadata. Such a factory is declared as follows:

...
interface

uses SysUtils, Firebird;

type

  TProcedureSimpleFactory<T: IExternalProcedureImpl, constructor> =
  class(IUdrProcedureFactoryImpl)
    procedure dispose(); override;

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

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

...

implementation

{ TProcedureSimpleFactory<T> }

procedure TProcedureSimpleFactory<T>.dispose;
begin
  Destroy;
end;

function TProcedureSimpleFactory<T>.newItem(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure;
begin
  Result := T.Create;
end;

procedure TProcedureSimpleFactory<T>.setup(AStatus: IStatus;
  AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder,
  AOutBuilder: IMetadataBuilder);
begin

...

Now let’s move on to the implementation of the procedure. Let’sfirst declare structures for input and output messages.

  TInput = record
    txt: ISC_QUAD;
    txtNull: WordBool;
    delimiter: array [0 .. 3] of AnsiChar;
    delimiterNull: WordBool;
  end;

  TInputPtr = ^TInput;

  TOutput = record
    Id: Integer;
    Null: WordBool;
  end;

  TOutputPtr = ^TOutput;

As you can see, instead of the BLOB value, the Blob identifier is transmitted, which is described by the ISC_QUAD structure.

Now let’s describe the procedure class and the returned data set:

  TSplitProcedure = class(IExternalProcedureImpl)
  private
    procedure SaveBlobToStream(AStatus: IStatus; AContext: IExternalContext;
      ABlobId: ISC_QUADPtr; AStream: TStream);
    function readBlob(AStatus: IStatus; AContext: IExternalContext;
      ABlobId: ISC_QUADPtr): string;
  public
    // Called when destroying a copy of the procedure
    procedure dispose(); override;

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

    function open(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer;
      AOutMsg: Pointer): IExternalResultSet; override;
  end;

  TSplitResultSet = class(IExternalResultSetImpl)
{$IFDEF FPC}
    OutputArray: TStringArray;
{$ELSE}
    OutputArray: TArray<string>;
{$ENDIF}
    Counter: Integer;
    Output: TOutputPtr;

    procedure dispose(); override;
    function fetch(AStatus: IStatus): Boolean; override;
  end;

Additional SaveBlobToStream and` readBlob` are designed to readBlob. The first reads Blob in a stream, the second is based onthe first and performs a convert for the read flow into a Delphiline. The data set of the lines of the OutputArray and thecounter of the returned records Counter are transmitted.

In the `open` method, Blob is read and converted into a line.
The resulting line is divided into a separator using the built
-in `split` method from a Hellper for lines. The resulting array
of lines is transmitted to the resulting data set.
function TSplitProcedure.open(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer): IExternalResultSet;
var
  xInput: TInputPtr;
  xText: string;
  xDelimiter: string;
begin
  xInput := AInMsg;

  Result := TSplitResultSet.Create;
  TSplitResultSet(Result).Output := AOutMsg;

  if xInput.txtNull or xInput.delimiterNull then
  begin
    with TSplitResultSet(Result) do
    begin
      // We create an empty array
      OutputArray := [];
      Counter := 1;
    end;
    Exit;
  end;

  xText := readBlob(AStatus, AContext, @xInput.txt);
  xDelimiter := TFBCharSet.CS_UTF8.GetString(TBytes(@xInput.delimiter), 0, 4);
  // automatically is not correctly determined because the lines
  // not completed by zero
  // Place the backing of byte/4
  SetLength(xDelimiter, 1);

  with TSplitResultSet(Result) do
  begin
    OutputArray := xText.Split([xDelimiter], TStringSplitOptions.ExcludeEmpty);
    Counter := 0;
  end;
end;
Note
Comment

Type of TFBCharSet is not included in Firebird.pas. It was written by me to relieve work with Firebird encodings. In this case, we believe that all our lines come in the UTF-8 encoding.

Now we will describe the data reading procedure from BLOB to thestream. In order to read data from BLOB, it must be opened. Thiscan be done by calling the openBlob method` IAttachment`. Sincewe read Blob from our database, we will open it in the context ofthe current connection. The context of the current connection andthe context of the current transaction can be obtained from thecontext of the external procedure, function or trigger (the ``IEXTERNALCONTEXT).

Blob is read in portions (segments), the maximum size of thesegment is 64 KB. The segment is read by the getSegmentinterface` IBlob`.

procedure TSplitProcedure.SaveBlobToStream(AStatus: IStatus;
  AContext: IExternalContext; ABlobId: ISC_QUADPtr; AStream: TStream);
var
  att: IAttachment;
  trx: ITransaction;
  blob: IBlob;
  buffer: array [0 .. 32767] of AnsiChar;
  l: Integer;
begin
  try
    att := AContext.getAttachment(AStatus);
    trx := AContext.getTransaction(AStatus);
    blob := att.openBlob(AStatus, trx, ABlobId, 0, nil);
    while True do
    begin
      case blob.getSegment(AStatus, SizeOf(buffer), @buffer, @l) of
        IStatus.RESULT_OK:
          AStream.WriteBuffer(buffer, l);
        IStatus.RESULT_SEGMENT:
          AStream.WriteBuffer(buffer, l);
      else
        break;
      end;
    end;
    AStream.Position := 0;
    // 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;
    if Assigned(trx) then
      trx.release;
    if Assigned(att) then
      att.release;
  end;
end;
Note
Comment

Please note that the interfaces IAttachment, ITransaction andIBlob inherit the` IReferenCecauted` interface, which meansthese are objects with the calculation of links. Methods of thereturning objects of these interfaces set the link meter in 1.Upon completion of work with such objects, you need to reduce thelink counter using the release method.
Important
Important

The close method of the` IBlob` interface in case of successfulexecution frees the interface, so there is no need to call therelease method.

In the example of the variable blob assigned the value ofnil. Further in the finally section, whether the pointer isinitialized to the IBlob interface, and only if the executionwas completed earlier than the call blob.close (AStatus) or ifthis challenge ended with an error, Iblob.release is called.

On the basis of the SaveBlobToStream method, the Blob readingprocedure in the line is written:

function TSplitProcedure.readBlob(AStatus: IStatus; AContext: IExternalContext;
  ABlobId: ISC_QUADPtr): string;
var
{$IFDEF FPC}
  xStream: TBytesStream;
{$ELSE}
  xStream: TStringStream;
{$ENDIF}
begin
{$IFDEF FPC}
  xStream := TBytesStream.Create(nil);
{$ELSE}
  xStream := TStringStream.Create('', 65001);
{$ENDIF}
  try
    SaveBlobToStream(AStatus, AContext, ABlobId, xStream);
{$IFDEF FPC}
    Result := TEncoding.UTF8.GetString(xStream.Bytes, 0, xStream.Size);
{$ELSE}
    Result := xStream.DataString;
{$ENDIF}
  finally
    xStream.Free;
  end;
end;
Note
Comment

Unfortunately, Free Pascal does not provide full reversecompatibility with Delphi for the TStringStream class. In theversion for FPC, you cannot specify the encoding with which thestream will work, and therefore it is necessary to process thetransformation for it into the line in a special way.

The fetch method of the output set of data extracts an elementwith the Counter index from the line and increases it until thelast element of the array is extracted. Each extracted line isconverted to the whole. If this is impossible to do, then anexception will be excited with the isc_convert_error code.

procedure TSplitResultSet.dispose;
begin
  SetLength(OutputArray, 0);
  Destroy;
end;

function TSplitResultSet.fetch(AStatus: IStatus): Boolean;
var
  statusVector: array [0 .. 4] of NativeIntPtr;
begin
  if Counter <= High(OutputArray) then
  begin
    Output.Null := False;
    // Exceptions will be intercepted in any case with the ISC_Random code
    // Here we will throw out the standard for Firebird
    // error ISC_CONVERT_ERROR
    try
      Output.Id := OutputArray[Counter].ToInteger();
    except
      on e: EConvertError do
      begin

        statusVector[0] := NativeIntPtr(isc_arg_gds);
        statusVector[1] := NativeIntPtr(isc_convert_error);
        statusVector[2] := NativeIntPtr(isc_arg_string);
        statusVector[3] := NativeIntPtr(PAnsiChar('Cannot convert string to integer'));
        statusVector[4] := NativeIntPtr(isc_arg_end);

        AStatus.setErrors(@statusVector);
      end;
    end;
    inc(Counter);
    Result := True;
  end
  else
    Result := False;
end;
Note
Comment

In fact, the processing of any errors except isc_random is notvery convenient, you can write your wrapper to simplify.

The performance of the procedure can be checked as follows:

SELECT ids.ID
FROM SPLIT((SELECT LIST(ID) FROM MYTABLE), ',') ids
Note
Comment

The main drawback of this implementation is that Blob will alwaysbe read entirely, even if you want to interrupt the extraction ofrecords from the procedure ahead of schedule. If desired, you canchange the procedure code so that smashing into tunes is carriedout in smaller portions. To do this, the reading of theseportions must be carried out in the Fetch method as the resultis extracted.

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;

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.