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 GetClientMajor: integer; override;
    function GetClientMinor: integer; override;

    {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;
    function FormatStatus(Status: TFBStatus): AnsiString; 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.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, 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;

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;

end.


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