client/3.0/FB30ClientAPI.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FB30ClientAPI;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, FBClientAPI, Firebird, IB, IBExternals, FmtBCD, FBClientLib;

type

  { TFB30Status }

  TFB30Status = class(TFBStatus,IStatus)
  private
    FStatus: Firebird.IStatus;
  public
    procedure Init;
    function InErrorState: boolean;
    function GetStatus: Firebird.IStatus;
    function StatusVector: PStatusVector; override;
  end;

  { TFB30StatusObject }

  TFB30StatusObject = class(TFB30Status)
  public
    constructor Create(aOwner: TFBClientAPI; status: Firebird.IStatus);
  end;

  Tfb_get_master_interface = function: IMaster;
                              {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}

  { TFB30ClientAPI }

  TFB30ClientAPI = class(TFBClientAPI,IFirebirdAPI,IFBIMasterProvider)
  private
    FMaster: Firebird.IMaster;
    FUtil: Firebird.IUtil;
    FProvider: Firebird.IProvider;
    FConfigManager: Firebird.IConfigManager;
    FStatus: TFB30Status;
    FIsEmbeddedServer: boolean;
    FStatusIntf: IStatus;   {Keep a reference to the interface - automatic destroy
                             when this class is freed and last reference to IStatus
                             goes out of scope.}
    procedure CheckPlugins;
    function Firebird4orLater: boolean;
  public
    constructor Create(aFBLibrary: TFBLibrary);
    destructor Destroy; override;

    function StatusIntf: Firebird.IStatus;
    procedure Check4DataBaseError;
    function InErrorState: boolean;
    function LoadInterface: boolean; override;
    procedure FBShutdown; override;
    function GetAPI: IFirebirdAPI; override;
    {$IFDEF UNIX}
    function GetFirebirdLibList: string; override;
    {$ENDIF}

  public
    {IFirebirdAPI}
    function GetStatus: IStatus; override;
    function AllocateDPB: IDPB;
    function AllocateTPB: ITPB;

    {Database connections}
    function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
    function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
    function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
    {Start Transaction against multiple databases}
    function StartTransaction(Attachments: array of IAttachment;
             TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
    function StartTransaction(Attachments: array of IAttachment;
             TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload;

    {Service Manager}
    function AllocateSPB: ISPB;
    function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
    function GetServiceManager(ServerName: AnsiString; Port: Ansistring; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;

    {Information}
    function HasServiceAPI: boolean;
    function HasRollbackRetaining: boolean;
    function IsEmbeddedServer: boolean; override;
    function GetClientMajor: integer; override;
    function GetClientMinor: integer; override;
    function HasLocalTZDB: boolean; override;
    function HasTimeZoneSupport: boolean; override;
    function HasExtendedTZSupport: boolean; override;
    function HasInt128Support: boolean; override;

    {Firebird 3 API}
    function HasMasterIntf: boolean;
    function GetIMaster: TObject;

    {IFBIMasterProvider}
    function GetIMasterIntf: Firebird.IMaster;

    {Encode/Decode}
    function DecodeInteger(bufptr: PByte; len: short): integer; override;
    procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override;
    function SQLDecodeDate(bufptr: PByte): TDateTime; override;
    procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override;
    function SQLDecodeTime(bufptr: PByte): TDateTime;  override;
    procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
    function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
    function FormatStatus(Status: TFBStatus): AnsiString; override;

    {Firebird 4 Extensions}
    procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte);
      override;
    function SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD; override;
    function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; override;
    procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte); override;

    {Firebird Interfaces}
    property MasterIntf: Firebird.IMaster read FMaster;
    property UtilIntf: Firebird.IUtil read FUtil;
    property ProviderIntf: Firebird.IProvider read FProvider;

  end;

implementation

uses FB30Attachment, {$IFDEF FPC}dynlibs{$ELSE} windows{$ENDIF},
     FBMessages, FB30Services, FB30Transaction, IBUtils, DateUtils,
     FBAttachment, FBTransaction, FBServices;

type
  PISC_DATE = ^ISC_DATE;
  PISC_TIME = ^ISC_TIME;

{ TFB30StatusObject }

constructor TFB30StatusObject.Create(aOwner: TFBClientAPI;
  status: Firebird.IStatus);
begin
  inherited Create(aOwner);
  FStatus := status;
end;

{ TFB30Status }

procedure TFB30Status.Init;
begin
  if assigned(FStatus) then
    FStatus.Init;
end;

function TFB30Status.InErrorState: boolean;
begin
  with GetStatus do
    Result := ((getState and STATE_ERRORS) <> 0);
end;

function TFB30Status.GetStatus: Firebird.IStatus;
begin
  if FStatus = nil then
  with FOwner do
    FStatus := (FOwner as TFB30ClientAPI).MasterIntf.GetStatus;
  Result := FStatus;
end;

function TFB30Status.StatusVector: PStatusVector;
begin
  Result := PStatusVector(GetStatus.getErrors);
end;

{ TFB30ClientAPI }

procedure TFB30ClientAPI.CheckPlugins;
var FBConf: Firebird.IFirebirdConf;
    Plugins: AnsiString;
    PluginsList: TStringList;
begin
  FIsEmbeddedServer := false;
  FBConf := FConfigManager.getFirebirdConf;
  try
    Plugins := FBConf.asString(FBConf.getKey('Providers'));
  finally
    FBConf.release;
  end;
  if Plugins = '' then Exit;

  PluginsList := TStringList.Create;
  try
    PluginsList.CommaText := Plugins;
    FIsEmbeddedServer := (PluginsList.IndexOf('Engine12') <> -1) or {Firebird 3}
                         (PluginsList.IndexOf('Engine13') <> -1); {Firebird 4}
  finally
    PluginsList.Free;
  end;
end;

function TFB30ClientAPI.Firebird4orLater: boolean;
begin
  Result :=  (GetClientMajor >=4) and (UtilIntf.vtable.version >= 4)
    and (UtilIntf.vtable.version <> 21) {ignore FB4 Beta1}
    and (UtilIntf.vtable.version <> 24) {ignore FB4 Beta2}
end;

{$IFDEF UNIX}
function TFB30ClientAPI.GetFirebirdLibList: string;
begin
  Result := 'libfbclient.so:libfbclient.so.2';
end;
{$ENDIF}

function TFB30ClientAPI.LoadInterface: boolean;
var
  fb_get_master_interface: Tfb_get_master_interface;
begin
  Result := inherited LoadInterface;
  fb_get_master_interface := GetProcAddress(GetFBLibrary.GetHandle, 'fb_get_master_interface'); {do not localize}
  if assigned(fb_get_master_interface) then
  begin
    FMaster := fb_get_master_interface;
    FUtil := FMaster.getUtilInterface;
    FProvider := FMaster.getDispatcher;
    FConfigManager := FMaster.getConfigManager;
    CheckPlugins;
  end;
  Result := Result and HasMasterIntf;
end;

procedure TFB30ClientAPI.FBShutdown;
begin
  if assigned(fb_shutdown) and assigned(FProvider) then
  begin
    FProvider.release;
    FProvider := nil;
  end;
  inherited;
end;

function TFB30ClientAPI.GetAPI: IFirebirdAPI;
begin
  Result := self;
end;

constructor TFB30ClientAPI.Create(aFBLibrary: TFBLibrary);
begin
  inherited Create(aFBLibrary);
  FStatus := TFB30Status.Create(self);
  FStatusIntf := FStatus;
end;

destructor TFB30ClientAPI.Destroy;
begin
  if assigned(FProvider) then
    FProvider.release;
  inherited Destroy;
end;

function TFB30ClientAPI.StatusIntf: Firebird.IStatus;
begin
  Result := FStatus.GetStatus;
  Result.Init;
end;

procedure TFB30ClientAPI.Check4DataBaseError;
begin
  if FStatus.InErrorState then
    IBDataBaseError;
end;

function TFB30ClientAPI.InErrorState: boolean;
begin
  Result := FStatus.InErrorState;
end;

function TFB30ClientAPI.GetStatus: IStatus;
begin
  Result := FStatusIntf;
end;

function TFB30ClientAPI.AllocateDPB: IDPB;
begin
  Result := TDPB.Create(self);
end;

function TFB30ClientAPI.AllocateTPB: ITPB;
begin
  Result := TTPB.Create(self);
end;

function TFB30ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
  RaiseExceptionOnConnectError: boolean): IAttachment;
