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;

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;
  public
    constructor Create(aFBLibrary: TFBLibrary);
    destructor Destroy; override;

    function StatusIntf: Firebird.IStatus;
    procedure Check4DataBaseError;
    function InErrorState: boolean;
    function LoadInterface: boolean; 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 GetImplementationVersion: AnsiString;

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

    {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;

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

implementation

uses FBParamBlock, FB30Attachment, {$IFDEF FPC}dynlibs{$ELSE} windows{$ENDIF},
     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: 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;
  finally
    PluginsList.Free;
  end;
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;

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.HasRollbackRetaining: boolean;
begin
  Result := true;
end;

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

function TFB30ClientAPI.GetImplementationVersion: AnsiString;
begin
  Result := Format('3.%d',[UtilIntf.GetClientVersion]);
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, Ms: Word;
begin
  DecodeTime(aTime, Hr, Mt, S, Ms);
  PISC_TIME(bufptr)^ :=  UtilIntf.encodeTime(Hr, Mt, S, Ms*10);
end;

function TFB30ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
var
  Hr, Mt, S, Ms: cardinal;
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: 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;

end.


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