UDR in Pascal schreiben

Firebird ist seit langem in der Lage, die Funktionen der PSQL-Sprache durch das Schreiben externer Funktionen zu erweitern - UDF (User Defined Functions). UDF kann in fast jeder kompilierten Programmiersprache geschrieben werden.


Firebird 3.0 führte eine Plug-In-Architektur ein, um die Funktionen von Firebird zu erweitern. Eines dieser Plugins ist die External Engine (externe Engines). Der UDR-Mechanismus (User Defined Routines - User Defined Routines) fügt der FirebirdExternal-Engine-Oberfläche eine Ebene hinzu.


In diesem Handbuch erfahren Sie, wie Sie UDR deklarieren, welche internen Mechanismen und Funktionen sie haben und wie Sie UDR in Pascal schreiben. Darüber hinaus werden einige Aspekte der Verwendung der neuen objektorientierten API behandelt.


Bemerkung

In diesem Artikel erfahren Sie, wie Sie UDR mithilfe der Objekt-Firebird-API schreiben.
Die schriftlichen Funktionen und Verfahren haben möglicherweise keine praktische Anwendung.

UDRs bieten gegenüber Legacy-UDF die folgenden Vorteile:


  • Sie können nicht nur Funktionen schreiben, die ein skalares Ergebnis zurückgeben, sondern auch gespeicherte Prozeduren (sowohl ausführbare als auch selektive) sowie Trigger.
  • verbesserte Steuerung der Eingabe- und Ausgabeparameter. In einigen Fällen (Übergabe durch Deskriptor) wurden die Typen und anderen Eigenschaften der Eingabeparameter überhaupt nicht gesteuert. Sie können diese Eigenschaften jedoch in UDF abrufen. UDRs bieten eine einheitlichere Möglichkeit, Eingabe- und Ausgabeparameter zu deklarieren, wie dies bei regulären PSQL-Funktionen und -Prozeduren der Fall ist.
  • UDR Der Kontext der aktuellen Verbindung oder Transaktion ist verfügbar, sodass Sie eine Ausführung durchführen können
    einige Manipulationen mit der aktuellen Datenbank in diesem Zusammenhang;
  • Die Firebird-Fehlergenerierung ist verfügbar, wenn Ausnahmen auftreten. Es ist nicht erforderlich, einen speziellen Wert zurückzugeben.
  • Externe Prozeduren und Funktionen (UDR) können in PSQL-Paketen gruppiert werden.
  • UDR kann in jeder Programmiersprache geschrieben werden (optional in Objektcodes kompiliert). Dazu muss das entsprechende External Engine Plug-In geschrieben sein. Beispielsweise gibt es Plugins zum Schreiben externer Module in Java oder einer der .NET-Sprachen.

Bemerkung

Die aktuelle UDR-Implementierung verwendet einen PSQL-Stub. Zum Beispiel ist es gewohnt
Überprüfen von Parametern und Rückgabewerten auf Einhaltung von Einschränkungen. Stub
wurde wegen der Unflexibilität verwendet, um interne Funktionen direkt aufzurufen. Ergebnisse
Ein Test, der die Leistung von UDR und UDF vergleicht, zeigt, dass UDR ungefähr ist
2,5-mal langsamer mit der einfachsten Funktion, zwei Argumente als Beispiel hinzuzufügen. Geschwindigkeit
UDR entspricht ungefähr der Geschwindigkeit einer regulären PSQL-Funktion. Vielleicht in Zukunft das
Moment wird optimiert. In komplexeren Funktionen kann dieser Overhead werden
nicht wahrnehmbar.

Weiter in verschiedenen Teilen dieses Handbuchs, wenn die Begriffe externes Verfahren verwendet werden,
Funktion oder Trigger meinen wir genau UDR (und nicht UDF).


Bemerkung

Alle unsere Beispiele arbeiten mit Delphi 2009 und höher sowie mit Free Pascal. Alle
Beispiele können sowohl in Delphi als auch in Free Pascal zusammengestellt werden, wenn
nicht separat angegeben.

Firebird API


Um externe Prozeduren, Funktionen oder Trigger in kompilierten Programmiersprachen zu schreiben, benötigen wir Kenntnisse der neuen objektorientierten Firebird-API. Dieses Handbuch enthält keine vollständige Beschreibung der Firebird-API. Sie können es im Dokumentationsverzeichnis lesen, das mit Firebird verteilt wird ( doc/Using_OO_API.html ).


