Menulis UDR dalam Pascal

Firebird telah lama dapat memperluas kemampuan bahasa PSQL dengan menulis fungsi eksternal - UDF (Fungsi yang Ditentukan Pengguna). UDF dapat ditulis dalam hampir semua bahasa pemrograman yang dikompilasi.


Firebird 3.0 memperkenalkan arsitektur plug-in untuk memperluas kemampuan Firebird. Salah satu plugin ini adalah External Engine (mesin eksternal). Mekanisme UDR (User Defined Routines - User Defined Routines) menambahkan lapisan di atas antarmuka engine FirebirdExternal.


Dalam panduan ini, kami akan memberi tahu Anda cara mendeklarasikan UDR, tentang mekanisme internal, kemampuan, dan memberikan contoh penulisan UDR dalam Pascal. Selain itu, beberapa aspek menggunakan API berorientasi objek baru akan dibahas.


Komentar

Artikel ini dimaksudkan untuk mengajarkan Anda cara menulis UDR menggunakan objek Firebird API.
Fungsi dan prosedur tertulis mungkin tidak memiliki aplikasi praktis.

UDR memiliki keunggulan berikut dibandingkan Legacy UDF:


  • Anda dapat menulis tidak hanya fungsi yang mengembalikan hasil skalar, tetapi juga prosedur tersimpan (baik yang dapat dieksekusi dan selektif), serta pemicu;
  • peningkatan kontrol parameter input dan output. Dalam beberapa kasus (lewat deskriptor) jenis dan properti lain dari parameter input tidak dikontrol sama sekali, namun, Anda bisa mendapatkan properti ini di dalam UDF. UDR menyediakan cara yang lebih terpadu untuk mendeklarasikan parameter input dan output, karena ini adalah kasus dengan fungsi dan prosedur PSQL biasa;
  • UDR konteks koneksi atau transaksi saat ini tersedia, yang memungkinkan Anda untuk melakukan
    beberapa manipulasi dengan database saat ini dalam konteks ini;
  • Pembuatan kesalahan Firebird tersedia saat pengecualian terjadi, tidak perlu mengembalikan nilai khusus;
  • Prosedur dan fungsi eksternal (UDR) dapat dikelompokkan dalam paket PSQL;
  • UDR dapat ditulis dalam bahasa pemrograman apa saja (opsional dikompilasi ke dalam kode objek), untuk ini perlu bahwa plug-in Mesin Eksternal yang sesuai ditulis. Misalnya, ada plugin untuk menulis modul eksternal di Java atau dalam bahasa .NET mana saja.

Komentar

Implementasi UDR saat ini menggunakan rintisan PSQL. Sebagai contoh, ini digunakan untuk
memeriksa parameter dan mengembalikan nilai kepatuhan dengan pembatasan. Rintisan
digunakan karena tidak fleksibel untuk langsung memanggil fungsi internal. Hasil
Tes membandingkan kinerja UDR dan UDF menunjukkan bahwa UDR sekitar
2,5 kali lebih lambat menggunakan fungsi paling sederhana untuk menambahkan dua argumen sebagai contoh. Kecepatan
UDR kira-kira sama dengan kecepatan fungsi PSQL biasa. Mungkin di masa depan ini
momen akan dioptimalkan. Dalam fungsi yang lebih kompleks, overhead ini bisa menjadi
tak terlihat.

Lebih lanjut dalam berbagai bagian manual ini, ketika menggunakan istilah prosedur eksternal,
fungsi atau pemicu yang kami maksud persis UDR (dan bukan UDF).


Komentar

Semua contoh kami berfungsi pada Delphi 2009 dan yang lebih baru, serta pada Free Pascal. Semua
contoh dapat dikompilasi dalam Delphi dan Free Pascal, jika
tidak ditentukan secara terpisah.

API Firebird


