FirebirdSQL logo
 Les classesHistorique du document 

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.