Plug-Ins für verschiedene Programmiersprachen, die APIs enthalten, werden nicht als Teil der Firebird-Distribution für Windows verteilt. Sie können sie jedoch aus von Linux verteilten komprimierten Tarbar-Dateien extrahieren (der Pfad im Archiv /opt/firebird/include/firebird/Firebird.pas ).


CLOOP


CLOOP - Sprachübergreifende objektorientierte Programmierung. Dieses Tool ist nicht in Firebird enthalten. Es befindet sich im Quellcode https://github.com/FirebirdSQL/firebird/tree/B3_0_Release/extern/cloop . Nach dem Zusammenstellen des Tools können Sie eine API für Ihre Programmiersprache ( IdlFbInterfaces.h oder Firebird.pas ) basierend auf der Schnittstellenbeschreibungsdatei include/firebird/FirebirdInterface.idl .


Für Object Pascal erfolgt dies mit dem folgenden Befehl:


 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 

Die fb_get_master_interface.pas Pascal.interface.pas , Pascal.implementation.pas und fb_get_master_interface.pas finden Sie unter https://github.com/FirebirdSQL/firebird/tree/B3_0_Release/src/misc/pascal .


Bemerkung

In diesem Fall wird das Präfix I für die Firebird-APIs hinzugefügt, da dies in Object Pascal akzeptiert wird.

Konstanten


Die resultierende Datei Firebird.pas enthält keine isc_* . Diese Konstanten für C / C ++ - Sprachen finden Sie unter https://github.com/FirebirdSQL/firebird/blob/B3_0_Release/src/include/consts_pub.h . Um die Konstanten für die Pascal-Sprache zu erhalten, verwenden wir das AWK-Skript, um die Syntax zu konvertieren. Unter Windows müssen Sie Gawk für Windows installieren oder das Windows-Subsystem für Linux verwenden (verfügbar unter Windows 10). Dies erfolgt mit folgendem Befehl:


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

Der Inhalt der resultierenden Datei muss unmittelbar nach der Implementierung in den leeren const-Abschnitt der Firebird.pas Datei kopiert werden. Die Datei Pascal.Constants.awk finden Sie unter
https://github.com/FirebirdSQL/firebird/tree/B3_0_Release/src/misc/pascal .


Lebenszeitmanagement


Firebird-Schnittstellen basieren nicht auf der COM-Spezifikation, daher unterscheidet sich die Verwaltung ihrer Lebensdauer.


In Firebird gibt es zwei Schnittstellen, die sich mit der Lebensdauerverwaltung befassen: IDisposable und IReferenceCounted. Letzteres ist besonders aktiv beim Erstellen anderer Schnittstellen: IPlugin zählt Links, wie viele andere von Plug-Ins verwendete Schnittstellen. Dazu gehören Schnittstellen, die beschreiben, wie eine Verbindung zu einer Datenbank hergestellt wird, Transaktionsverwaltung und SQL-Anweisungen.


Ein zusätzlicher Overhead der Schnittstelle mit Referenzzählung ist nicht immer erforderlich. Beispielsweise hat IMaster, die Hauptschnittstelle, die Funktionen aufruft, die für den Rest der API verfügbar sind, per Definition eine unbegrenzte Lebensdauer. Bei anderen APIs wird die Lebensdauer streng durch die Lebensdauer der übergeordneten Schnittstelle bestimmt. IStatus-Schnittstelle ist nicht
Multithreaded. Für Schnittstellen mit einer begrenzten Lebensdauer ist es nützlich, eine einfache Möglichkeit zu haben, sie zu zerstören, dh die Funktion dispose ().


Hinweis

Wenn Sie nicht wissen, wie ein Objekt zerstört wird, überprüfen Sie die Hierarchie, falls vorhanden
Schnittstelle IReferenceCounted, dann wird die Referenzzählung verwendet.
Für Schnittstellen mit Referenzzählung ist es nach Abschluss der Arbeit mit einem Objekt erforderlich
Verringern Sie den Referenzzähler, indem Sie die release () -Methode aufrufen.

UDR-Ankündigung


UDRs können mithilfe von DDL-Befehlen zur Datenbank hinzugefügt oder daraus entfernt werden, genau wie Sie reguläre PSQL-Prozeduren, -Funktionen oder -Trigger hinzufügen oder entfernen. In diesem Fall wird anstelle des Triggerkörpers dessen Position im externen Modul mit der EXTERNAL NAME-Klausel angegeben.


Berücksichtigen Sie die Syntax dieses Satzes, die externen Prozeduren, Funktionen und Triggern gemeinsam ist.


