Версия для печати


Библиотеки пользовательских функций UDF для Interbase на Free Pascal.
http://www.delphikingdom.com/asp/viewitem.asp?catalogID=403

Кубанычбек Тажмамат уулу
дата публикации 03-05-2001 00:00

Библиотеки пользовательских функций UDF для Interbase на Free Pascal.

Всем известно, что возможности interbase можно расширить за счет написания пользовательских функций UDF. Но почему на Free Pascal?

Есть ряд веских причин.

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

library libosh;
{$mode objfpc}
{$PACKRECORDS C}
const
// Чтобы не было проблем с распознаванием кодировок на разных платформах
  rus_chars:pChar = #197#210#211#206#208#192#205#202#213#209
                +#194#204#229#243#232#238#240#224#234#245#241#236
;
  lat_chars:pChar = 'ETYOPAHKXCBMeyuopakxcm';
  small_chars:pChar =
#113#119#101#114#116#121#117#105#111#112#97#115#100#102#103
+#104#106#107#108#122#120#99#118#98#110#109#233#246#243#234
+#229#237#227#248#249#231#245#250#244#251#226#224#239#240#238
+#235#228#230#253#255#247#241#236#232#242#252#225#254#184
;
  cap_chars:pChar = 
#81#87#69#82#84#89#85#73#79#80#65#83#68#70#71#72#74#75#76#90
+#88#67#86#66#78#77#201#214#211#202#197#205#195#216#217#199
+#213#218#212#219#194#192#207#208#206#203#196#198#221#223#215
+#209#204#200#210#220#193#222#168
;
   cp1251:pChar =
#233#246#243#234#229#237#227#248#249#231#245#250#244#251#226
+#224#239#240#238#235#228#230#253#255#247#241#236#232#242#252
+#225#254#184#201#214#211#202#197#205#195#216#217#199#213#218
+#212#219#194#192#207#208#206#203#196#198#221#223#215#209#204
+#200#210#220#193#222#168
;
   cp866:pChar =
#169#230#227#170#165#173#163#232#233#167#229#234#228#235#162
+#160#175#224#174#171#164#166#237#239#231#225#172#168#226#236
+#161#238#241#137#150#147#138#133#141#131#152#153#135#149#154
+#148#155#130#128#143#144#142#139#132#134#157#159#151#145#140
+#136#146#156#129#158#240
;
    koi8:pChar = 
 #202#195#213#203#197#206#199#219#221#218#200#223#198#217#215#193
+#208#210#207#204#196#214#220#209#222#211#205#201#212#216#194#192
+#163
+#234#227#245#235#229#238#231#251#253#250#232#255#230#249#247#225
+#240#242#239#236#228#246#252#241#254#243#237#233#244#248#226#224
+#179
;
function replace_it(CString: PChar;scr: PChar;dest: PChar):PChar;