begin
  Result := TFB30Attachment.Create(self,DatabaseName, DPB, RaiseExceptionOnConnectError);
  if not Result.IsConnected then
    Result := nil;
end;

function TFB30ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
  RaiseExceptionOnError: boolean): IAttachment;
begin
  Result := TFB30Attachment.CreateDatabase(self,DatabaseName,DPB, RaiseExceptionOnError);
  if not Result.IsConnected then
    Result := nil;
end;

function TFB30ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
  RaiseExceptionOnError: boolean): IAttachment;
begin
  Result := TFB30Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError);
  if not Result.IsConnected then
    Result := nil;
end;

function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
  TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
begin
  Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion);
end;

function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
  TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
begin
  Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion);
end;

function TFB30ClientAPI.AllocateSPB: ISPB;
begin
  Result := TSPB.Create(self);
end;

function TFB30ClientAPI.GetServiceManager(ServerName: AnsiString;
  Protocol: TProtocol; SPB: ISPB): IServiceManager;
begin
  Result := TFB30ServiceManager.Create(self,ServerName,Protocol,SPB);
end;

function TFB30ClientAPI.GetServiceManager(ServerName: AnsiString;
  Port: Ansistring; Protocol: TProtocol; SPB: ISPB): IServiceManager;
begin
  Result := TFB30ServiceManager.Create(self,ServerName,Protocol,SPB,Port);
end;

function TFB30ClientAPI.HasServiceAPI: boolean;
begin
  Result := true;
end;

function TFB30ClientAPI.HasMasterIntf: boolean;
begin
  Result := MasterIntf <> nil;
end;

function TFB30ClientAPI.GetIMaster: TObject;
begin
  Result := FMaster;
end;

function TFB30ClientAPI.GetIMasterIntf: Firebird.IMaster;
begin
  Result := FMaster;
end;

function TFB30ClientAPI.HasRollbackRetaining: boolean;
begin
  Result := true;
end;

function TFB30ClientAPI.IsEmbeddedServer: boolean;
begin
  Result := FIsEmbeddedServer;
end;

function TFB30ClientAPI.GetClientMajor: integer;
begin
  Result := UtilIntf.GetClientVersion div 256;
end;

function TFB30ClientAPI.GetClientMinor: integer;
begin
  Result := UtilIntf.GetClientVersion mod 256;
end;

function TFB30ClientAPI.DecodeInteger(bufptr: PByte; len: short): integer;
var P: PByte;
begin
  Result := 0;
  P := Bufptr + len - 1;
  while P >= bufptr do
  begin
    Result := (Result shl 8 ) or P^;
    Dec(P);
  end;
