Ecrire UDR en Pascal

Firebird a depuis longtemps été en mesure d'étendre les capacités du langage PSQL en écrivant des fonctions externes - UDF (User Defined Functions). UDF peut être écrit dans presque tous les langages de programmation compilés.


Firebird 3.0 a introduit une architecture de plug-in pour étendre les capacités de Firebird. L'un de ces plugins est le moteur externe (moteurs externes). Le mécanisme UDR (User Defined Routines - User Defined Routines) ajoute une couche au-dessus de l'interface du moteur FirebirdExternal.


Dans ce guide, nous vous expliquerons comment déclarer UDR, leurs mécanismes internes, leurs capacités et donnerons des exemples d'écriture UDR en Pascal. De plus, certains aspects de l'utilisation de la nouvelle API orientée objet seront abordés.


Remarque

Cet article est destiné à vous apprendre à écrire UDR à l'aide de l'API Firebird objet.
Les fonctions et procédures écrites peuvent ne pas avoir d'application pratique.

Les UDR présentent les avantages suivants par rapport aux UDF hérités:


  • vous pouvez écrire non seulement des fonctions qui renvoient un résultat scalaire, mais aussi des procédures stockées (à la fois exécutables et sélectives), ainsi que des déclencheurs;
  • contrôle amélioré des paramètres d'entrée et de sortie. Dans certains cas (en passant par le descripteur), les types et autres propriétés des paramètres d'entrée n'étaient pas contrôlés du tout, cependant, vous pourriez obtenir ces propriétés dans UDF. Les UDR fournissent un moyen plus unifié de déclarer les paramètres d'entrée et de sortie, comme c'est le cas avec les fonctions et procédures PSQL standard;
  • UDR le contexte de la connexion ou transaction en cours est disponible, ce qui permet
    quelques manipulations avec la base de données actuelle dans ce contexte;
  • La génération d'erreurs Firebird est disponible lorsque des exceptions se produisent, il n'est pas nécessaire de retourner une valeur spéciale;
  • Les procédures et fonctions externes (UDR) peuvent être regroupées dans des packages PSQL;
  • L'UDR peut être écrit dans n'importe quel langage de programmation (éventuellement compilé en codes objet), pour cela il est nécessaire que le plug-in External Engine correspondant soit écrit. Par exemple, il existe des plugins pour écrire des modules externes en Java ou dans l'un des langages .NET.

Remarque

L'implémentation UDR actuelle utilise un stub PSQL. Par exemple, il est utilisé pour
vérification des paramètres et des valeurs de retour pour vérifier la conformité aux restrictions. Stub
a été utilisé en raison de la rigidité pour appeler directement les fonctions internes. Résultats
test comparant les performances des UDR et UDF montre que UDR est approximativement
2,5 fois plus lent en utilisant la fonction la plus simple d'ajouter deux arguments comme exemple. La vitesse
UDR est approximativement égal à la vitesse d'une fonction PSQL régulière. Peut-être qu'à l'avenir,
moment sera optimisé. Dans les fonctions plus complexes, cette surcharge peut devenir
imperceptible.

Plus loin dans différentes parties de ce manuel, lorsque vous utilisez les termes procédure externe,
fonction ou déclencheur, nous entendrons exactement UDR (et non UDF).


Remarque

Tous nos exemples fonctionnent sur Delphi 2009 et versions ultérieures, ainsi que sur Free Pascal. Tous
des exemples peuvent être compilés à la fois en Delphi et en Free Pascal, si
non spécifié séparément.

API Firebird


Pour écrire des procédures, des fonctions ou des déclencheurs externes dans des langages de programmation compilés, nous avons besoin de connaître la nouvelle API Firebird orientée objet. Ce guide ne comprend pas une description complète de l'API Firebird. Vous pouvez le lire dans le répertoire de documentation distribué avec Firebird ( doc/Using_OO_API.html ).


Les plug-ins pour divers langages de programmation qui contiennent des API ne sont pas distribués dans le cadre de la distribution Firebird pour Windows, mais vous pouvez les extraire des fichiers tarbar compressés distribués par Linux (le chemin à l'intérieur de l'archive /opt/firebird/include/firebird/Firebird.pas ).


CLOOP


CLOOP - Programmation orientée objet en langage croisé. Cet outil n'est pas inclus avec Firebird. Il peut être trouvé dans le code source https://github.com/FirebirdSQL/firebird/tree/B3_0_Release/extern/cloop . Une fois l'outil assemblé, vous pouvez générer une API pour votre langage de programmation ( IdlFbInterfaces.h ou Firebird.pas ) sur la base du fichier de description d'interface include/firebird/FirebirdInterface.idl .


Pour Object pascal, cela se fait avec la commande suivante:


 cloop FirebirdInterface.idl pascal Firebird.pas Firebird --uses SysUtils \ --interfaceFile Pascal.interface.pas \ --implementationFile Pascal.implementation.pas \ --exceptionClass FbException --prefix I \ --functionsFile fb_get_master_interface.pas 

Les Pascal.interface.pas , Pascal.implementation.pas et fb_get_master_interface.pas se trouvent sur https://github.com/FirebirdSQL/firebird/tree/B3_0_Release/src/misc/pascal .


Remarque

Dans ce cas, le préfixe I sera ajouté pour les API Firebird, car cela est accepté en Object Pascal.

Constantes


Il n'y a pas de constantes isc_* dans le fichier Firebird.pas résultant. Ces constantes pour les langages C / C ++ peuvent être trouvées sur https://github.com/FirebirdSQL/firebird/blob/B3_0_Release/src/include/consts_pub.h . Pour obtenir les constantes du langage Pascal, nous utiliserons le script AWK pour convertir la syntaxe. Sous Windows, vous devrez installer Gawk pour Windows ou utiliser le sous-système Windows pour Linux (disponible sur Windows 10). Cela se fait avec la commande suivante:


 awk -f Pascal.Constants.awk consts_pub.h > const.pas 

Le contenu du fichier résultant doit être copié dans la section const vide du fichier Firebird.pas immédiatement après l'implémentation. Le fichier Pascal.Constants.awk se trouve à l' Pascal.Constants.awk
https://github.com/FirebirdSQL/firebird/tree/B3_0_Release/src/misc/pascal .


Gestion du temps de vie


Les interfaces Firebird ne sont pas basées sur la spécification COM, donc la gestion de leur durée de vie est différente.


Il existe deux interfaces dans Firebird qui traitent de la gestion du temps de vie: IDisposable et IReferenceCounted. Ce dernier est particulièrement actif lors de la création d'autres interfaces: IPlugin compte les liens, comme beaucoup d'autres interfaces utilisées par les plug-ins. Il s'agit notamment des interfaces qui décrivent comment se connecter à une base de données, la gestion des transactions et les instructions SQL.


Une surcharge supplémentaire de l'interface avec comptage de références n'est pas toujours nécessaire. Par exemple, IMaster, l'interface principale qui appelle les fonctions disponibles pour le reste de l'API, a une durée de vie illimitée par définition. Pour les autres API, la durée de vie est strictement déterminée par la durée de vie de l'interface parent; L'interface IStatus n'est pas
multithread. Pour les interfaces avec une durée de vie limitée, il est utile d'avoir un moyen simple de les détruire, c'est-à-dire la fonction dispose ().


Indice

Si vous ne savez pas comment un objet est détruit, regardez sa hiérarchie, s'il a
interface IReferenceCounted, puis le comptage des références est utilisé.
Pour les interfaces avec comptage de références, à la fin du travail avec un objet, il est nécessaire
diminuez le compteur de référence en appelant la méthode release ().

Annonce UDR


Les UDR peuvent être ajoutés ou supprimés de la base de données à l'aide des commandes DDL, tout comme vous ajoutez ou supprimez des procédures, fonctions ou déclencheurs PSQL standard. Dans ce cas, au lieu du corps du déclencheur, son emplacement dans le module externe est indiqué à l'aide de la clause EXTERNAL NAME.


Considérez la syntaxe de cette phrase; elle sera commune aux procédures, fonctions et déclencheurs externes.


Syntaxe:


 EXTERNAL NAME '<extname>' ENGINE <engine> [AS <extbody>] <extname> ::= '<module name>!<routine name>[!<misc info>]' 

L'argument de cette clause EXTERNAL NAME est une chaîne indiquant l'emplacement de la fonction dans le module externe. Pour les modules externes utilisant le moteur UDR, cette ligne à travers le séparateur indique le nom du module externe, le nom de la fonction à l'intérieur du module et les informations définies par l'utilisateur. Un point d'exclamation (!) Est utilisé comme séparateur.


La clause ENGINE spécifie le nom du moteur de traitement de la connexion des modules externes. Firebird utilise le moteur UDR pour travailler avec des modules externes écrits dans des langages compilés (C, C ++, Pascal). Les fonctions externes écrites en Java nécessitent le moteur Java.


Après le mot clé AS, un littéral de chaîne peut être spécifié - le «corps» du module externe (procédure, fonction ou déclencheur), il peut être utilisé par le module externe à diverses fins. Par exemple, une requête SQL peut être spécifiée pour accéder à une base de données externe ou du texte dans une langue pour l'interprétation par votre fonction.


Fonctions externes