Untuk menulis prosedur eksternal, fungsi, atau pemicu dalam bahasa pemrograman yang dikompilasi, kita perlu pengetahuan tentang Firebird API berorientasi objek yang baru. Panduan ini tidak termasuk deskripsi lengkap tentang API Firebird. Anda dapat membacanya di direktori dokumentasi yang didistribusikan bersama Firebird ( doc/Using_OO_API.html ).


Plug-in untuk berbagai bahasa pemrograman yang mengandung API tidak didistribusikan sebagai bagian dari distribusi Firebird untuk Windows, namun Anda dapat mengekstraknya dari file tarbar terkompresi yang didistribusikan oleh Linux (jalur di dalam arsip /opt/firebird/include/firebird/Firebird.pas ).


CLOOP


CLOOP - Pemrograman Berorientasi Objek Lintas Bahasa. Alat ini tidak termasuk dengan Firebird. Itu dapat ditemukan di kode sumber https://github.com/FirebirdSQL/firebird/tree/B3_0_Release/extern/cloop . Setelah alat dirakit, Anda dapat membuat API untuk bahasa pemrograman Anda ( IdlFbInterfaces.h atau Firebird.pas ) berdasarkan pada file deskripsi antarmuka antar muka include/firebird/FirebirdInterface.idl .


Untuk Object pascal, ini dilakukan dengan perintah berikut:


 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 

File Pascal.interface.pas , Pascal.implementation.pas dan fb_get_master_interface.pas dapat ditemukan di https://github.com/FirebirdSQL/firebird/tree/B3_0_Release/src/misc/pascal .


Komentar

Dalam hal ini, awalan I akan ditambahkan untuk API Firebird, karena ini diterima di Object Pascal.

Konstanta


Tidak ada isc_* dalam file Firebird.pas dihasilkan. Konstanta untuk bahasa C / C ++ ini dapat ditemukan di https://github.com/FirebirdSQL/firebird/blob/B3_0_Release/src/include/consts_pub.h . Untuk mendapatkan konstanta untuk bahasa Pascal, kami akan menggunakan skrip AWK untuk mengonversi sintaks. Di Windows, Anda harus menginstal Gawk untuk Windows atau menggunakan Subsistem Windows untuk Linux (tersedia di Windows 10). Ini dilakukan dengan perintah berikut:


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

Isi dari file yang dihasilkan harus disalin ke bagian const kosong dari file Firebird.pas segera setelah implementasi. File Pascal.Constants.awk dapat ditemukan di
https://github.com/FirebirdSQL/firebird/tree/B3_0_Release/src/misc/pascal .


Manajemen seumur hidup


Antarmuka Firebird tidak didasarkan pada spesifikasi COM, jadi mengatur masa pakai mereka berbeda.


Ada dua antarmuka di Firebird yang berhubungan dengan manajemen seumur hidup: IDisposable dan IReferenceCounted. Yang terakhir ini sangat aktif saat membuat antarmuka lain: IPlugin menghitung tautan, seperti banyak antarmuka lain yang digunakan oleh plug-in. Ini termasuk antarmuka yang menggambarkan bagaimana menghubungkan ke database, manajemen transaksi, dan pernyataan SQL.


Overhead tambahan antarmuka dengan penghitungan referensi tidak selalu diperlukan. Misalnya, IMaster, antarmuka utama yang memanggil fungsi-fungsi yang tersedia untuk seluruh API, memiliki masa pakai tak terbatas menurut definisi. Untuk API lain, masa pakai sangat ditentukan oleh masa pakai antarmuka induk; Antarmuka IStatus tidak
multithreaded. Untuk antarmuka dengan masa pakai terbatas, ada gunanya memiliki cara sederhana untuk menghancurkannya, yaitu fungsi buang ().


Petunjuk

Jika Anda tidak tahu bagaimana suatu objek dihancurkan, lihat hierarkinya, jika ada
antarmuka IReferenceCounted, kemudian penghitungan referensi digunakan.
Untuk antarmuka dengan penghitungan referensi, setelah menyelesaikan pekerjaan dengan objek, perlu
kurangi penghitung referensi dengan memanggil metode release ().

Pengumuman UDR


