Как научиться писать UDF на Delphi за 21 минуту?

Олег Кукарцев, 1996

Как известно, InterBase включает только базовый набор функций для использования в SQL-выражениях. Однако, пугаться этого не стоит – InterBase предоставляет вам мощное средство – механизм User Defined Functions (UDF), позволяющий писать пользовательские функции на любом компилирующем инструменте разработки (хост-языке). При этом, такие функции будут выполняться на сервере, причем в рамках процесса сервера, что повышает скорость их вызова практически до уровня скорости вызова стандартных SQL-функций. Несмотря на то, что последнее время мы все слышим много разговоров о “новой технологии” встраиваемых в серверы баз данных модулях расширения, InterBase был первым сервером, который реализовал концепцию UDF на практке.

В этой статье мы рассмотрим процесс создания UDF для InterBase на платформах Windows NT и Windows 95 с помощью Delphi 3.0/4.0 (подойдет также Delphi 2.0) – как передаются и возвращаются параметры, и некоторые особенности, связанные с каждым типом данных.
   

Передача и возврат целых чисел, передача параметров

Начнем с примера простейшей UDF:

function Add_A(var iSmall: SmallInt; var iLong: Integer): Integer; cdecl; export;

//             ^^^                   ^^^                  ^^^^^^^  ^^^^^  ^^^^^^
//             by reference          by reference         by value call convention
begin
  Result := iSmall + iLong;
end;

Для того, чтобы параметры передавались в правильном порядке, и выполнялись определенные правила входа/выхода из функции, при ее объявлении всегда используются следующие ключевые слова: cdecl – передача параметров и очистка стека по правилам C; export – для доступа к функции извне DLL.

Наша функция Add_A(var iSmall: SmallInt; var iLong: Integer) имеет два входных параметра iSmall и iLong, которые передаются по ссылке (ключевое слово var). Результат функции имеет тип Integer, и передается по значению.

А вот как аналогичная функция возвращает результат по ссылке:

var
  ResultInteger: Integer;

function Add_B(var iSmall: SmallInt; var iLong: Integer): PInteger; cdecl; export;
//             ^^^                   ^^^                  ^^^^^^^^
//             by reference          by reference         by reference
begin
  ResultInteger := iSmall + iLong;
  Result := @ResultInteger;
end;

Не правда ли, чуточку посложнее? Для того чтобы вернуть результат по ссылке, нужно объявить глобальную переменную, а результат возвращать в виде ссылки на эту переменную. Чувствую, у опытных программистов к этому моменту должно возникнуть много вопросов. Немного терпения, господа! Я постараюсь ответить на них чуть ниже.

Вернемся к нашей функции Add_B. Для того, чтобы она могла вернуть результат, нам пришлось ввести переменную ResultInteger. Обратите внимание, не локальную переменную для функции Add_B, а именно глобальную. Разница между ними состоит в "продолжительности жизни" этих переменных.

Глобальная переменная размещается в сегменте данных и доступна и после выхода из функции, в то время как значение локальной переменной после выхода из функции не определено. Но что произойдет, если нашу функцию одновременно вызовут два пользователя? (Хотя слово "одновременно" трактуется немного по-разному для одно и многопроцессорных компьютеров, в данном случае это не имеет никакого значения.) InterBase 4.2 и 5.x полностью поддерживает многонитевую архитектуру [multithreaded architecture], т. е. действительно две и более нити (threads) могут в один и тот же момент времени вызвать функцию Add_B! Какой же результат вернет функция? Поскольку сегмент данных у нитей общий, то результат одной нити перезапишет результат другой. А что же делать? Нужно использовать свою переменную для каждой нити. К счастью, выход прост: вместо ключевого слова var нужно использовать threadvar. Тогда каждая нить будет иметь свою переменную ResultInteger и не "испортит" результат другой нити. (к сожалению, реализация threadvar в Delphi 2,3,4 имеет ошибки, приводящие к "падению" dll при работе на многопроцессорном компьютере. Вместо threadvar лучше использовать прямые вызовы WinAPI TLSAlloc и т. п., или стараться совсем не использовать threadvar).

Для того чтобы InterBase смог "увидеть" и использовать наши функции, их необходимо поместить в библиотеку DLL и объявить "экспортируемыми".

exports
  Add_A, Add_B;

Но, прежде чем использовать наши новые функции в SQL, нам еще раз необходимо описать их, но уже на SQL:

Для функции Add_A