Syntaxe
 {CREATE [OR ALTER] | RECREATE} FUNCTION funcname [(<inparam> [, <inparam> ...])] RETURNS <type> [COLLATE collation] [DETERMINISTIC] EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>] <inparam> ::= <param_decl> [{= |DEFAULT} <value>] <value> ::= {literal | NULL | context_var} <param_decl> ::= paramname <type> [NOT NULL] [COLLATE collation] <extname> ::= '<module name>!<routine name> [!<misc info>]' <type> ::= <datatype> | [TYPE OF] domain | TYPE OF COLUMN rel.col <datatype> ::= {SMALLINT | INT[EGER] | BIGINT} | BOOLEAN | {FLOAT | DOUBLE PRECISION} | {DATE | TIME | TIMESTAMP} | {DECIMAL | NUMERIC} [(precision [, scale])] | {CHAR | CHARACTER | CHARACTER VARYING | VARCHAR} [(size)] [CHARACTER SET charset] | {NCHAR |NATIONAL CHARACTER | NATIONAL CHAR} [VARYING] [(size)] | BLOB [SUB_TYPE {subtype_num | subtype_name}] [SEGMENT SIZE seglen] [CHARACTER SET charset] | BLOB [(seglen [, subtype_num])] 

Tous les paramètres d'une fonction externe peuvent être modifiés à l'aide de l'instruction ALTER FUNCTION.


Syntaxe:


 ALTER FUNCTION funcname [(<inparam> [, <inparam> ...])] RETURNS <type> [COLLATE collation] [DETERMINISTIC] EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>] <extname> ::= '<module name>!<routine name>[!<misc info>]' 

Vous pouvez supprimer une fonction externe à l'aide de l'instruction DROP FUNCTION.


Syntaxe:


 DROP FUNCTION funcname 

Quelques paramètres d'une fonction externe
ParamètreLa description
funcnameLe nom de la fonction stockée. Peut contenir jusqu'à 31 octets.
inparamDescription du paramètre d'entrée.
nom du moduleNom du module externe dans lequel se trouve la fonction.
nom de routineNom interne de la fonction à l'intérieur du module externe.
informations diversesInformations définies par l'utilisateur à transmettre à
fonction du module externe.
moteurNom du moteur d'utilisation des fonctions externes. Habituellement, le nom est UDR.
extbodyLe corps est une fonction externe. Littéral de chaîne pouvant être utilisé par l'UDR à diverses fins.

Ici, nous ne décrirons pas la syntaxe des paramètres d'entrée et de sortie. Il est entièrement conforme à la syntaxe des fonctions PSQL standard, qui est décrite en détail dans le Guide du langage SQL. Au lieu de cela, nous donnons des exemples de déclaration de fonctions externes avec des explications.


La fonction d'ajouter trois arguments


 create function sum_args ( n1 integer, n2 integer, n3 integer ) returns integer external name 'udrcpp_example!sum_args' engine udr; 

L'implémentation de la fonction est dans le module udrcpp_example. A l'intérieur de ce module, une fonction est enregistrée sous le nom sum_args. Une fonction externe utilise le moteur UDR.


Fonction Java


 create or alter function regex_replace ( regex varchar(60), str varchar(60), replacement varchar(60) ) returns varchar(60) external name 'org.firebirdsql.fbjava.examples.fbjava_example.FbRegex.replace( String, String, String)' engine java; 

L'implémentation de la fonction se trouve dans la fonction statique de remplacement de la classe org.firebirdsql.fbjava.examples.fbjava_example.FbRegex . Une fonction externe utilise le moteur Java.


Procédures externes


Syntaxe
 {CREATE [OR ALTER] | RECREATE} PROCEDURE procname [(<inparam> [, <inparam> ...])] RETURNS (<outparam> [<outparam> ...]) EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>] <inparam> ::= <param_decl> [{= | DEFAULT} <value>] <outparam> ::= <param_decl> <value> ::= {literal | NULL | context_var} <param_decl> ::= paramname <type> [NOT NULL] [COLLATE collation] <extname> ::= '<module name>!<routine name>[!<misc info>]' <type> ::= <datatype> | [TYPE OF] domain | TYPE OF COLUMN rel.col <datatype> ::= {SMALLINT | INT[EGER] | BIGINT} | BOOLEAN | {FLOAT | DOUBLE PRECISION} | {DATE | TIME | TIMESTAMP} | {DECIMAL | NUMERIC} [(precision [,scale])] | {CHAR | CHARACTER | CHARACTER VARYING | VARCHAR} [(size)] [CHARACTER SET charset] | {NCHAR | NATIONAL CHARACTER | NATIONAL CHAR} [VARYING] [(size)] | BLOB [SUB_TYPE {subtype_num | subtype_name}] [SEGMENT SIZE seglen] [CHARACTER SET charset] | BLOB [(seglen [, subtype_num])] 

Tous les paramètres de la procédure externe peuvent être modifiés à l'aide de l'instruction ALTER PROCEDURE.


Syntaxe:


 ALTER PROCEDURE procname [(<inparam> [, <inparam> ...])] RETURNS (<outparam> [, <outparam> ...]) EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>] 

Vous pouvez supprimer une procédure externe à l'aide de l'instruction DROP PROCEDURE.


Syntaxe:


 DROP PROCEDURE procname 

Quelques paramètres de la procédure externe
ParamètreLa description
funcnameNom de la procédure stockée. Peut contenir jusqu'à 31 octets.
inparamDescription du paramètre d'entrée.
outparamDescription du paramètre de sortie.
nom du moduleNom du module externe dans lequel se trouve la procédure.
nom de routineNom interne de la procédure à l'intérieur du module externe.
informations diversesInformations définies par l'utilisateur à transmettre à
procédure de module externe.
moteurNom du moteur pour l'utilisation des procédures externes. Habituellement, le nom est UDR.
extbodyLe corps d'une procédure externe. Littéral de chaîne pouvant être utilisé par l'UDR à diverses fins.

Ici, nous ne décrirons pas la syntaxe des paramètres d'entrée et de sortie. Il est entièrement conforme à la syntaxe des procédures PSQL standard, qui est décrite en détail dans le Guide du langage SQL. Au lieu de cela, nous donnons des exemples de déclaration de procédures externes avec des explications.


 create procedure gen_rows_pascal ( start_n integer not null, end_n integer not null ) returns ( result integer not null ) external name 'pascaludr!gen_rows' engine udr; 

L'implémentation de la fonction est dans le module pascaludr. A l'intérieur de ce module, la procédure est enregistrée sous le nom gen_rows. Une procédure externe utilise le moteur UDR.


 create or alter procedure write_log ( message varchar(100) ) external name 'pascaludr!write_log' engine udr; 

L'implémentation de la fonction est dans le module pascaludr. A l'intérieur de ce module, la procédure est enregistrée sous le nom write_log. Une procédure externe utilise le moteur UDR.


 create or alter procedure employee_pgsql ( -- Firebird 3.0.0 has a bug with external procedures without parameters dummy integer = 1 ) returns ( id type of column employee.id, name type of column employee.name ) external name 'org.firebirdsql.fbjava.examples.fbjava_example.FbJdbc .executeQuery()!jdbc:postgresql:employee|postgres|postgres' engine java as 'select * from employee'; 

L'implémentation de la fonction est dans la fonction statique executeQuery de la classe
org.firebirdsql.fbjava.examples.fbjava_example.FbJdbc . Après le point d'exclamation (!), Les informations se trouvent pour la connexion à une base de données externe via JDBC. Une fonction externe utilise le moteur Java. Ici, en tant que "corps" d'une procédure externe, une requête SQL est passée pour récupérer des données.


Remarque

Cette procédure utilise un stub dans lequel un paramètre inutilisé est transmis. Cela est dû au fait que dans Firebird 3.0 il y a un bug avec le traitement des procédures externes sans paramètres.

Placement des procédures et fonctions externes dans les packages


Il est pratique de placer un groupe de procédures et de fonctions interdépendantes dans des packages PSQL. Les packages peuvent contenir des procédures et des fonctions PSQL externes et régulières.


Syntaxe
 {CREATE [OR ALTER] | RECREATE} PACKAGE package_name AS BEGIN [<package_item> ...] END {CREATE | RECREATE} PACKAGE BODY package_name AS BEGIN [<package_item> ...] [<package_body_item> ...] END <package_item> ::= <function_decl>; | <procedure_decl>; <function_decl> ::= FUNCTION func_name [(<in_params>)] RETURNS <type> [COLLATE collation] [DETERMINISTIC] <procedure_decl> ::= PROCEDURE proc_name [(<in_params>)] [RETURNS (<out_params>)] <package_body_item> ::= <function_impl> | <procedure_impl> <function_impl> ::= FUNCTION func_name [(<in_impl_params>)] RETURNS <type> [COLLATE collation] [DETERMINISTIC] <routine body> <procedure_impl> ::= PROCEDURE proc_name [(<in_impl_params>)] [RETURNS (<out_params>)] <routine body> <routine body> ::= <sql routine body> | <external body reference> <sql routine body> ::= AS   [<declarations>] BEGIN [<PSQL_statements>]   END <declarations> ::= <declare_item> [<declare_item> ...] <declare_item> ::= <declare_var>; | <declare_cursor>; | <subroutine declaration>; | <subroutine implimentation> <subroutine declaration> ::= <subfunc_decl> | <subproc_decl> <subroutine implimentation> ::= <subfunc_impl> | <subproc_impl> <external body reference> ::= EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>] <extname> ::= '<module name>!<routine name>[!<misc info>]' 

Pour les procédures et fonctions externes, le nom du package, les paramètres d'entrée, leurs types, les valeurs par défaut et les paramètres de sortie sont indiqués dans l'en-tête du package, et tout est identique dans le corps du package, à l'exception des valeurs par défaut, ainsi que l'emplacement dans le module externe (clause EXTERNAL NAME) , le nom du moteur et éventuellement le "corps" de la procédure / fonction.


Supposons que vous ayez écrit un UDR pour travailler avec des expressions régulières, qui se trouve dans le module externe PCRE (bibliothèque dynamique), et que vous disposez de plusieurs UDR supplémentaires qui effectuent d'autres tâches. Si nous n'avions pas utilisé de packages PSQL, toutes nos procédures et fonctions externes seraient mélangées à la fois entre elles et avec les procédures et fonctions PSQL ordinaires. Cela complique la recherche de dépendances et la modification de modules externes, et crée en outre de la confusion et force au moins l'utilisation de préfixes pour regrouper les procédures et les fonctions. Les packages PSQL nous facilitent la tâche.