UDR dapat ditambahkan atau dihapus dari database menggunakan perintah DDL, seperti halnya Anda menambah atau menghapus prosedur, fungsi, atau pemicu PSQL biasa. Dalam hal ini, alih-alih tubuh pemicu, lokasinya di modul eksternal diindikasikan menggunakan klausa NAMA EKSTERNAL.


Pertimbangkan sintaks kalimat ini, itu akan umum untuk prosedur eksternal, fungsi, dan pemicu.


Sintaks:


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

Argumen untuk klausa NAMA EKSTERNAL ini adalah string yang menunjukkan lokasi fungsi dalam modul eksternal. Untuk modul eksternal menggunakan mesin UDR, baris ini melalui pemisah menunjukkan nama modul eksternal, nama fungsi di dalam modul, dan informasi yang ditentukan pengguna. Tanda seru (!) Digunakan sebagai pemisah.


Klausa ENGINE menentukan nama mesin untuk memproses koneksi modul eksternal. Firebird menggunakan mesin UDR untuk bekerja dengan modul eksternal yang ditulis dalam bahasa yang dikompilasi (C, C ++, Pascal). Fungsi eksternal yang ditulis dalam Java memerlukan engine Java.


Setelah kata kunci AS, string literal dapat ditentukan - "tubuh" dari modul eksternal (prosedur, fungsi atau pemicu), itu dapat digunakan oleh modul eksternal untuk berbagai keperluan. Misalnya, kueri SQL dapat ditentukan untuk mengakses database atau teks eksternal dalam beberapa bahasa untuk ditafsirkan oleh fungsi Anda.


Fungsi eksternal


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

Semua parameter fungsi eksternal dapat diubah menggunakan pernyataan ALTER FUNCTION.


Sintaks:


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

Anda dapat menghapus fungsi eksternal menggunakan pernyataan FUNGSI DROP.


Sintaks:


 DROP FUNCTION funcname 

Beberapa parameter fungsi eksternal
ParameterDeskripsi
funcnameNama fungsi yang disimpan. Dapat memuat hingga 31 byte.
inparamDeskripsi parameter input.
nama modulNama modul eksternal tempat fungsi berada.
nama rutinNama internal fungsi di dalam modul eksternal.
info miscInformasi yang ditentukan pengguna untuk ditransmisikan
fungsi modul eksternal.
mesinNama mesin untuk menggunakan fungsi eksternal. Biasanya namanya UDR.
orang luarTubuh adalah fungsi eksternal. String literal yang dapat digunakan oleh UDR untuk berbagai keperluan.

Di sini kita tidak akan menjelaskan sintaks dari parameter input dan output. Ini sepenuhnya sesuai dengan sintaks untuk fungsi PSQL biasa, yang dijelaskan secara rinci dalam Panduan Bahasa SQL. Sebagai gantinya, kami memberikan contoh menyatakan fungsi eksternal dengan penjelasan.


Fungsi menambahkan tiga argumen


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

Implementasi fungsi ada di modul udrcpp_example. Di dalam modul ini, sebuah fungsi terdaftar dengan nama sum_args. Fungsi eksternal menggunakan mesin UDR.


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

Implementasi fungsi ini di ganti fungsi statis dari kelas org.firebirdsql.fbjava.examples.fbjava_example.FbRegex . Fungsi eksternal menggunakan mesin Java.


Prosedur eksternal


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

Semua parameter prosedur eksternal dapat diubah menggunakan pernyataan ALTER PROCEDURE.


Sintaks:


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

Anda dapat menghapus prosedur eksternal menggunakan pernyataan PROSEDUR DROP.


Sintaks:


 DROP PROCEDURE procname 