var i,j:integer;
begin
  i:=0;
  while (CString[i]<>#0) do
  begin
    j:=0;
    while (scr[j]<>#0) do
    begin
       if CString[i]=scr[j]
       then 
       begin
         CString[i]:=dest[j];
         Break; 
       end; 
       inc(j);
    end;
    inc(i);
  end;

  result:=CString;
end;

function latrus(CString: PChar): PChar;stdcall;export;
begin
  result:=replace_it(CString,lat_chars,rus_chars);
end;

function rupper(CString: PChar): PChar;stdcall;export;
begin
  result:=replace_it(CString,small_chars,cap_chars);
end;

function rlower(CString: PChar): PChar;stdcall;export;
begin
  result:=replace_it(CString,cap_chars,small_chars);
end;

function dos2win(CString: PChar): PChar;stdcall;export;
begin
  result:=replace_it(CString,cp866,cp1251);
end;

function win2dos(CString: PChar): PChar;stdcall;export;
begin
  result:=replace_it(CString,cp1251,cp866);
end;

function koi82win(CString: PChar): PChar;stdcall;export;
begin
  result:=replace_it(CString,koi8,cp1251);
end;

function koi82dos(CString: PChar): PChar;stdcall;export;
begin
  result:=replace_it(CString,koi8,cp866);
end;

function dos2koi8(CString: PChar): PChar;stdcall;export;
begin
  result:=replace_it(CString,cp866,koi8);
end;

function win2koi8(CString: PChar): PChar;stdcall;export;
begin
  result:=replace_it(CString,cp1251,koi8);
end;

function UDF_strcat(dest,source : pchar) : pchar; stdcall;export; 
begin
  result:=strcat(dest,source);
end;

exports
  latrus name 'latrus', 
// преобразование латинских бук, похожих на кирилличесике 
// в кириллические 1251. Иногда надо при переделке существующих
// баз данных, в которых некоторые русские буквы по ошибке
// набраны латинницей

  rupper name 'rupper',   // перевод русских в верхний и нижний регистры
  rlower name 'rlower',

  dos2win name 'dos2win', // перевод различных кодировок кириллицы
  win2dos name 'win2dos',

  koi82win name 'koi82win',
  koi82dos name 'koi82dos',

  dos2koi8 name 'dos2koi8',
  win2koi8 name 'win2koi8'
;
end.

Откомпилированные библиотеки должны иметь названия libosh.dll для win32 и libosh.so для FreeBSD и Linux.
Для подключения этих функций используйте скрипт 
CONNECT 'mysvr:/db/test.gdb'
    USER 'UZVER' PASSWORD 'uzver';

DECLARE EXTERNAL FUNCTION LATRUS
   CSTRING(255)
   RETURNS CSTRING(255)
  ENTRY_POINT 'latrus'  MODULE_NAME 'libosh';

DECLARE EXTERNAL FUNCTION RUPPER
   CSTRING(255)
   RETURNS CSTRING(255)
  ENTRY_POINT 'rupper'  MODULE_NAME 'libosh';

DECLARE EXTERNAL FUNCTION RLOWER
   CSTRING(255)
   RETURNS CSTRING(255)
  ENTRY_POINT 'rlower'  MODULE_NAME 'libosh';

DECLARE EXTERNAL FUNCTION DOS2WIN
   CSTRING(255)
   RETURNS CSTRING(255)
  ENTRY_POINT 'dos2win'  MODULE_NAME 'libosh';

DECLARE EXTERNAL FUNCTION WIN2DOS
   CSTRING(255)
   RETURNS CSTRING(255)
  ENTRY_POINT 'win2dos'  MODULE_NAME 'libosh';

DECLARE EXTERNAL FUNCTION KOI82WIN
   CSTRING(255)
   RETURNS CSTRING(255)
  ENTRY_POINT 'koi82win'  MODULE_NAME 'libosh';

DECLARE EXTERNAL FUNCTION KOI82DOS
   CSTRING(255)
   RETURNS CSTRING(255)
  ENTRY_POINT 'koi82dos'  MODULE_NAME 'libosh';

DECLARE EXTERNAL FUNCTION DOS2KOI8
   CSTRING(255)
   RETURNS CSTRING(255)
  ENTRY_POINT 'dos2koi8'  MODULE_NAME 'libosh';

DECLARE EXTERNAL FUNCTION WIN2KOI8
   CSTRING(255)
   RETURNS CSTRING(255)
  ENTRY_POINT 'win2koi8'  MODULE_NAME 'libosh';
commit;
В порте freepascal для freeBSD немного недоделан модуль sysutils, и вызов некоторых функций из него приводит к runtime error. Пример использования функций библиотеки 
SELECT WIN2KOI8(NAME) FROM PEOPLE и т.д.

Найти freepascal можно по адресу www.freepascal.org

Кубанычбек Тажмамат уулу,
03 мая 2001г
Специально для Королевства Delphi