Forfait RegExp
 SET TERM ^; CREATE OR ALTER PACKAGE REGEXP AS BEGIN PROCEDURE preg_match( APattern VARCHAR(8192), ASubject VARCHAR(8192)) RETURNS (Matches VARCHAR(8192)); FUNCTION preg_is_match( APattern VARCHAR(8192), ASubject VARCHAR(8192)) RETURNS BOOLEAN; FUNCTION preg_replace( APattern VARCHAR(8192), AReplacement VARCHAR(8192), ASubject VARCHAR(8192)) RETURNS VARCHAR(8192); PROCEDURE preg_split( APattern VARCHAR(8192), ASubject VARCHAR(8192)) RETURNS (Lines VARCHAR(8192)); FUNCTION preg_quote( AStr VARCHAR(8192), ADelimiter CHAR(10) DEFAULT NULL) RETURNS VARCHAR(8192); END^ RECREATE PACKAGE BODY REGEXP AS BEGIN PROCEDURE preg_match( APattern VARCHAR(8192), ASubject VARCHAR(8192)) RETURNS (Matches VARCHAR(8192)) EXTERNAL NAME 'PCRE!preg_match' ENGINE UDR; FUNCTION preg_is_match( APattern VARCHAR(8192), ASubject VARCHAR(8192)) RETURNS BOOLEAN AS BEGIN RETURN EXISTS( SELECT * FROM preg_match(:APattern, :ASubject)); END FUNCTION preg_replace( APattern VARCHAR(8192), AReplacement VARCHAR(8192), ASubject VARCHAR(8192)) RETURNS VARCHAR(8192) EXTERNAL NAME 'PCRE!preg_replace' ENGINE UDR; PROCEDURE preg_split( APattern VARCHAR(8192), ASubject VARCHAR(8192)) RETURNS (Lines VARCHAR(8192)) EXTERNAL NAME 'PCRE!preg_split' ENGINE UDR; FUNCTION preg_quote( AStr VARCHAR(8192), ADelimiter CHAR(10)) RETURNS VARCHAR(8192) EXTERNAL NAME 'PCRE!preg_quote' ENGINE UDR; END^ SET TERM ;^ 

Déclencheurs externes


Syntaxe
 {CREATE [OR ALTER] | RECREATE} TRIGGER trigname {<relation_trigger_legacy> | <relation_trigger_sql2003> | <database_trigger> | <ddl_trigger> } <external-body> <external-body> ::= EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>] <relation_trigger_legacy> ::= FOR {tablename | viewname} [ACTIVE | INACTIVE] {BEFORE | AFTER} <mutation_list> [POSITION number] <relation_trigger_sql2003> ::= [ACTIVE | INACTIVE] {BEFORE | AFTER} <mutation_list> [POSITION number] ON {tablename | viewname} <database_trigger> ::= [ACTIVE | INACTIVE] ON db_event [POSITION number] <ddl_trigger> ::= [ACTIVE | INACTIVE] {BEFORE | AFTER} <ddl_events> [POSITION number] <mutation_list> ::= <mutation> [OR <mutation> [OR <mutation>]] <mutation> ::= INSERT | UPDATE | DELETE <db_event> ::= CONNECT | DISCONNECT | TRANSACTION START | TRANSACTION COMMIT | TRANSACTION ROLLBACK <ddl_events> ::= ANY DDL STATEMENT | <ddl_event_item> [{OR <ddl_event_item>} ...] <ddl_event_item> ::= CREATE TABLE | ALTER TABLE | DROP TABLE | CREATE PROCEDURE | ALTER PROCEDURE | DROP PROCEDURE | CREATE FUNCTION | ALTER FUNCTION | DROP FUNCTION | CREATE TRIGGER | ALTER TRIGGER | DROP TRIGGER | CREATE EXCEPTION | ALTER EXCEPTION | DROP EXCEPTION | CREATE VIEW | ALTER VIEW | DROP VIEW | CREATE DOMAIN | ALTER DOMAIN | DROP DOMAIN | CREATE ROLE | ALTER ROLE | DROP ROLE | CREATE SEQUENCE | ALTER SEQUENCE | DROP SEQUENCE | CREATE USER | ALTER USER | DROP USER | CREATE INDEX | ALTER INDEX | DROP INDEX | CREATE COLLATION | DROP COLLATION | ALTER CHARACTER SET | CREATE PACKAGE | ALTER PACKAGE | DROP PACKAGE | CREATE PACKAGE BODY | DROP PACKAGE BODY | CREATE MAPPING | ALTER MAPPING | DROP MAPPING 

Un déclencheur externe peut être modifié à l'aide de l'instruction ALTER TRIGGER.


Syntaxe:


 ALTER TRIGGER trigname { [ACTIVE | INACTIVE] [ {BEFORE | AFTER} {<mutation_list> | <ddl_events>} | ON db_event ] [POSITION number] [<external-body>] <external-body> ::= EXTERNAL NAME <extname> ENGINE <engine> [AS <extbody>] <extname> ::= '<module name>!<routine name>[!<misc info>]' <mutation_list> ::= <mutation> [OR <mutation> [OR <mutation>]] <mutation> ::= { INSERT | UPDATE | DELETE } 

Vous pouvez supprimer un déclencheur externe à l'aide de l'instruction DROP TRIGGER.


Syntaxe:


 DROP TRIGGER trigname 

ParamètreLa description
trignameLe nom du déclencheur. Peut contenir jusqu'à 31 octets.
relation_trigger_legacyDéclaration de déclencheur de table (hérité).
relation_trigger_sql2003Déclaration d'un déclencheur de table selon la norme SQL-2003.
base de données_triggerDéclaration de déclenchement de la base de données.
ddl_triggerDéclaration de déclenchement DDL.
nom de tableLe nom de la table.
nom_vueLe nom de la vue.
mutation_listListe des événements de table.
mutationUn des événements de la table.
db_eventUn événement de connexion ou de transaction.
ddl_eventsListe des événements de changement de métadonnées.
ddl_event_itemL'un des événements de changement de métadonnées.
nombreL'ordre de déclenchement. 0 à 32767
extbodyLe corps d'un déclencheur externe. Littéral de chaîne pouvant être utilisé par l'UDR à diverses fins.
nom du moduleNom du module externe dans lequel se trouve le déclencheur.
nom de routineNom interne du déclencheur à l'intérieur du module externe.
informations diversesInformations définies par l'utilisateur pour le transfert vers le déclencheur d'un module externe.
moteurNom du moteur d'utilisation des déclencheurs externes. Habituellement, le nom est UDR.

Voici des exemples de déclaration de déclencheurs externes avec des explications.


 create database 'c:\temp\slave.fdb'; create table persons ( id integer not null, name varchar(60) not null, address varchar(60), info blob sub_type text ); commit; create database 'c:\temp\master.fdb'; create table persons ( id integer not null, name varchar(60) not null, address varchar(60), info blob sub_type text ); create table replicate_config ( name varchar(31) not null, data_source varchar(255) not null ); insert into replicate_config (name, data_source) values ('ds1', 'c:\temp\slave.fdb'); create trigger persons_replicate after insert on persons external name 'udrcpp_example!replicate!ds1' engine udr; 

L'implémentation du déclencheur se trouve dans le module udrcpp_example. À l'intérieur de ce module, un déclencheur est enregistré sous le nom répliqué. Un déclencheur externe utilise le moteur UDR.


Dans le lien vers le module externe, un paramètre supplémentaire ds1 , selon lequel la configuration est lue dans la table replicate_config à l'intérieur du déclencheur externe pour la communication avec la base de données externe.


Structure UDR


Il est maintenant temps d'écrire le premier UDR. Nous décrirons la structure de l'UDR en Pascal. Pour expliquer la structure minimale de construction d'un UDR, nous utiliserons des exemples standard d' examples/udr/ traduits en Pascal.


Créez un nouveau projet pour la nouvelle bibliothèque dynamique, que nous appellerons MyUdr. Par conséquent, vous devriez obtenir le fichier MyUdr.dpr (si vous avez créé le projet dans Delphi) ou le fichier MyUdr.lpr (si vous avez créé le projet dans Lazarus). Modifions maintenant le fichier de projet principal pour qu'il ressemble à ceci:


 library MyUdr; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} uses {$IFDEF unix} cthreads, // the c memory manager is on some systems much faster for multi-threading cmem, {$ENDIF} UdrInit in 'UdrInit.pas', SumArgsFunc in 'SumArgsFunc.pas'; exports firebird_udr_plugin; end. 

Dans ce cas, vous devez exporter une seule fonction firebird_udr_plugin , qui est le point d'entrée pour le plug-in des modules UDR externes. L'implémentation de cette fonction sera localisée dans le module UdrInit.


Remarque

Si vous développez votre UDR en Free Pascal, vous aurez besoin de directives supplémentaires. La {$mode objfpc} est requise pour activer le mode Object Pascal. À la place, vous pouvez utiliser la directive {$mode delphi} pour assurer la compatibilité avec Delphi. Comme mes exemples devraient se compiler avec succès dans FPC et Delphi, je choisis le {$mode delphi} .

La directive {$H+} inclut la prise en charge des chaînes longues. Cela est nécessaire si vous utilisez les types chaîne, ansistring, et pas seulement les chaînes terminées par null PChar, PAnsiChar, PWideChar.

De plus, nous devrons connecter des modules séparés pour prendre en charge le multithreading sur Linux et d'autres systèmes d'exploitation de type Unix.

Enregistrer des procédures, des fonctions ou des déclencheurs