Beberapa parameter prosedur eksternal
ParameterDeskripsi
funcnameNama prosedur tersimpan. Dapat memuat hingga 31 byte.
inparamDeskripsi parameter input.
outparamDeskripsi parameter output.
nama modulNama modul eksternal tempat prosedur berada.
nama rutinNama internal prosedur di dalam modul eksternal.
info miscInformasi yang ditentukan pengguna untuk ditransmisikan
prosedur modul eksternal.
mesinNama mesin untuk menggunakan prosedur eksternal. Biasanya namanya UDR.
orang luarTubuh prosedur eksternal. String literal yang dapat digunakan oleh UDR untuk berbagai keperluan.

Di sini kita tidak akan menjelaskan sintaks parameter input dan output. Ini sepenuhnya sesuai dengan sintaks untuk prosedur PSQL biasa, yang dijelaskan secara rinci dalam Panduan Bahasa SQL. Sebagai gantinya, kami memberikan contoh menyatakan prosedur eksternal dengan penjelasan.


 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; 

Implementasi fungsi ada dalam modul pascaludr. Di dalam modul ini, prosedur terdaftar dengan nama gen_rows. Prosedur eksternal menggunakan mesin UDR.


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

Implementasi fungsi ada dalam modul pascaludr. Di dalam modul ini, prosedur terdaftar dengan nama write_log. Prosedur eksternal menggunakan mesin 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'; 

Implementasi fungsi ini berada di fungsi statis, mengeksekusi Query dari kelas
org.firebirdsql.fbjava.examples.fbjava_example.FbJdbc . Setelah tanda seru (!), Informasi berada untuk menghubungkan ke database eksternal melalui JDBC. Fungsi eksternal menggunakan mesin Java. Di sini, sebagai "tubuh" dari prosedur eksternal, kueri SQL dilewatkan untuk mengambil data.


Komentar

Prosedur ini menggunakan rintisan di mana parameter yang tidak digunakan dilewatkan. Hal ini disebabkan oleh fakta bahwa di Firebird 3.0 terdapat bug dengan pemrosesan prosedur eksternal tanpa parameter.

Penempatan prosedur dan fungsi eksternal di dalam paket


Lebih mudah untuk menempatkan sekelompok prosedur dan fungsi yang saling terkait dalam paket PSQL. Paket dapat berisi prosedur dan fungsi PSQL eksternal dan reguler.


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

Untuk prosedur dan fungsi eksternal, nama paket, parameter input, jenisnya, nilai default, dan parameter output ditunjukkan dalam header paket, dan semuanya sama di tubuh paket kecuali nilai default, serta lokasi dalam modul eksternal (klausa NAMA EKSTERNAL) , nama mesin, dan mungkin "tubuh" dari prosedur / fungsi.


Misalkan Anda menulis UDR untuk bekerja dengan ekspresi reguler, yang terletak di modul eksternal (perpustakaan dinamis) PCRE, dan Anda memiliki beberapa UDR lagi yang melakukan tugas-tugas lain. Jika kita tidak menggunakan paket PSQL, maka semua prosedur dan fungsi eksternal kita akan dicampur satu sama lain dan dengan prosedur dan fungsi PSQL biasa. Ini mempersulit pencarian dependensi dan membuat perubahan pada modul eksternal, dan di samping itu menciptakan kebingungan dan memaksa setidaknya penggunaan awalan untuk prosedur dan fungsi grup. Paket PSQL membuat tugas ini lebih mudah bagi kami.


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

Pemicu eksternal


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

Pemicu eksternal dapat diubah menggunakan pernyataan ALTER TRIGGER.


Sintaks:


 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 } 

Anda dapat menghapus pemicu eksternal menggunakan pernyataan DROP TRIGGER.


Sintaks:


 DROP TRIGGER trigname 

