FirebirdSQL logo
 MessagesTravailler avec le type BLOB 

Création d’instances d’UDR en fonction de leur déclaration

Dans la méthode newItem, vous pouvez créer différentes instances d’une procédure ou d’une fonction externe, en fonction de sa déclaration dans PSQL. Pour ce faire, vous pouvez utiliser les informations obtenues à partir de IMessageMetadata.

Supposons que nous voulions implémenter un package PSQL avec le même ensemble de fonctions externes pour élever un nombre au carré pour différents types de données et un point d’entrée unique.

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 ; ^

Pour tester les fonctions, nous utiliserons la requête suivante

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

Pour faciliter le travail avec IMessageMetadata et les tampons, vous pouvez écrire un wrapper pratique ou essayer d’utiliser IMessageMetadata et des structures pour afficher les messages ensemble. Ici, nous allons montrer l’utilisation de la seconde méthode.

L’implémentation de cette idée est assez simple : dans la classe de fonctions, nous allons créer différentes instances de fonctions en fonction du type de l’argument d’entrée.Dans les versions modernes de Delphi, vous pouvez utiliser les génériques pour généraliser le code.

.......................
type
  // la structure à laquelle le message d'entrée sera associé
  TSqrInMsg<T> = record
    n1: T;
    n1Null: WordBool;
  end;

  // la structure à laquelle le message de sortie sera associé
  TSqrOutMsg<T> = record
    result: T;
    resultNull: WordBool;
  end;

  // Classe pour l'instanciation d'une fonction externe TSqrFunction
  TSqrFunctionFactory = class(IUdrFunctionFactoryImpl)
    // Appelé lors de la destruction de la classe
    procedure dispose(); override;

    { Exécuté chaque fois qu'une fonction externe est chargée dans le cache de métadonnées.
      Permet de modifier le format des messages d'entrée et de sortie.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @param(AInBuilder Constructeur de messages pour les métadonnées d'entrée)
      @param(AOutBuilder Constructeur de messages pour les métadonnées de sortie)
    }
    procedure setup(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder;
      AOutBuilder: IMetadataBuilder); override;

    { Création d'une nouvelle instance d'une TSqrFunction externe

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AMetadata Métadonnées de la fonction externe)
      @returns(Instance de fonction externe)
    }
    function newItem(AStatus: IStatus; AContext: IExternalContext;
      AMetadata: IRoutineMetadata): IExternalFunction; override;
  end;


  // Fonction externe 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;
    // Appelé lorsque l'instance de la fonction est détruite
    procedure dispose(); override;

    { Cette méthode est appelée juste avant l'exécution et indique au noyau le jeu de caractères requis
      pour communiquer dans cette méthode.

      Lors de cet appel, le contexte utilise le jeu de caractères obtenu par ExternalEngine::getCharSet.

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AName Nom du jeu de caractères)
      @param(ANameSize Longueur du nom du jeu de caractères)
    }
    procedure getCharSet(AStatus: IStatus; AContext: IExternalContext;
      AName: PAnsiChar; ANameSize: Cardinal); override;

    { Exécution d'une fonction externe

      @param(AStatus Vecteur de statut)
      @param(AContext Contexte d'exécution de la fonction externe)
      @param(AInMsg Pointeur vers le message d'entrée)
      @param(AOutMsg Pointeur vers le message de sortie)
    }
    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
  // obtenir le type de l'argument d'entrée
  xInputMetadata := AMetadata.getInputMetadata(AStatus);
  xInputType := TFBType(xInputMetadata.getType(AStatus, 0));
  xInputMetadata.release;
  // créer une instance d'une fonction en fonction du 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;

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

méthode de configuration

La méthode setup permet de modifier les types de paramètres d’entrée et de variables de sortie pour les procédures et fonctions externes ou les champs pour les triggers. Pour cela, on utilise l’interface iMetadatabuilder qui permet de construire des messages d’entrée et de sortie avec des types spécifiés, une dimension et un ensemble de caractères. Les messages d’entrée seront reconstruits dans le format défini dans la méthode setup, et le week-end est reconstruit à partir du format défini dans le format setup vers le format du message dans la procédure, la fonction ou le déclencheur de la DLL. Les types de champs ou de paramètres doivent être compatibles pour la transformation.

Cette méthode permet de simplifier la création de généralisations pour différents types de paramètres et de fonctions en les ramenant au type le plus général. Un exemple plus compliqué et plus utile sera étudié plus tard, mais pour l’instant, nous allons légèrement modifier l’exemple existant de la fonction externe de sumargs.

Notre fonction fonctionnera avec des messages décrits par la structure suivante

type
  // la structure à laquelle le message d'entrée sera associé
  TSumArgsInMsg = record
    n1: Integer;
    n1Null: WordBool;
    n2: Integer;
    n2Null: WordBool;
    n3: Integer;
    n3Null: WordBool;
  end;

  PSumArgsInMsg = ^TSumArgsInMsg;

  // la structure à laquelle le message de sortie sera associé
  TSumArgsOutMsg = record
    result: Integer;
    resultNull: WordBool;
  end;

  PSumArgsOutMsg = ^TSumArgsOutMsg;

Créons maintenant une classe de fonctions, dans la méthode setup nous définissons les messages de format qui correspondent aux structures ci-dessus.

{ 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
  // construction d'un message pour les paramètres d'entrée
  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));
  // construction d'un message pour les paramètres de sortie
  AOutBuilder.setType(AStatus, 0, Cardinal(SQL_LONG));
  AOutBuilder.setLength(AStatus, 0, sizeof(Int32));
end;

Fonctions de mise en œuvre triviales

procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext;
  AInMsg, AOutMsg: Pointer);
var
  xInput: PSumArgsInMsg;
  xOutput: PSumArgsOutMsg;