Syntax:


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

Das Argument für diese EXTERNAL NAME-Klausel ist eine Zeichenfolge, die den Speicherort der Funktion im externen Modul angibt. Bei externen Modulen, die die UDR-Engine verwenden, gibt diese Zeile durch das Trennzeichen den Namen des externen Moduls, den Namen der Funktion innerhalb des Moduls und benutzerdefinierte Informationen an. Ein Ausrufezeichen (!) Wird als Trennzeichen verwendet.


Die ENGINE-Klausel gibt den Namen der Engine für die Verarbeitung der Verbindung externer Module an. Firebird verwendet die UDR-Engine, um mit externen Modulen zu arbeiten, die in kompilierten Sprachen (C, C ++, Pascal) geschrieben sind. In Java geschriebene externe Funktionen erfordern die Java-Engine.


Nach dem Schlüsselwort AS kann ein String-Literal angegeben werden - der "Body" des externen Moduls (Prozedur, Funktion oder Trigger), der vom externen Modul für verschiedene Zwecke verwendet werden kann. Beispielsweise kann eine SQL-Abfrage angegeben werden, um auf eine externe Datenbank oder einen Text in einer bestimmten Sprache zur Interpretation durch Ihre Funktion zuzugreifen.


Externe Funktionen


Syntax
 {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])] 

Alle Parameter einer externen Funktion können mit der Anweisung ALTER FUNCTION geändert werden.


Syntax:


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

Sie können eine externe Funktion mit der Anweisung DROP FUNCTION löschen.


Syntax:


 DROP FUNCTION funcname 

Einige Parameter einer externen Funktion
ParameterBeschreibung
FunktionsnameDer Name der gespeicherten Funktion. Kann bis zu 31 Bytes enthalten.
inparamBeschreibung des Eingabeparameters.
ModulnameDer Name des externen Moduls, in dem sich die Funktion befindet.
RoutinennameDer interne Name der Funktion innerhalb des externen Moduls.
Sonstiges InfoBenutzerdefinierte Informationen, an die übertragen werden soll
Funktion des externen Moduls.
MotorDer Name des Motors für die Verwendung externer Funktionen. Normalerweise lautet der Name UDR.
extbodyDer Körper ist eine äußere Funktion. Ein String-Literal, das von UDR für verschiedene Zwecke verwendet werden kann.

Hier werden wir die Syntax der Eingabeparameter und der Ausgabe nicht beschreiben. Es entspricht vollständig der Syntax für reguläre PSQL-Funktionen, die im SQL Language Guide ausführlich beschrieben wird. Stattdessen geben wir Beispiele für die Deklaration externer Funktionen mit Erklärungen.


Die Funktion zum Hinzufügen von drei Argumenten


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

Die Implementierung der Funktion erfolgt im Modul udrcpp_example. Innerhalb dieses Moduls ist eine Funktion unter dem Namen sum_args registriert. Eine externe Funktion verwendet die UDR-Engine.


Java-Funktion


 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; 

Die Implementierung der Funktion erfolgt in der statischen org.firebirdsql.fbjava.examples.fbjava_example.FbRegex Klasse org.firebirdsql.fbjava.examples.fbjava_example.FbRegex . Eine externe Funktion verwendet die Java-Engine.


Externe Verfahren


Syntax
 {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])] 

Alle Parameter der externen Prozedur können mit der Anweisung ALTER PROCEDURE geändert werden.


Syntax:


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

Sie können eine externe Prozedur mit der Anweisung DROP PROCEDURE löschen.


Syntax:


 DROP PROCEDURE procname 

Einige Parameter der externen Prozedur
ParameterBeschreibung
FunktionsnameDer Name der gespeicherten Prozedur. Kann bis zu 31 Bytes enthalten.
inparamBeschreibung des Eingabeparameters.
outparamBeschreibung des Ausgabeparameters.
ModulnameDer Name des externen Moduls, in dem sich die Prozedur befindet.
RoutinennameDer interne Name der Prozedur innerhalb des externen Moduls.
Sonstiges InfoBenutzerdefinierte Informationen, an die übertragen werden soll
externe Modulprozedur.
MotorDer Name des Motors für die Verwendung externer Verfahren. Normalerweise lautet der Name UDR.
extbodyDer Körper eines externen Verfahrens. Ein String-Literal, das von UDR für verschiedene Zwecke verwendet werden kann.

