ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/2.5/FB25ClientAPI.pas
Revision: 266
Committed: Wed Dec 26 18:34:32 2018 UTC (5 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 26069 byte(s)
Log Message: 
Fixes Merged

File Contents

# 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. Although predominantly
4     * a new development they include source code taken from IBX and may be
5     * considered a derived product. This software thus also includes the copyright
6     * notice and license conditions from IBX.
7     *
8     * Except for those parts dervied from IBX, contents of this file are subject
9     * to the Initial Developer's Public License Version 1.0 (the "License"); you
10     * may not use this file except in compliance with the License. You may obtain a
11     * copy of the License here:
12     *
13     * http://www.firebirdsql.org/index.php?op=doc&id=idpl
14     *
15     * Software distributed under the License is distributed on an "AS
16     * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17     * implied. See the License for the specific language governing rights
18     * and limitations under the License.
19     *
20     * The Initial Developer of the Original Code is Tony Whyman.
21     *
22     * The Original Code is (C) 2016 Tony Whyman, MWA Software
23     * (http://www.mwasoftware.co.uk).
24     *
25     * All Rights Reserved.
26     *
27     * Contributor(s): ______________________________________.
28     *
29     *)
30     {************************************************************************}
31     { }
32     { Borland Delphi Visual Component Library }
33     { InterBase Express core components }
34     { }
35     { Copyright (c) 1998-2000 Inprise Corporation }
36     { }
37     { InterBase Express is based in part on the product }
38     { Free IB Components, written by Gregory H. Deatz for }
39     { Hoagland, Longo, Moran, Dunst & Doukas Company. }
40     { Free IB Components is used under license. }
41     { }
42     { The contents of this file are subject to the InterBase }
43     { Public License Version 1.0 (the "License"); you may not }
44     { use this file except in compliance with the License. You }
45     { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
46     { Software distributed under the License is distributed on }
47     { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
48     { express or implied. See the License for the specific language }
49     { governing rights and limitations under the License. }
50     { The Original Code was created by InterBase Software Corporation }
51     { and its successors. }
52     { Portions created by Inprise Corporation are Copyright (C) Inprise }
53     { Corporation. All Rights Reserved. }
54     { Contributor(s): Jeff Overcash }
55     { }
56     { IBX For Lazarus (Firebird Express) }
57     { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
58     { Portions created by MWA Software are copyright McCallum Whyman }
59     { Associates Ltd 2011 - 2015 }
60     { }
61     {************************************************************************}
62     unit FB25ClientAPI;
63 tony 56 {$IFDEF MSWINDOWS}
64     {$DEFINE WINDOWS}
65     {$ENDIF}
66 tony 45
67     {$IFDEF FPC}
68     {$mode delphi}
69     {$interfaces COM}
70     {$ENDIF}
71    
72     interface
73    
74     uses
75     Classes, SysUtils, FBClientAPI, IBHeader, IBExternals, IB;
76    
77     const
78     FBClientInterfaceVersion = '2.5';
79    
80     type
81    
82     { TFB25Status }
83    
84     TFB25Status = class(TFBStatus,IStatus)
85     public
86     function StatusVector: PStatusVector; override;
87     end;
88    
89     { TFB25ClientAPI }
90    
91     TFB25ClientAPI = class(TFBClientAPI,IFirebirdAPI)
92     private
93     FIBServiceAPIPresent: boolean;
94     FStatus: TFB25Status;
95     FStatusIntf: IStatus; {Keep a reference to the interface - automatic destroy
96     when this class is freed and last reference to IStatus
97     goes out of scope.}
98 tony 263 public
99     constructor Create(aFBLibrary: TFBLibrary);
100     destructor Destroy; override;
101     function StatusVector: PISC_STATUS;
102     function LoadInterface: boolean; override;
103     function GetAPI: IFirebirdAPI; override;
104 tony 45 {$IFDEF UNIX}
105     function GetFirebirdLibList: string; override;
106     {$ENDIF}
107     property IBServiceAPIPresent: boolean read FIBServiceAPIPresent;
108     property Status: TFB25Status read FStatus;
109    
110     public
111    
112     {fbclient API}
113     BLOB_get: TBLOB_get;
114     BLOB_put: TBLOB_put;
115     isc_wait_for_event: Tisc_wait_for_event;
116     isc_vax_integer: Tisc_vax_integer;
117     isc_portable_integer: Tisc_portable_integer;
118     isc_blob_info: Tisc_blob_info;
119     isc_blob_lookup_desc: Tisc_blob_lookup_desc;
120     isc_open_blob2: Tisc_open_blob2;
121     isc_close_blob: Tisc_close_blob;
122     isc_get_segment: Tisc_get_segment;
123     isc_put_segment: Tisc_put_segment;
124     isc_create_blob2: Tisc_create_blob2;
125     isc_cancel_blob: Tisc_cancel_blob;
126     isc_service_attach: Tisc_service_attach;
127     isc_service_detach: Tisc_service_detach;
128     isc_service_query: Tisc_service_query;
129     isc_service_start: Tisc_service_start;
130     isc_decode_date: Tisc_decode_date;
131     isc_decode_sql_date: Tisc_decode_sql_date;
132     isc_decode_sql_time: Tisc_decode_sql_time;
133     isc_decode_timestamp: Tisc_decode_timestamp;
134     isc_encode_date: Tisc_encode_date;
135     isc_encode_sql_date: Tisc_encode_sql_date;
136     isc_encode_sql_time: Tisc_encode_sql_time;
137     isc_encode_timestamp: Tisc_encode_timestamp;
138     isc_dsql_free_statement: Tisc_dsql_free_statement;
139     isc_dsql_execute2: Tisc_dsql_execute2;
140     isc_dsql_execute: Tisc_dsql_execute;
141     isc_dsql_set_cursor_name: Tisc_dsql_set_cursor_name;
142     isc_dsql_fetch: Tisc_dsql_fetch;
143     isc_dsql_sql_info: Tisc_dsql_sql_info;
144     isc_dsql_alloc_statement2: Tisc_dsql_alloc_statement2;
145     isc_dsql_prepare: Tisc_dsql_prepare;
146     isc_dsql_describe_bind: Tisc_dsql_describe_bind;
147     isc_dsql_describe: Tisc_dsql_describe;
148     isc_dsql_execute_immediate: Tisc_dsql_execute_immediate;
149     isc_drop_database: Tisc_drop_database;
150     isc_detach_database: Tisc_detach_database;
151     isc_attach_database: Tisc_attach_database;
152     isc_database_info: Tisc_database_info;
153     isc_start_transaction: Tisc_start_transaction;
154     isc_start_multiple: Tisc_start_multiple;
155     isc_commit_transaction: Tisc_commit_transaction;
156     isc_commit_retaining: Tisc_commit_retaining;
157     isc_rollback_transaction: Tisc_rollback_transaction;
158     isc_rollback_retaining: Tisc_rollback_retaining;
159     isc_cancel_events: Tisc_cancel_events;
160     isc_que_events: Tisc_que_events;
161     isc_add_user : Tisc_add_user;
162     isc_delete_user: Tisc_delete_user;
163     isc_modify_user: Tisc_modify_user;
164     isc_array_lookup_bounds: Tisc_array_lookup_bounds;
165     isc_array_get_slice: Tisc_array_get_slice;
166     isc_array_put_slice: Tisc_array_put_slice;
167     isc_prepare_transaction: Tisc_prepare_transaction;
168 tony 266 isc_version: Tisc_Version;
169 tony 45
170     public
171     {Helper Functions}
172 tony 56 function DecodeInteger(bufptr: PByte; len: short): integer; override;
173     procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override;
174     function SQLDecodeDate(bufptr: PByte): TDateTime; override;
175     procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override;
176     function SQLDecodeTime(bufptr: PByte): TDateTime; override;
177     procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
178     function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
179 tony 45
180     public
181     {IFirebirdAPI}
182    
183     {Database connections}
184     function AllocateDPB: IDPB;
185 tony 56 function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
186     function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
187     function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
188 tony 45
189     {Start Transaction against multiple databases}
190     function AllocateTPB: ITPB;
191     function StartTransaction(Attachments: array of IAttachment;
192     TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
193     function StartTransaction(Attachments: array of IAttachment;
194     TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
195    
196     {Service Manager}
197     function AllocateSPB: ISPB;
198     function HasServiceAPI: boolean;
199 tony 143 function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
200     function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
201 tony 45
202     {Information}
203     function GetStatus: IStatus; override;
204     function HasRollbackRetaining: boolean;
205     function IsEmbeddedServer: boolean; override;
206 tony 56 function GetImplementationVersion: AnsiString;
207 tony 45
208     {Firebird 3 API}
209     function HasMasterIntf: boolean;
210     function GetIMaster: TObject;
211    
212     end;
213    
214     implementation
215    
216 tony 56 uses FBMessages,
217     {$IFDEF WINDOWS}Windows, {$ENDIF}
218     {$IFDEF FPC} Dynlibs, {$ENDIF}
219     FB25Attachment, FB25Transaction, FB25Services, FBParamBlock,
220 tony 45 IBUtils;
221    
222     { Stubs for 6.0 only functions }
223     function isc_rollback_retaining_stub(status_vector : PISC_STATUS;
224     tran_handle : PISC_TR_HANDLE):
225     ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
226     begin
227     Result := 0;
228     IBError(ibxeIB60feature, ['isc_rollback_retaining']); {do not localize}
229     end;
230    
231     function isc_service_attach_stub(status_vector : PISC_STATUS;
232     isc_arg2 : UShort;
233 tony 56 isc_arg3 : PAnsiChar;
234 tony 45 service_handle : PISC_SVC_HANDLE;
235     isc_arg5 : UShort;
236 tony 56 isc_arg6 : PAnsiChar):
237 tony 45 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
238     begin
239     Result := 0;
240     IBError(ibxeIB60feature, ['isc_service_attach']); {do not localize}
241     end;
242    
243     function isc_service_detach_stub(status_vector : PISC_STATUS;
244     service_handle : PISC_SVC_HANDLE):
245     ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
246     begin
247     Result := 0;
248     IBError(ibxeIB60feature, ['isc_service_detach']); {do not localize}
249     end;
250    
251     function isc_service_query_stub(status_vector : PISC_STATUS;
252     service_handle : PISC_SVC_HANDLE;
253     recv_handle : PISC_SVC_HANDLE;
254     isc_arg4 : UShort;
255 tony 56 isc_arg5 : PAnsiChar;
256 tony 45 isc_arg6 : UShort;
257 tony 56 isc_arg7 : PAnsiChar;
258 tony 45 isc_arg8 : UShort;
259 tony 56 isc_arg9 : PAnsiChar):
260 tony 45 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
261     begin
262     Result := 0;
263     IBError(ibxeIB60feature, ['isc_service_query']); {do not localize}
264     end;
265    
266     function isc_service_start_stub(status_vector : PISC_STATUS;
267     service_handle : PISC_SVC_HANDLE;
268     recv_handle : PISC_SVC_HANDLE;
269     isc_arg4 : UShort;
270 tony 56 isc_arg5 : PAnsiChar):
271 tony 45 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
272     begin
273     Result := 0;
274     IBError(ibxeIB60feature, ['isc_service_start']); {do not localize}
275     end;
276    
277     procedure isc_encode_sql_date_stub(tm_date : PCTimeStructure;
278     ib_date : PISC_DATE);
279     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
280     begin
281     IBError(ibxeIB60feature, ['isc_encode_sql_date']); {do not localize}
282     end;
283    
284     procedure isc_encode_sql_time_stub(tm_date : PCTimeStructure;
285     ib_time : PISC_TIME);
286     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
287     begin
288     IBError(ibxeIB60feature, ['isc_encode_sql_time']); {do not localize}
289     end;
290    
291     procedure isc_encode_timestamp_stub(tm_date : PCTimeStructure;
292     ib_timestamp : PISC_TIMESTAMP);
293     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
294     begin
295     IBError(ibxeIB60feature, ['isc_encode_sql_timestamp']); {do not localize}
296     end;
297    
298     procedure isc_decode_sql_date_stub(ib_date : PISC_DATE;
299     tm_date : PCTimeStructure);
300     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
301     begin
302     IBError(ibxeIB60feature, ['isc_decode_sql_date']); {do not localize}
303     end;
304    
305     procedure isc_decode_sql_time_stub(ib_time : PISC_TIME;
306     tm_date : PCTimeStructure);
307     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
308     begin
309     IBError(ibxeIB60feature, ['isc_decode_sql_time']); {do not localize}
310     end;
311    
312     procedure isc_decode_timestamp_stub(ib_timestamp : PISC_TIMESTAMP;
313     tm_date : PCTimeStructure);
314     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
315     begin
316     IBError(ibxeIB60feature, ['isc_decode_timestamp']); {do not localize}
317     end;
318    
319     { TFB25Status }
320    
321     threadvar
322     FStatusVector: TStatusVector;
323    
324 tony 263 { TFB25ActivityReporter }
325    
326 tony 45 function TFB25Status.StatusVector: PStatusVector;
327     begin
328     Result := @FStatusVector;
329     end;
330    
331    
332     { TFB25ClientAPI }
333    
334     {$IFDEF UNIX}
335     function TFB25ClientAPI.GetFirebirdLibList: string;
336     begin
337     Result := 'libfbembed.so:libfbembed.so.2.5:libfbembed.so.2.1:libfbclient.so:libfbclient.so.2';
338     end;
339     {$ENDIF}
340    
341 tony 263 function TFB25ClientAPI.LoadInterface: boolean;
342 tony 45 begin
343 tony 263 Result := inherited LoadInterface;
344 tony 45 BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
345     BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
346     isc_wait_for_event := GetProcAddr('isc_wait_for_event'); {do not localize}
347     isc_vax_integer := GetProcAddr('isc_vax_integer'); {do not localize}
348     isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
349     isc_blob_info := GetProcAddr('isc_blob_info'); {do not localize}
350     isc_blob_lookup_desc := GetProcAddr('isc_blob_lookup_desc'); {do not localize}
351     isc_open_blob2 := GetProcAddr('isc_open_blob2'); {do not localize}
352     isc_close_blob := GetProcAddr('isc_close_blob'); {do not localize}
353     isc_get_segment := GetProcAddr('isc_get_segment'); {do not localize}
354     isc_put_segment := GetProcAddr('isc_put_segment'); {do not localize}
355     isc_create_blob2 := GetProcAddr('isc_create_blob2'); {do not localize}
356     isc_cancel_blob := GetProcAddr('isc_cancel_blob'); {do not localize}
357     isc_decode_date := GetProcAddr('isc_decode_date'); {do not localize}
358     isc_encode_date := GetProcAddr('isc_encode_date'); {do not localize}
359     isc_dsql_free_statement := GetProcAddr('isc_dsql_free_statement'); {do not localize}
360     isc_dsql_execute2 := GetProcAddr('isc_dsql_execute2'); {do not localize}
361     isc_dsql_execute := GetProcAddr('isc_dsql_execute'); {do not localize}
362     isc_dsql_set_cursor_name := GetProcAddr('isc_dsql_set_cursor_name'); {do not localize}
363     isc_dsql_fetch := GetProcAddr('isc_dsql_fetch'); {do not localize}
364     isc_dsql_sql_info := GetProcAddr('isc_dsql_sql_info'); {do not localize}
365     isc_dsql_alloc_statement2 := GetProcAddr('isc_dsql_alloc_statement2'); {do not localize}
366     isc_dsql_prepare := GetProcAddr('isc_dsql_prepare'); {do not localize}
367     isc_dsql_describe_bind := GetProcAddr('isc_dsql_describe_bind'); {do not localize}
368     isc_dsql_describe := GetProcAddr('isc_dsql_describe'); {do not localize}
369     isc_dsql_execute_immediate := GetProcAddr('isc_dsql_execute_immediate'); {do not localize}
370     isc_drop_database := GetProcAddr('isc_drop_database'); {do not localize}
371     isc_detach_database := GetProcAddr('isc_detach_database'); {do not localize}
372     isc_attach_database := GetProcAddr('isc_attach_database'); {do not localize}
373     isc_database_info := GetProcAddr('isc_database_info'); {do not localize}
374     isc_start_transaction := GetProcAddr('isc_start_transaction'); {do not localize}
375     isc_start_multiple := GetProcAddr('isc_start_multiple'); {do not localize}
376     isc_commit_transaction := GetProcAddr('isc_commit_transaction'); {do not localize}
377     isc_commit_retaining := GetProcAddr('isc_commit_retaining'); {do not localize}
378     isc_rollback_transaction := GetProcAddr('isc_rollback_transaction'); {do not localize}
379     isc_cancel_events := GetProcAddr('isc_cancel_events'); {do not localize}
380     isc_que_events := GetProcAddr('isc_que_events'); {do not localize}
381     isc_add_user := GetProcAddr('isc_add_user'); {do not localize}
382     isc_delete_user := GetProcAddr('isc_delete_user'); {do not localize}
383     isc_modify_user := GetProcAddr('isc_modify_user'); {do not localize}
384     isc_array_lookup_bounds := GetProcAddr('isc_array_lookup_bounds'); {do not localize}
385     isc_array_get_slice := GetProcAddr('isc_array_get_slice'); {do not localize}
386     isc_array_put_slice := GetProcAddr('isc_array_put_slice'); {do not localize}
387     isc_prepare_transaction := GetProcAddr('isc_prepare_transaction'); {do not localize}
388 tony 266 isc_version := GetProcAddr('isc_version'); {do not localize}
389 tony 45
390     FIBServiceAPIPresent := true;
391 tony 263 isc_rollback_retaining := GetProcAddress(FFBLibrary.IBLibrary, 'isc_rollback_retaining'); {do not localize}
392 tony 45 if Assigned(isc_rollback_retaining) then
393     begin
394     isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize}
395     isc_service_detach := GetProcAddr('isc_service_detach'); {do not localize}
396     isc_service_query := GetProcAddr('isc_service_query'); {do not localize}
397     isc_service_start := GetProcAddr('isc_service_start'); {do not localize}
398     isc_decode_sql_date := GetProcAddr('isc_decode_sql_date'); {do not localize}
399     isc_decode_sql_time := GetProcAddr('isc_decode_sql_time'); {do not localize}
400     isc_decode_timestamp := GetProcAddr('isc_decode_timestamp'); {do not localize}
401     isc_encode_sql_date := GetProcAddr('isc_encode_sql_date'); {do not localize}
402     isc_encode_sql_time := GetProcAddr('isc_encode_sql_time'); {do not localize}
403     isc_encode_timestamp := GetProcAddr('isc_encode_timestamp'); {do not localize}
404     end else
405     begin
406     FIBServiceAPIPresent := false;
407     isc_rollback_retaining := @isc_rollback_retaining_stub;
408     isc_service_attach := @isc_service_attach_stub;
409     isc_service_detach := @isc_service_detach_stub;
410     isc_service_query := @isc_service_query_stub;
411     isc_service_start := @isc_service_start_stub;
412     isc_decode_sql_date := @isc_decode_sql_date_stub;
413     isc_decode_sql_time := @isc_decode_sql_time_stub;
414     isc_decode_timestamp := @isc_decode_timestamp_stub;
415     isc_encode_sql_date := @isc_encode_sql_date_stub;
416     isc_encode_sql_time := @isc_encode_sql_time_stub;
417     isc_encode_timestamp := @isc_encode_timestamp_stub;
418     end;
419 tony 263 Result := Result and assigned(isc_attach_database);
420 tony 45 end;
421    
422 tony 263 function TFB25ClientAPI.GetAPI: IFirebirdAPI;
423 tony 45 begin
424 tony 263 Result := self;
425     end;
426    
427     constructor TFB25ClientAPI.Create(aFBLibrary: TFBLibrary);
428     begin
429     inherited Create(aFBLibrary);
430 tony 45 FStatus := TFB25Status.Create(self);
431     FStatusIntf := FStatus;
432     end;
433    
434     destructor TFB25ClientAPI.Destroy;
435     begin
436     FStatusIntf := nil;
437     inherited Destroy;
438     end;
439    
440    
441     function TFB25ClientAPI.StatusVector: PISC_STATUS;
442     begin
443     Result := PISC_STATUS(FStatus.StatusVector);
444     end;
445    
446     function TFB25ClientAPI.GetStatus: IStatus;
447     begin
448     Result := FStatus;
449     end;
450    
451     function TFB25ClientAPI.AllocateDPB: IDPB;
452     begin
453 tony 263 Result := TDPB.Create(self);
454 tony 45 end;
455    
456 tony 56 function TFB25ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
457 tony 45 RaiseExceptionOnConnectError: boolean): IAttachment;
458     begin
459 tony 263 Result := TFB25Attachment.Create(self,DatabaseName,DPB,RaiseExceptionOnConnectError);
460 tony 45 if not Result.IsConnected then
461     Result := nil;
462     end;
463    
464 tony 56 function TFB25ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
465 tony 45 RaiseExceptionOnError: boolean): IAttachment;
466     begin
467 tony 263 Result := TFB25Attachment.CreateDatabase(self,DatabaseName, DPB, RaiseExceptionOnError );
468 tony 45 if (Result <> nil) and not Result.IsConnected then
469     Result := nil;
470     end;
471    
472 tony 56 function TFB25ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
473 tony 47 RaiseExceptionOnError: boolean): IAttachment;
474     begin
475 tony 263 Result := TFB25Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError );
476 tony 47 if (Result <> nil) and not Result.IsConnected then
477     Result := nil;
478     end;
479    
480 tony 45 function TFB25ClientAPI.AllocateSPB: ISPB;
481     begin
482 tony 263 Result := TSPB.Create(self);
483 tony 45 end;
484    
485     function TFB25ClientAPI.AllocateTPB: ITPB;
486     begin
487 tony 263 Result := TTPB.Create(self);
488 tony 45 end;
489    
490 tony 56 function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
491 tony 45 Protocol: TProtocol; SPB: ISPB): IServiceManager;
492     begin
493     if HasServiceAPI then
494 tony 263 Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB)
495 tony 45 else
496     Result := nil;
497     end;
498    
499 tony 143 function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
500     Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager;
501     begin
502     if HasServiceAPI then
503 tony 263 Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB,Port)
504 tony 143 else
505     Result := nil;
506     end;
507    
508 tony 45 function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
509     TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
510     begin
511 tony 263 Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
512 tony 45 end;
513    
514     function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
515     TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
516     begin
517 tony 263 Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
518 tony 45 end;
519    
520     function TFB25ClientAPI.HasServiceAPI: boolean;
521     begin
522     Result := IBServiceAPIPresent;
523     end;
524    
525     function TFB25ClientAPI.HasRollbackRetaining: boolean;
526     begin
527     Result := assigned(isc_rollback_retaining);
528     end;
529    
530     function TFB25ClientAPI.IsEmbeddedServer: boolean;
531     begin
532     Result := false;
533     {$IFDEF UNIX}
534 tony 263 Result := Pos('libfbembed',FFBLibrary.GetLibraryName) = 1;
535 tony 45 {$ENDIF}
536     {$IFDEF WINDOWS}
537 tony 263 Result := CompareText(FFBLibrary.GetLibraryName,FIREBIRD_EMBEDDED) = 0;
538 tony 45 {$ENDIF}
539     end;
540    
541     function TFB25ClientAPI.HasMasterIntf: boolean;
542     begin
543     Result := false;
544     end;
545    
546     function TFB25ClientAPI.GetIMaster: TObject;
547     begin
548     Result := nil;
549     end;
550    
551 tony 56 function TFB25ClientAPI.GetImplementationVersion: AnsiString;
552 tony 45 begin
553     Result := FBClientInterfaceVersion;
554     end;
555    
556 tony 56 function TFB25ClientAPI.DecodeInteger(bufptr: PByte; len: short): integer;
557 tony 45 begin
558     Result := isc_portable_integer(bufptr,len);
559     end;
560    
561 tony 56 procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
562 tony 45 var
563     tm_date: TCTimeStructure;
564     Yr, Mn, Dy: Word;
565     begin
566     DecodeDate(aDate, Yr, Mn, Dy);
567     with tm_date do begin
568     tm_sec := 0;
569     tm_min := 0;
570     tm_hour := 0;
571     tm_mday := Dy;
572     tm_mon := Mn - 1;
573     tm_year := Yr - 1900;
574     end;
575     isc_encode_sql_date(@tm_date, PISC_DATE(bufptr));
576     end;
577    
578 tony 56 function TFB25ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime;
579 tony 45 var
580     tm_date: TCTimeStructure;
581     begin
582     isc_decode_sql_date(PISC_DATE(bufptr), @tm_date);
583     try
584     result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
585     Word(tm_date.tm_mday));
586     except
587     on E: EConvertError do begin
588     IBError(ibxeInvalidDataConversion, [nil]);
589     end;
590     end;
591     end;
592    
593 tony 56 procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
594 tony 45 var
595     tm_date: TCTimeStructure;
596     Hr, Mt, S, Ms: Word;
597     begin
598     DecodeTime(aTime, Hr, Mt, S, Ms);
599     with tm_date do begin
600     tm_sec := S;
601     tm_min := Mt;
602     tm_hour := Hr;
603     tm_mday := 0;
604     tm_mon := 0;
605     tm_year := 0;
606     end;
607 tony 263 isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
608 tony 45 if Ms > 0 then
609     Inc(PISC_TIME(bufptr)^,Ms*10);
610     end;
611    
612 tony 56 function TFB25ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
613 tony 45 var
614     tm_date: TCTimeStructure;
615     msecs: Word;
616     begin
617     isc_decode_sql_time(PISC_TIME(bufptr), @tm_date);
618     try
619     msecs := (PISC_TIME(bufptr)^ mod 10000) div 10;
620     result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
621     Word(tm_date.tm_sec), msecs)
622     except
623     on E: EConvertError do begin
624     IBError(ibxeInvalidDataConversion, [nil]);
625     end;
626     end;
627     end;
628    
629 tony 56 procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte);
630 tony 45 var
631     tm_date: TCTimeStructure;
632     Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
633     begin
634     DecodeDate(aDateTime, Yr, Mn, Dy);
635     DecodeTime(aDateTime, Hr, Mt, S, Ms);
636     with tm_date do begin
637     tm_sec := S;
638     tm_min := Mt;
639     tm_hour := Hr;
640     tm_mday := Dy;
641     tm_mon := Mn - 1;
642     tm_year := Yr - 1900;
643     end;
644     isc_encode_date(@tm_date, PISC_QUAD(bufptr));
645     if Ms > 0 then
646     Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,Ms*10);
647     end;
648    
649 tony 56 function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
650 tony 45 var
651     tm_date: TCTimeStructure;
652     msecs: Word;
653     begin
654     isc_decode_date(PISC_QUAD(bufptr), @tm_date);
655     try
656     result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
657     Word(tm_date.tm_mday));
658     msecs := (PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000) div 10;
659     if result >= 0 then
660     result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
661     Word(tm_date.tm_sec), msecs)
662     else
663     result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
664     Word(tm_date.tm_sec), msecs)
665     except
666     on E: EConvertError do begin
667     IBError(ibxeInvalidDataConversion, [nil]);
668     end;
669     end;
670     end;
671    
672     end.
673    
674 tony 56