declare external function Add_Short_Long
  smallint, integer
returns
  integer by value
entry_point 'Add_A'
module_name 'UDFDemo';

Рассмотрим каждую строчку поподробнее:

declare external function Add_Short_Long

Под именем Add_Short_Long функция будет известна в SQL, оно может не совпадать с тем, под которым мы экспортировали ее из DLL.

smallint, integer

Входные параметры (всегда передаются по ссылке)

returns
  integer by value

Результат, может передаваться как по ссылке, так и по значению, по умолчанию принимается вариант передачи по ссылке, поэтому мы явно указываем by value.

entry_point 'Add_A'
module_name 'UDFDemo';

А дальше все просто – Add_A это имя, под которым функция была экспортирована из DLL, и UDFDemo – имя этой DLL.

Одна "тонкость" – имя функции чувствительно к регистру, т. е. Add_A и ADD_A это разные имена. А имя DLL – нет, т. е. UDFDemo и UDFDEMO это одно и тоже имя.

Еще одно объявление функции:

declare external function Add_Short_Long2
  smallint, integer
returns
  integer
entry_point 'Add_B'
module_name 'UDFDemo';

Если вы уже нашли все отличия этого объявления от предыдущего примера, то можно считать, что вы уже полностью освоили технику программировани UDF! Если нет, то давайте продолжим.

Вот в чем состоят отличия: изменилось имя функции, под которым она будет известна в SQL, т. к. нельзя иметь две функции с одинаковыми именами:

declare external function Add_Short_Long2

returns
  integer

Из описания результата исчезло by value и изменилось имя Add_B т. е. мы экспортируем из DLL уже другую функцию. А что мешает нам экспортировать одну и ту же функцию под разными именами? В принципе, ничего, кроме, наверное, здравого смысла.

Итак, входные параметры всегда передаются по ссылке, а результат может возвращаться как по ссылке, так и по значению. А что будет, если изменить значение входного параметра, ведь он передается по ссылке? Изменится ли соответствующая переменная в процедуре, из которой вызвана наша UDF? А если в качестве параметров используются не локальные переменные сохраненной процедуры SQL, а значения полей из таблицы, например,

select AddA(S, 5), AddB(5, I)
from TestUDF
where AddA(S, I) = 110;

где S и I – поля таблицы TestUDF, соответственно SmallInt и Integer.

Для ответа на этот вопрос нужно чуть подробнее остановиться на механизме передачи параметров в процедуру. Перед тем, как выполнить UDF, InterBase создает копии входных переменных в памяти, и передает указатели именно на эти копии. Таким образом, вы можете совершенно спокойно модифицировать значения входных параметров, на IB это не произведет никакого впечатления! Зачем останавливаться на таких мелочах, спросите вы? Я отвечу вам конкретными примерами. Есть несколько "нестандартных" возможностей использовать такой способ передачи параметров.

В последнем примере для возврата результата по ссылке нам нужна была "глобальная" переменная, причем уникальная для каждой нити, вызывающей UDF. А ведь на роль такой переменной вполне подходит входной параметр соответствующего типа:

function Add_B2(var iSmall: SmallInt; var iLong: Integer): PInteger; cdecl; export;
//              ^^^                   ^^^                  ^^^^^^^^
//              by reference          by reference         by reference
begin
  iLong := iSmall + iLong;
  Result := @iLong;
end;

Пожалуйста, постарайтесь понять до конца этот пример, ничего сложного здесь нет. Дальше при работе со строками, мы постоянно будем использовать эту технологию.

В вышеприведенных примерах мы использовали переменные типа integer, smallint – эти типы полностью совпадают в IB и Delphi.
А вот таблица соответствия остальных типов данных:

type
  C, C++,       Delphi        InterBase
  ------------- ------------- ----------------
  Short         SmallInt      SmallInt
  Long          Longint       Integer
  int           Integer       Integer
  Float         Single        Float
  Double        Double        Double precision
  *void, *char  PChar         Char(???), VarChar(???), CString

И для удобства можно объявить несколько "указательных" типов:

  PSmallInt = ^SmallInt;
  PInteger  = ^Integer;
  PShort    = ^Short;
  PLong     = ^Long;
  PFloat    = ^Float;
  PDouble   = ^Double;

Числа с плавающей запятой

Работа с числами с плавающей запятой ничем не отличается от работы с целочисленной арифметикой, поэтому оставим ее для самостоятельного экспериментирования и перейдем сразу к строковым типам.
 