Hier wird die Syntax der Eingabe- und Ausgabeparameter nicht beschrieben. Es entspricht vollständig der Syntax für reguläre PSQL-Prozeduren, die im SQL-Sprachhandbuch ausführlich beschrieben wird. Stattdessen geben wir Beispiele für die Deklaration externer Verfahren mit Erläuterungen.


 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; 

Die Implementierung der Funktion erfolgt im Pascaludr-Modul. Innerhalb dieses Moduls ist die Prozedur unter dem Namen gen_rows registriert. Eine externe Prozedur verwendet die UDR-Engine.


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

Die Implementierung der Funktion erfolgt im Pascaludr-Modul. Innerhalb dieses Moduls ist die Prozedur unter dem Namen write_log registriert. Eine externe Prozedur verwendet die UDR-Engine.


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

Die Implementierung der Funktion erfolgt in der statischen Funktion executeQuery der Klasse
org.firebirdsql.fbjava.examples.fbjava_example.FbJdbc . Nach dem Ausrufezeichen (!) Befinden sich Informationen für die Verbindung mit einer externen Datenbank über JDBC. Eine externe Funktion verwendet die Java-Engine. Hier wird als "Hauptteil" einer externen Prozedur eine SQL-Abfrage übergeben, um Daten abzurufen.


Bemerkung

Diese Prozedur verwendet einen Stub, in dem ein nicht verwendeter Parameter übergeben wird. Dies liegt an der Tatsache, dass in Firebird 3.0 ein Fehler bei der Verarbeitung externer Prozeduren ohne Parameter vorliegt.

Platzierung externer Prozeduren und Funktionen in Paketen


Es ist praktisch, eine Gruppe miteinander verbundener Prozeduren und Funktionen in PSQL-Paketen zu platzieren. Pakete können sowohl externe als auch reguläre PSQL-Prozeduren und -Funktionen enthalten.


Syntax
 {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>]' 

Bei externen Prozeduren und Funktionen werden der Name des Pakets, die Eingabeparameter, ihre Typen, Standardwerte und Ausgabeparameter im Paketkopf angegeben, und im Paketkörper ist bis auf die Standardwerte sowie die Position im externen Modul (EXTERNAL NAME-Klausel) alles gleich. , den Namen des Motors und möglicherweise den "Körper" der Prozedur / Funktion.


Angenommen, Sie haben eine UDR für die Arbeit mit regulären Ausdrücken geschrieben, die sich im externen PCRE-Modul (dynamische Bibliothek) befindet, und Sie haben mehrere weitere UDRs, die andere Aufgaben ausführen. Wenn wir keine PSQL-Pakete verwendet hätten, würden alle unsere externen Prozeduren und Funktionen sowohl miteinander als auch mit normalen PSQL-Prozeduren und -Funktionen gemischt. Dies erschwert die Suche nach Abhängigkeiten und das Vornehmen von Änderungen an externen Modulen und führt außerdem zu Verwirrung und erzwingt zumindest die Verwendung von Präfixen zum Gruppieren von Prozeduren und Funktionen. PSQL-Pakete erleichtern uns diese Aufgabe erheblich.


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

Externe Trigger


Syntax
 {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 

Ein externer Trigger kann mit der Anweisung ALTER TRIGGER geändert werden.


Syntax:


 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 } 

Sie können einen externen Trigger mit der Anweisung DROP TRIGGER entfernen.


Syntax:


 DROP TRIGGER trigname 

ParameterBeschreibung
trignameDer Name des Auslösers. Kann bis zu 31 Bytes enthalten.
relation_trigger_legacyTabellentriggerdeklaration (geerbt).
relation_trigger_sql2003Deklarieren eines Tabellentriggers gemäß dem SQL-2003-Standard.
database_triggerDatenbank-Trigger-Deklaration.
ddl_triggerDDL-Triggerdeklaration.
TabellennameDer Name der Tabelle.
viewnameDer Name der Ansicht.
mutations_listListe der Tabellenereignisse.
MutationEines der Ereignisse der Tabelle.
db_eventEin Verbindungs- oder Transaktionsereignis.
ddl_eventsListe der Metadatenänderungsereignisse.
ddl_event_itemEines der Metadatenänderungsereignisse.
NummerDie Triggerreihenfolge. 0 bis 32767
extbodyDer Körper eines externen Auslösers. Ein String-Literal, das von UDR für verschiedene Zwecke verwendet werden kann.
ModulnameDer Name des externen Moduls, in dem sich der Trigger befindet.
RoutinennameDer interne Name des Triggers im externen Modul.
Sonstiges InfoBenutzerdefinierte Informationen zur Übertragung an den Trigger eines externen Moduls.
MotorDer Name der Engine für die Verwendung externer Trigger. Normalerweise lautet der Name UDR.