end;

procedure TFB30ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
var
  Yr, Mn, Dy: Word;
begin
   DecodeDate(aDate, Yr, Mn, Dy);
   PISC_Date(Bufptr)^ := UtilIntf.encodeDate(Yr, Mn, Dy);
end;

function TFB30ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime;
var
  Yr, Mn, Dy: cardinal;
begin
  UtilIntf.decodeDate(PISC_DATE(bufptr)^,@Yr, @Mn, @Dy);
  try
    result := EncodeDate(Yr, Mn,Dy);
  except
    on E: EConvertError do begin
      IBError(ibxeInvalidDataConversion, [nil]);
    end;
  end;
end;

procedure TFB30ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
var
  Hr, Mt, S: word;
  DMs: cardinal;
begin
  FBDecodeTime(aTime,Hr, Mt, S, DMs);
  PISC_TIME(bufptr)^ :=  UtilIntf.encodeTime(Hr, Mt, S, DMs);
end;

function TFB30ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
var
  Hr, Mt, S, DMs: cardinal;
begin
  UtilIntf.decodeTime(PISC_TIME(bufptr)^,@Hr, @Mt, @S, @DMs);
  try
    Result := FBEncodeTime(Hr, Mt, S, DMs);
  except
    on E: EConvertError do begin
      IBError(ibxeInvalidDataConversion, [nil]);
    end;
  end;
end;

procedure TFB30ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte);
begin
  SQLEncodeDate(aDateTime,bufPtr);
  Inc(bufptr,sizeof(ISC_DATE));
  SQLEncodeTime(aDateTime,bufPtr);
end;

function TFB30ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
begin
  Result := SQLDecodeDate(bufPtr);
  Inc(bufptr,sizeof(ISC_DATE));
  Result := Result + SQLDecodeTime(bufPtr);
end;

function TFB30ClientAPI.FormatStatus(Status: TFBStatus): AnsiString;
var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
begin
  Result := '';
  if UtilIntf.formatStatus(@local_buffer,sizeof(local_buffer),(Status as TFB30Status).GetStatus) > 0 then
    Result := strpas(local_buffer);
end;

procedure TFB30ClientAPI.SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal;
  bufptr: PByte);
var DecFloat16: IDecFloat16;
    DecFloat34: IDecFloat34;
    sign: integer;
    exp: integer;
    buffer: array [1..34] of byte;

    procedure UnpackBuffer(width: integer);
    var i,j: integer;
    begin
      Fillchar(buffer,sizeof(buffer),0);
      if BCDPrecision(aValue) > width then
        IBError(ibxeBCDTooBig,[BCDPrecision(aValue),width]);
      j := 1 + (width - aValue.Precision);
      for i := 0 to (aValue.Precision - 1) div 2 do
      if j <= width then
      begin
          buffer[j] := (aValue.Fraction[i] and $f0) shr 4;
          Inc(j);
          if j <= width then
          begin
            buffer[j] := (aValue.Fraction[i] and $0f);
            Inc(j);
          end;
      end;
      {writeln('Precision = ',aValue.Precision,' Places = ',aValue.SignSpecialPlaces and $2f);
      write('BCD Buffer = ');
      for i := 1 to 34 do
        write(buffer[i],' ');
      writeln; }
    end;

begin
  inherited SQLDecFloatEncode(aValue, SQLType, bufptr);
  sign := (aValue.SignSpecialPlaces and $80) shr 7;
  exp := -(aValue.SignSpecialPlaces and $2f);

  case SQLType of
  SQL_DEC16:
    begin
      UnPackbuffer(16);
      DecFloat16 := UtilIntf.getDecFloat16(StatusIntf);
      Check4DataBaseError;
      DecFloat16.fromBcd(sign,@buffer,exp,FB_DEC16Ptr(bufptr));
      Check4DataBaseError;
    end;

  SQL_DEC34:
    begin
      UnPackbuffer(34);
      DecFloat34 := UtilIntf.getDecFloat34(StatusIntf);
      Check4DataBaseError;
      DecFloat34.fromBcd(sign,@buffer,exp,FB_DEC34Ptr(bufptr));
      Check4DataBaseError;
    end;

  else
    IBError(ibxeInvalidDataConversion,[]);
  end;
end;

function TFB30ClientAPI.SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD;

var DecFloat16: IDecFloat16;
    DecFloat34: IDecFloat34;
    sign: integer;
    exp: integer;
    buffer: array [1..38] of byte;

  procedure packbuffer(buflen: integer);
  var i,j: integer;
  begin
{    write('Decode: BCD Buffer = ');
    for i := 1 to 34 do
      write(buffer[i],' ');
    writeln; }
    {pack buffer}
    i := 1;
    while (i <= buflen) and (buffer[i] = 0) do  {skip leading zeroes}
      inc(i);

    j := 0;
    Result.Precision := 0;
    while i <= buflen do
    begin
      inc(Result.Precision);
      if odd(Result.Precision) then
        Result.Fraction[j] := (buffer[i] and $0f) shl 4
      else
      begin
        Result.Fraction[j] := Result.Fraction[j] or (buffer[i] and $0f);
        Inc(j);
      end;
      inc(i);
    end;
  end;