begin
  // convertir les pointeurs d'entrée et de sortie en caractères typés
  xInput := PSumArgsInMsg(AInMsg);
  xOutput := PSumArgsOutMsg(AOutMsg);
  // par défaut, l'argument de sortie est NULL, nous lui attribuons donc la valeur nullFlag
  xOutput^.resultNull := True;
  // si l'un des arguments est NULL, le résultat est NULL sinon, on calcule la somme des arguments
  with xInput^ do
  begin
    if not(n1Null or n2Null or n3Null) then
    begin
      xOutput^.result := n1 + n2 + n3;
      // une fois qu'il y a un résultat, réinitialiser le flag NULL
      xOutput^.resultNull := False;
    end;
  end;
end;

Maintenant, même si nous déclarons les fonctions comme suit, il restera opérationnel, puisque les messages d’entrée et de sortie seront convertis au format que nous avons défini dans la méthode setup.

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;

Vous pouvez vérifier l’affirmation ci-dessus en exécutant la requête suivante

SELECT FN_SUM_ARGS('15', '21', '35') FROM rdb$database

docnext count = 8

Les classes génériques

Dans le processus de développement de l’UDR, il est nécessaire pour chaque procédure, fonction ou déclencheur externe d’écrire votre classe créant une instance de l’UDR. Cette tâche peut être simplifiée en écrivant des classes généralisées à l’aide de ce que l’on appelle les génériques. Ils sont disponibles à partir de Delphi 2009, en Free Pascal à partir de la version FPC 2.2.

Note

En Free Pascal, la syntaxe de création des types génériques est différente de celle de Delphi.Depuis la version FPC 2.6.0, la syntaxe compatible avec Delphi est déclarée.

Considérons les deux principaux cas pour lesquels des usines généralisées seront écrites :

  • les copies de procédures, de fonctions et de déclencheurs externes ne nécessitent pas d’informations sur les métadonnées, ni d’actions spéciales dans la logique de création des copies UDR ; des structures fixes sont utilisées pour travailler avec les messages ;

  • Les corps des procédures, fonctions et déclencheurs externes ont besoin d’informations sur les métadonnées, des actions spéciales ne sont pas nécessaires dans la logique de création des copies UDR, et les instances de messages IMessagemetadata sont utilisées pour travailler avec les messages.

Dans le premier cas, il suffit de créer la copie désirée de la classe dans la méthode Newitem sans actions supplémentaires.Pour ce faire, nous utiliserons la restriction du concepteur dans les classes IUdrFunctionFactoryImpl, IUdrProcedureFactoryImpl, IUdrTriggerFactoryImpl. Les annonces de telles classes sont les suivantes :

unit UdrFactories;

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

interface

uses SysUtils, Firebird;

type

  // Une simple classe de fonctions externes
  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;

  // Une simple procédure externe
  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;

  // Une simple classe de déclencheur externe
  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;

Dans la section d’implémentation, le corps de la méthode setup peut être laissé vide, rien n’y est fait, dans le corps de la méthode dispose, il suffit d’appeler le destructeur. Et dans le corps de la méthode Newitem, il suffit d’appeler le designer par défaut pour le type de substitution 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;

Dans le premier cas, vous ne pouvez pas écrire des classes pour chaque procédure, fonction ou déclencheur. Au lieu de cela, enregistrez-les avec des classes génériques comme suit :

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // inscrire notre fonction
  AUdrPlugin.registerFunction(AStatus, 'sum_args',
    TFunctionSimpleFactory<TSumArgsFunction>.Create());
  // inscrire notre procédure
  AUdrPlugin.registerProcedure(AStatus, 'gen_rows',
    TProcedureSimpleFactory<TGenRowsProcedure>.Create());
  // inscrire notre déclencheur
  AUdrPlugin.registerTrigger(AStatus, 'test_trigger',
    TTriggerSimpleFactory<TMyTrigger>.Create());

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

Le second cas est plus compliqué. Par défaut, les informations sur les métadonnées ne sont pas transmises dans les copies des procédures, des fonctions et des déclencheurs. Cependant, les métadonnées sont transmises en tant que paramètre dans la méthode des classes newitem. Les métadonnées UDR ont le type IRoutineMetadata, dont le cycle de vie est contrôlé par le moteur Firebird lui-même, de sorte qu’elles peuvent être transférées en toute sécurité dans les copies UDR. A partir de là, vous pouvez obtenir des copies des interfaces pour les messages d’entrée et de sortie, les métadonnées et le type de déclencheur, le nom de l’UDR, le paquetage, les points d’entrée et le corps de l’UDR. Les classes elles-mêmes pour l’implémentation des procédures externes, des fonctions et des déclencheurs n’ont pas de champs pour stocker les métadonnées, nous devrons donc les hérités.

unit UdrFactories;

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

interface

uses SysUtils, Firebird;

type
...

  // Fonction externe avec métadonnées
  TExternalFunction = class(IExternalFunctionImpl)
    Metadata: IRoutineMetadata;
  end;

  // Procédure externe avec métadonnées
  TExternalProcedure = class(IExternalProcedureImpl)
    Metadata: IRoutineMetadata;
  end;

  // Déclencheur externe avec métadonnées
  TExternalTrigger = class(IExternalTriggerImpl)
    Metadata: IRoutineMetadata;
  end;

Dans ce cas, vos propres procédures stockées, fonctions et triggers doivent être hérités de nouvelles classes avec des métadonnées.

Déclarons maintenant les classes qui créeront l’UDR et initialiseront les métadonnées.

unit UdrFactories;

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

interface

uses SysUtils, Firebird;

type
...

  // Classe de fonctions externes avec métadonnées
  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;

  // Classe de procédures externes avec métadonnées
  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;

  // Classe de déclencheurs externes avec métadonnées
  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;

L’implémentation de la méthode newitem est triviale et est similaire au premier cas, sauf qu’il est nécessaire d’initialiser le champ avec AMetadata.

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;

