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 FPC}
{$mode delphi}
{$interfaces COM}
{$ENDIF}

interface

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

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;

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

  { TFB30ClientAPI }

  TFB30ClientAPI = class(TFBClientAPI,IFirebirdAPI)
  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;
  protected
    {$IFDEF UNIX}
    function GetFirebirdLibList: string; override;
    {$ENDIF}
   procedure LoadInterface; override;
  public
    constructor Create;
    destructor Destroy; override;

    function StatusIntf: Firebird.IStatus;
    procedure Check4DataBaseError;
    function InErrorState: boolean;

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

    {Database connections}
    function OpenDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
    function CreateDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
    function CreateDatabase(sql: string; 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: string; Protocol: TProtocol; SPB: ISPB): IServiceManager;

    {Information}
    function HasServiceAPI: boolean;
    function HasRollbackRetaining: boolean;
    function IsEmbeddedServer: boolean; override;
    function GetImplementationVersion: string;

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

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

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

var Firebird30ClientAPI: TFB30ClientAPI;

implementation

uses FBParamBlock, FB30Attachment, dynlibs, FBMessages, FB30Services,
  FB30Transaction;

type
  PISC_DATE = ^ISC_DATE;
  PISC_TIME = ^ISC_TIME;

{ 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: string;
    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;
  finally
    PluginsList.Free;
  end;
end;

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

procedure TFB30ClientAPI.LoadInterface;
var
  fb_get_master_interface: Tfb_get_master_interface;
begin
  inherited LoadInterface;
  fb_get_master_interface := GetProcAddress(IBLibrary, '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;
end;

constructor TFB30ClientAPI.Create;
begin
  inherited;
  FStatus := TFB30Status.Create(self);
  FStatusIntf := FStatus;
  Firebird30ClientAPI := self;
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;
end;

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

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

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

function TFB30ClientAPI.CreateDatabase(sql: string; aSQLDialect: integer;
  RaiseExceptionOnError: boolean): IAttachment;
begin
  Result := TFB30Attachment.CreateDatabase(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(Attachments,TPB,DefaultCompletion);
end;

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

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

function TFB30ClientAPI.GetServiceManager(ServerName: string;
  Protocol: TProtocol; SPB: ISPB): IServiceManager;
begin
  Result := TFB30ServiceManager.Create(ServerName,Protocol,SPB);
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.HasRollbackRetaining: boolean;
begin
  Result := true;
end;

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

function TFB30ClientAPI.GetImplementationVersion: string;
begin
  Result := Format('3.%d',[UtilIntf.GetClientVersion]);
end;

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

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

function TFB30ClientAPI.SQLDecodeDate(bufptr: PChar): TDateTime;
var
  Yr, Mn, Dy: Word;
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: PChar);
var
  Hr, Mt, S, Ms: Word;
begin
  DecodeTime(aTime, Hr, Mt, S, Ms);
  PISC_TIME(bufptr)^ :=  UtilIntf.encodeTime(Hr, Mt, S, Ms*10);
end;

function TFB30ClientAPI.SQLDecodeTime(bufptr: PChar): TDateTime;
var
  Hr, Mt, S, Ms: Word;
begin
  UtilIntf.decodeTime(PISC_TIME(bufptr)^,@Hr, @Mt, @S, @Ms);
  try
    Result := EncodeTime(Hr, Mt, S, Ms div 10);
  except
    on E: EConvertError do begin
      IBError(ibxeInvalidDataConversion, [nil]);
    end;
  end;
end;

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

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

end.

Revision:	47
Committed:	Mon Jan 9 15:31:51 2017 UTC (7 years, 10 months ago) by tony
Content type:	text/x-pascal
File size:	10892 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	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
29			{$IFDEF FPC}
30			{$mode delphi}
31			{$interfaces COM}
32			{$ENDIF}
33
34			interface
35
36			uses
37			Classes, SysUtils, FBClientAPI, Firebird, IB, IBExternals;
38
39			type
40
41			{ TFB30Status }
42
43			TFB30Status = class(TFBStatus,IStatus)
44			private
45			FStatus: Firebird.IStatus;
46			public
47			procedure Init;
48			function InErrorState: boolean;
49			function GetStatus: Firebird.IStatus;
50			function StatusVector: PStatusVector; override;
51			end;
52
53			Tfb_get_master_interface = function: IMaster;
54			{$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
55
56			{ TFB30ClientAPI }
57
58			TFB30ClientAPI = class(TFBClientAPI,IFirebirdAPI)
59			private
60			FMaster: Firebird.IMaster;
61			FUtil: Firebird.IUtil;
62			FProvider: Firebird.IProvider;
63			FConfigManager: Firebird.IConfigManager;
64			FStatus: TFB30Status;
65			FIsEmbeddedServer: boolean;
66			FStatusIntf: IStatus; {Keep a reference to the interface - automatic destroy
67			when this class is freed and last reference to IStatus
68			goes out of scope.}
69			procedure CheckPlugins;
70			protected
71			{$IFDEF UNIX}
72			function GetFirebirdLibList: string; override;
73			{$ENDIF}
74			procedure LoadInterface; override;
75			public
76			constructor Create;
77			destructor Destroy; override;
78
79			function StatusIntf: Firebird.IStatus;
80			procedure Check4DataBaseError;
81			function InErrorState: boolean;
82
83			public
84			{IFirebirdAPI}
85			function GetStatus: IStatus; override;
86			function AllocateDPB: IDPB;
87			function AllocateTPB: ITPB;
88
89			{Database connections}
90			function OpenDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
91	tony	47	function CreateDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
92			function CreateDatabase(sql: string; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
93	tony	45	{Start Transaction against multiple databases}
94			function StartTransaction(Attachments: array of IAttachment;
95			TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
96			function StartTransaction(Attachments: array of IAttachment;
97			TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
98
99			{Service Manager}
100			function AllocateSPB: ISPB;
101			function GetServiceManager(ServerName: string; Protocol: TProtocol; SPB: ISPB): IServiceManager;
102
103			{Information}
104			function HasServiceAPI: boolean;
105			function HasRollbackRetaining: boolean;
106			function IsEmbeddedServer: boolean; override;
107			function GetImplementationVersion: string;
108
109			{Firebird 3 API}
110			function HasMasterIntf: boolean;
111			function GetIMaster: TObject;
112
113			{Encode/Decode}
114			function DecodeInteger(bufptr: PChar; len: short): integer; override;
115			procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); override;
116			function SQLDecodeDate(bufptr: PChar): TDateTime; override;
117			procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); override;
118			function SQLDecodeTime(bufptr: PChar): TDateTime; override;
119			procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); override;
120			function SQLDecodeDateTime(bufptr: PChar): TDateTime; override;
121
122			{Firebird Interfaces}
123			property MasterIntf: Firebird.IMaster read FMaster;
124			property UtilIntf: Firebird.IUtil read FUtil;
125			property ProviderIntf: Firebird.IProvider read FProvider;
126			end;
127
128			var Firebird30ClientAPI: TFB30ClientAPI;
129
130			implementation
131
132			uses FBParamBlock, FB30Attachment, dynlibs, FBMessages, FB30Services,
133			FB30Transaction;
134
135			type
136			PISC_DATE = ^ISC_DATE;
137			PISC_TIME = ^ISC_TIME;
138
139			{ TFB30Status }
140
141			procedure TFB30Status.Init;
142			begin
143			if assigned(FStatus) then
144			FStatus.Init;
145			end;
146
147			function TFB30Status.InErrorState: boolean;
148			begin
149			with GetStatus do
150			Result := ((getState and STATE_ERRORS) <> 0);
151			end;
152
153			function TFB30Status.GetStatus: Firebird.IStatus;
154			begin
155			if FStatus = nil then
156			with FOwner do
157			FStatus := (FOwner as TFB30ClientAPI).MasterIntf.GetStatus;
158			Result := FStatus;
159			end;
160
161			function TFB30Status.StatusVector: PStatusVector;
162			begin
163			Result := PStatusVector(GetStatus.getErrors);
164			end;
165
166			{ TFB30ClientAPI }
167
168			procedure TFB30ClientAPI.CheckPlugins;
169			var FBConf: Firebird.IFirebirdConf;
170			Plugins: string;
171			PluginsList: TStringList;
172			begin
173			FIsEmbeddedServer := false;
174			FBConf := FConfigManager.getFirebirdConf;
175			try
176			Plugins := FBConf.asString(FBConf.getKey('Providers'));
177			finally
178			FBConf.release;
179			end;
180			if Plugins = '' then Exit;
181
182			PluginsList := TStringList.Create;
183			try
184			PluginsList.CommaText := Plugins;
185			FIsEmbeddedServer := PluginsList.IndexOf('Engine12') <> -1;
186			finally
187			PluginsList.Free;
188			end;
189			end;
190
191			{$IFDEF UNIX}
192			function TFB30ClientAPI.GetFirebirdLibList: string;
193			begin
194			Result := 'libfbclient.so:libfbclient.so.2';
195			end;
196			{$ENDIF}
197
198			procedure TFB30ClientAPI.LoadInterface;
199			var
200			fb_get_master_interface: Tfb_get_master_interface;
201			begin
202			inherited LoadInterface;
203			fb_get_master_interface := GetProcAddress(IBLibrary, 'fb_get_master_interface'); {do not localize}
204			if assigned(fb_get_master_interface) then
205			begin
206			FMaster := fb_get_master_interface;
207			FUtil := FMaster.getUtilInterface;
208			FProvider := FMaster.getDispatcher;
209			FConfigManager := FMaster.getConfigManager;
210			CheckPlugins;
211			end;
212			end;
213
214			constructor TFB30ClientAPI.Create;
215			begin
216			inherited;
217			FStatus := TFB30Status.Create(self);
218			FStatusIntf := FStatus;
219			Firebird30ClientAPI := self;
220			end;
221
222			destructor TFB30ClientAPI.Destroy;
223			begin
224			if assigned(FProvider) then
225			FProvider.release;
226			inherited Destroy;
227			end;
228
229			function TFB30ClientAPI.StatusIntf: Firebird.IStatus;
230			begin
231			Result := FStatus.GetStatus;
232			Result.Init;
233			end;
234
235			procedure TFB30ClientAPI.Check4DataBaseError;
236			begin
237			if FStatus.InErrorState then
238			IBDataBaseError;
239			end;
240
241			function TFB30ClientAPI.InErrorState: boolean;
242			begin
243			Result := FStatus.InErrorState;
244			end;
245
246			function TFB30ClientAPI.GetStatus: IStatus;
247			begin
248			Result := FStatusIntf;
249			end;
250
251			function TFB30ClientAPI.AllocateDPB: IDPB;
252			begin
253			Result := TDPB.Create;
254			end;
255
256			function TFB30ClientAPI.AllocateTPB: ITPB;
257			begin
258			Result := TTPB.Create;
259			end;
260
261			function TFB30ClientAPI.OpenDatabase(DatabaseName: string; DPB: IDPB;
262			RaiseExceptionOnConnectError: boolean): IAttachment;
263			begin
264			Result := TFB30Attachment.Create(DatabaseName, DPB, RaiseExceptionOnConnectError);
265			if not Result.IsConnected then
266			Result := nil;
267			end;
268
269			function TFB30ClientAPI.CreateDatabase(DatabaseName: string; DPB: IDPB;
270			RaiseExceptionOnError: boolean): IAttachment;
271			begin
272			Result := TFB30Attachment.CreateDatabase(DatabaseName,DPB, RaiseExceptionOnError);
273			if not Result.IsConnected then
274			Result := nil;
275			end;
276
277	tony	47	function TFB30ClientAPI.CreateDatabase(sql: string; aSQLDialect: integer;
278			RaiseExceptionOnError: boolean): IAttachment;
279			begin
280			Result := TFB30Attachment.CreateDatabase(sql,aSQLDialect, RaiseExceptionOnError);
281			if not Result.IsConnected then
282			Result := nil;
283			end;
284
285	tony	45	function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
286			TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
287			begin
288			Result := TFB30Transaction.Create(Attachments,TPB,DefaultCompletion);
289			end;
290
291			function TFB30ClientAPI.StartTransaction(Attachments: array of IAttachment;
292			TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
293			begin
294			Result := TFB30Transaction.Create(Attachments,TPB,DefaultCompletion);
295			end;
296
297			function TFB30ClientAPI.AllocateSPB: ISPB;
298			begin
299			Result := TSPB.Create;
300			end;
301
302			function TFB30ClientAPI.GetServiceManager(ServerName: string;
303			Protocol: TProtocol; SPB: ISPB): IServiceManager;
304			begin
305			Result := TFB30ServiceManager.Create(ServerName,Protocol,SPB);
306			end;
307
308			function TFB30ClientAPI.HasServiceAPI: boolean;
309			begin
310			Result := true;
311			end;
312
313			function TFB30ClientAPI.HasMasterIntf: boolean;
314			begin
315			Result := MasterIntf <> nil;
316			end;
317
318			function TFB30ClientAPI.GetIMaster: TObject;
319			begin
320			Result := FMaster;
321			end;
322
323			function TFB30ClientAPI.HasRollbackRetaining: boolean;
324			begin
325			Result := true;
326			end;
327
328			function TFB30ClientAPI.IsEmbeddedServer: boolean;
329			begin
330			Result := FIsEmbeddedServer;
331			end;
332
333			function TFB30ClientAPI.GetImplementationVersion: string;
334			begin
335			Result := Format('3.%d',[UtilIntf.GetClientVersion]);
336			end;
337
338			function TFB30ClientAPI.DecodeInteger(bufptr: PChar; len: short): integer;
339			var P: PChar;
340			begin
341			Result := 0;
342			P := Bufptr + len - 1;
343			while P >= bufptr do
344			begin
345			Result := (Result shl 8 ) or byte(P^);
346			Dec(P);
347			end;
348			end;
349
350			procedure TFB30ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PChar);
351			var
352			Yr, Mn, Dy: Word;
353			begin
354			DecodeDate(aDate, Yr, Mn, Dy);
355			PISC_Date(Bufptr)^ := UtilIntf.encodeDate(Yr, Mn, Dy);
356			end;
357
358			function TFB30ClientAPI.SQLDecodeDate(bufptr: PChar): TDateTime;
359			var
360			Yr, Mn, Dy: Word;
361			begin
362			UtilIntf.decodeDate(PISC_DATE(bufptr)^,@Yr, @Mn, @Dy);
363			try
364			result := EncodeDate(Yr, Mn,Dy);
365			except
366			on E: EConvertError do begin
367			IBError(ibxeInvalidDataConversion, [nil]);
368			end;
369			end;
370			end;
371
372			procedure TFB30ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PChar);
373			var
374			Hr, Mt, S, Ms: Word;
375			begin
376			DecodeTime(aTime, Hr, Mt, S, Ms);
377			PISC_TIME(bufptr)^ := UtilIntf.encodeTime(Hr, Mt, S, Ms*10);
378			end;
379
380			function TFB30ClientAPI.SQLDecodeTime(bufptr: PChar): TDateTime;
381			var
382			Hr, Mt, S, Ms: Word;
383			begin
384			UtilIntf.decodeTime(PISC_TIME(bufptr)^,@Hr, @Mt, @S, @Ms);
385			try
386			Result := EncodeTime(Hr, Mt, S, Ms div 10);
387			except
388			on E: EConvertError do begin
389			IBError(ibxeInvalidDataConversion, [nil]);
390			end;
391			end;
392			end;
393
394			procedure TFB30ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar);
395			begin
396			SQLEncodeDate(aDateTime,bufPtr);
397			Inc(bufptr,sizeof(ISC_DATE));
398			SQLEncodeTime(aDateTime,bufPtr);
399			end;
400
401			function TFB30ClientAPI.SQLDecodeDateTime(bufptr: PChar): TDateTime;
402			begin
403			Result := SQLDecodeDate(bufPtr);
404			Inc(bufptr,sizeof(ISC_DATE));
405			Result += SQLDecodeTime(bufPtr);
406			end;
407
408			end.
409