begin
  Result := inherited SQLDecFloatDecode(SQLType, bufptr);
  FillChar(Result, sizeof(tBCD),0);
  case SQLType of
  SQL_DEC16:
    begin
      DecFloat16 := UtilIntf.getDecFloat16(StatusIntf);
      Check4DataBaseError;
      DecFloat16.toBcd(FB_DEC16Ptr(bufptr),@sign,@buffer,@exp);
      Check4DataBaseError;
      packbuffer(16);
    end;

  SQL_DEC34:
    begin
      DecFloat34 := UtilIntf.getDecFloat34(StatusIntf);
      Check4DataBaseError;
      DecFloat34.toBcd(FB_DEC34Ptr(bufptr),@sign,@buffer,@exp);
      Check4DataBaseError;
      packbuffer(34);
    end;

  else
    IBError(ibxeInvalidDataConversion,[]);
  end;
  Result.SignSpecialPlaces :=  (-exp and $2f);
  if sign <> 0 then
    Result.SignSpecialPlaces := Result.SignSpecialPlaces or $80;
end;

procedure TFB30ClientAPI.StrToInt128(scale: integer; aValue: AnsiString;
  bufptr: PByte);
begin
  inherited StrToInt128(scale,aValue,bufPtr);

  UtilIntf.getInt128(StatusIntf).fromString(StatusIntf,scale,PAnsiChar(aValue),FB_I128Ptr(bufptr));
  Check4DatabaseError;
end;

function TFB30ClientAPI.Int128ToStr(bufptr: PByte; scale: integer
  ): AnsiString;
const
  bufLength = 64;
var Buffer: array[ 0.. bufLength] of AnsiChar;
begin
  Result := inherited Int128ToStr(bufPtr,scale);

  UtilIntf.getInt128(StatusIntf).toString(StatusIntf,FB_I128Ptr(bufptr),scale,buflength,PAnsiChar(@Buffer));
  Check4DatabaseError;
  Result := strpas(PAnsiChar(@Buffer));
end;

function TFB30ClientAPI.HasLocalTZDB: boolean;
const
  bufLength = 128;
var Buffer: ISC_TIME_TZ;
    Hr, Mt, S, DMs: cardinal;
    tzBuffer: array[ 0.. bufLength] of AnsiChar;
begin
  Result := HasTimeZoneSupport;
  if Result then
  begin
    Buffer.utc_time := 0;
    Buffer.time_zone := TimeZoneID_GMT;
    UtilIntf.decodeTimeTz(StatusIntf, ISC_TIME_TZPtr(@Buffer),@Hr, @Mt, @S, @DMs,bufLength,PAnsiChar(@tzBuffer));
    Check4DataBaseError;
    Result := strpas(PAnsiChar(@tzBuffer)) <> 'GMT*';
  end;
end;

function TFB30ClientAPI.HasTimeZoneSupport: boolean;
begin
  Result := Firebird4orLater;
end;

function TFB30ClientAPI.HasExtendedTZSupport: boolean;
begin
  Result := Firebird4orLater;
end;

function TFB30ClientAPI.HasInt128Support: boolean;
begin
  Result := Firebird4orLater;
end;

end.