Un module prêt à l’emploi avec des classes génériques peut être téléchargé à l’adresse suivante https://github.com/sim1984/udr-book/blob/master/examples/Common/UdrFactories.pas.

Travailler avec le type BLOB

Contrairement aux autres types de données BLOB, elles sont transmises par leur Id (identifiant BLOB) et non par la valeur. C’est logique, car les Blob peuvent être énormes et il est donc impossible de les placer dans une mémoire tampon de largeur fixe. Au lieu de cela, l’identifiant BLOB est placé dans le tampon du message, et le travail avec les données de type BLOB est effectué par l’intermédiaire de l’interface IBlob.

Une autre caractéristique importante du type BLOB est qu’il s’agit d’un type inchangé, vous ne pouvez pas modifier le contenu du BLOB avec un identifiant donné, mais vous devez créer un BLOB avec un nouveau contenu et l’identifiant.

Comme la taille du type BLOB peut être très grande, les données BLOB sont lues et écrites par portions (segments), la taille maximale d’un segment étant de 64 Ko. Le segment est lu par l’interface getSegment Iblob. Le segment est enregistré par l’interface putSegment Iblob.

Lecture des données d’un BLOB

Pour illustrer la lecture d’un BLOB, prenons l’exemple d’une procédure qui divise une chaîne de caractères par délimiteur (procédure inverse des fonctions intégrées d’agrégation LIST). Elle est déclarée comme suit :

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;

Inscrivons notre classe de procédures :

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // inscrire notre procédure
  AUdrPlugin.registerProcedure(AStatus, 'split', TProcedureSimpleFactory<TSplitProcedure>.Create());

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

Ici, j’ai utilisé une classe généralisée pour les cas simples où la classe crée simplement une copie de la procédure sans utiliser de métadonnées. Une telle classe est déclarée comme suit :

...
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

...

Passons maintenant à la mise en œuvre de la procédure. Commençons par déclarer des structures pour les messages d’entrée et de sortie.

  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;

Comme vous pouvez le voir, au lieu de la valeur du BLOB, c’est l’identifiant du Blob qui est transmis, qui est décrit par la structure ISC_QUAD.

Décrivons maintenant la classe de procédure et l’ensemble des données renvoyées :

  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
    // Appelé lors de la destruction d'une copie de la procédure
    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;

Les fonctions supplémentaires SaveBlobToStream et` readBlob` sont conçues pour lire Blob. La première lit Blob dans un flux, la seconde est basée sur la première et effectue une conversion du flux de lecture dans une ligne Delphi. L’ensemble des données des lignes du OutputArray et le compteur des enregistrements retournés Counter sont transmis.

Dans la méthode open, le Blob est lu et converti en une ligne.La ligne résultante est divisée en un séparateur en utilisant la méthode intégrée split d’un Helper pour les chaines de caractères. Le tableau de chaines de caractères résultant est transmis à l’ensemble de données.

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
      // Nous créons un tableau vide
      OutputArray := [];
      Counter := 1;
    end;
    Exit;
  end;

  xText := readBlob(AStatus, AContext, @xInput.txt);
  xDelimiter := TFBCharSet.CS_UTF8.GetString(TBytes(@xInput.delimiter), 0, 4);
  SetLength(xDelimiter, 1);

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

Le type TFBCharSet n’est pas inclus dans Firebird.pas. Il a été écrit par moi pour soulager le travail avec les encodages de Firebird. Dans ce cas, nous pensons que toutes nos lignes sont encodées en UTF-8.

