Help us understand the problem. What is going on with this article?

【Delphi】IBX (InterBase Express) で Firebird を使う

はじめに

これは Delphi Advent Calendar 2017 14日目の記事です。

ちょっと前に IBConsole を更新したのですが、修正した IBX の内容を公開しないと片手落ちという事に気づいて、この記事を書くことにしました。

Firebird には InterBase 6 互換モードがありますので、Firebird の大抵の機能は IBX で動作するのですが、InterBase に特化した実装部分は Firebird ではちゃんと動かない事があります。IBX で マトモに Firebird を扱えるようにするには IBX を修正する必要があります。

記事は Delphi 10.2 Tokyo を対象に書かれていますが、Delphi 2009 以降は似たようなコードでイケると思います。

コードの修正

以下の修正が行われます。

  • UTF-8 が使えるようになる。
  • (若干) 高速化する。
  • Firebird 3.0 で追加された Boolean 型が使えるようになる。

IBX のソースコードを修正しますが、オリジナルを書き換えてはいけません。[ファイル | 新規作成 | VCL フォームアプリケーション - Delphi] でプロジェクトを新規作成し、プロジェクトフォルダに以下のファイルをコピーしてきてください。

  • IBX.IB.pas
  • IBX.IBCustomDataSet.pas
  • IBX.IBDatabase.pas
  • IBX.IBExtract.pas
  • IBX.IBHeader.pas
  • IBX.IBInputOutput.pas
  • IBX.IBSQL.pas
  • IBX.IBStoredProc.pas

IBX のソースファイルは $(BDS)\source\IBX にあります。

UTF-8 対応

InterBase と Firebird で UTF-8 の SqlSubtype の値が異なるため、Firebird で UTF-8 を使うと文字の長さを間違ってしまう件を修正します。

IBX.IBSQL.pas
function TIBXSQLVAR.GetCharsetSize: Integer;
begin
{
  case SQLVar.SQLSubtype and $FF of
    0, 1, 2, 10, 11, 12, 13, 14, 19, 21, 22, 39,
    45, 46, 47, 50, 51, 52, 53, 54, 55, 58 :  Result := 1;
    5, 6, 8, 44, 56, 57, 64 : Result := 2;
    3 :
    begin
      // System Tables incorrectly state they are in Unicode_Fss character set but they are not
      if SQLVar.RelName.StartsWith('RDB$') or
         (SQLVar.SqlLen mod 3 <> 0) then
        Result := 1
      else
        Result := 3;
    end;
    59 : Result := 4;
    else
      Result := 1;
  end;
}
  case SqlVar.SqlSubtype and $FF of
     5, // SJIS_0208
     6, // EUCJ_0208
     8, // UNICODE_BE / UCS2BE (InterBase)
    44, // KSC_5601
    56, // BIG_5
    57, // GB_2312
    64, // UNICODE_LE / UCS2LE (InterBase)
    67, // GBK (Firebird)
    68: // CP943C (Firebird)
      result := 2;
    3: // UNICODE_FSS
      begin
        // System Tables incorrectly state they are in Unicode_Fss character set but they are not
        if SqlVar.RelName.StartsWith('RDB$') or (SqlVar.SqlLen mod 3 <> 0) then
          result := 1
        else
          result := 3;
      end;
     4, // UTF8 (Firebird)
    59, // UTF8 / UTF_8 (InterBase)
    69: // GB18030 (Firebird)
      result := 4;
  else
    result := 1;
  end;  
end;

image.png

Firebird にしかない文字コードや InterBase にしかない文字コードがあります。しかも
InterBase と Firebird で両対応しようとしてもできない文字コードがあります。仕方ないので、大筋は InterBase に合わせておきます。