Ajoutez maintenant le module UdrInit, il devrait ressembler à ceci:


 unit UdrInit; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} interface uses Firebird; //    External Engine  UDR function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; implementation uses SumArgsFunc; var myUnloadFlag: Boolean; theirUnloadFlag: BooleanPtr; function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; begin //    AUdrPlugin.registerFunction(AStatus, 'sum_args', TSumArgsFunctionFactory.Create()); //    //AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc', // TSumArgsProcedureFactory.Create()); //AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create()); //    //AUdrPlugin.registerTrigger(AStatus, 'test_trigger', // TMyTriggerFactory.Create()); theirUnloadFlag := AUnloadFlagLocal; Result := @myUnloadFlag; end; initialization myUnloadFlag := false; finalization if ((theirUnloadFlag <> nil) and not myUnloadFlag) then theirUnloadFlag^ := true; end. 

Dans la fonction firebird_udr_plugin , firebird_udr_plugin nécessaire d'enregistrer les usines de nos procédures, fonctions et déclencheurs externes. Pour chaque fonction, procédure ou déclencheur, vous devez écrire votre propre usine. Cela se fait à l'aide des méthodes d'interface IUdrPlugin:


  • registerFunction — ;
  • registerProcedure — ;
  • registerTrigger — .

, ( ). // SQL. ( ).



. SumArgsFunc. .


SumArgsFunc
 unit SumArgsFunc; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} interface uses Firebird; // ********************************************************* // create function sum_args ( // n1 integer, // n2 integer, // n3 integer // ) returns integer // external name 'myudr!sum_args' // engine udr; // ********************************************************* type //        TSumArgsInMsg = record n1: Integer; n1Null: WordBool; n2: Integer; n2Null: WordBool; n3: Integer; n3Null: WordBool; end; PSumArgsInMsg = ^TSumArgsInMsg; //        TSumArgsOutMsg = record result: Integer; resultNull: WordBool; end; PSumArgsOutMsg = ^TSumArgsOutMsg; //       TSumArgsFunction TSumArgsFunctionFactory = class(IUdrFunctionFactoryImpl) //     procedure dispose(); override; {          .        . @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @param(AInBuilder     ) @param(AOutBuilder     ) } procedure setup(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder; AOutBuilder: IMetadataBuilder); override; {      TSumArgsFunction @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @returns(  ) } function newItem(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction; override; end; //   TSumArgsFunction. TSumArgsFunction = class(IExternalFunctionImpl) //      procedure dispose(); override; {      execute             .        ,   ExternalEngine::getCharSet. @param(AStatus  ) @param(AContext    ) @param(AName   ) @param(AName    ) } procedure getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); override; {    @param(AStatus  ) @param(AContext    ) @param(AInMsg    ) @param(AOutMsg    ) } procedure execute(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer); override; end; implementation { 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 end; { TSumArgsFunction } procedure TSumArgsFunction.dispose; begin Destroy; end; procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext; AInMsg, AOutMsg: Pointer); var xInput: PSumArgsInMsg; xOutput: PSumArgsOutMsg; begin //         xInput := PSumArgsInMsg(AInMsg); xOutput := PSumArgsOutMsg(AOutMsg); //     NULL    NULL xOutput^.resultNull := xInput^.n1Null or xInput^.n2Null or xInput^.n3Null; xOutput^.result := xInput^.n1 + xInput^.n2 + xInput^.n3; end; procedure TSumArgsFunction.getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); begin end; end. 

IUdrFunctionFactory. IUdrFunctionFactoryImpl. . , , . .


dispose , . .


setup . , . .


newItem . , . IRoutineMetadata , . PSQL. . TSumArgsFunction .


IExternalFunction. IExternalFunctionImpl .


dispose , . .


.


getCharSet , . , .


execute . , , .


. , , BLOB. BLOB, .


, . , . , , , NULL ( Null ). , , IMessageMetadata. , execute.


. Pour
Null Null
, NULL,



UDR . : . , .. EXECUTE PROCEDURE .


UdrInit firebird_udr_plugin .


 function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; begin //    AUdrPlugin.registerFunction(AStatus, 'sum_args', TSumArgsFunctionFactory.Create()); //    AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc', TSumArgsProcedureFactory.Create()); //AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create()); //    //AUdrPlugin.registerTrigger(AStatus, 'test_trigger', // TMyTriggerFactory.Create()); theirUnloadFlag := AUnloadFlagLocal; Result := @myUnloadFlag; end; 

Remarque

uses SumArgsProc, .

IUdrProcedureFactory. IUdrProcedureFactoryImpl. . , , . .


dispose , . .


setup . , . .


newItem . , . IRoutineMetadata , . PSQL. . TSumArgsProcedure .


SumArgsProc.


SumArgsProc
 unit SumArgsProc; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} interface uses Firebird; { ********************************************************** create procedure sp_sum_args ( n1 integer, n2 integer, n3 integer ) returns (result integer) external name 'myudr!sum_args_proc' engine udr; ********************************************************* } type //        TSumArgsInMsg = record n1: Integer; n1Null: WordBool; n2: Integer; n2Null: WordBool; n3: Integer; n3Null: WordBool; end; PSumArgsInMsg = ^TSumArgsInMsg; //        TSumArgsOutMsg = record result: Integer; resultNull: WordBool; end; PSumArgsOutMsg = ^TSumArgsOutMsg; //       TSumArgsProcedure TSumArgsProcedureFactory = class(IUdrProcedureFactoryImpl) //     procedure dispose(); override; {                  . @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @param(AInBuilder     ) @param(AOutBuilder     ) } procedure setup(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder; AOutBuilder: IMetadataBuilder); override; {      TSumArgsProcedure @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @returns(  ) } function newItem(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure; override; end; TSumArgsProcedure = class(IExternalProcedureImpl) public //      procedure dispose(); override; {      open             .        ,   ExternalEngine::getCharSet. @param(AStatus  ) @param(AContext    ) @param(AName   ) @param(AName    ) } procedure getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); override; {    @param(AStatus  ) @param(AContext    ) @param(AInMsg    ) @param(AOutMsg    ) @returns(      nil   ) } function open(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer): IExternalResultSet; override; end; implementation { TSumArgsProcedureFactory } procedure TSumArgsProcedureFactory.dispose; begin Destroy; end; function TSumArgsProcedureFactory.newItem(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure; begin Result := TSumArgsProcedure.create; end; procedure TSumArgsProcedureFactory.setup(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder, AOutBuilder: IMetadataBuilder); begin end; { TSumArgsProcedure } procedure TSumArgsProcedure.dispose; begin Destroy; end; procedure TSumArgsProcedure.getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); begin end; function TSumArgsProcedure.open(AStatus: IStatus; AContext: IExternalContext; AInMsg, AOutMsg: Pointer): IExternalResultSet; var xInput: PSumArgsInMsg; xOutput: PSumArgsOutMsg; begin Result := nil; //         xInput := PSumArgsInMsg(AInMsg); xOutput := PSumArgsOutMsg(AOutMsg); //     NULL    NULL xOutput^.resultNull := xInput^.n1Null or xInput^.n2Null or xInput^.n3Null; xOutput^.result := xInput^.n1 + xInput^.n2 + xInput^.n3; end; end. 

IExternalProcedure. IExternalProcedureImpl .


dispose , . .


getCharSet . , .


open . , , . , nil, . . TSumArgsFunction.execute.



UDR . firebird_udr_plugin .


 function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; begin //    AUdrPlugin.registerFunction(AStatus, 'sum_args', TSumArgsFunctionFactory.Create()); //    AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc', TSumArgsProcedureFactory.Create()); AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create()); //    //AUdrPlugin.registerTrigger(AStatus, 'test_trigger', // TMyTriggerFactory.Create()); theirUnloadFlag := AUnloadFlagLocal; Result := @myUnloadFlag; end; 

Remarque

uses GenRowsProc, .

. , open, .


GenRowsProc
 unit GenRowsProc; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} interface uses Firebird, SysUtils; type { ********************************************************** create procedure gen_rows ( start integer, finish integer ) returns (n integer) external name 'myudr!gen_rows' engine udr; ********************************************************* } TInput = record start: Integer; startNull: WordBool; finish: Integer; finishNull: WordBool; end; PInput = ^TInput; TOutput = record n: Integer; nNull: WordBool; end; POutput = ^TOutput; //       TGenRowsProcedure TGenRowsFactory = class(IUdrProcedureFactoryImpl) //     procedure dispose(); override; {          .        . @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @param(AInBuilder     ) @param(AOutBuilder     ) } procedure setup(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder; AOutBuilder: IMetadataBuilder); override; {      TGenRowsProcedure @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @returns(  ) } function newItem(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure; override; end; //   TGenRowsProcedure. TGenRowsProcedure = class(IExternalProcedureImpl) public //      procedure dispose(); override; {      open             .        ,   ExternalEngine::getCharSet. @param(AStatus  ) @param(AContext    ) @param(AName   ) @param(AName    ) } procedure getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); override; {    @param(AStatus  ) @param(AContext    ) @param(AInMsg    ) @param(AOutMsg    ) @returns(      nil   ) } function open(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer): IExternalResultSet; override; end; //      TGenRowsProcedure TGenRowsResultSet = class(IExternalResultSetImpl) Input: PInput; Output: POutput; //       procedure dispose(); override; {      .     SUSPEND.          . @param(AStatus  ) @returns(True        , False   ) } function fetch(AStatus: IStatus): Boolean; override; end; implementation { TGenRowsFactory } procedure TGenRowsFactory.dispose; begin Destroy; end; function TGenRowsFactory.newItem(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalProcedure; begin Result := TGenRowsProcedure.create; end; procedure TGenRowsFactory.setup(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder, AOutBuilder: IMetadataBuilder); begin end; { TGenRowsProcedure } procedure TGenRowsProcedure.dispose; begin Destroy; end; procedure TGenRowsProcedure.getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); begin end; function TGenRowsProcedure.open(AStatus: IStatus; AContext: IExternalContext; AInMsg, AOutMsg: Pointer): IExternalResultSet; begin //      NULL    if PInput(AInMsg).startNull or PInput(AInMsg).finishNull then begin POutput(AOutMsg).nNull := True; Result := nil; exit; end; //  if PInput(AInMsg).start > PInput(AInMsg).finish then raise Exception.Create('First parameter greater then second parameter.'); Result := TGenRowsResultSet.create; with TGenRowsResultSet(Result) do begin Input := AInMsg; Output := AOutMsg; //   Output.nNull := False; Output.n := Input.start - 1; end; end; { TGenRowsResultSet } procedure TGenRowsResultSet.dispose; begin Destroy; end; //   True       . //   False       //         //     function TGenRowsResultSet.fetch(AStatus: IStatus): Boolean; begin Inc(Output.n); Result := (Output.n <= Input.finish); end; end. 