Hier finden Sie Beispiele für die Deklaration externer Trigger mit Erläuterungen.


 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; 

Die Trigger-Implementierung befindet sich im Modul udrcpp_example. Innerhalb dieses Moduls ist ein Trigger unter dem Namen replicate registriert. Ein externer Trigger verwendet die UDR-Engine.


In der Verknüpfung zum externen Modul wird ein zusätzlicher Parameter ds1 , mit dem die Konfiguration zum Lesen der externen Datenbank aus der Tabelle replicate_config vom externen Trigger gelesen wird.


UDR-Struktur


Jetzt ist die Zeit gekommen, den ersten UDR zu schreiben. Wir werden die Struktur von UDR in Pascal beschreiben. Um die minimale Struktur für die examples/udr/ eines UDR zu erläutern, verwenden wir Standardbeispiele aus examples/udr/ die in Pascal übersetzt wurden.


Erstellen Sie ein neues Projekt für die neue dynamische Bibliothek, die wir MyUdr nennen werden. Daher sollten Sie die Datei MyUdr.dpr (wenn Sie das Projekt in Delphi erstellt haben) oder die Datei MyUdr.lpr (wenn Sie das Projekt in Lazarus erstellt haben) erhalten. Ändern wir nun die Hauptprojektdatei so, dass sie folgendermaßen aussieht:


 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. 

In diesem Fall müssen Sie nur eine firebird_udr_plugin Funktion firebird_udr_plugin , die der Einstiegspunkt für das Plug-In externer UDR-Module ist. Die Implementierung dieser Funktion befindet sich im UdrInit-Modul.


Bemerkung

Wenn Sie Ihren UDR in Free Pascal entwickeln, benötigen Sie zusätzliche Anweisungen. Die {$mode objfpc} ist erforderlich, um den Object Pascal-Modus zu aktivieren. Stattdessen können Sie die Direktive {$mode delphi} , um die Kompatibilität mit Delphi sicherzustellen. Da meine Beispiele sowohl in FPC als auch in Delphi erfolgreich kompiliert werden sollten, wähle ich den {$mode delphi} .

Die Direktive {$H+} unterstützt lange Zeichenfolgen. Dies ist erforderlich, wenn Sie die Typen string, ansistring und nicht nur nullterminierte Zeichenfolgen PChar, PAnsiChar, PWideChar verwenden.

Darüber hinaus müssen separate Module angeschlossen werden, um Multithreading unter Linux und anderen Unix-ähnlichen Betriebssystemen zu unterstützen.

Registrieren Sie Prozeduren, Funktionen oder Trigger


Fügen Sie nun das UdrInit-Modul hinzu, es sollte folgendermaßen aussehen:


 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. 

In der Funktion firebird_udr_plugin müssen die Fabriken unserer externen Prozeduren, Funktionen und Trigger registriert werden. Für jede Funktion, Prozedur oder jeden Trigger müssen Sie Ihre eigene Factory schreiben. Dies erfolgt mithilfe der IUdrPlugin-Schnittstellenmethoden:


  • registerFunction - registriert eine externe Funktion;
  • 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.


. Für
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; 

Bemerkung

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; 

Bemerkung

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


Bemerkung

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


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


UDR .


Hinweis

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; 

Bemerkung

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


Bemerkung

, , . IMessageMetadata. , . , , /.

, PSQL


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

Nachrichten


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
INTEGERGanzzahl
BIGINTInt64
FLOATSingle
DOUBLE PRECISIONDoppel
NUMERIC(N, M):
  • 1-4 — Smallint;
  • 5-9 — Integer;
  • 10-18 (3 ) — Int64;
  • 10-15 (1 ) — Double.

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

10M.
CHAR(N)array[0… M] of AnsiCharM M=NBytesPerChar1,
BytesPerChar — , /. UTF-8 — 4 /, WIN1251 — 1 /.
VARCHAR(N)FbVarChar<N>M M=NBytesPerChar1,
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. , . . Zum Beispiel:


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.


Bemerkung

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; 

Bemerkung

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; 

Bemerkung

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

Bemerkung

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; 

Bemerkung

isc_random
, .

:


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

Bemerkung

, BLOB
,
.
,
.
fetch .

BLOB


BLOB
BLOB .


Bemerkung

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.


Bemerkung

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 .


Bemerkung

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; 

Bemerkung

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
.


Das ist alles UDR Firebird, .

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


All Articles