Revision:	319
Committed:	Thu Feb 25 12:05:40 2021 UTC (3 years, 2 months ago) by tony
Content type:	text/x-pascal
File size:	18701 byte(s)
Log Message:	Merge into public release
#	User	Rev	Content
1	tony	45	(*
2			* Firebird Interface (fbintf). The fbintf components provide a set of
3			* Pascal language bindings for the Firebird API.
4			*
5			* The contents of this file are subject to the Initial Developer's
6			* Public License Version 1.0 (the "License"); you may not use this
7			* file except in compliance with the License. You may obtain a copy
8			* of the License here:
9			*
10			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11			*
12			* Software distributed under the License is distributed on an "AS
13			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14			* implied. See the License for the specific language governing rights
15			* and limitations under the License.
16			*
17			* The Initial Developer of the Original Code is Tony Whyman.
18			*
19			* The Original Code is (C) 2016 Tony Whyman, MWA Software
20			* (http://www.mwasoftware.co.uk).
21			*
22			* All Rights Reserved.
23			*
24			* Contributor(s): ______________________________________.
25			*
26			*)
27			unit FB30ClientAPI;
28	tony	56	{$IFDEF MSWINDOWS}
29			{$DEFINE WINDOWS}
30			{$ENDIF}
31	tony	45
32			{$IFDEF FPC}
33			{$mode delphi}
34			{$interfaces COM}
35			{$ENDIF}
36
37			interface
38
39			uses
40	tony	315	Classes, SysUtils, FBClientAPI, Firebird, IB, IBExternals, FmtBCD, FBClientLib;
41	tony	45
42			type
43
44			{ TFB30Status }
45
46			TFB30Status = class(TFBStatus,IStatus)
47			private
48			FStatus: Firebird.IStatus;
49			public
50			procedure Init;
51			function InErrorState: boolean;
52			function GetStatus: Firebird.IStatus;
53			function StatusVector: PStatusVector; override;
54			end;
55
56	tony	315	{ TFB30StatusObject }
57
58			TFB30StatusObject = class(TFB30Status)
59			public
60			constructor Create(aOwner: TFBClientAPI; status: Firebird.IStatus);
61			end;
62
63	tony	45	Tfb_get_master_interface = function: IMaster;
64			{$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
65
66			{ TFB30ClientAPI }
67
68	tony	315	TFB30ClientAPI = class(TFBClientAPI,IFirebirdAPI,IFBIMasterProvider)
69	tony	45	private
70			FMaster: Firebird.IMaster;
71			FUtil: Firebird.IUtil;
72			FProvider: Firebird.IProvider;
73			FConfigManager: Firebird.IConfigManager;
74			FStatus: TFB30Status;
75			FIsEmbeddedServer: boolean;
76			FStatusIntf: IStatus; {Keep a reference to the interface - automatic destroy
77			when this class is freed and last reference to IStatus
78			goes out of scope.}
79			procedure CheckPlugins;
80	tony	319	function Firebird4orLater: boolean;
81	tony	45	public
82	tony	263	constructor Create(aFBLibrary: TFBLibrary);
83	tony	45	destructor Destroy; override;
84
85			function StatusIntf: Firebird.IStatus;
86			procedure Check4DataBaseError;
87			function InErrorState: boolean;
88	tony	263	function LoadInterface: boolean; override;
89	tony	315	procedure FBShutdown; override;
90	tony	263	function GetAPI: IFirebirdAPI; override;
91			{$IFDEF UNIX}
92			function GetFirebirdLibList: string; override;
93			{$ENDIF}
94	tony	45
95			public
96			{IFirebirdAPI}
97			function GetStatus: IStatus; override;
98			function AllocateDPB: IDPB;
99			function AllocateTPB: ITPB;
100
101			{Database connections}
102	tony	56	function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
103			function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
104			function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
105	tony	45	{Start Transaction against multiple databases}
106			function StartTransaction(Attachments: array of IAttachment;
107			TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
108			function StartTransaction(Attachments: array of IAttachment;
109			TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
110
111			{Service Manager}
112			function AllocateSPB: ISPB;
113	tony	143	function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
114			function GetServiceManager(ServerName: AnsiString; Port: Ansistring; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
115	tony	45
116			{Information}
117			function HasServiceAPI: boolean;
118			function HasRollbackRetaining: boolean;
119			function IsEmbeddedServer: boolean; override;
120	tony	308	function GetClientMajor: integer; override;
121			function GetClientMinor: integer; override;
122	tony	315	function HasLocalTZDB: boolean; override;
123			function HasTimeZoneSupport: boolean; override;
124			function HasExtendedTZSupport: boolean; override;
125			function HasInt128Support: boolean; override;
126	tony	45
127			{Firebird 3 API}
128			function HasMasterIntf: boolean;
129			function GetIMaster: TObject;
130
131	tony	315	{IFBIMasterProvider}
132			function GetIMasterIntf: Firebird.IMaster;
133
134	tony	45	{Encode/Decode}
135	tony	56	function DecodeInteger(bufptr: PByte; len: short): integer; override;
136			procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override;
137			function SQLDecodeDate(bufptr: PByte): TDateTime; override;
138			procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override;
139			function SQLDecodeTime(bufptr: PByte): TDateTime; override;
140			procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
141			function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
142	tony	308	function FormatStatus(Status: TFBStatus): AnsiString; override;
143	tony	45
144	tony	315	{Firebird 4 Extensions}
145			procedure SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal; bufptr: PByte);
146			override;
147			function SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD; override;
148			function Int128ToStr(bufptr: PByte; scale: integer): AnsiString; override;
149			procedure StrToInt128(scale: integer; aValue: AnsiString; bufptr: PByte); override;
150
151	tony	45	{Firebird Interfaces}
152			property MasterIntf: Firebird.IMaster read FMaster;
153			property UtilIntf: Firebird.IUtil read FUtil;
154			property ProviderIntf: Firebird.IProvider read FProvider;
155	tony	315
156	tony	45	end;
157
158			implementation
159
160	tony	315	uses FB30Attachment, {$IFDEF FPC}dynlibs{$ELSE} windows{$ENDIF},
161			FBMessages, FB30Services, FB30Transaction, IBUtils, DateUtils,
162			FBAttachment, FBTransaction, FBServices;
163	tony	45
164			type
165			PISC_DATE = ^ISC_DATE;
166			PISC_TIME = ^ISC_TIME;
167
168	tony	315	{ TFB30StatusObject }
169
170			constructor TFB30StatusObject.Create(aOwner: TFBClientAPI;
171			status: Firebird.IStatus);
172			begin
173			inherited Create(aOwner);
174			FStatus := status;
175			end;
176
177	tony	45	{ TFB30Status }
178
179			procedure TFB30Status.Init;
180			begin
181			if assigned(FStatus) then
182			FStatus.Init;
183			end;
184
185			function TFB30Status.InErrorState: boolean;
186			begin
187			with GetStatus do
188			Result := ((getState and STATE_ERRORS) <> 0);
189			end;
190
191			function TFB30Status.GetStatus: Firebird.IStatus;
192			begin
193			if FStatus = nil then
194			with FOwner do
195			FStatus := (FOwner as TFB30ClientAPI).MasterIntf.GetStatus;
196			Result := FStatus;
197			end;
198
199			function TFB30Status.StatusVector: PStatusVector;
200			begin
201			Result := PStatusVector(GetStatus.getErrors);
202			end;
203
204			{ TFB30ClientAPI }
205
206			procedure TFB30ClientAPI.CheckPlugins;
207			var FBConf: Firebird.IFirebirdConf;
208	tony	56	Plugins: AnsiString;
209	tony	45	PluginsList: TStringList;
210			begin
211			FIsEmbeddedServer := false;
212			FBConf := FConfigManager.getFirebirdConf;
213			try
214			Plugins := FBConf.asString(FBConf.getKey('Providers'));
215			finally
216			FBConf.release;
217			end;
218			if Plugins = '' then Exit;
219
220			PluginsList := TStringList.Create;
221			try
222			PluginsList.CommaText := Plugins;
223	tony	315	FIsEmbeddedServer := (PluginsList.IndexOf('Engine12') <> -1) or {Firebird 3}
224			(PluginsList.IndexOf('Engine13') <> -1); {Firebird 4}
225	tony	45	finally
226			PluginsList.Free;
227			end;
228			end;
229
230	tony	319	function TFB30ClientAPI.Firebird4orLater: boolean;
231			begin
232			Result := (GetClientMajor >=4) and (UtilIntf.vtable.version >= 4)
233			and (UtilIntf.vtable.version <> 21) {ignore FB4 Beta1}
234			and (UtilIntf.vtable.version <> 24) {ignore FB4 Beta2}
235			end;
236
237	tony	45	{$IFDEF UNIX}
238			function TFB30ClientAPI.GetFirebirdLibList: string;
239			begin
240			Result := 'libfbclient.so:libfbclient.so.2';
241			end;
242			{$ENDIF}
243
244	tony	263	function TFB30ClientAPI.LoadInterface: boolean;
245	tony	45	var
246			fb_get_master_interface: Tfb_get_master_interface;
247			begin
248	tony	263	Result := inherited LoadInterface;
249			fb_get_master_interface := GetProcAddress(GetFBLibrary.GetHandle, 'fb_get_master_interface'); {do not localize}
250	tony	45	if assigned(fb_get_master_interface) then
251			begin
252			FMaster := fb_get_master_interface;
253			FUtil := FMaster.getUtilInterface;
254			FProvider := FMaster.getDispatcher;
255			FConfigManager := FMaster.getConfigManager;
256			CheckPlugins;
257			end;
258	tony	263	Result := Result and HasMasterIntf;
259	tony	45	end;
260
261	tony	315	procedure TFB30ClientAPI.FBShutdown;
262			begin
263			if assigned(fb_shutdown) and assigned(FProvider) then
264			begin
265			FProvider.release;
266			FProvider := nil;
267			end;
268			inherited;
269			end;
270
271	tony	263	function TFB30ClientAPI.GetAPI: IFirebirdAPI;
272	tony	45	begin
273	tony	263	Result := self;
274			end;
275
276			constructor TFB30ClientAPI.Create(aFBLibrary: TFBLibrary);
277			begin
278			inherited Create(aFBLibrary);
279	tony	45	FStatus := TFB30Status.Create(self);
280			FStatusIntf := FStatus;
281			end;
282
283			destructor TFB30ClientAPI.Destroy;
284			begin
285			if assigned(FProvider) then
286			FProvider.release;
287			inherited Destroy;
288			end;
289
290			function TFB30ClientAPI.StatusIntf: Firebird.IStatus;
291			begin
292			Result := FStatus.GetStatus;
293			Result.Init;
294			end;
295
296			procedure TFB30ClientAPI.Check4DataBaseError;
297			begin
298			if FStatus.InErrorState then
299			IBDataBaseError;
300			end;
301
302			function TFB30ClientAPI.InErrorState: boolean;
303			begin
304			Result := FStatus.InErrorState;
305			end;
306
307			function TFB30ClientAPI.GetStatus: IStatus;
308			begin
309			Result := FStatusIntf;
310			end;
311
312			function TFB30ClientAPI.AllocateDPB: IDPB;
313			begin
314	tony	263	Result := TDPB.Create(self);
315	tony	45	end;
316
317			function TFB30ClientAPI.AllocateTPB: ITPB;
318			begin
319	tony	263	Result := TTPB.Create(self);
320	tony	45	end;
321
322	tony	56	function TFB30ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
323	tony	45	RaiseExceptionOnConnectError: boolean): IAttachment;
324			begin
325	tony	263	Result := TFB30Attachment.Create(self,DatabaseName, DPB, RaiseExceptionOnConnectError);
326	tony	45	if not Result.IsConnected then
327			Result := nil;
328			end;
329
330	tony	56	function TFB30ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
331	tony	45	RaiseExceptionOnError: boolean): IAttachment;
332			begin
333	tony	263	Result := TFB30Attachment.CreateDatabase(self,DatabaseName,DPB, RaiseExceptionOnError);
334	tony	45	if not Result.IsConnected then
335			Result := nil;
336			end;
337
338	tony	56	function TFB30ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
339	tony	47	RaiseExceptionOnError: boolean): IAttachment;
340			begin
341	tony	263	Result := TFB30Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError);
342	tony	47	if not Result.IsConnected then
343			Result := nil;
344			end;
345
346	tony	45	function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
347			TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
348			begin
349	tony	263	Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion);
350	tony	45	end;
351
352			function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
353			TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
354			begin
355	tony	263	Result := TFB30Transaction.Create(self,Attachments,TPB,DefaultCompletion);
356	tony	45	end;
357
358			function TFB30ClientAPI.AllocateSPB: ISPB;
359			begin
360	tony	263	Result := TSPB.Create(self);
361	tony	45	end;
362
363	tony	56	function TFB30ClientAPI.GetServiceManager(ServerName: AnsiString;
364	tony	45	Protocol: TProtocol; SPB: ISPB): IServiceManager;
365			begin
366	tony	263	Result := TFB30ServiceManager.Create(self,ServerName,Protocol,SPB);
367	tony	45	end;
368
369	tony	143	function TFB30ClientAPI.GetServiceManager(ServerName: AnsiString;
370			Port: Ansistring; Protocol: TProtocol; SPB: ISPB): IServiceManager;
371			begin
372	tony	263	Result := TFB30ServiceManager.Create(self,ServerName,Protocol,SPB,Port);
373	tony	143	end;
374
375	tony	45	function TFB30ClientAPI.HasServiceAPI: boolean;
376			begin
377			Result := true;
378			end;
379
380			function TFB30ClientAPI.HasMasterIntf: boolean;
381			begin
382			Result := MasterIntf <> nil;
383			end;
384
385			function TFB30ClientAPI.GetIMaster: TObject;
386			begin
387			Result := FMaster;
388			end;
389
390	tony	315	function TFB30ClientAPI.GetIMasterIntf: Firebird.IMaster;
391			begin
392			Result := FMaster;
393			end;
394
395	tony	45	function TFB30ClientAPI.HasRollbackRetaining: boolean;
396			begin
397			Result := true;
398			end;
399
400			function TFB30ClientAPI.IsEmbeddedServer: boolean;
401			begin
402			Result := FIsEmbeddedServer;
403			end;
404
405	tony	308	function TFB30ClientAPI.GetClientMajor: integer;
406	tony	45	begin
407	tony	308	Result := UtilIntf.GetClientVersion div 256;
408	tony	45	end;
409
410	tony	308	function TFB30ClientAPI.GetClientMinor: integer;
411			begin
412			Result := UtilIntf.GetClientVersion mod 256;
413			end;
414
415	tony	56	function TFB30ClientAPI.DecodeInteger(bufptr: PByte; len: short): integer;
416			var P: PByte;
417	tony	45	begin
418			Result := 0;
419			P := Bufptr + len - 1;
420			while P >= bufptr do
421			begin
422	tony	56	Result := (Result shl 8 ) or P^;
423	tony	45	Dec(P);
424			end;
425			end;
426
427	tony	56	procedure TFB30ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
428	tony	45	var
429			Yr, Mn, Dy: Word;
430			begin
431			DecodeDate(aDate, Yr, Mn, Dy);
432			PISC_Date(Bufptr)^ := UtilIntf.encodeDate(Yr, Mn, Dy);
433			end;
434
435	tony	56	function TFB30ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime;
436	tony	45	var
437	tony	56	Yr, Mn, Dy: cardinal;
438	tony	45	begin
439			UtilIntf.decodeDate(PISC_DATE(bufptr)^,@Yr, @Mn, @Dy);
440			try
441			result := EncodeDate(Yr, Mn,Dy);
442			except
443			on E: EConvertError do begin
444			IBError(ibxeInvalidDataConversion, [nil]);
445			end;
446			end;
447			end;
448
449	tony	56	procedure TFB30ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
450	tony	45	var
451	tony	315	Hr, Mt, S: word;
452			DMs: cardinal;
453	tony	45	begin
454	tony	315	FBDecodeTime(aTime,Hr, Mt, S, DMs);
455			PISC_TIME(bufptr)^ := UtilIntf.encodeTime(Hr, Mt, S, DMs);
456	tony	45	end;
457
458	tony	56	function TFB30ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
459	tony	45	var
460	tony	315	Hr, Mt, S, DMs: cardinal;
461	tony	45	begin
462	tony	315	UtilIntf.decodeTime(PISC_TIME(bufptr)^,@Hr, @Mt, @S, @DMs);
463	tony	45	try
464	tony	315	Result := FBEncodeTime(Hr, Mt, S, DMs);
465	tony	45	except
466			on E: EConvertError do begin
467			IBError(ibxeInvalidDataConversion, [nil]);
468			end;
469			end;
470			end;
471
472	tony	56	procedure TFB30ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte);
473	tony	45	begin
474			SQLEncodeDate(aDateTime,bufPtr);
475			Inc(bufptr,sizeof(ISC_DATE));
476			SQLEncodeTime(aDateTime,bufPtr);
477			end;
478
479	tony	56	function TFB30ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
480	tony	45	begin
481			Result := SQLDecodeDate(bufPtr);
482			Inc(bufptr,sizeof(ISC_DATE));
483	tony	56	Result := Result + SQLDecodeTime(bufPtr);
484	tony	45	end;
485
486	tony	308	function TFB30ClientAPI.FormatStatus(Status: TFBStatus): AnsiString;
487			var local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
488			begin
489			Result := '';
490			if UtilIntf.formatStatus(@local_buffer,sizeof(local_buffer),(Status as TFB30Status).GetStatus) > 0 then
491			Result := strpas(local_buffer);
492			end;
493
494	tony	315	procedure TFB30ClientAPI.SQLDecFloatEncode(aValue: tBCD; SQLType: cardinal;
495			bufptr: PByte);
496			var DecFloat16: IDecFloat16;
497			DecFloat34: IDecFloat34;
498			sign: integer;
499			exp: integer;
500			buffer: array [1..34] of byte;
501
502			procedure UnpackBuffer(width: integer);
503			var i,j: integer;
504			begin
505			Fillchar(buffer,sizeof(buffer),0);
506			if BCDPrecision(aValue) > width then
507			IBError(ibxeBCDTooBig,[BCDPrecision(aValue),width]);
508			j := 1 + (width - aValue.Precision);
509			for i := 0 to (aValue.Precision - 1) div 2 do
510			if j <= width then
511			begin
512			buffer[j] := (aValue.Fraction[i] and $f0) shr 4;
513			Inc(j);
514			if j <= width then
515			begin
516			buffer[j] := (aValue.Fraction[i] and $0f);
517			Inc(j);
518			end;
519			end;
520			{writeln('Precision = ',aValue.Precision,' Places = ',aValue.SignSpecialPlaces and $2f);
521			write('BCD Buffer = ');
522			for i := 1 to 34 do
523			write(buffer[i],' ');
524			writeln; }
525			end;
526
527			begin
528			inherited SQLDecFloatEncode(aValue, SQLType, bufptr);
529			sign := (aValue.SignSpecialPlaces and $80) shr 7;
530			exp := -(aValue.SignSpecialPlaces and $2f);
531
532			case SQLType of
533			SQL_DEC16:
534			begin
535			UnPackbuffer(16);
536			DecFloat16 := UtilIntf.getDecFloat16(StatusIntf);
537			Check4DataBaseError;
538			DecFloat16.fromBcd(sign,@buffer,exp,FB_DEC16Ptr(bufptr));
539			Check4DataBaseError;
540			end;
541
542			SQL_DEC34:
543			begin
544			UnPackbuffer(34);
545			DecFloat34 := UtilIntf.getDecFloat34(StatusIntf);
546			Check4DataBaseError;
547			DecFloat34.fromBcd(sign,@buffer,exp,FB_DEC34Ptr(bufptr));
548			Check4DataBaseError;
549			end;
550
551			else
552			IBError(ibxeInvalidDataConversion,[]);
553			end;
554			end;
555
556			function TFB30ClientAPI.SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBCD;
557
558			var DecFloat16: IDecFloat16;
559			DecFloat34: IDecFloat34;
560			sign: integer;
561			exp: integer;
562			buffer: array [1..38] of byte;
563
564			procedure packbuffer(buflen: integer);
565			var i,j: integer;
566			begin
567			{ write('Decode: BCD Buffer = ');
568			for i := 1 to 34 do
569			write(buffer[i],' ');
570			writeln; }
571			{pack buffer}
572			i := 1;
573			while (i <= buflen) and (buffer[i] = 0) do {skip leading zeroes}
574			inc(i);
575
576			j := 0;
577			Result.Precision := 0;
578			while i <= buflen do
579			begin
580			inc(Result.Precision);
581			if odd(Result.Precision) then
582			Result.Fraction[j] := (buffer[i] and $0f) shl 4
583			else
584			begin
585			Result.Fraction[j] := Result.Fraction[j] or (buffer[i] and $0f);
586			Inc(j);
587			end;
588			inc(i);
589			end;
590			end;
591
592			begin
593			Result := inherited SQLDecFloatDecode(SQLType, bufptr);
594			FillChar(Result, sizeof(tBCD),0);
595			case SQLType of
596			SQL_DEC16:
597			begin
598			DecFloat16 := UtilIntf.getDecFloat16(StatusIntf);
599			Check4DataBaseError;
600			DecFloat16.toBcd(FB_DEC16Ptr(bufptr),@sign,@buffer,@exp);
601			Check4DataBaseError;
602			packbuffer(16);
603			end;
604
605			SQL_DEC34:
606			begin
607			DecFloat34 := UtilIntf.getDecFloat34(StatusIntf);
608			Check4DataBaseError;
609			DecFloat34.toBcd(FB_DEC34Ptr(bufptr),@sign,@buffer,@exp);
610			Check4DataBaseError;
611			packbuffer(34);
612			end;
613
614			else
615			IBError(ibxeInvalidDataConversion,[]);
616			end;
617			Result.SignSpecialPlaces := (-exp and $2f);
618			if sign <> 0 then
619			Result.SignSpecialPlaces := Result.SignSpecialPlaces or $80;
620			end;
621
622			procedure TFB30ClientAPI.StrToInt128(scale: integer; aValue: AnsiString;
623			bufptr: PByte);
624			begin
625			inherited StrToInt128(scale,aValue,bufPtr);
626
627			UtilIntf.getInt128(StatusIntf).fromString(StatusIntf,scale,PAnsiChar(aValue),FB_I128Ptr(bufptr));
628			Check4DatabaseError;
629			end;
630
631			function TFB30ClientAPI.Int128ToStr(bufptr: PByte; scale: integer
632			): AnsiString;
633			const
634			bufLength = 64;
635			var Buffer: array[ 0.. bufLength] of AnsiChar;
636			begin
637			Result := inherited Int128ToStr(bufPtr,scale);
638
639			UtilIntf.getInt128(StatusIntf).toString(StatusIntf,FB_I128Ptr(bufptr),scale,buflength,PAnsiChar(@Buffer));
640			Check4DatabaseError;
641			Result := strpas(PAnsiChar(@Buffer));
642			end;
643
644			function TFB30ClientAPI.HasLocalTZDB: boolean;
645			const
646			bufLength = 128;
647			var Buffer: ISC_TIME_TZ;
648			Hr, Mt, S, DMs: cardinal;
649			tzBuffer: array[ 0.. bufLength] of AnsiChar;
650			begin
651			Result := HasTimeZoneSupport;
652			if Result then
653			begin
654			Buffer.utc_time := 0;
655			Buffer.time_zone := TimeZoneID_GMT;
656			UtilIntf.decodeTimeTz(StatusIntf, ISC_TIME_TZPtr(@Buffer),@Hr, @Mt, @S, @DMs,bufLength,PAnsiChar(@tzBuffer));
657			Check4DataBaseError;
658			Result := strpas(PAnsiChar(@tzBuffer)) <> 'GMT*';
659			end;
660			end;
661
662			function TFB30ClientAPI.HasTimeZoneSupport: boolean;
663			begin
664	tony	319	Result := Firebird4orLater;
665	tony	315	end;
666
667			function TFB30ClientAPI.HasExtendedTZSupport: boolean;
668			begin
669	tony	319	Result := Firebird4orLater;
670	tony	315	end;
671
672			function TFB30ClientAPI.HasInt128Support: boolean;
673			begin
674	tony	319	Result := Firebird4orLater;
675	tony	315	end;
676
677	tony	45	end.
678
679	tony	56