open TGenRowsProcedure NULL, NULL, NULL, SELECT, nil.


, , . UDR Firebird. UDR Legacy UDF.


, open , IExternalResultSet. IExternalResultSetImpl .


dispose . .


fetch SELECT. SUSPEND PSQL . , . true, , false , . , .


Remarque

Delphi yeild,
 while(...) do { ... yield result; } 


, open, , fetch. ( SELECT FIRST/ROWS/FETCH FIRST SELECT.)


UDR .


Note

C++ . , . .

UdrInit firebird_udr_plugin .


 function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; begin //    AUdrPlugin.registerFunction(AStatus, 'sum_args', TSumArgsFunctionFactory.Create()); //    AUdrPlugin.registerProcedure(AStatus, 'sum_args_proc', TSumArgsProcedureFactory.Create()); AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create()); //    AUdrPlugin.registerTrigger(AStatus, 'test_trigger', TMyTriggerFactory.Create()); theirUnloadFlag := AUnloadFlagLocal; Result := @myUnloadFlag; end; 

Remarque

uses TestTrigger, .

IUdrTriggerFactory. IUdrTriggerFactoryImpl.
.


dispose , . .


setup . , . .


newItem . , . IRoutineMetadata , . PSQL. . TMyTrigger .


TestTrigger.


TestTrigger
 unit TestTrigger; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} interface uses Firebird, SysUtils; type { ********************************************************** create table test ( id int generated by default as identity, a int, b int, name varchar(100), constraint pk_test primary key(id) ); create or alter trigger tr_test_biu for test active before insert or update position 0 external name 'myudr!test_trigger' engine udr; } //     NEW.*  OLD.* //      test TFieldsMessage = record Id: Integer; IdNull: WordBool; A: Integer; ANull: WordBool; B: Integer; BNull: WordBool; Name: record Length: Word; Value: array [0 .. 399] of AnsiChar; end; NameNull: WordBool; end; PFieldsMessage = ^TFieldsMessage; //       TMyTrigger TMyTriggerFactory = class(IUdrTriggerFactoryImpl) //     procedure dispose(); override; {          .       . @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @param(AFieldsBuilder     ) } procedure setup(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata; AFieldsBuilder: IMetadataBuilder); override; {      TMyTrigger @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @returns(  ) } function newItem(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalTrigger; override; end; TMyTrigger = class(IExternalTriggerImpl) //     procedure dispose(); override; {      execute             .        ,   ExternalEngine::getCharSet. @param(AStatus  ) @param(AContext    ) @param(AName   ) @param(AName    ) } procedure getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); override; {   TMyTrigger @param(AStatus  ) @param(AContext    ) @param(AAction  ( ) ) @param(AOldMsg      :OLD.*) @param(ANewMsg      :NEW.*) } procedure execute(AStatus: IStatus; AContext: IExternalContext; AAction: Cardinal; AOldMsg: Pointer; ANewMsg: Pointer); override; end; implementation { TMyTriggerFactory } procedure TMyTriggerFactory.dispose; begin Destroy; end; function TMyTriggerFactory.newItem(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalTrigger; begin Result := TMyTrigger.create; end; procedure TMyTriggerFactory.setup(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata; AFieldsBuilder: IMetadataBuilder); begin end; { TMyTrigger } procedure TMyTrigger.dispose; begin Destroy; end; procedure TMyTrigger.execute(AStatus: IStatus; AContext: IExternalContext; AAction: Cardinal; AOldMsg, ANewMsg: Pointer); var xOld, xNew: PFieldsMessage; begin // xOld := PFieldsMessage(AOldMsg); xNew := PFieldsMessage(ANewMsg); case AAction of IExternalTrigger.ACTION_INSERT: begin if xNew.BNull and not xNew.ANull then begin xNew.B := xNew.A + 1; xNew.BNull := False; end; end; IExternalTrigger.ACTION_UPDATE: begin if xNew.BNull and not xNew.ANull then begin xNew.B := xNew.A + 1; xNew.BNull := False; end; end; IExternalTrigger.ACTION_DELETE: begin end; end; end; procedure TMyTrigger.getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); begin end; end. 

IExternalTrigger. IExternalTriggerImpl .


dispose , . .


getCharSet . , .


execute . , , () . () IExternalTrigger. ACTION_ . , Firebird . , DDL , , , nil. . , , .


Remarque

, , . IMessageMetadata. , . , , /.

, PSQL


  if (:new.B IS NULL) THEN :new.B = :new.A + 1; 

Des messages


UDR , . NEW OLD.


, , .
:


  • ( Delphi , .. record);


  • IMessageMetadata, / , .



, — , UDR.



. :


 TMyStruct = record <var_1>: <type_1>; <nullIndicator_1>: WordBool; <var_2>: <type_1>; <nullIndicator_2>: WordBool; ... <var_N>: <type_1>; <nullIndicator_N>: WordBool; end; PMyStruct = ^TMyStruct; 

/ ( ). Null- /, NOT NULL. Null- 2 . -1
/ NULL. NULL- NULL, 2- . SQL :


SQLDelphi
BOOLEANBoolean, ByteBool
SMALLINTSmallint
INTEGERInteger
BIGINTInt64
FLOATSingle
DOUBLE PRECISIONDouble
NUMERIC(N, M):
  • 1-4 — Smallint;
  • 5-9 — Integer;
  • 10-18 (3 ) — Int64;
  • 10-15 (1 ) — Double.

.
DECIMAL(N, M):
  • 1-4 — Integer;
  • 5-9 — Integer;
  • 10-18 (3 ) — Int64;
  • 10-15 (1 ) — Double.

.
CHAR(N)array[0… M] of AnsiCharM ,
BytesPerChar — , /. UTF-8 — 4 /, WIN1251 — 1 /.
VARCHAR(N)FbVarChar<N>M ,
BytesPerChar — , /. UTF-8 — 4 /, WIN1251 — 1 /. Length . Delphi C++,
FbVarChar<N> ,
. .
DATEISC_DATE
TIMEISC_TIME
TIMESTAMPISC_TIMESTAMPISC_TIMESTAMP Firebird.pas, . .
BLOBISC_QUADBLOB , BlobId. BLOB .

 //      VARCHAR(N) // M = N * BytesPerChar - 1 record Length: Smallint; Data: array[0 .. M] of AnsiChar; end; //      TIMESTAMP ISC_TIMESTAMP = record date: ISC_DATE; time: ISC_TIME; end; 


, .


:


 function SUM_ARGS(A SMALLINT, B INTEGER) RETURNS BIGINT .... 


:


 TInput = record A: Smallint; ANull: WordBool; B: Integer; BNull: WordBool; end; PInput = ^TInput; TOutput = record Value: Int64; Null: WordBool; end; POutput = ^TOutput; 

( 3 ):


 function SUM_ARGS(A NUMERIC(4, 2), B NUMERIC(9, 3)) RETURNS NUMERIC(18, 6) .... 


:


 TInput = record A: Smallint; ANull: WordBool; B: Integer; BNull: WordBool; end; PInput = ^TInput; TOutput = record Value: Int64; Null: WordBool; end; POutput = ^TOutput; 

:


 procedure SOME_PROC(A CHAR(3) CHARACTER SET WIN1251, B VARCHAR(10) CHARACTER SET UTF8) .... 

:


 TInput = record A: array[0..2] of AnsiChar; ANull: WordBool; B: record Length: Smallint; Value: array[0..39] of AnsiChar; end; BNull: WordBool; end; PInput = ^TInput; 

IMessageMetadata




IMessageMetadata. /
:


  • /;
  • ;
  • ;
  • BLOB;
  • /;
  • / NULL;
  • ;
  • NULL-.

IMessageMetadata


  1. getCount


     unsigned getCount(StatusType* status) 

    / . , , : 0 <= index < getCount().


  2. getField


     const char* getField(StatusType* status, unsigned index) 

    .


  3. getRelation


     const char* getRelation(StatusType* status, unsigned index) 

    ( ).


  4. getOwner


     const char* getOwner(StatusType* status, unsigned index) 

    .


  5. getAlias


     const char* getAlias(StatusType* status, unsigned index) 

    .


  6. getType


     unsigned getType(StatusType* status, unsigned index) 

    SQL .


  7. isNullable


     FB_BOOLEAN isNullable(StatusType* status, unsigned index) 

    true, NULL.


  8. getSubType


     int getSubType(StatusType* status, unsigned index) 

    BLOB (0 — , 1 — . .).


  9. getLength


     unsigned getLength(StatusType* status, unsigned index) 

    .


  10. getScale


     int getScale(StatusType* status, unsigned index) 

    .


  11. getCharSet


     unsigned getCharSet(StatusType* status, unsigned index) 

    BLOB.


  12. getOffset


     unsigned getOffset(StatusType* status, unsigned index) 

    ( ).


  13. getNullOffset


     unsigned getNullOffset(StatusType* status, unsigned index) 

    NULL .


  14. getBuilder


     IMetadataBuilder* getBuilder(StatusType* status) 

    IMetadataBuilder, .


  15. getMessageLength


     unsigned getMessageLength(StatusType* status) 

    ( ).