IBX.IBDatabase.pas
procedure BuildDPBConstants;
begin

  ...

  CodePages.Add('DOS775', 775);      {do not localize} // 15
  CodePages.Add('DOS858', 858);      {do not localize} // 16
  CodePages.Add('DOS862', 862);      {do not localize} // 17
  CodePages.Add('DOS864', 864);      {do not localize} // 18
  CodePages.Add('ISO8859_2', 28592); {do not localize} // 22
  CodePages.Add('ISO8859_8', 1255);  {do not localize} // 38
  CodePages.Add('DOS866', 866);      {do not localize} // 48
  CodePages.Add('DOS869', 1255);     {do not localize} // 49
  CodePages.Add('BIG_5', 950);       {do not localize} // 56
  CodePages.Add('WIN1255', 1255);    {do not localize} // 58
  CodePages.Add('WIN1256', 1256);    {do not localize} // 59
  CodePages.Add('WIN1257', 1257);    {do not localize} // 60
  CodePages.Add('KOI8R', 20866);     {do not localize} // 63
  CodePages.Add('WIN1258', 1258);    {do not localize} // 65
  CodePages.Add('GBK', 936);         {do not localize} // 67
  CodePages.Add('TIS620', 874);      {do not localize} // 66
  CodePages.Add('CP943C', 932);      {do not localize} // 68
  CodePages.Add('GB18030', 54936);   {do not localize} // 69
end;

IBExtract を使う際に一部コメントアウトしておかないと動作しない非互換部分があります。

IBX.IBExtract.pas
function TIBExtract.ExtractDDL(Flag: Boolean; TableName: String) : Boolean;
begin

  ...

  if TableName <> '' then
  begin
    if not ExtractListTable(TableName, '', true) then
      Result := false;
  end
  else
  begin
    ListCreateDb;
//    ListEUAUsers;
//    ListEncryptions;
//    if ConnectAsOwner then
//      BuildConnectString;
    ListFilters;
    ListFunctions;
    ListDomains;
    ListAllTables(flag);
    ListIndex;
    ListForeign;
    ListGenerators;
    ListSubscriptions;
    ListViews;
    ListCheck;
    ListException;
    ListProcs;
    ListTriggers;
    ListGrants;
  end;

  ...

end;

IBX の高速化

元ネタはこちらです。

IBX.IBX.IB.pas
procedure IBAlloc(var P; OldSize, NewSize: NativeInt);
var
  i: Integer;
begin
  if Assigned(Pointer(P)) then
    ReallocMem(Pointer(P), NewSize)
  else
    GetMem(Pointer(P), NewSize);

//  for i := OldSize to NewSize - 1 do
//    PByte(P)[i] := 0;
  if NewSize > OldSize then
    FillChar((PByte(P) + OldSize)^, NewSize - OldSize, 0);
end;

{$IFDEF NEXTGEN}
procedure IBAlloc(var p : TRecBuf; OldSize, NewSize: NativeInt);
var
  i: Integer;
begin
  ReallocMem(Pointer(p), NewSize);
  for i := OldSize to NewSize - 1 do
    PByte(p)[i] := 0;
end;
{$ELSE}
procedure IBAlloc(var p : TRecordBuffer; OldSize, NewSize: NativeInt);
var
  i: Integer;
begin
  ReallocMem(p, NewSize);
//  for i := OldSize to NewSize - 1 do
//    p[i] := 0;
  if NewSize > OldSize then
    FillChar((PByte(P) + OldSize)^, NewSize - OldSize, 0);
end;
{$ENDIF NEXTGEN}

2か所あるのでご注意!

Boolean 型 (Firebird 3.0 以降) への対応

Firebird と InterBase で Boolean 型に対する定数が異なる場合があるのでそれを修正します。

IBX.IBHeader.pas
  ...

const
  isc_blob_filter_open           =          0;
  isc_blob_filter_get_segment    =          1;
  isc_blob_filter_close          =          2;
  isc_blob_filter_create         =          3;
  isc_blob_filter_put_segment    =          4;
  isc_blob_filter_alloc          =          5;
  isc_blob_filter_free           =          6;
  isc_blob_filter_seek           =          7;