Строки

Строки могут быть представлены в таблице InterBase двумя типами: Char(N) и VarChar(N). Внутренне представление (хранение) этих типов совершенно идентично, разница только в том, как их видит "клиент". Тип Char(N) всегда дополняется пробелами до длины N, в тоже время дл типа VarChar(N) возвращается только то, что было записано, и без всяких дополнений (поэтому при передаче в UDF значений типа CHAR не забывайте, что внутрь UDF строка попадет дополненная пробелами).

В UDF те же самые строки могут быть представлены тремя типами: CString, VarChar и Char.

CString – это строка символов оканчивающаяся нулевым символом, т. е. типичная строка языка С (или Delphi PChar), что и видно из названия.

VarChar – это очень похоже на строку языка Pascal (или Delphi ShortString), но имеет в начале не один, а два байта, представляющие длину строки. Максимальная длина строки (и CHAR и VARCHAR) в IB 32767 символов, хотя двумя байтами можно "покрыть" несколько большую длину. Значение переменной этого типа не обязательно заканчивается нулевым символом. Но нулевой символ может быть в конце такой строки, например из-за выравнивания.

И последний тип, Char(N) – похож на массив символов (Array[0..N-1] of Char). Этот тип также не обязательно заканчивается нулевым символом.

Давайте рассмотрим функцию:

declare external function Test
cstring(5), varchar(5), char(5)

При вызове Test('Aaa', 'Bbb', 'Ccc') параметры будут выглядеть следующим образом:

'Aaa'#0#?#?

т. к. первый параметр (cstring) был объявлен с длинной 5, минимум 6 байт будет выделено для хранения этого параметра, т. е. 5 байт + 1 концевой ноль (+ 0 или 2 для выравнивания на границу слова или двойного слова, но нас сейчас это не интересует).
#? – это один байт или символ, значение которого не определено,

#3#0'Bbb'#?#?

для второго параметра (varchar) выделяется 5 байт + 2 байта длины, без учета выравнивания,

'Ccc ' = 'Ccc' + ' ' + ' '

для третьего параметра (char) выделяется ровно 5 байт, также без учета выравнивания. Т. е. типы CString, VarChar "несут в себе" информацию и длине переданного параметра, а тип Char всегда дополняется проделами до объявленной длины.

Поясним вышесказанное несколькими примерами:

// ==============================================
// declare external function ...
// cstring(1000)
// returns
// integer by value
// ...
// ==============================================
function CStrLength(CString: PChar): Integer; cdecl; export;
begin
  Result := StrLen(CString);
end;

// ==============================================
// эта фукнция будет возвращать пустую строку в IB 5.5!
// declare external function ...
// varchar(1000)
// returns
// integer by value
// ...
// ==============================================
function VarCharLength(VarChar: PChar): Integer; cdecl; export;
begin
  Result := PSmallInt(VarChar)^;
  // Result := StrLen(VarChar + 2); Никогда не делайте так !!!
end;

// ==============================================
// declare external function ...
// char(1000)
// returns
// integer by value
// ...
// ==============================================
function CharLength(CharI: PChar): Integer; cdecl; export;
begin
  Result := 1000;
  // потому, что Length(char(1000)) и будет равно 1000
  // из-за принудительного дополнения строки пробелами.
end;

// ==============================================
// declare external function ...
// cstring(256), integer, integer
// returns
// cstring(256)
// ...
// ==============================================
function SubString(CString: PChar; var FromPos, ToPos: Integer): PChar; cdecl; export;
var
  Length: Integer;
begin
  Length := StrLen(CString);
  Result := CString + Length;
  if (FromPos > 0) and (ToPos >= FromPos) then
    begin
      if Length >= FromPos then Result := CString + FromPos - 1;
      if Length > ToPos then CString[ToPos] := #0;
    end;
end;

// ==============================================
// declare external function ...
// cstring(256), cstring(256)
// returns
// integer by value
// ...
// ==============================================
function Position(CSubString, CString: PChar): Integer; cdecl; export;
var
  PChr: PChar;
begin
  PChr := StrPos(CString, CSubString);
  if PChr <> nil then
    Result := PChr - CString + 1
  else
    Result := 0;
end;