IMessageMetadata


IMessageMetadata IRoutineMetadata. , . . Par exemple:


RoutineMetadata
  //       TSumArgsFunction TSumArgsFunctionFactory = class(IUdrFunctionFactoryImpl) //     procedure dispose(); override; {           @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @param(AInBuilder     ) @param(AOutBuilder     ) } procedure setup(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder: IMetadataBuilder; AOutBuilder: IMetadataBuilder); override; {      TSumArgsFunction @param(AStatus  ) @param(AContext    ) @param(AMetadata   ) @returns(  ) } function newItem(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction; override; end; //   TSumArgsFunction. TSumArgsFunction = class(IExternalFunctionImpl) private FMetadata: IRoutineMetadata; public property Metadata: IRoutineMetadata read FMetadata write FMetadata; public //      procedure dispose(); override; {      execute             .        ,   ExternalEngine::getCharSet. @param(AStatus  ) @param(AContext    ) @param(AName   ) @param(AName    ) } procedure getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); override; {    @param(AStatus  ) @param(AContext    ) @param(AInMsg    ) @param(AOutMsg    ) } procedure execute(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer); override; end; ........................ { TSumArgsFunctionFactory } procedure TSumArgsFunctionFactory.dispose; begin Destroy; end; function TSumArgsFunctionFactory.newItem(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata): IExternalFunction; begin Result := TSumArgsFunction.Create(); with Result as TSumArgsFunction do begin Metadata := AMetadata; end; end; procedure TSumArgsFunctionFactory.setup(AStatus: IStatus; AContext: IExternalContext; AMetadata: IRoutineMetadata; AInBuilder, AOutBuilder: IMetadataBuilder); begin end; 

IMessageMetadata getInputMetadata getOutputMetadata IRoutineMetadata. , , getTriggerMetadata.




, IMessageMetadata . IReferenceCounted. getInputMetadata getOutputMetadata 1 , xInputMetadata xOutputMetadata release.

. IMessageMetadata getOffset . .
null , getNullOffset.


IMessageMetadata
 // ........................ procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext; AInMsg, AOutMsg: Pointer); var n1, n2, n3: Integer; n1Null, n2Null, n3Null: WordBool; Result: Integer; resultNull: WordBool; xInputMetadata, xOutputMetadata: IMessageMetadata; begin xInputMetadata := FMetadata.getInputMetadata(AStatus); xOutputMetadata := FMetadata.getOutputMetadata(AStatus); try //        n1 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 0))^; n2 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 1))^; n3 := PInteger(PByte(AInMsg) + xInputMetadata.getOffset(AStatus, 2))^; //   null-      n1Null := PWordBool(PByte(AInMsg) + xInputMetadata.getNullOffset(AStatus, 0))^; n2Null := PWordBool(PByte(AInMsg) + xInputMetadata.getNullOffset(AStatus, 1))^; n3Null := PWordBool(PByte(AInMsg) + xInputMetadata.getNullOffset(AStatus, 2))^; //     = NULL,     nullFlag resultNull := True; Result := 0; //     NULL    NULL //       if not(n1Null or n2Null or n3Null) then begin Result := n1 + n2 + n3; //   ,   NULL  resultNull := False; end; PWordBool(PByte(AInMsg) + xOutputMetadata.getNullOffset(AStatus, 0))^ := resultNull; PInteger(PByte(AInMsg) + xOutputMetadata.getOffset(AStatus, 0))^ := Result; finally xInputMetadata.release; xOutputMetadata.release; end; end; 


. .


, . IUdrProcedureFactory, IUdrFunctionFactory IUdrTriggerFactory UDR. UDR firebird_udr_plugin .


 function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; begin //    AUdrPlugin.registerFunction(AStatus, 'sum_args', TSumArgsFunctionFactory.Create()); //    AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TGenRowsFactory.Create()); //    AUdrPlugin.registerTrigger(AStatus, 'test_trigger', TMyTriggerFactory.Create()); theirUnloadFlag := AUnloadFlagLocal; Result := @myUnloadFlag; end; 

TSumArgsFunctionFactory IUdrFunctionFactory, TGenRowsFactory IUdrProcedureFactory, TMyTriggerFactory IUdrTriggerFactory.


, . Firebird. , SuperServer , Classic
.


setup newItem IUdrProcedureFactory, IUdrFunctionFactory IUdrTriggerFactory.


  IUdrFunctionFactory = class(IDisposable) const VERSION = 3; procedure setup(status: IStatus; context: IExternalContext; metadata: IRoutineMetadata; inBuilder: IMetadataBuilder; outBuilder: IMetadataBuilder); function newItem(status: IStatus; context: IExternalContext; metadata: IRoutineMetadata): IExternalFunction; end; IUdrProcedureFactory = class(IDisposable) const VERSION = 3; procedure setup(status: IStatus; context: IExternalContext; metadata: IRoutineMetadata; inBuilder: IMetadataBuilder; outBuilder: IMetadataBuilder); function newItem(status: IStatus; context: IExternalContext; metadata: IRoutineMetadata): IExternalProcedure; end; IUdrTriggerFactory = class(IDisposable) const VERSION = 3; procedure setup(status: IStatus; context: IExternalContext; metadata: IRoutineMetadata; fieldsBuilder: IMetadataBuilder); function newItem(status: IStatus; context: IExternalContext; metadata: IRoutineMetadata): IExternalTrigger; end; 

, IDisposable, dispose. Firebird , . dispose , , .
IUdrProcedureFactoryImpl , IUdrFunctionFactoryImpl , IUdrTriggerFactoryImpl . .


newItem


newItem , . UDR , .. , . .


. , , , IUdrFunctionFactory . . .


newItem ,
UDR UDR.



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

IRoutineMetadata , UDR . UDR. UDR .


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

setup


setup . IMetadataBuilder, , .
setup, setup DLL , . .


. , SumArgs.


,


 type //        TSumArgsInMsg = record n1: Integer; n1Null: WordBool; n2: Integer; n2Null: WordBool; n3: Integer; n3Null: WordBool; end; PSumArgsInMsg = ^TSumArgsInMsg; //        TSumArgsOutMsg = record result: Integer; resultNull: WordBool; end; PSumArgsOutMsg = ^TSumArgsOutMsg; 

, setup , .


SumArgsFunctionFactory
 { 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 //      AInBuilder.setType(AStatus, 0, Cardinal(SQL_LONG) + 1); AInBuilder.setLength(AStatus, 0, sizeof(Int32)); AInBuilder.setType(AStatus, 1, Cardinal(SQL_LONG) + 1); AInBuilder.setLength(AStatus, 1, sizeof(Int32)); AInBuilder.setType(AStatus, 2, Cardinal(SQL_LONG) + 1); AInBuilder.setLength(AStatus, 2, sizeof(Int32)); //      AOutBuilder.setType(AStatus, 0, Cardinal(SQL_LONG) + 1); AOutBuilder.setLength(AStatus, 0, sizeof(Int32)); end; 



SQL Firebird . , SQL NULL. XSQLDA.


 procedure TSumArgsFunction.execute(AStatus: IStatus; AContext: IExternalContext; AInMsg, AOutMsg: Pointer); var xInput: PSumArgsInMsg; xOutput: PSumArgsOutMsg; begin //         xInput := PSumArgsInMsg(AInMsg); xOutput := PSumArgsOutMsg(AOutMsg); //     = NULL,     nullFlag xOutput^.resultNull := True; //     NULL    NULL //       xOutput^.resultNull := xInput^.n1Null or xInput^.n2Null or xInput^.n3Null; xOutput^.result := xInput^.n1 + xInput^.n2 + xInput^.n3; end; 

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


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


UDR , UDR. . Delphi 2009, Free Pascal FPC 2.2.


Remarque

Free Pascal
Delphi. FPC 2.6.0 Delphi
.


:


  • , , UDR, ;


  • , , UDR, IMessageMetadata.



newItem . IUdrFunctionFactoryImpl , IUdrProcedureFactoryImpl , IUdrTriggerFactoryImpl . :


SimpleFactories
 unit UdrFactories; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} interface uses SysUtils, Firebird; type //     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; //     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; //     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; 

setup , , dispose . newItem 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; 

1 , . :


 function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; begin //    AUdrPlugin.registerFunction(AStatus, 'sum_args', TFunctionSimpleFactory<TSumArgsFunction>.Create()); //    AUdrPlugin.registerProcedure(AStatus, 'gen_rows', TProcedureSimpleFactory<TGenRowsProcedure>.Create()); //    AUdrPlugin.registerTrigger(AStatus, 'test_trigger', TTriggerSimpleFactory<TMyTrigger>.Create()); theirUnloadFlag := AUnloadFlagLocal; Result := @myUnloadFlag; end; 

. , . newItem . UDR IRoutineMetadata , Firebird, UDR. , , UDR, ,
UDR. , , .


 unit UdrFactories; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} interface uses SysUtils, Firebird; type ... //     TExternalFunction = class(IExternalFunctionImpl) Metadata: IRoutineMetadata; end; //     TExternalProcedure = class(IExternalProcedureImpl) Metadata: IRoutineMetadata; end; //     TExternalTrigger = class(IExternalTriggerImpl) Metadata: IRoutineMetadata; end; 

, .


 unit UdrFactories; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} interface uses SysUtils, Firebird; type ... //     TExternalFunction = class(IExternalFunctionImpl) Metadata: IRoutineMetadata; end; //     TExternalProcedure = class(IExternalProcedureImpl) Metadata: IRoutineMetadata; end; //     TExternalTrigger = class(IExternalTriggerImpl) Metadata: IRoutineMetadata; end; 