(*********************)
(** Blr definitions **)
(*********************)

  // In pascal, how does one deal with the below "#define"?
  // blr_word(n) ((n) % 256), ((n) / 256)
  blr_text                       =         14;
  blr_text2                      =         15;
  blr_short                      =          7;
  blr_long                       =          8;
  blr_quad                       =          9;
  blr_float                      =         10;
  blr_double                     =         27;
  blr_d_float                    =         11;
  blr_timestamp                  =         35;
  blr_varying                    =         37;
  blr_varying2                   =         38;
  blr_blob                       =        261;
  blr_cstring                    =         40;
  blr_cstring2                   =         41;
  blr_blob_id                    =         45;
  blr_sql_date                   =         12;
  blr_sql_time                   =         13;
  blr_int64                      =         16;
//blr_boolean_dtype              =         17; // InterBase 用
  blr_boolean_dtype              =         23; // Firebird 用
  blr_date                       =         blr_timestamp;

  ...

(*********************)
(** SQL definitions **)
(*********************)
  SQL_VARYING                    =        448;
  SQL_TEXT                       =        452;
  SQL_DOUBLE                     =        480;
  SQL_FLOAT                      =        482;
  SQL_LONG                       =        496;
  SQL_SHORT                      =        500;
  SQL_TIMESTAMP                  =        510;
  SQL_BLOB                       =        520;
  SQL_D_FLOAT                    =        530;
  SQL_ARRAY                      =        540;
  SQL_QUAD                       =        550;
  SQL_TYPE_TIME                  =        560;
  SQL_TYPE_DATE                  =        570;
  SQL_INT64                      =        580;
  SQL_DATE                       =        SQL_TIMESTAMP;
  SQL_BOOLEAN                    =        590; 
  SQL_FIREBIRD_BOOLEAN           =        32764; // 追加
  SQL_NULL                       =        32766; // 追加

  ...

以下のファイルで SQL_BOOLEAN となっている所を SQL_BOOLEAN, SQL_FIREBIRD_BOOLEAN で置き換えます。

  • IBX.IBCustomDataSet.pas
  • IBX.Extract.pas
  • IBX.IBInputOutput.pas
  • IBX.IBSQL.pas
  • IBX.IBStoredProc.pas

すべて case 文での定数なので、一括置換で構いません。

例えばこのようなコードを...

IBX.IBExtract.pas
          SQL_SHORT, SQL_LONG, SQL_INT64,
          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, SQL_BOOLEAN:
            Values := Values + qrySelect.Fields[i].AsTrimString;

こんな感じで置換します。

IBX.IBExtract.pas
          SQL_SHORT, SQL_LONG, SQL_INT64,
          SQL_DOUBLE, SQL_FLOAT, SQL_D_FLOAT, SQL_BOOLEAN, SQL_FIREBIRD_BOOLEAN:   // 追加
            Values := Values + qrySelect.Fields[i].AsTrimString;

修正をすべて終えたら、IBX 関係のファイルをどこかに保存しておきます。IBX で Firebird を使いたくなったらこのファイルをプロジェクトフォルダにコピーして使ってください。

おわりに

修正を行っても InterBase との互換性は失われていませんので、InterBase / Firebird どちらにも接続可能なハズです。ぶっちゃけこの程度の違いしかないので、最初から IBX で Firebird 対応してくれるといいのにと思わなくもありません。

それから、IBX は Professional Edition 以上の SKU に含まれます。残念ながら Starter Edition では利用できませんので、Starter Edition で Firebird を使いたい方は ZeosLib を使いましょう。Enterprise Edition 以上の SKU をお持ちの方は素直に FireDAC を使いましょう。

ht_deko
とある熊本の障害復旧(トラブルシューター)
https://ht-deko.com/
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away