ParameterDeskripsi
trignameNama pemicunya. Dapat memuat hingga 31 byte.
relation_trigger_legacyDeklarasi pemicu tabel (diwariskan).
relation_trigger_sql2003Mendeklarasikan pemicu tabel sesuai dengan standar SQL-2003.
database_triggerDeklarasi pemicu basis data.
ddl_triggerDeklarasi pemicu DDL.
nama tabNama tabel.
nama tampilanNama tampilan.
mutation_listDaftar acara tabel.
mutasiSalah satu acara di meja.
db_eventKoneksi atau acara transaksi.
ddl_eventsDaftar acara perubahan metadata.
ddl_event_itemSalah satu peristiwa perubahan metadata.
angkaPerintah pemicu. 0 hingga 32767
orang luarTubuh pemicu eksternal. String literal yang dapat digunakan oleh UDR untuk berbagai keperluan.
nama modulNama modul eksternal tempat pemicu berada.
nama rutinNama internal pemicu di dalam modul eksternal.
info miscInformasi yang ditentukan pengguna untuk dipindahkan ke pemicu modul eksternal.
mesinNama mesin untuk menggunakan pemicu eksternal. Biasanya namanya UDR.

Berikut adalah contoh menyatakan pemicu eksternal dengan penjelasan.


 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; 

Implementasi pemicu ada di modul udrcpp_example. Di dalam modul ini, pemicu terdaftar dengan nama replikat. Pemicu eksternal menggunakan mesin UDR.


Dalam tautan ke modul eksternal, parameter tambahan ds1 , di mana konfigurasi untuk membaca database eksternal dibaca dari tabel replicate_config dari pemicu eksternal.


Struktur UDR


Sekarang saatnya untuk menulis UDR pertama. Kami akan menggambarkan struktur UDR di Pascal. Untuk menjelaskan struktur minimal untuk membangun UDR, kami akan menggunakan contoh standar dari examples/udr/ diterjemahkan ke dalam Pascal.


Buat proyek baru untuk pustaka dinamis baru, yang akan kita sebut MyUdr. Akibatnya, Anda harus mendapatkan file MyUdr.dpr (jika Anda membuat proyek di Delphi) atau file MyUdr.lpr (jika Anda membuat proyek di Lazarus). Sekarang mari kita ubah file proyek utama sehingga terlihat seperti ini:


 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. 

Dalam hal ini, Anda hanya perlu mengekspor satu fungsi firebird_udr_plugin , yang merupakan titik masuk untuk plug-in modul UDR eksternal. Implementasi fungsi ini akan berlokasi di modul UdrInit.


Komentar

Jika Anda mengembangkan UDR Anda dalam Free Pascal, maka Anda akan memerlukan arahan tambahan. {$mode objfpc} diperlukan untuk mengaktifkan mode Object Pascal. Sebagai gantinya, Anda dapat menggunakan arahan {$mode delphi} untuk memastikan kompatibilitas dengan Delphi. Karena contoh saya harus berhasil dikompilasi di FPC dan Delphi, saya memilih {$mode delphi} .

Arahan {$H+} mencakup dukungan untuk string panjang. Ini diperlukan jika Anda akan menggunakan string tipe, ansistring, dan bukan hanya string yang diakhiri null PChar, PAnsiChar, PWideChar.

Selain itu, kita perlu menghubungkan modul terpisah untuk mendukung multithreading di Linux dan sistem operasi mirip Unix lainnya.

Mendaftar prosedur, fungsi, atau pemicu


Sekarang tambahkan modul UdrInit, akan terlihat seperti ini:


 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. 

Dalam fungsi firebird_udr_plugin , perlu mendaftarkan pabrik dari prosedur, fungsi, dan pemicu eksternal kami. Untuk setiap fungsi, prosedur atau pemicu, Anda harus menulis pabrik Anda sendiri. Ini dilakukan dengan menggunakan metode antarmuka 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.


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

Komentar

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; 

Komentar

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


Komentar

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; 

Komentar

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


Komentar

, , . IMessageMetadata. , . , , /.

, PSQL


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


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. , . . Sebagai contoh:


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.


Komentar

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; 

Komentar

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; 

Komentar

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

Komentar

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; 

Komentar

isc_random
, .

:


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

Komentar

, BLOB
,
.
,
.
fetch .

BLOB


BLOB
BLOB .


Komentar

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.


Komentar

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 .


Komentar

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; 

Komentar

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
.


Itu saja. UDR Firebird, .

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


All Articles