, .


UDR .


 unit UdrFactories; {$IFDEF FPC} {$MODE DELPHI}{$H+} {$ENDIF} interface uses SysUtils, Firebird; type ... //      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; //      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; //      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; 

newItem ,
, .


 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; 

https://github.com/sim1984/udr-book/blob/master/examples/Common/UdrFactories.pas .


BLOB


BLOB ( BLOB), . , BLOB , . BLOB . BLOB
IBlob .


BLOB , BLOB , BLOB , BLOB .


BLOB , BLOB (), 64 . getSegment IBlob . putSegment IBlob .


BLOB


BLOB
(
LIST).


 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; 

:


 function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; begin //    AUdrPlugin.registerProcedure(AStatus, 'split', TProcedureSimpleFactory<TSplitProcedure>.Create()); theirUnloadFlag := AUnloadFlagLocal; Result := @myUnloadFlag; end; 

, . .


. .


  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; 

BLOB BLOB, ISC_QUAD .


:


Split
  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 //      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; 

SaveBlobToStream readBlob BLOB. BLOB , — Delphi. OutputArray Counter.


open BLOB . Split . .


TSplitProcedure.open
 function TSplitProcedure.open(AStatus: IStatus; AContext: IExternalContext; AInMsg, AOutMsg: Pointer): IExternalResultSet; var xInput: TInputPtr; xText: string; xDelimiter: string; begin xInput := AInMsg; if xInput.txtNull or xInput.delimiterNull then begin Result := nil; Exit; end; xText := readBlob(AStatus, AContext, @xInput.txt); xDelimiter := TFBCharSet.CS_UTF8.GetString(TBytes(@xInput.delimiter), 0, 4); //        //    //  - /4 SetLength(xDelimiter, 1); Result := TSplitResultSet.Create; with TSplitResultSet(Result) do begin Output := AOutMsg; OutputArray := xText.Split([xDelimiter], TStringSplitOptions.ExcludeEmpty); Counter := 0; end; end; 

Remarque

TFBCharSet Firebird.pas.
Firebird.
UTF-8.
FbCharsets.pas

BLOB . BLOB . openBlob IAttachment . BLOB , . ,
( IExternalContext ).


BLOB (), 64 . getSegment IBlob .


TSplitProcedure.SaveBlobToStream
 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; blob.close(AStatus); finally if Assigned(att) then att.release; if Assigned(trx) then trx.release; if Assigned(blob) then blob.release; end; end; 

Remarque

, IAttachment , ITransaction IBlob
IReferenceCounted ,
.
1.
release.

SaveBlobToStream BLOB
:


 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; 

Remarque

Free Pascal
Delphi TStringStream . FPC
,
.

fetch Counter , . . isc_convert_error .


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; //         isc_random //        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('Cannot convert string to integer')); statusVector[4] := NativeIntPtr(isc_arg_end); AStatus.setErrors(@statusVector); end; end; inc(Counter); Result := True; end else Result := False; end; 

Remarque

isc_random
, .

:


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

Remarque

, BLOB
,
.
,
.
fetch .

BLOB


BLOB
BLOB .


Remarque

UDF
BLOB / . UDF
blobsaveload.zip

BLOB /


 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^ 

:


 function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; begin //  AUdrPlugin.registerProcedure(AStatus, 'SaveBlobToFile', TSaveBlobToFileProcFactory.Create()); AUdrPlugin.registerFunction(AStatus, 'LoadBlobFromFile', TLoadBlobFromFileFuncFactory.Create()); theirUnloadFlag := AUnloadFlagLocal; Result := @myUnloadFlag; end; 

BLOB , UDR
06.BlobSaveLoad . LoadBlobFromFile :


 interface uses Firebird, Classes, SysUtils; type //    TInput = record filename: record len: Smallint; str: array [0 .. 1019] of AnsiChar; end; filenameNull: WordBool; end; TInputPtr = ^TInput; //    TOutput = record blobData: ISC_QUAD; blobDataNull: WordBool; end; TOutputPtr = ^TOutput; //   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; //       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; 

execute TLoadBlobFromFile , .


execute
 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; //    xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0, xInput.filename.len * 4); SetLength(xFileName, xInput.filename.len); //     xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone); att := AContext.getAttachment(AStatus); trx := AContext.getTransaction(AStatus); blob := nil; try xStreamSize := xStream.Size; //     () if xStreamSize > MaxBufSize then xBufferSize := MaxBufSize else xBufferSize := xStreamSize; //   blob blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil); //        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; //  BLOB blob.close(AStatus); finally if Assigned(blob) then blob.release; att.release; trx.release; xStream.Free; end; end; 

BLOB blobId createBlob IAttachment . BLOB , . , ( IExternalContext ).


BLOB, putSegment IBlob , . close .


BLOB


BLOB
, BLOB .
BLOB,
.


Delphi Free Pascal
.
IBlob
/ Blob.


FbBlob, .


BlobHelper
 unit FbBlob; interface uses Classes, SysUtils, Firebird; const MAX_SEGMENT_SIZE = $7FFF; type TFbBlobHelper = class helper for IBlob {   BLOB   @param(AStatus  ) @param(AStream ) } procedure LoadFromStream(AStatus: IStatus; AStream: TStream); {     BLOB @param(AStatus  ) @param(AStream ) } procedure SaveToStream(AStatus: IStatus; AStream: TStream); end; implementation uses Math; procedure TFbBlobHelper.LoadFromStream(AStatus: IStatus; AStream: TStream); var xStreamSize: Integer; xReadLength: Integer; xBuffer: array [0 .. MAX_SEGMENT_SIZE] of Byte; begin xStreamSize := AStream.Size; AStream.Position := 0; while xStreamSize <> 0 do begin xReadLength := Min(xStreamSize, MAX_SEGMENT_SIZE); AStream.ReadBuffer(xBuffer, xReadLength); Self.putSegment(AStatus, xReadLength, @xBuffer[0]); Dec(xStreamSize, xReadLength); end; end; procedure TFbBlobHelper.SaveToStream(AStatus: IStatus; AStream: TStream); var xInfo: TFbBlobInfo; Buffer: array [0 .. MAX_SEGMENT_SIZE] of Byte; xBytesRead: Cardinal; xBufferSize: Cardinal; begin AStream.Position := 0; xBufferSize := Min(SizeOf(Buffer), MAX_SEGMENT_SIZE); while True do begin case Self.getSegment(AStatus, xBufferSize, @Buffer[0], @xBytesRead) of IStatus.RESULT_OK: AStream.WriteBuffer(Buffer, xBytesRead); IStatus.RESULT_SEGMENT: AStream.WriteBuffer(Buffer, xBytesRead); else break; end; end; end; end. 

BLOB, BLOB :


TLoadBlobFromFileFunc.execute
 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; //    xFileName := TEncoding.UTF8.GetString(TBytes(@xInput.filename.str), 0, xInput.filename.len * 4); SetLength(xFileName, xInput.filename.len); //     xStream := TFileStream.Create(xFileName, fmOpenRead or fmShareDenyNone); att := AContext.getAttachment(AStatus); trx := AContext.getTransaction(AStatus); blob := nil; try //   blob blob := att.createBlob(AStatus, trx, @xOutput.blobData, 0, nil); //     BLOB blob.LoadFromStream(AStatus, xStream); //  BLOB blob.close(AStatus); finally if Assigned(blob) then blob.release; att.release; trx.release; xStream.Free; end; end; 


, , , / . , BLOB.


, IExternalContext execute , open . IExternalContext getAttachment , getTransaction . UDR, , , startTransaction IExternalContext . . , , .. (2PC).


, SELECT JSON. :


 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; 

SQL , , . IMessageMetadata . , ,
Firebird.


Remarque

JSON .
CHAR, VARCHAR OCTETS NONE BLOB SUB_TYPE BINARY
base64,
JSON.

:


 function firebird_udr_plugin(AStatus: IStatus; AUnloadFlagLocal: BooleanPtr; AUdrPlugin: IUdrPlugin): BooleanPtr; cdecl; begin //   AUdrPlugin.registerFunction(AStatus, 'getJson', TFunctionSimpleFactory<TJsonFunction>.Create()); theirUnloadFlag := AUnloadFlagLocal; Result := @myUnloadFlag; end; 

, :


GetJson
 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; //   TSumArgsFunction. TJsonFunction = class(IExternalFunctionImpl) public procedure dispose(); override; procedure getCharSet(AStatus: IStatus; AContext: IExternalContext; AName: PAnsiChar; ANameSize: Cardinal); override; {         @param(AValue ) @param(Scale ) @returns(   ) } function MakeScaleInteger(AValue: Int64; Scale: Smallint): string; {       Json @param(AStatus  ) @param(AContext    ) @param(AJson   Json) @param(ABuffer  ) @param(AMeta  ) @param(AFormatSetting     ) } procedure writeJson(AStatus: IStatus; AContext: IExternalContext; AJson: TJsonArray; ABuffer: PByte; AMeta: IMessageMetadata; AFormatSettings: TFormatSettings); {    @param(AStatus  ) @param(AContext    ) @param(AInMsg    ) @param(AOutMsg    ) } procedure execute(AStatus: IStatus; AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer); override; end; 

MakeScaleInteger , writeJson Json . , execute .


