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

Автор: Кубанычбек Тажмамат уулу

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

• 1. При переносе Вашего сервера на другую платформу, например, с win32 на FreeBSD или Linux, возникает проблема переноса также и UDF. Как известно, есть дистрибутивы Free Pascal на эти платформы.
• 2. В Pascal имеется очень удачная концепция библиотеки (library). При переносе на другую платформу достаточно перекомпилировать библиотеку, и она будет работать. При написании аналогичной библиотеки на с приходится переделывать make файл.
• 3. Вы имеете возможность выбора: сделать или на с, или на паскале.
• 4. Free Pascal - хорошее подспорье для программиста на Delphi. Знакомый синтаксис, наверное, поможет многим сделать шаг в изучении Unix и использовании серверных возможностей платформ FreeBSD и Linux.

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.

CONNECT 'mysvr:/db/test.gdb'
USER 'UZVER' PASSWORD 'uzver';

DECLARE

EXTERNALfunction LATRUS
  CSTRING(255)
  RETURNS CSTRING(255)
  ENTRY_POINT 'latrus' MODULE_NAME 'libosh';

DECLARE

externalfunction RUPPER
  CSTRING(255)
  RETURNS CSTRING(255)
  ENTRY_POINT 'rupper' MODULE_NAME 'libosh';

DECLARE

externalfunction RLOWER
  CSTRING(255)
  RETURNS CSTRING(255)
  ENTRY_POINT 'rlower' MODULE_NAME 'libosh';

DECLARE

externalfunction DOS2WIN
  CSTRING(255)
  RETURNS CSTRING(255)
  ENTRY_POINT 'dos2win' MODULE_NAME 'libosh';

DECLARE

externalfunction WIN2DOS
  CSTRING(255)
  RETURNS CSTRING(255)
  ENTRY_POINT 'win2dos' MODULE_NAME 'libosh';

DECLARE

externalfunction KOI82WIN
  CSTRING(255)
  RETURNS CSTRING(255)
  ENTRY_POINT 'koi82win' MODULE_NAME 'libosh';

DECLARE

externalfunction KOI82DOS
  CSTRING(255)
  RETURNS CSTRING(255)
  ENTRY_POINT 'koi82dos' MODULE_NAME 'libosh';

DECLARE

externalfunction DOS2KOI8
  CSTRING(255)
  RETURNS CSTRING(255)
  ENTRY_POINT 'dos2koi8' MODULE_NAME 'libosh';

DECLARE

externalfunction WIN2KOI8
  CSTRING(255)
  RETURNS CSTRING(255)
  ENTRY_POINT 'win2koi8' MODULE_NAME 'libosh';
commit;

SELECT WIN2KOI8(NAME)FROM PEOPLE и т.д.

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