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, 3 months ago) by tony
Content type:	text/x-pascal
File size:	10892 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	Content
1	(*
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	function CreateDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
92	function CreateDatabase(sql: string; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
93	{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	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	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