Nous allons maintenant décrire la procédure de lecture des données d’un BLOB vers un flux. Pour lire les données d’un BLOB, il faut l’ouvrir. Cela peut être fait en appelant la méthode openBlob de l’interface IAttachment`. Puisque nous lisons un Blob à partir de notre base de données, nous l’ouvrirons dans le contexte de la connexion actuelle. Le contexte de la connexion courante et le contexte de la transaction courante peuvent être obtenus à partir du contexte de la procédure externe, de la fonction ou du trigger (IEXTERNALCONTEXT).

Le Blob est lu par portions (segments), la taille maximale d’un segment étant de 64 KB. Le segment est lu par la méthode getSegment de l’interface 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;
    // La méthode `CLOSE` en cas de succès combine l'interface IBLOB.
    // Par conséquent, l'appel suivant n'est pas nécessaire
    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

Veuillez noter que les interfaces IAttachment, ITransaction et IBlob héritent de l’interface IReferenceCounted, ce qui signifie qu’il s’agit d’objets avec le calcul des liens. Les méthodes des objets qui renvoient des objets de ces interfaces fixent le compteur de liens à 1.Une fois le travail avec ces objets terminé, vous devez réduire le compteur de liens à l’aide de la méthode release.
Important
Important

La méthode close de l’interface` IBlob` en cas d’exécution réussie libère l’interface, il n’est donc pas nécessaire d’appeler la méthode release.

Dans l’exemple de la variable blob assignée à la valeur nil. Plus loin dans la section finally, si le pointeur est initialisé à l’interface IBlob, et seulement si l’exécutiona été terminée avant l’appel blob.close (AStatus) ou si ce challenge s’est terminé par une erreur, Iblob.release est appelé.

Sur la base de la méthode SaveBlobToStream, la procédure de lecture de Blob dans la ligne est écrite :

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

Malheureusement, Free Pascal ne fournit pas une compatibilité inverse complète avec Delphi pour la classe TStringStream. Dans la version pour FPC, vous ne pouvez pas spécifier l’encodage avec lequel le flux fonctionnera, et il est donc nécessaire de traiter la transformation dans la ligne d’une manière spéciale.

La méthode fetch de l’ensemble des données extrait un élément avec l’index Counter de la ligne et l’augmente jusqu’à ce que le dernier élément du tableau soit extrait. Chaque ligne extraite est convertie en un tout. Si cela est impossible, une exception sera levée avec le code isc_convert_error.

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;
    // Les exceptions seront interceptées dans tous les cas avec le code ISC_Random Ici,
    // nous lancerons l'erreur standard de Firebird 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('Impossible de convertir une chaîne de caractères en un nombre entier'));
        statusVector[4] := NativeIntPtr(isc_arg_end);

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

En fait, le traitement des erreurs autres que isc_random n’est pas très pratique, vous pouvez écrire votre wrapper pour simplifier.

La performance de la procédure peut être vérifiée comme suit :

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

Le principal inconvénient de cette implémentation est que Blob sera toujours lu entièrement, même si vous souhaitez interrompre l’extraction des enregistrements de la procédure plus tôt que prévu. Si vous le souhaitez, vous pouvez modifier le code de la procédure de manière à ce que le découpage en plus petit bloc. Pour ce faire, la lecture de ces blocs doit être effectuée dans la méthode Fetch au fur et à mesure que le résultat est extrait.

Enregistrement des données dans un Blob

Comme exemple d’enregistrement de Blob, considérons la fonction du contenu du lecteur du Blob à partir du fichier.

Note

Cet exemple est une version adaptée des fonctions UDF pour la lecture et l’enregistrement de BLOB depuis/vers un fichier. L’UDF original est disponible à l’adresse suivante blobsaveload.zip

Les utilitaires de lecture et d’enregistrement de Blob depuis/vers le fichier sont délivrés sous la forme d’un 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^

Inscrivons les classes de nos procédures et de nos fonctions :

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

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

Dans ce cas, nous donnons un exemple uniquement pour la fonction de lecture de BLOB depuis le fichier, l’exemple complet d’udr peut être téléchargé à BlobSaveLoad La partie interface du module avec une description de la fonction Loadblobfromfile est la suivante :

interface

uses
  Firebird, Classes, SysUtils;

type

  // Messages d'entrée de la fonction
  TInput = record
    filename: record
      len: Smallint;
      str: array [0 .. 1019] of AnsiChar;
    end;
    filenameNull: WordBool;
  end;
  TInputPtr = ^TInput;

  // Fonction de sortie
  TOutput = record
    blobData: ISC_QUAD;
    blobDataNull: WordBool;
  end;
  TOutputPtr = ^TOutput;

  // fonctionnalités de réalisation 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;

  // Classe permettant de créer une copie de la fonction externe 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;

Nous ne donnons que l’implémentation de la classe Execute de base tloadblobfromfile, les autres classes de classes sont élémentaires.

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;
  // Nous obtenons le nom du fichier
  xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0,
    xInput.filename.len * 4);
  SetLength(xFileName, xInput.filename.len);
  // Nous lisons le fichier dans le flux
  xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone);
  att := AContext.getAttachment(AStatus);
  trx := AContext.getTransaction(AStatus);
  blob := nil;
  try
    xStreamSize := xStream.Size;
    // Déterminer la taille maximale du tampon (segment)
    if xStreamSize > MaxBufSize then
      xBufferSize := MaxBufSize
    else
      xBufferSize := xStreamSize;
    // Nous créons un nouveau Blob
    blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil);
    // Nous lisons le contenu du flux et l'écrivons dans le 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;
    // Ferme le Blob
    // La méthode CLOSE en cas de succès combine l'interface IBLOB
    // L'appel suivant n'est donc pas nécessaire
    blob.close(AStatus);
    blob := nil;
  finally
    if Assigned(blob) then
      blob.release;
    trx.release;
    att.release;
    xStream.Free;
  end;
end;

Tout d’abord, il est nécessaire de créer un nouveau Blob et de le lier dans la sortie Blobid à l’aide de la méthode createBlob de IAttachment.Étant donné que nous écrivons un objet blob temporaire pour notre base de données, nous allons le créer dans le contexte de la connexion actuelle. Le contexte de la connexion en cours et le contexte de la transaction en cours peuvent être obtenus à partir du contexte de la procédure, de la fonction ou du déclencheur externe (le IExternalContext).

Comme dans le cas de la lecture de données à partir d’un objet blob, l’enregistrement est effectué par segmentation à l’aide de la méthode putSegment IBlob jusqu’à ce que les données du flux de fichiers soient terminées. Une fois l’enregistrement des données terminé dans Blob, il est nécessaire de le fermer à l’aide de la méthode close.

Important
Important

La méthode close de l’interface IBlob en cas d’exécution réussie libère l’interface.Par conséquent, il n’est pas nécessaire d’appeler la méthode Release.

Assistant pour l’utilisation du type Blob

Dans les exemples décrits, nous avons utilisé la préservation du contenu de BLOB dans le flux, ainsi que le chargement du contenu de BLOB dans le flux. Il s’agit d’une opération assez fréquente lorsque l’on travaille avec le type BLOB, il serait donc bon d’écrire un ensemble spécial d’utilitaires pour la réutilisation du code.

Les versions modernes de Delphi et de Free Pascal vous permettent d’étendre les classes et les types existants sans héritage en utilisant ce que l’on appelle un Helper. Ajoutez les méthodes à l’interface IBlob pour enregistrer et charger le contenu du flux de/vers le Blob.

Créez un module spécial FbBlob, où notre Helper sera placé.

unit FbBlob;

interface

uses Classes, SysUtils, Firebird;

const
  MAX_SEGMENT_SIZE = $7FFF;

type
  TFbBlobHelper = class helper for IBlob
    procedure LoadFromStream(AStatus: IStatus; AStream: TStream);
    { Charge le contenu d'un BLOB dans le flux

      @param(AStatus IStatus)
      @param(AStream TStream)
    }
    procedure SaveToStream(AStatus: IStatus; AStream: TStream);
    { Charge dans un Blob le contenu du flux

      @param(AStatus IStatus)
      @param(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.

Maintenant, vous pouvez grandement simplifier les opérations avec le type BLOB, par exemple, la fonction ci-dessus d’enregistrement de Blob dans le fichier peut être réécrite comme suit :

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;
  // Nous obtenons le nom du fichier
  xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0,
    xInput.filename.len * 4);
  SetLength(xFileName, xInput.filename.len);
  // Nous lisons le fichier dans le flux
  xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone);
  att := AContext.getAttachment(AStatus);
  trx := AContext.getTransaction(AStatus);
  blob := nil;
  try
    // Nous créons un nouveau Blob
    blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil);
    // Nous chargeons le contenu du flux dans Blob
    blob.LoadFromStream(AStatus, xStream);
    // Fermer Blob
    // En cas de succès, la méthode CLOSE combine l’interface IBLOB
    // Par conséquent, l’appel suivant n’est pas nécessaire
    blob.close(AStatus);
    blob := nil;
  finally
    if Assigned(blob) then
      blob.release;
    att.release;
    trx.release;
    xStream.Free;
  end;
end;

Contexte de connexion et de transaction

Si votre procédure, fonction ou déclencheur externe doit recevoir des données de votre propre base de données non pas par le biais d’arguments d’entrée, mais par exemple par le biais d’une requête, vous devrez alors recevoir le contexte de la connexion et/ou des transactions en cours. De plus, le contexte de la connexion et de la transaction est nécessaire si vous travaillez avec le type BLOB.

Le contexte de la procédure, de la fonction ou du déclencheur en cours est transmis en tant que paramètre avec le type IExternalContext dans la méthode ou la fonction de déclencheur execute, ou dans la méthode de procédure ouverte. L’interface IExternalContext vous permet d’obtenir la connexion actuelle à l’aide de la méthode getAttachment et la transaction actuelle à l’aide de la méthode getTransaction. Cela donne une plus grande flexibilité à votre UDR, par exemple, vous pouvez répondre aux demandes de base de données actuelles tout en conservant l’environnement de session actuel, dans la même transaction ou dans une nouvelle transaction créée à l’aide de la méthode d’interface StartTransaction IExternalContext. Dans ce dernier cas, la demande sera faite comme si elle était exécutée dans une transaction autonome. De plus, vous pouvez vous conformer à la base de données externe en utilisant la transaction jointe à la transaction en cours, c’est-à-dire les transactions avec confirmation en deux phases (2PC).

À titre d’exemple de travail avec le contexte de la fonction, nous allons écrire une fonction qui sérialisera le résultat de l’exécution de la requête SELECT au format JSON. Il est déclaré comme suit :

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;

Comme nous nous permettons d’exécuter une requête SQL arbitraire, nous ne connaissons pas à l’avance le format des champs de sortie, et nous ne pourrons pas utiliser une structure avec des champs fixes. Dans ce cas, nous devrons travailler avec l’interface IMessageMetadata. Nous l’avons déjà rencontré précédemment, mais cette fois-ci, nous devrons travailler avec lui de manière plus approfondie, car nous devons traiter tous les types de Firebird existants.

Note

En JSON, vous pouvez encoder presque tous les types de données, à l’exception des données binaires.Pour coder les types de char, varchar avec octets none et blob sub_type binary nous allons encoder le contenu binaire en utilisant le codage base64, qui peut déjà être placé en JSON.

We will register the factory of our function:

function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr;
  AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl;
begin
  // Nous enregistrons une fonction
  AUdrPlugin.registerFunction(AStatus, 'getJson', TFunctionSimpleFactory<TJsonFunction>.Create());

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

Maintenant, nous allons déclarer les structures pour le message d’entrée et de sortie, ainsi que la partie interface de notre fonction :

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;

  // Fonction Tsumargsfunction externe.
  TJsonFunction = class(IExternalFunctionImpl)
  public
    procedure dispose(); override;

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

    { Convertit l’ensemble en une ligne conforme à l’échelle

      @param(AValue La valeur en paramètre)
      @param(Scale Diviseur)
      @returns(Strokal Représentation d’un ensemble à l’échelle)
    }
    function MakeScaleInteger(AValue: Int64; Scale: Smallint): string;

    { Ajoute une entrée codée à un tableau d’objets JSON

      @param(AStatus Statut du vecteur)
      @param(AContext Le contexte de la fonction externe)
      @param(AJson Un tableau d’objets JSON)
      @param(ABuffer Enregistrements de tampon)
      @param(AMeta Curseur de métadonnées)
      @param(AFormatSetting Réglage de la date et de l’heure)
    }
    procedure writeJson(AStatus: IStatus; AContext: IExternalContext;
      AJson: TJsonArray; ABuffer: PByte; AMeta: IMessageMetadata;
      AFormatSettings: TFormatSettings);

    { External function

      @param (AStatus Vecteur d’état)
      @PARAM (ACONTEXT Contexte de la fonction externe)
      @param (AInMSG Message d’entrée)
      @PARAM (AOutMSG Message de sortie)
    }
    procedure execute(AStatus: IStatus; AContext: IExternalContext;
      AInMsg: Pointer; AOutMsg: Pointer); override;
  end;

La méthode supplémentaire de MakeScaleInteger est conçue pour convertir des nombres en une ligne, la méthode Writejson encode l’enregistrement suivant de l’objet sélectionné à partir du curseur en Json et l’ajoute au tableau de ces objets.

Dans cet exemple, nous devrons implémenter la méthode getCharSet pour indiquer l’encodage souhaité de la requête pour la demande de la connexion courante au sein de la fonction externe.Par défaut, cette requête interne sera effectuée dans l’encodage de la connexion courante. Cependant, ce n’est pas tout à fait pratique. Nous ne savons pas à l’avance quel encodage le client va fonctionner, nous devrons donc déterminer l’encodage de chaque champ de chaîne retourné et le transcoder en UTF8. Pour simplifier la tâche, nous indiquerons immédiatement au contexte que nous allons travailler à l’intérieur de la procédure en encodage UTF8.

procedure TJsonFunction.getCharSet(AStatus: IStatus; AContext: IExternalContext;
  AName: PAnsiChar; ANameSize: Cardinal);
begin
  // rectifier l’encodage précédent
  Fillchar (aname, anamesize, #0);
  // mettre l’encodage souhaité
  Strcopy (aname, 'UTF8');
end;

Nous décrirons ces méthodes plus tard, mais pour l’instant nous donnerons la méthode principale de 'execute' pour exécuter une fonction externe.

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;
  // Si l’un des arguments d’entrée est nul, le résultat est nul
  if xInput.SqlNull or xInput.SqlDialectNull then
  begin
    xOutput.NullFlag := True;
    Exit;
  end;
  xOutput.NullFlag := False;
  // Définition de la mise en forme de la date et de l’heure
{$IFNDEF FPC}
  xFormatSettings := TFormatSettings.Create;
{$ELSE}
  xFormatSettings := DefaultFormatSettings;
{$ENDIF}
  xFormatSettings.DateSeparator := '-';
  xFormatSettings.TimeSeparator := ':';
  // Nous créons un flux d’octets pour la lecture d’objets blob
  inStream := TBytesStream.Create(nil);
{$IFNDEF FPC}
  outStream := TStringStream.Create('', 65001);
{$ELSE}
  outStream := TStringStream.Create('');
{$ENDIF}
  jsonArray := TJsonArray.Create;
  // Obtention de la connexion et de la transaction en cours
  att := AContext.getAttachment(AStatus);
  tra := AContext.getTransaction(AStatus);
  stmt := nil;
  rs := nil;
  inBlob := nil;
  outBlob := nil;
  try
    // Nous lisons le Blob dans un flux
    inBlob := att.openBlob(AStatus, tra, @xInput.SqlText, 0, nil);
    inBlob.SaveToStream(AStatus, inStream);
    // La méthode Close, en cas de succès, combine l’interface IBLOB Par conséquent,
    // l’appel suivant n’est pas nécessaire
    inBlob.close(AStatus);
    inBlob := nil;
    // On assigne IStatement
    stmt := att.prepare(AStatus, tra, inStream.Size, @inStream.Bytes[0],
      xInput.SqlDialect, IStatement.PREPARE_PREFETCH_METADATA);
    // Nous obtenons les métadonnées du curseur
    cursorMetaData := stmt.getOutputMetadata(AStatus);
    // Nous ouvrons le curseur
    rs := stmt.openCursor(AStatus, tra, nil, nil, nil, 0);
    // Nous mettons en évidence le tampon à la taille souhaitée
    msgLen := cursorMetaData.getMessageLength(AStatus);
    msg := AllocMem(msgLen);
    try
      // Nous lisons chaque enregistrement de curseur
      while rs.fetchNext(AStatus, msg) = IStatus.RESULT_OK do
      begin
        // et l'écrivons en json
        writeJson(AStatus, AContext, jsonArray, msg, cursorMetaData,
          xFormatSettings);
      end;
    finally
      // Nous libérons le tampon
      FreeMem(msg);
    end;
    // Fermer le curseur En cas de succès, la méthode CLOSE combine l’interface IRESULTSET
    // Par conséquent, l’appel suivant n’est pas nécessaire
    rs.close(AStatus);
    rs := nil;
    // Nous libérons la requête préparée La méthode FREE, en cas de succès, combine l’interface ISTATEMENT
    // Par conséquent, l’appel suivant n’est pas nécessaire
    stmt.free(AStatus);
    stmt := nil;
    // Nous écrivons json dans le flux
{$IFNDEF FPC}
    outStream.WriteString(jsonArray.ToJSON);
{$ELSE}
    outStream.WriteString(jsonArray.AsJSON);
{$ENDIF}
    //On écrit json sur le Blob
    outBlob := att.createBlob(AStatus, tra, @xOutput.Json, 0, nil);
    outBlob.LoadFromStream(AStatus, outStream);
    // CLOSE en cas de succès combine l’interface IBLOB Par conséquent, l’appel suivant n’est pas nécessaire
    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;

Tout d’abord, nous obtenons une connexion actuelle à partir du contexte de la fonction et de la transaction en cours en utilisant les méthodes getAttachment et getTransaction de l’interface IExternalContext. Ensuite, nous lisons le contenu du BLOB pour obtenir le texte de la requête SQL. La requête est préparée à l’aide de la méthode Prepare de l’interface IAttachment. Le cinquième paramètre est transmis par le dialecte SQL obtenu à partir du paramètre d’entrée de notre fonction.

Le sixième paramètre est l’indicateur IStatement.PREPARE_PREFETCH_METADATA, ce qui signifie que nous voulons obtenir un curseur de métadonnées avec le résultat de la préparation de la requête. Nous obtenons la fin du curseur de métadonnées à l’aide de getOutputMetadata via l’interface IStatement.

Note
Comment

En fait, la méthode getoutPutmetadata renverra les métadonnées de fin dans tous les cas. L’indicateur IStatement.PREPARE_PREFETCH_METADATA forcera les métadonnées avec le résultat de la préparation d’une demande pour un paquet réseau.Étant donné que nous nous conformons à une demande dans le cadre de la connexion actuelle de n’importe quel échange de réseau, ce n’est pas fondamental.

Ensuite, ouvrez le curseur à l’aide de la méthode openCursor dans le cadre de la transaction en cours (paramètre 2). Nous obtenons la taille du tampon de sortie au résultat du curseur à l’aide de getMessageLength de l’interface IMessageMetadata. Cela vous permet de mettre à dimension la mémoire du tampon, que nous libérerons immédiatement après le verrouillage du dernier enregistrement du curseur.

Les enregistrements de curseur sont lus à l’aide de la méthode fetchNext de IResultSet. Cette méthode remplit le tampon msg avec les valeurs des champs du curseur et renvoie IStatus.RESULT_OK jusqu’à ce que les enregistrements du curseur soient terminés. Chaque enregistrement lu est transmis à la méthode Writejson, qui ajoute un objet tel que TJsonObject avec un curseur sérialisé enregistrant dans le tableau TJsonArray.

Après avoir terminé le travail avec le curseur, nous le fermons par la méthode close, convertissons un tableau d’objets json en une ligne, écrivons-le dans le flux de sortie, que nous écrivons dans la sortie Blob.

Analysons maintenant la méthode writeJson. Nous aurons besoin de l’objet IUtil pour recevoir des fonctions de décodage de la date et de l’heure. Cette méthode consiste activement à travailler avec les champs de sortie des métadonnées du curseur à l’aide de l’interface IMessageMetadata.

Tout d’abord, nous créons un type d’objet TJsonObject dans lequel nous allons enregistrer les valeurs des champs de l’enregistrement courant. Comme noms des clés, nous utiliserons l’alias des champs du curseur. Si Nullflag est vérifié, alors nous écrivons la valeur de NULL pour la clé et passons au champ suivant, sinon nous analysons le type de champ et écrivons sa valeur en 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
  // Nous obtenons Util
  util := AContext.getMaster().getUtilInterface();
  // Nous créons un objet Tjsonobject dans lequel nous allons
  // écrire la valeur des champs d'enregistrement.
  jsonObject := TJsonObject.Create;
  for i := 0 to AMeta.getCount(AStatus) - 1 do
  begin
    // Nous obtenons des champs alias dans la requête
    FieldName := AMeta.getAlias(AStatus, i);
    NullFlag := PWordBool(ABuffer + AMeta.getNullOffset(AStatus, i))^;
    if NullFlag then
    begin
      // Si Null, nous l'écrivons en json et passons au champ suivant.
{$IFNDEF FPC}
      jsonObject.AddPair(FieldName, TJsonNull.Create);
{$ELSE}
      jsonObject.Add(FieldName, TJsonNull.Create);
{$ENDIF}
      continue;
    end;
    // Nous recevons un pointeur sur ces champs
    pData := ABuffer + AMeta.getOffset(AStatus, i);
    // identique AMeta->getType(AStatus, i) & ~1
    fieldType := AMeta.getType(AStatus, i) and not 1;
    case fieldType of
      // VARCHAR
      SQL_VARYING:
        begin
          // Taille de la mémoire tampon pour Varchar
          metaLength := AMeta.getLength(AStatus, i);
          SetLength(CharBuffer, metaLength);
          charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
          charLength := PSmallint(pData)^;
          // Les données binaires sont encodées en Base64
          if charset = CS_BINARY then
          begin
{$IFNDEF FPC}
            StringValue := TNetEncoding.base64.EncodeBytesToString((pData + 2),
              charLength);
{$ELSE}
            // Pour Varchar, les 2 premiers octets - longueur en octets,
            // donc copie dans la mémoire tampon à partir de 3 octets.
            Move((pData + 2)^, CharBuffer[0], metaLength);
            StringValue := charset.GetString(CharBuffer, 0, charLength);
            StringValue := EncodeStringBase64(StringValue);
{$ENDIF}
          end
          else
          begin
            // Pour Varchar, les 2 premiers octets - longueur en octets,
            // donc copie dans la mémoire tampon à partir de 3 octets.
            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
          // Taille de la mémoire tampon pour Char
          metaLength := AMeta.getLength(AStatus, i);
          SetLength(CharBuffer, metaLength);
          charset := TFBCharSet(AMeta.getCharSet(AStatus, i));
          Move(pData^, CharBuffer[0], metaLength);
          // Données binaires encodées en 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), où 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), où p = 5..9
      // DECIMAL(p, s), où 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)^;
          // nous obtenons le décodage de la date-heure
          util.decodeDate(TimestampValue.timestamp_date, @year, @month, @day);
          util.decodeTime(TimestampValue.timestamp_time, @hours, @minutes, @seconds,
            @fractions);
          // Nous obtenons une date-heure dans notre type delphi
          DateTimeValue := EncodeDate(year, month, day) +
            EncodeTime(hours, minutes, seconds, fractions div 10);
          // On met en forme une date-heure selon un format donné
          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);
          // Nous obtenons les composants de la date-heure et du fuseau horaire
          util.decodeTimeStampTz(AStatus, TimestampValueTz, @year, @month, @day, @hours, @minutes, @seconds,
            @fractions, 64, @tzBuffer[0]);
          // Nous obtenons une date-heure dans notre type delphi
          DateTimeValue := EncodeDate(year, month, day) +
            EncodeTime(hours, minutes, seconds, fractions div 10);
          // Formater la date-heure selon le format donné + fuseau horaire
          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)^;
          // Nous obtenons les composants de la date
          util.decodeDate(DateValue, @year, @month, @day);
          // On obtient une date dans le type natif Delphi
          DateTimeValue := EncodeDate(year, month, day);
          // Nous formatons la date selon le format donné
          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)^;
          // Nous obtenons les composantes de l’heure
          util.decodeTime(TimeValue, @hours, @minutes, @seconds, @fractions);
          // Nous obtenons le temps dans le type natif Delphi
          DateTimeValue := EncodeTime(hours, minutes, seconds,
            fractions div 10);
          // Nous formatons l’heure selon un format donné
          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);
          // Nous obtenons les composants de l’heure et du fuseau horaire
          util.decodeTimeTz(AStatus, TimeValueTz, @hours, @minutes, @seconds,
            @fractions, 64, @tzBuffer[0]);
          // Nous obtenons le temps dans le type natif Delphi
          DateTimeValue := EncodeTime(hours, minutes, seconds,
            fractions div 10);
          // Nous formatons l’heure en fonction d’un format donné + fuseau horaire
          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));
              // Créer un flux avec un encodage donné
{$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}
              // Tous les autres sous-types sont considérés comme binaires
              binaryStream := TBytesStream.Create;
              try
                blob.SaveToStream(AStatus, binaryStream);
                blob.close(AStatus);
                blob := nil;
                // Encoder la chaîne en 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;
  // Ajout d’une entrée au format json à un tableau
{$IFNDEF FPC}
  AJson.AddElement(jsonObject);
{$ELSE}
  AJson.Add(jsonObject);
{$ENDIF}
end;
Note

La liste du type TFbType est absente dans le module standard Firebird.pas. Cependant, il n’est pas pratique d’utiliser des valeurs numériques, j’ai donc écrit un module spécial FbTypes dans lequel j’ai placé des types supplémentaires pour plus de commodité.

L’énumération de TFBCharSet est également absente dans le module Firebird.pas.J’ai écrit un module séparé FbCharsets dans lequel ce transfert est posté. De plus, pour ce type, un Helper spécial est écrit, qui contient des fonctions permettant d’obtenir le nom de l’ensemble de caractères, le code page, la taille du symbole en octets, l’obtention de la classe TEncoding dans l’encodage nécessaire, ainsi que la fonction de conversion de la chaine d’octets en une chaîne de caractères Unicode Delphi.

Pour les lignes de type CHAR et VARCHAR, vérifiez l’encodage, si son encodage est OCTETS, alors nous encodons la ligne avec l’algorithme base64, sinon nous convertissons les données du tampon vers la ligne Delphi. Veuillez noter que pour le type de VARCHAR, les 2 premiers octets contiennent la longueur de la chaîne de caractères.

Les types de SMALLINT, INTEGER, BIGINT peuvent être des entiers ordinaires, donc évolutifs. L’échelle du nombre peut être obtenue par la fonction getScale de l’interface IMessageMetadata. Si l’échelle n’est pas égale à 0, un traitement spécial du nombre est nécessaire, qui est effectué par le MakeScaleInteger.

Les types DATE, TIME et TIMESTAMP sont décodés sur les composants de la date et de l’heure à l’aide des méthodes decodeDate et decodeTime de l’interface IUtil. Nous utilisons des parties de la date et de l’heure pour recevoir la date et l’heure dans le type standard Delphi TDateTime.

Avec le type BLOB, nous travaillons à travers des flux Delphi. Si le Blob est binaire, nous créons un flux comme TBytesStream. Le résultat d’un tableau d’octets est codé à l’aide de l’algorithme base64.Si BLOB est textuel, alors nous utilisons un flux spécialisé TStringStream pour une chaîne de caractères, ce qui permet de prendre en compte le code page. Nous obtenons le code page à partir de l’encodage du champ BLOB.

Pour travailler avec les données INT128, il y a une interface spéciale IInt128. Il peut être obtenu en appelant le getInt128 de l’interface IUtil. Ce type est apparu dans Firebird 4.0 et est conçu pour représenter avec précision de très grands nombres. Il n’y a pas de type de données direct dans Delphi, qui pourrait fonctionner avec ce type, nous affichons donc simplement au format de chaîne de caractères.

Pour travailler avec les types DECFLOAT(16) et DECFLOAT(34), il existe des interfaces spéciales IDecFloat16 et IDecFloat34.Ils peuvent être obtenus en appelant getDecFloat16 ou getDecFloat34 de l’interface IUtil. Ces types sont disponibles à partir de Firebird 4.0. Il n’y a pas de types de données directes dans Delphi qui pourraient fonctionner avec ces types. Ces types peuvent être affichés en BCD ou présentés sous la forme d’une chaîne de caractères.

Les types TIME WITH TIME ZONE et TIMESTAMP WITH TIME ZONE sont décodés sur les composants de la date et de l’heure, ainsi que sur le nom du fuseau horaire, à l’aide des méthodes decodeTimeStampTz et decodeTimeTz. Nous utilisons des parties de la date et de l’heure pour recevoir la date et l’heure dans le type standard de Delphi TDateTime. Ensuite, nous convertissons la valeur de ce type dans une chaîne de caractères et y ajoutons le nom du fuseau horaire.

Appendices

License notice

Le contenu de cette documentation est soumis à desLicence de documentation version 1.0 (ci-après dénommée « Licence ») ;vous ne pouvez utiliser cette Documentation que si vous respectez les conditions de la présente Licence.Des copies de la licence sont disponibles à l’adresse suivante : PDF and HTML.

La documentation originale s’appelle Writing UDR Firebird en Pascal.

L’auteur original de la documentation est : Denis Simonov.L’auteur du texte en russe est Denis Simonov.

Auteur: Denis Simonov.

Les parties créées par Denis Simonov sont protégées par le droit d’auteur © 2018-2023.Tous droits réservés.

(Contacts de l’auteur: sim-mail at list dot ru).

Contributeur : Martin Köditz.

Traduction en anglais. Les parties créées par Martin Köditz sont protégées par le droit d’auteur © 2023.Tous droits réservés.

(Contacts de l’auteur: martin koeditz at it syn dot de).

Contributeur : @Arcantar.

Traduction en français. Les parties créées par @arcantar sont protégées par le droit d’auteur © 2024.Tous droits réservés.

Historique du document

L’historique exact du fichier est enregistré dans le dépôt git firebird-documentation ; voir firebird-documentation

Historique des révisions

1.0.0-fr

23 Jan 2024

@A

Traduction française du document anglais par @Arcantar.

1.0.0

22 Sep 2023

MK

Traduction anglaise du document russe par Martin Köditz.

1.0.0-ru

21 Sep 2023

DS

Première version du document. L’original a été rédigé par Denis Simonov en langue russe.