TJsonFunction.execute
 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; //      NULL,    NULL if xInput.SqlNull or xInput.SqlDialectNull then begin xOutput.NullFlag := True; Exit; end; xOutput.NullFlag := False; //      xFormatSettings := TFormatSettings.Create; xFormatSettings.DateSeparator := '-'; xFormatSettings.TimeSeparator := ':'; //      blob inStream := TBytesStream.Create(nil); outStream := TStringStream.Create('', 65001); jsonArray := TJsonArray.Create; //      att := AContext.getAttachment(AStatus); tra := AContext.getTransaction(AStatus); stmt := nil; inBlob := nil; outBlob := nil; try //  BLOB   inBlob := att.openBlob(AStatus, tra, @xInput.SqlText, 0, nil); inBlob.SaveToStream(AStatus, inStream); inBlob.close(AStatus); //   stmt := att.prepare(AStatus, tra, inStream.Size, @inStream.Bytes[0], xInput.SqlDialect, IStatement.PREPARE_PREFETCH_METADATA); //     cursorMetaData := stmt.getOutputMetadata(AStatus); //   rs := stmt.openCursor(AStatus, tra, nil, nil, nil, 0); //     msgLen := cursorMetaData.getMessageLength(AStatus); msg := AllocMem(msgLen); try //     while rs.fetchNext(AStatus, msg) = IStatus.RESULT_OK do begin //     JSON writeJson(AStatus, AContext, jsonArray, msg, cursorMetaData, xFormatSettings); end; finally //   FreeMem(msg); end; //   rs.close(AStatus); //  JSON   outStream.WriteString(jsonArray.ToJSON); //  json   blob outBlob := att.createBlob(AStatus, tra, @xOutput.Json, 0, nil); outBlob.LoadFromStream(AStatus, outStream); outBlob.close(AStatus); finally if Assigned(inBlob) then inBlob.release; if Assigned(stmt) then stmt.release; if Assigned(outBlob) then outBlob.release; tra.release; att.release; jsonArray.Free; inStream.Free; outStream.Free; end; end; 

getAttachment getTransaction IExternalContext . BLOB SQL . prepare IAttachment . SQL . IStatement.PREPARE_PREFETCH_METADATA , . getOutputMetadata IStatement .


Remarque

getOutputMetadata .
IStatement.PREPARE_PREFETCH_METADATA
.
, .

openCursor ( 2). getMessageLength IMessageMetadata . , .


fetchNext IResultSet . msg IStatus.RESULT_OK , . writeJson , TJsonObject TJsonArray .


, close , Json , , Blob.


writeJson . IUtil , . IMessageMetadata . TJsonObject . . NullFlag, null , Json.


writeJson
 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; pData: PByte; util: IUtil; metaLength: Integer; //  CharBuffer: array [0 .. 35766] of Byte; charLength: Smallint; charset: TFBCharSet; StringValue: string; SmallintValue: Smallint; IntegerValue: Integer; BigintValue: Int64; Scale: Smallint; SingleValue: Single; DoubleValue: Double; BooleanValue: Boolean; DateValue: ISC_DATE; TimeValue: ISC_TIME; TimestampValue: ISC_TIMESTAMP; DateTimeValue: TDateTime; year, month, day: Cardinal; hours, minutes, seconds, fractions: Cardinal; blobId: ISC_QUADPtr; BlobSubtype: Smallint; blob: IBlob; textStream: TStringStream; binaryStream: TBytesStream; att: IAttachment; tra: ITransaction; begin //  IUtil util := AContext.getMaster().getUtilInterface(); //   TJsonObject    //     jsonObject := TJsonObject.Create; for i := 0 to AMeta.getCount(AStatus) - 1 do begin //      FieldName := AMeta.getAlias(AStatus, i); NullFlag := PWordBool(ABuffer + AMeta.getNullOffset(AStatus, i))^; if NullFlag then begin //  NULL    JSON      jsonObject.AddPair(FieldName, TJsonNull.Create); continue; end; //      pData := ABuffer + AMeta.getOffset(AStatus, i); case TFBType(AMeta.getType(AStatus, i)) of // VARCHAR SQL_VARYING: begin //    VARCHAR metaLength := AMeta.getLength(AStatus, i); charset := TFBCharSet(AMeta.getCharSet(AStatus, i)); //  VARCHAR  2  -  charLength := PSmallint(pData)^; //     base64 if charset = CS_BINARY then StringValue := TNetEncoding.Base64.EncodeBytesToString((pData + 2), charLength) else begin //       3  Move((pData + 2)^, CharBuffer, metaLength - 2); StringValue := charset.GetString(TBytes(@CharBuffer), 0, charLength * charset.GetCharWidth) SetLength(StringValue, charLength); end; jsonObject.AddPair(FieldName, StringValue); end; // CHAR SQL_TEXT: begin //    CHAR metaLength := AMeta.getLength(AStatus, i); charset := TFBCharSet(AMeta.getCharSet(AStatus, i)); //     base64 if charset = CS_BINARY then StringValue := TNetEncoding.Base64.EncodeBytesToString((pData + 2), metaLength) else begin //     Move(pData^, CharBuffer, metaLength); StringValue := charset.GetString(TBytes(@CharBuffer), 0, metaLength); charLength := metaLength div charset.GetCharWidth; SetLength(StringValue, charLength); end; jsonObject.AddPair(FieldName, StringValue); end; // FLOAT SQL_FLOAT: begin SingleValue := PSingle(pData)^; jsonObject.AddPair(FieldName, TJSONNumber.Create(SingleValue)); end; // DOUBLE PRECISION // DECIMAL(p, s),  p = 10..15  1  SQL_DOUBLE, SQL_D_FLOAT: begin DoubleValue := PDouble(pData)^; jsonObject.AddPair(FieldName, TJSONNumber.Create(DoubleValue)); end; // INTEGER // NUMERIC(p, s),  p = 1..4 SQL_SHORT: begin Scale := AMeta.getScale(AStatus, i); SmallintValue := PSmallint(pData)^; if (Scale = 0) then begin jsonObject.AddPair(FieldName, TJSONNumber.Create(SmallintValue)); end else begin StringValue := MakeScaleInteger(SmallintValue, Scale); jsonObject.AddPair(FieldName, TJSONNumber.Create(StringValue)); end; end; // INTEGER // NUMERIC(p, s),  p = 5..9 // DECIMAL(p, s),  p = 1..9 SQL_LONG: begin Scale := AMeta.getScale(AStatus, i); IntegerValue := PInteger(pData)^; if (Scale = 0) then begin jsonObject.AddPair(FieldName, TJSONNumber.Create(IntegerValue)); end else begin StringValue := MakeScaleInteger(IntegerValue, Scale); jsonObject.AddPair(FieldName, TJSONNumber.Create(StringValue)); end; end; // BIGINT // NUMERIC(p, s),  p = 10..18  3  // DECIMAL(p, s),  p = 10..18  3  SQL_INT64: begin Scale := AMeta.getScale(AStatus, i); BigintValue := Pint64(pData)^; if (Scale = 0) then begin jsonObject.AddPair(FieldName, TJSONNumber.Create(BigintValue)); end else begin StringValue := MakeScaleInteger(BigintValue, Scale); jsonObject.AddPair(FieldName, TJSONNumber.Create(StringValue)); end; end; // TIMESTAMP SQL_TIMESTAMP: begin TimestampValue := PISC_TIMESTAMP(pData)^; //    - util.decodeDate(TimestampValue.date, @year, @month, @day); util.decodeTime(TimestampValue.time, @hours, @minutes, @seconds, @fractions); //  -    Delphi DateTimeValue := EncodeDate(year, month, day) + EncodeTime(hours, minutes, seconds, fractions div 10); //  -    StringValue := FormatDateTime('yyyy/mm/dd hh:nn:ss', DateTimeValue, AFormatSettings); jsonObject.AddPair(FieldName, StringValue); end; // DATE SQL_DATE: begin DateValue := PISC_DATE(pData)^; //     util.decodeDate(DateValue, @year, @month, @day); //      Delphi DateTimeValue := EncodeDate(year, month, day); //      StringValue := FormatDateTime('yyyy/mm/dd', DateTimeValue, AFormatSettings); jsonObject.AddPair(FieldName, StringValue); end; // TIME SQL_TIME: begin TimeValue := PISC_TIME(pData)^; //     util.decodeTime(TimeValue, @hours, @minutes, @seconds, @fractions); //      Delphi DateTimeValue := EncodeTime(hours, minutes, seconds, fractions div 10); //      StringValue := FormatDateTime('hh:nn:ss', DateTimeValue, AFormatSettings); jsonObject.AddPair(FieldName, StringValue); end; // BOOLEAN SQL_BOOLEAN: begin BooleanValue := PBoolean(pData)^; jsonObject.AddPair(FieldName, TJsonBool.Create(BooleanValue)); 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); if BlobSubtype = 1 then begin //  charset := TFBCharSet(AMeta.getCharSet(AStatus, i)); //      textStream := TStringStream.Create('', charset.GetCodePage); try blob.SaveToStream(AStatus, textStream); StringValue := textStream.DataString; finally textStream.Free; blob.release; tra.release; att.release end; end else begin //      binaryStream := TBytesStream.Create; try blob.SaveToStream(AStatus, binaryStream); //    base64 StringValue := TNetEncoding.Base64.EncodeBytesToString (binaryStream.Memory, binaryStream.Size); finally binaryStream.Free; blob.release; tra.release; att.release end; end; jsonObject.AddPair(FieldName, StringValue); end; end; end; //     Json   AJson.AddElement(jsonObject); end; 

Remarque

TFbType Firebird.pas .
,
FbTypes .

TFBCharSet Firebird.pas .

FbCharsets . ,
,
, , ,
TEncoding ,
Delphi.

CHAR VARCHAR , OCTETS, base64, Delphi. , VARCHAR 2 .


SMALLINT, INTEGER, BIGINT , . getScale IMessageMetadata . 0, , MakeScaleInteger .


DATE, TIME TIMESTAMP decodeDate decodeTime IUtil . - Delphi TDateTime .


BLOB Delphi. BLOB , TBytesStream . base64. BLOB , TStringStream , . BLOB
.


C’est tout. UDR Firebird, .

Source: https://habr.com/ru/post/fr455375/


All Articles