Строковые типы нельзя возвращать по значению, но для них есть еще один способ вернуть результат (кстати, этот синтаксис не описан в документации на IB 4.2 и 5.x , но работает:

declare external function ...
  integer, varchar(10)
returns
  parameter 2 <- Результат будет возвращен по ссылке(by REFERENCE) во втором параметре

Эта функция имеет не два входных параметра, а всего один (и даже может быть процедурой, а не функцией). Но у нее есть также и один выходной параметр. Перед вызовом InterBase резервирует место под оба, а помещает входное значение лишь в первый параметр. В UDF передаются указатели на оба параметра, а после выполнения UDF InterBase "считает", что результат помещен во второй параметр.

Лучше, как всегда, обратиться к примеру:

// ==============================================
// declare external function ...
// integer, varchar(10)
// returns
// parameter 2
// ==============================================
procedure HexValue(var iLong: Integer; VarChar: PChar); cdecl; export;
var
  HexStr: ShortString;
begin
  HexStr := IntToHex(iLong, 8);
  try
    StrPCopy(VarChar + 2, HexStr);
    PSmallInt(VarChar)^ := Length(HexStr);
  except
    PSmallInt(VarChar)^ := 0;
  end;
end;

В данном случае мы используем не function, а procedure. У нас два параметра, один указывает на входное значение, а в другой мы должны поместить результат. Технология ничем не отличается от используемой в примере SubString, но т. к. входной и выходной параметры имеют разный тип (вернее разный размер, integer и varchar(10) требуют разного "количества" памяти), мы "просим" InterBase, чтобы он сам выделил нам место для результата.

InterBase спокойно "проглотит" функцию типа:

declare external function ...
  integer, integer
returns
  parameter 2

но результат вас "разочарует"...

Вовсе необязательно делать "выходной" параметр последним, вы можете "поставить его на любое место", главное, чтобы самим потом не запутаться, где "вход", а где "выход" у данной функции. Большей проблемой является то, что IB не хранит в метаданных информацию о том, какой номер параметра был взят в качестве возвращаемого значения. Например, при декларации функции HexStr как returns parameter 2, обратно (извлечением DDL или просмотром текста в Database Explorer) мы получим следующее объявление функции:

declare external function
  integer
returns
  varchar(10)

Действительно, функция именно так и работает, т. е. вызывается в коде хранимых процедур, триггеров или SQL как HexStr(x). И такое объявление фукнции будет правильным в соответствии с порядком передаваемых параметров в стеке. Но лучше всего оригинальные объявления таких функций сохранять в отдельном скрипте.

Кстати, немного об исключениях (exception) – лучше их обрабатывать самим, не передавая Interbase, а в результат функции передайте специальное значение, по которому вы сможете определить, что "что-то не так".

Все вышесказанное работает для InterBase 4.2 Начиная с версии 5.0, появился еще один способ передачи параметров:

// ==============================================
// declare external function ...
// integer
// returns
// cstring(10) free_it <- Ключевое слово FREE_IT сообщает IB
// что нужно освободить память, занятую результатом
// ==============================================

// в документации InterBase 5.0 Language Reference для написания UDF с free_it на
// Delphi
// упоминается несуществующая функция SysAlloc. Вместо нее нужно использовать malloc,
// объявленную ниже, как для Delphi так и для Borland C++Builder.
// Т.е. для аллокирования памяти должен использоваться менеджер MSVC.

function malloc(Size: Integer): PChar; cdecl; external 'msvcrt.dll';

// в InterBase 5.5 введена новая UDF ib_util с функцией ib_malloc, которая выделяет память на любой ОС (не только 95/NT). Библиотека ib_util.dll должна находиться в системном пути - например в Windows/System32.

function HexValue2(var iLong: Integer): PChar; cdecl; export;
var
  HexStr: ShortString;
begin
  HexStr := IntToHex(iLong, 8);
  Result := malloc(Length(HexStr) + 1);
  StrPCopy(Result, HexStr);
end;

То есть я сам распределяю памяти столько, чтобы поместился мой текущий результат, а "освободит" эту память InterBase. Преимущества этого подхода очевидны (для тех кто любит экономить память), если UFD возвращает один раз из тысячи строку длинной 32 кБ, а в остальных случаях по несколько байт, то при старом подходе мы должны были бы объявить:

declare external function ...
  integer, varchar(32000)
returns
  parameter 2

и перед каждым вызовом InterBase должен был бы распределять 32кБ, не зная, какой объем памяти потребуется на самом деле.

Пользуясь новым подходом, можно значительно сэкономить "память", особенно "в масштабах всей страны"! На самом, деле перерасход памяти действительно возможен, если много пользователей вызовут одновременно наш UDF, и вычисления в нем окажутся достаточно длительными по времени.

На что нужно обратить внимание? Если изменить описание функции на

declare external function ...
  integer
returns
  cstring(3) free_it

Т. е. наш UDF возвращает как минимум 8 байтовую строку, а мы объявили как cstring(3). В этом случае результат будет "усекаться" до... 2 символов, т.к. последний символ в cstring обязан содержать ноль. Так что при объявлении UDF экономить не стоит.

А почему мы "распределяли" память таким способом, не проще ли было через GetMem?

К сожалению, нет. Функции GetMem и FreeMem работают с менеджером памяти Deplhi, который является "надстройкой" над менеджером памяти Win32. Поэтому, поручая Interbase"освободить" память, мы должны распределить ее "заранее оговоренным" способом, т. е. при помощи стандартной функции malloc.
 

Дата и время

Для хранения даты и времени в Interbase существует тип date.

Внутреннее представление таково – это запись из двух 32 разрядных знаковых целых чисел.

В первом числе хранится число дней, прошедших с 17 ноября 1858, а во втором – число время в десятых долях миллисекунды, прошедшее после полуночи

  PIBDateTime = ^TIBDateTime;
  TIBDateTime = record
    Days, // Date: Days since 17 November 1858
    MSec10: Integer; // Time: Millisecond * 10 since midnigth
  end;

В Delphi дата и время представлено типом TDateTime, который объявлен как TDateTime = type Double;

Целая часть это число дней, прошедших с 30 декабря 1899, а дробная часть время, прошедшее после полуночи (.0 = 0:00; .25 = 6:00; .5 = 12:00; .75 = 18:00 pm)

Таким образом, совсем не сложно преобразовать даты из формата InterBase в Delphi и наоборот.

Пример:

const // константы трансляции даты:
  MSecsPerDay10 = MSecsPerDay * 10; // миллисекунд в сутках * 10
  IBDateDelta = 15018; // разница в днях между датами Delphi 2.0 и InterBase

// ==============================================
// declare external function ...
// date, cstring(255)
// returns
// parameter 2
// ...
// ==============================================
procedure DateToString(var IBDateTime: TIBDateTime; CString: PChar); cdecl; export;
var
  DateTime: TDateTime;
begin
  with IBDateTime do
    DateTime := Days - IBDateDelta + MSec10 / MSecsPerDay10;

  StrPCopy(CString, FormatDateTime('"Date is" dddd, dd mmmm yyyy "Time is" h:mm:ss', DateTime));
end;

UDF не может вернуть дату "по значению", также мне не удалось воспользоваться способом 'returns parameter N'...

Соответственно, остаются два способа: первый – использовать переменную типа threadvar; второй – ввести дополнительный входной параметр и в нем передать результат. Таким образом, совсем не сложно преобразовать даты из формата InterBase в Delphi и наоборот.

Пример:

// ==============================================
// declare external function ...
// date
// returns
// date
// ...
// ==============================================
function ServerDate(var ServerIBDateTime: TIBDateTime): PIBDateTime; cdecl; export;
var
  DateTime: TDateTime;
  DelphiDays: Integer;
begin
  DateTime := Now;
  DelphiDays := Trunc(DateTime);
  with ServerIBDateTime do
    begin
      Days := DelphiDays + IBDateDelta;
      MSec10 := Trunc((DateTime - DelphiDays) * MSecsPerDay10);
    end;
  Result := @ServerIBDateTime;
end;

При этом трюк с возвратом адреса входного параметра в качестве выходного позволяет отказаться от threadvar. А получать значение из этой функции можно следующим способом:

select ServerDate('01.01.0001') from rdb$database.
 

BLOb

BLOb (Binary Large Object) – этот тип данных предназначен для хранения произвольных данных (текст, картинки, звук и т. п.). Размер хранимых данных в одном поле BLOb может быть максимально от 64Мб до 32Гб (зависит от размера страницы БД).

Основное применение UDF для BLOb, это быстрая загрузка и выгрузка данных, а также всевозможные операции поиска. BLOb хранятся, читаются и записываютс по сегментам, соответственно, каждый конкретный BLOb имеет такие характеристики, как число сегментов, максимальная длина сегмента, и суммарная длина BLOb. Для доступа к BLOb определена специальная структура (отдаленно напоминает тип File в Delphi), в которой описаны все характеристики, а также есть функции чтения, записи и позиционирования.

TBLOb = record
  GetSegment: function(Handle: Pointer; Buffer: PChar;
  MaxLength: Long; var ReadLength: Long): WordBool; cdecl;
  Handle: Pointer; // BLOb handle
  SegCount, // Number of BLOb segments
  MaxSegLength, // Max length of BLOb segment
  TotalLength: Long; // Total BLOb length
  PutSegment: procedure(Handle: Pointer; Buffer: PChar;
  Length: Long); cdecl;
  // Seek: function: Long; cdecl; // Я не знаю входные параметры...
end;

Надеюсь, что эта тема целиком будет ясна из примеров. Здесь также встречаются примеры отладки UDF,

{$Ifdef Debug}
Writeln(X, E.Message);
{$Endif}

их мы рассмотрим несколько позже.

// Размер буфера для чтения BLOb
const
  MaxBufSize = 32768;

// ==============================================
// declare external function ...
// BLOb, cstring(255)
// returns
// parameter 2
// ...
// ==============================================
procedure BLObInfo(var BLOb: TBLOb; CString: PChar); cdecl; export;
begin
  with BLOb do
    if Assigned(Handle) then
      StrLFmt(CString, 255, // максимальна длина строки-результата
        'number of segments:%d max. segment length:%d total length:%d',
        [SegCount, MaxSegLength, TotalLength])
    else
      StrCopy(CString, '');
end;

function SearchSample(Buf, Sample: PChar): Boolean;
begin
  Result := StrPos(Buf, Sample) <> nil;
end;

function FillBuffer(var BLOb: TBLOb; Buf: PChar; FreeBufLen: Integer;
var ReadLen: Integer): Boolean;
var
  EndOfBLOb: Boolean;
  FreeBufLenX, GotLength: Long;
begin
  try
    ReadLen := 0;
    repeat
      GotLength := 0; { !?! }

      if FreeBufLen > MaxBLObPutLength then FreeBufLenX := MaxBLObPutLength
      else FreeBufLenX := FreeBufLen;

      with BLOb do
        EndOfBLOb := not GetSegment(Handle, Buf + ReadLen, FreeBufLenX, GotLength);

      Inc(ReadLen, GotLength);
      Dec(FreeBufLen, GotLength);
    until EndOfBLOb or (FreeBufLen = 0);
  except
    on E: Exception do
      begin
        {$Ifdef Debug}
        Writeln(X, E.Message);
        Writeln(X, ReadLen, ' ', FreeBufLen, ' ', GotLength, ' ', EndOfBLOb);
        Flush(X);
        {$Endif}
        EndOfBLOb := True;
      end;
  end;
  Buf[ReadLen] := #0;
  Result := EndOfBLOb;
end;

// ==============================================
// declare external function ...
// BLOb, cstring(1)
// returns
// integer by value
// ...
// ==============================================
function BLObSearch(var BLOb: TBLOb; KeyWord: PChar): Integer; cdecl; export;
var
  KeyWordLen, ReadLength, Offset: Integer;
  EndOfBLOb, Found: Boolean;
  Buf: PChar;
begin
  Result := 0;
  with BLOb do
    if (not Assigned(Handle)) or (TotalLength = 0) then Exit;

  Result := -2;
  KeyWordLen := StrLen(KeyWord) - 1;
  if KeyWordLen >= MaxBufSize then Exit;

  try
    Found := False;
    GetMem(Buf, MaxBufSize + 1);

    Result := -1;
    if not Assigned(Buf) then Exit;

    Offset := 0;
    repeat
      EndOfBLOb := FillBuffer(BLOb, Buf + Offset, MaxBufSize - Offset, ReadLength);

      if ReadLength + Offset >= KeyWordLen then
        begin
          Found := SearchSample(Buf, KeyWord);
          StrMove(Buf, Buf + ReadLength + Offset - KeyWordLen, KeyWordLen);
          Offset := KeyWordLen;
        end
      else
        Offset := Offset + ReadLength; // Only at the end of BLOb
    until EndOfBLOb or Found;

  finally
    FreeMem(Buf, MaxBufSize + 1);
  end;

  Result := Integer(Found);
end;

const
  MaxVarCharLength = 32767; // Max InterBase Char and VarChar length

procedure BLObToCString(var BLOb: TBLOb; CString: PChar); cdecl; export;
var
  ReadLength: Integer;
begin
  try
    CString[0] := #0;
    with BLOb do
      if (not Assigned(Handle)) or (TotalLength = 0) then Exit;

    FillBuffer(BLOb, CString, MaxVarCharLength - 1, ReadLength);
  except
    {$Ifdef Debug}
    on E: Exception do
      begin
        Writeln(X, 'Exception in BLObToCString!!!');
        Writeln(X, '>', CString, '< ');
        Writeln(X, StrLen(CString), ' ', ReadLength);
        Writeln(X, E.Message);
        Flush(X);
      end;
    {$Endif}
  end;
end;

procedure CStringToBLOb(CString: PChar; var BLOb: TBLOb); cdecl; export;
var
  CStringLength, PutLength: Long;
begin
  try
    CStringLength := StrLen(CString);
    if CStringLength = 0 then Exit; // Is it possible to set BLOb = null when
    // StrLen(CString) = 0 ?
    with BLOb do
      if not Assigned(Handle) then Exit;

    while CStringLength > 0 do
      begin
        if CStringLength > MaxBLObPutLength then PutLength := MaxBLObPutLength
        else PutLength := CStringLength;

        with BLOb do
          PutSegment(Handle, CString, PutLength);

        Dec(CStringLength, PutLength);
        Inc(CString, PutLength);
      end;

  except
    {$Ifdef Debug}
    on E: Exception do
      begin
        Writeln(X, 'Exception in CStringToBLOb!!!');
        Writeln(X, '>', CString, '< ');
        Writeln(X, StrLen(CString), ' ', CStringLength);
        Writeln(X, E.Message);
        Flush(X);
      end;
    {$Endif}
  end;
end;

procedure LoadBLObFromFile(FileName: PChar; var BLOb: TBLOb); cdecl; export;
const
  MaxBufSize = $8192;
var
  BufSize, ReadLength, StreamSize: Integer;
  Buffer: PChar;
  Stream: TStream;
begin
  try
    Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
    try
      StreamSize := Stream.Size;

      if StreamSize > MaxBufSize then BufSize := MaxBufSize else BufSize := StreamSize;
      GetMem(Buffer, BufSize);
      try
        while StreamSize <> 0 do
          begin
            if StreamSize > BufSize then ReadLength := BufSize else ReadLength := StreamSize;
            Stream.ReadBuffer(Buffer^, ReadLength);

            with BLOb do
              PutSegment(Handle, Buffer, ReadLength);

            Dec(StreamSize, ReadLength);
          end;
      finally
        FreeMem(Buffer, BufSize);
      end;
    finally
      Stream.Free;
    end;
  except
    {$Ifdef Debug}
    on E: Exception do
      begin
        Writeln(X, 'Exception in LoadBLObFromFile!!!');
        Writeln(X, 'FileName ', FileName);
        Writeln(X, E.Message);
        Flush(X);
      end;
    {$Endif}
  end;
end;
 

Значения null

К сожалению, механизмы определения значений null во входных параметрах UDF в настоящее время отсутствуют. При передаче параметров в UDF это можно легко обойти, передавая по два параметра, вместо одного, первый – собственно параметр, а второй индикатор, по которому можно определить, не является ли первый параметр значением null. Для того чтобы вернуть null из UDF, необходимо сделать две разные функции – первая вернет значение, а вторая – null-индикатор. В данном случае нельзя обойтись одним вызовом, т. к. UDF может вернуть только одно значение.

Я не привожу пример реализации UDF на Delphi, т. к. здесь "вся соль" именно в SQL.

Примеры:

create procedure IsNull(I Integer)
returns (V VarChar(10))
as
  declare variable Ix smallint;
begin
  /* Мы должны написать что-то типа:
  if (I is null) then V = 'null';
  else V = IntToHex(I);

  Но мы хотим, чтобы именно UDF знала, что передаваемый параметр равен null! */

  if (I is null) then Ix = 1;
  else Ix = 0;
  V = TestNullValue(I, Ix);

  suspend;
end^

create procedure TestIsNull
returns (V VarChar(10))
as
  declare variable I Integer;
begin
  execute procedure IsNull(100) returning_values V;
  suspend;

  I = null;
  execute procedure IsNull(I) returning_values V;
  suspend;
end^

select * from TestIsNull;
 

Отладка

Для отладки UDF я не смог выдумать ничего лучше метода печати сообщений на консоль. Для этого был реализован небольшой модуль, при подключении которого в UDF можно использовать конструкции типа:

Вы можете также использовать этот метод для отслеживания логики вызовов процедур SQL и срабатывания триггеров. Надеюсь, что со временем в IB появится "фирменный" отладчик, а пока... посмотрите пример:

// Debugging usage examples:
var
  Indent: SmallInt = 0; // Made it threadvar and init properly

function CheckPoint(CString: PChar): Integer; cdecl; export;
begin
  {$Ifdef Debug}
  if StrPos(CString, 'Exit from ') <> nil then Dec(Indent, 2);
  if Indent < 0 then Indent := 0;
  Write(X,
  Copy(' ' + ' ', 1, Indent));
  if StrPos(CString, 'Enter to ') <> nil then Inc(Indent, 2);
  if Indent > 128 then Indent := 128;
  Writeln(X, CString);
  Flush(X);
  {$Endif}
  Result := 0;
end;

create procedure NewLine
as
  declare variable Dummy integer;
begin
  Dummy = CheckPoint('');
  Dummy = CheckPoint(cast(cast('Now' as date) as varchar(20)));
  Dummy = CheckPoint('----------------------------------------------------------');
  Dummy = CheckPoint('');
end^

create procedure XXX()
returns (...)
as
  declare variable Dummy integer;
begin
  Dummy = CheckPoint('Enter to procedure " XXX "');
  ...
  Dummy = CheckPoint('LastPrintedDate ' || cast(LastPrintedDate as varchar(10)));
  ...
  Dummy = CheckPoint('Exit from procedure " XXX "');
end^

Пока интересующие нас процедуры SQL и триггеры обрамляются блоками Enter/Exit, а в теле можно просто распечатать значения переменных и параметров. Печать из UDF попадает на эту же консоль.

Все недостающие тексты UDF и процедуры SQL, а также модули необходимые для отладки вы сможете найти в UDF Starter Kit.

На этом, наверное, можно было бы и закончить, последние "традиционные" несколько слов. Данная статья написана на основе UDF Starter Kit. Это совсем маленькое "руководство для начинающих" по написанию и использованию UDF, написанное автором во время работы в фирме Epsylon Technologies.
 

Примечание kdv по отладке UDF в Delphi

Лучше всего сразу оформить новый модуль (new unit) в Delphi, и все функции располагать в нем. Проверить работу функции проще всего в дельфийском приложении, состоящем из полей ввода (входные значения UDF) и кнопки, котора будет вызывать нужную функцию. После того, как вы убедились, что функция работает, сделайте DLL, и поместите ее в каталог UDF для IB 6 и выше, или для предыдущих версий в Interbase\Bin, InterBase\Lib (для 5.0),WinNT\System32 или Windows\System. (В любой каталог Path!).

Однако иногда надо посмотреть, что же передает SQL-сервер в UDF. Это можно сделать достаточно простым способом в Delphi:

• на вашем компьютере должен быть установлен InterBase, Firebird или Yaffil (но не Firebird Embedded или Yaffil Personal). Желательно SuperServer (Classic запускает при коннекте отдельный процесс сервера, так что отладка при использовании Classic вряд ли получится).
• запустите среду Delphi
• убедитесь, что IB/FB/YA не запущен ни как сервис, ни как приложение
• загрузите модуль с текстом UDF (проект dll)
• установите в настройках проекта Output Directory в каталог UDF сервера (чтобы компилируемая dll и была загружаемой сервером udf)
• установите breakpoint в нужном месте UDF
• в меню Run/Parameters укажите в качестве Host application "ibserver.exe" (или fbserver.exe) (и полный путь к нему), в параметрах запуска для InterBase 6 и выше (FB,YA) укажите "-a" (без кавычек).
• Запустите проект (собственно, в этот момент запустится InterBase/Firebird, а IDE Delphi будет ждать попадания на определенную вами точку останова в UDF).

Теперь, когда вы выполните в IBExpert, IBConsole/SQL Explorer или WISQL/ISQL что-то вроде "select myudf(f1) from mytable", сработает точка останова в среде Delphi. Дальше вы можете пользоваться отладчиком среды Delphi. Снимать приложение (ibserver.exe) по Crtl-F2 не рекомендуется, т. к. это будет эквивалентом аварийного завершения сервера (поэтому если хочется завершать udf/сервер аварийно, лучше использовать для теста udf тестовую же базу данных). Если нужно остановить отладку, то снимите breakpoint, нажмите F9, и после этого сделайте Shutdown нажатием правой кнопки на иконке IB в панели задач.