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: 345
Committed: Mon Aug 23 14:22:29 2021 UTC (3 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 26483 byte(s)
Log Message: 
Merged into public release

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     type
78    
79     { TFB25Status }
80    
81     TFB25Status = class(TFBStatus,IStatus)
82     public
83     function StatusVector: PStatusVector; override;
84     end;
85    
86     { TFB25ClientAPI }
87    
88     TFB25ClientAPI = class(TFBClientAPI,IFirebirdAPI)
89     private
90     FIBServiceAPIPresent: boolean;
91     FStatus: TFB25Status;
92     FStatusIntf: IStatus; {Keep a reference to the interface - automatic destroy
93     when this class is freed and last reference to IStatus
94     goes out of scope.}
95 tony 263 public
96     constructor Create(aFBLibrary: TFBLibrary);
97     destructor Destroy; override;
98     function StatusVector: PISC_STATUS;
99     function LoadInterface: boolean; override;
100     function GetAPI: IFirebirdAPI; override;
101 tony 45 {$IFDEF UNIX}
102     function GetFirebirdLibList: string; override;
103     {$ENDIF}
104     property IBServiceAPIPresent: boolean read FIBServiceAPIPresent;
105     property Status: TFB25Status read FStatus;
106    
107     public
108    
109     {fbclient API}
110     BLOB_get: TBLOB_get;
111     BLOB_put: TBLOB_put;
112     isc_wait_for_event: Tisc_wait_for_event;
113     isc_vax_integer: Tisc_vax_integer;
114     isc_blob_info: Tisc_blob_info;
115     isc_blob_lookup_desc: Tisc_blob_lookup_desc;
116     isc_open_blob2: Tisc_open_blob2;
117     isc_close_blob: Tisc_close_blob;
118     isc_get_segment: Tisc_get_segment;
119     isc_put_segment: Tisc_put_segment;
120     isc_create_blob2: Tisc_create_blob2;
121     isc_cancel_blob: Tisc_cancel_blob;
122     isc_service_attach: Tisc_service_attach;
123     isc_service_detach: Tisc_service_detach;
124     isc_service_query: Tisc_service_query;
125     isc_service_start: Tisc_service_start;
126     isc_decode_date: Tisc_decode_date;
127     isc_decode_sql_date: Tisc_decode_sql_date;
128     isc_decode_sql_time: Tisc_decode_sql_time;
129     isc_decode_timestamp: Tisc_decode_timestamp;
130     isc_encode_date: Tisc_encode_date;
131     isc_encode_sql_date: Tisc_encode_sql_date;
132     isc_encode_sql_time: Tisc_encode_sql_time;
133     isc_encode_timestamp: Tisc_encode_timestamp;
134     isc_dsql_free_statement: Tisc_dsql_free_statement;
135     isc_dsql_execute2: Tisc_dsql_execute2;
136     isc_dsql_execute: Tisc_dsql_execute;
137     isc_dsql_set_cursor_name: Tisc_dsql_set_cursor_name;
138     isc_dsql_fetch: Tisc_dsql_fetch;
139     isc_dsql_sql_info: Tisc_dsql_sql_info;
140     isc_dsql_alloc_statement2: Tisc_dsql_alloc_statement2;
141     isc_dsql_prepare: Tisc_dsql_prepare;
142     isc_dsql_describe_bind: Tisc_dsql_describe_bind;
143     isc_dsql_describe: Tisc_dsql_describe;
144     isc_dsql_execute_immediate: Tisc_dsql_execute_immediate;
145     isc_drop_database: Tisc_drop_database;
146     isc_detach_database: Tisc_detach_database;
147     isc_attach_database: Tisc_attach_database;
148     isc_database_info: Tisc_database_info;
149     isc_start_transaction: Tisc_start_transaction;
150     isc_start_multiple: Tisc_start_multiple;
151     isc_commit_transaction: Tisc_commit_transaction;
152     isc_commit_retaining: Tisc_commit_retaining;
153     isc_rollback_transaction: Tisc_rollback_transaction;
154     isc_rollback_retaining: Tisc_rollback_retaining;
155     isc_cancel_events: Tisc_cancel_events;
156     isc_que_events: Tisc_que_events;
157     isc_add_user : Tisc_add_user;
158     isc_delete_user: Tisc_delete_user;
159     isc_modify_user: Tisc_modify_user;
160     isc_array_lookup_bounds: Tisc_array_lookup_bounds;
161     isc_array_get_slice: Tisc_array_get_slice;
162     isc_array_put_slice: Tisc_array_put_slice;
163     isc_prepare_transaction: Tisc_prepare_transaction;
164 tony 266 isc_version: Tisc_Version;
165 tony 308 isc_interprete: Tisc_interprete;
166 tony 45
167     public
168     {Helper Functions}
169 tony 56 procedure SQLEncodeDate(aDate: TDateTime; bufptr: PByte); override;
170     function SQLDecodeDate(bufptr: PByte): TDateTime; override;
171     procedure SQLEncodeTime(aTime: TDateTime; bufptr: PByte); override;
172     function SQLDecodeTime(bufptr: PByte): TDateTime; override;
173     procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte); override;
174     function SQLDecodeDateTime(bufptr: PByte): TDateTime; override;
175 tony 308 function FormatStatus(Status: TFBStatus): AnsiString; override;
176 tony 45 public
177     {IFirebirdAPI}
178    
179     {Database connections}
180     function AllocateDPB: IDPB;
181 tony 56 function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
182     function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
183     function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
184 tony 45
185     {Start Transaction against multiple databases}
186     function AllocateTPB: ITPB;
187     function StartTransaction(Attachments: array of IAttachment;
188     TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
189     function StartTransaction(Attachments: array of IAttachment;
190     TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload;
191    
192     {Service Manager}
193     function AllocateSPB: ISPB;
194     function HasServiceAPI: boolean;
195 tony 143 function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
196     function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
197 tony 45
198     {Information}
199     function GetStatus: IStatus; override;
200     function HasRollbackRetaining: boolean;
201     function IsEmbeddedServer: boolean; override;
202 tony 308 function GetClientMajor: integer; override;
203     function GetClientMinor: integer; override;
204 tony 45
205     {Firebird 3 API}
206     function HasMasterIntf: boolean;
207     function GetIMaster: TObject;
208    
209     end;
210    
211     implementation
212    
213 tony 56 uses FBMessages,
214     {$IFDEF WINDOWS}Windows, {$ENDIF}
215     {$IFDEF FPC} Dynlibs, {$ENDIF}
216 tony 315 FB25Attachment, FB25Transaction, FB25Services,
217     IBUtils, FBAttachment, FBTransaction, FBServices;
218 tony 45
219     { Stubs for 6.0 only functions }
220     function isc_rollback_retaining_stub(status_vector : PISC_STATUS;
221     tran_handle : PISC_TR_HANDLE):
222     ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
223     begin
224     Result := 0;
225     IBError(ibxeIB60feature, ['isc_rollback_retaining']); {do not localize}
226     end;
227    
228     function isc_service_attach_stub(status_vector : PISC_STATUS;
229     isc_arg2 : UShort;
230 tony 56 isc_arg3 : PAnsiChar;
231 tony 45 service_handle : PISC_SVC_HANDLE;
232     isc_arg5 : UShort;
233 tony 56 isc_arg6 : PAnsiChar):
234 tony 45 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
235     begin
236     Result := 0;
237     IBError(ibxeIB60feature, ['isc_service_attach']); {do not localize}
238     end;
239    
240     function isc_service_detach_stub(status_vector : PISC_STATUS;
241     service_handle : PISC_SVC_HANDLE):
242     ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
243     begin
244     Result := 0;
245     IBError(ibxeIB60feature, ['isc_service_detach']); {do not localize}
246     end;
247    
248     function isc_service_query_stub(status_vector : PISC_STATUS;
249     service_handle : PISC_SVC_HANDLE;
250     recv_handle : PISC_SVC_HANDLE;
251     isc_arg4 : UShort;
252 tony 56 isc_arg5 : PAnsiChar;
253 tony 45 isc_arg6 : UShort;
254 tony 56 isc_arg7 : PAnsiChar;
255 tony 45 isc_arg8 : UShort;
256 tony 56 isc_arg9 : PAnsiChar):
257 tony 45 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
258     begin
259     Result := 0;
260     IBError(ibxeIB60feature, ['isc_service_query']); {do not localize}
261     end;
262    
263     function isc_service_start_stub(status_vector : PISC_STATUS;
264     service_handle : PISC_SVC_HANDLE;
265     recv_handle : PISC_SVC_HANDLE;
266     isc_arg4 : UShort;
267 tony 56 isc_arg5 : PAnsiChar):
268 tony 45 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
269     begin
270     Result := 0;
271     IBError(ibxeIB60feature, ['isc_service_start']); {do not localize}
272     end;
273    
274     procedure isc_encode_sql_date_stub(tm_date : PCTimeStructure;
275     ib_date : PISC_DATE);
276     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
277     begin
278     IBError(ibxeIB60feature, ['isc_encode_sql_date']); {do not localize}
279     end;
280    
281     procedure isc_encode_sql_time_stub(tm_date : PCTimeStructure;
282     ib_time : PISC_TIME);
283     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
284     begin
285     IBError(ibxeIB60feature, ['isc_encode_sql_time']); {do not localize}
286     end;
287    
288     procedure isc_encode_timestamp_stub(tm_date : PCTimeStructure;
289     ib_timestamp : PISC_TIMESTAMP);
290     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
291     begin
292     IBError(ibxeIB60feature, ['isc_encode_sql_timestamp']); {do not localize}
293     end;
294    
295     procedure isc_decode_sql_date_stub(ib_date : PISC_DATE;
296     tm_date : PCTimeStructure);
297     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
298     begin
299     IBError(ibxeIB60feature, ['isc_decode_sql_date']); {do not localize}
300     end;
301    
302     procedure isc_decode_sql_time_stub(ib_time : PISC_TIME;
303     tm_date : PCTimeStructure);
304     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
305     begin
306     IBError(ibxeIB60feature, ['isc_decode_sql_time']); {do not localize}
307     end;
308    
309     procedure isc_decode_timestamp_stub(ib_timestamp : PISC_TIMESTAMP;
310     tm_date : PCTimeStructure);
311     {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
312     begin
313     IBError(ibxeIB60feature, ['isc_decode_timestamp']); {do not localize}
314     end;
315    
316     { TFB25Status }
317    
318     threadvar
319     FStatusVector: TStatusVector;
320    
321 tony 263 { TFB25ActivityReporter }
322    
323 tony 45 function TFB25Status.StatusVector: PStatusVector;
324     begin
325     Result := @FStatusVector;
326     end;
327    
328    
329     { TFB25ClientAPI }
330    
331     {$IFDEF UNIX}
332     function TFB25ClientAPI.GetFirebirdLibList: string;
333     begin
334     Result := 'libfbembed.so:libfbembed.so.2.5:libfbembed.so.2.1:libfbclient.so:libfbclient.so.2';
335     end;
336     {$ENDIF}
337    
338 tony 263 function TFB25ClientAPI.LoadInterface: boolean;
339 tony 45 begin
340 tony 263 Result := inherited LoadInterface;
341 tony 45 BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
342     BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
343     isc_wait_for_event := GetProcAddr('isc_wait_for_event'); {do not localize}
344     isc_vax_integer := GetProcAddr('isc_vax_integer'); {do not localize}
345     isc_blob_info := GetProcAddr('isc_blob_info'); {do not localize}
346     isc_blob_lookup_desc := GetProcAddr('isc_blob_lookup_desc'); {do not localize}
347     isc_open_blob2 := GetProcAddr('isc_open_blob2'); {do not localize}
348     isc_close_blob := GetProcAddr('isc_close_blob'); {do not localize}
349     isc_get_segment := GetProcAddr('isc_get_segment'); {do not localize}
350     isc_put_segment := GetProcAddr('isc_put_segment'); {do not localize}
351     isc_create_blob2 := GetProcAddr('isc_create_blob2'); {do not localize}
352     isc_cancel_blob := GetProcAddr('isc_cancel_blob'); {do not localize}
353     isc_decode_date := GetProcAddr('isc_decode_date'); {do not localize}
354     isc_encode_date := GetProcAddr('isc_encode_date'); {do not localize}
355     isc_dsql_free_statement := GetProcAddr('isc_dsql_free_statement'); {do not localize}
356     isc_dsql_execute2 := GetProcAddr('isc_dsql_execute2'); {do not localize}
357     isc_dsql_execute := GetProcAddr('isc_dsql_execute'); {do not localize}
358     isc_dsql_set_cursor_name := GetProcAddr('isc_dsql_set_cursor_name'); {do not localize}
359     isc_dsql_fetch := GetProcAddr('isc_dsql_fetch'); {do not localize}
360     isc_dsql_sql_info := GetProcAddr('isc_dsql_sql_info'); {do not localize}
361     isc_dsql_alloc_statement2 := GetProcAddr('isc_dsql_alloc_statement2'); {do not localize}
362     isc_dsql_prepare := GetProcAddr('isc_dsql_prepare'); {do not localize}
363     isc_dsql_describe_bind := GetProcAddr('isc_dsql_describe_bind'); {do not localize}
364     isc_dsql_describe := GetProcAddr('isc_dsql_describe'); {do not localize}
365     isc_dsql_execute_immediate := GetProcAddr('isc_dsql_execute_immediate'); {do not localize}
366     isc_drop_database := GetProcAddr('isc_drop_database'); {do not localize}
367     isc_detach_database := GetProcAddr('isc_detach_database'); {do not localize}
368     isc_attach_database := GetProcAddr('isc_attach_database'); {do not localize}
369     isc_database_info := GetProcAddr('isc_database_info'); {do not localize}
370     isc_start_transaction := GetProcAddr('isc_start_transaction'); {do not localize}
371     isc_start_multiple := GetProcAddr('isc_start_multiple'); {do not localize}
372     isc_commit_transaction := GetProcAddr('isc_commit_transaction'); {do not localize}
373     isc_commit_retaining := GetProcAddr('isc_commit_retaining'); {do not localize}
374     isc_rollback_transaction := GetProcAddr('isc_rollback_transaction'); {do not localize}
375     isc_cancel_events := GetProcAddr('isc_cancel_events'); {do not localize}
376     isc_que_events := GetProcAddr('isc_que_events'); {do not localize}
377     isc_add_user := GetProcAddr('isc_add_user'); {do not localize}
378     isc_delete_user := GetProcAddr('isc_delete_user'); {do not localize}
379     isc_modify_user := GetProcAddr('isc_modify_user'); {do not localize}
380     isc_array_lookup_bounds := GetProcAddr('isc_array_lookup_bounds'); {do not localize}
381     isc_array_get_slice := GetProcAddr('isc_array_get_slice'); {do not localize}
382     isc_array_put_slice := GetProcAddr('isc_array_put_slice'); {do not localize}
383     isc_prepare_transaction := GetProcAddr('isc_prepare_transaction'); {do not localize}
384 tony 266 isc_version := GetProcAddr('isc_version'); {do not localize}
385 tony 308 isc_interprete := GetProcAddr('isc_interprete'); {do not localize}
386 tony 45
387     FIBServiceAPIPresent := true;
388 tony 263 isc_rollback_retaining := GetProcAddress(FFBLibrary.IBLibrary, 'isc_rollback_retaining'); {do not localize}
389 tony 45 if Assigned(isc_rollback_retaining) then
390     begin
391     isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize}
392     isc_service_detach := GetProcAddr('isc_service_detach'); {do not localize}
393     isc_service_query := GetProcAddr('isc_service_query'); {do not localize}
394     isc_service_start := GetProcAddr('isc_service_start'); {do not localize}
395     isc_decode_sql_date := GetProcAddr('isc_decode_sql_date'); {do not localize}
396     isc_decode_sql_time := GetProcAddr('isc_decode_sql_time'); {do not localize}
397     isc_decode_timestamp := GetProcAddr('isc_decode_timestamp'); {do not localize}
398     isc_encode_sql_date := GetProcAddr('isc_encode_sql_date'); {do not localize}
399     isc_encode_sql_time := GetProcAddr('isc_encode_sql_time'); {do not localize}
400     isc_encode_timestamp := GetProcAddr('isc_encode_timestamp'); {do not localize}
401     end else
402     begin
403     FIBServiceAPIPresent := false;
404     isc_rollback_retaining := @isc_rollback_retaining_stub;
405     isc_service_attach := @isc_service_attach_stub;
406     isc_service_detach := @isc_service_detach_stub;
407     isc_service_query := @isc_service_query_stub;
408     isc_service_start := @isc_service_start_stub;
409     isc_decode_sql_date := @isc_decode_sql_date_stub;
410     isc_decode_sql_time := @isc_decode_sql_time_stub;
411     isc_decode_timestamp := @isc_decode_timestamp_stub;
412     isc_encode_sql_date := @isc_encode_sql_date_stub;
413     isc_encode_sql_time := @isc_encode_sql_time_stub;
414     isc_encode_timestamp := @isc_encode_timestamp_stub;
415     end;
416 tony 263 Result := Result and assigned(isc_attach_database);
417 tony 45 end;
418    
419 tony 263 function TFB25ClientAPI.GetAPI: IFirebirdAPI;
420 tony 45 begin
421 tony 263 Result := self;
422     end;
423    
424     constructor TFB25ClientAPI.Create(aFBLibrary: TFBLibrary);
425     begin
426     inherited Create(aFBLibrary);
427 tony 45 FStatus := TFB25Status.Create(self);
428     FStatusIntf := FStatus;
429     end;
430    
431     destructor TFB25ClientAPI.Destroy;
432     begin
433     FStatusIntf := nil;
434     inherited Destroy;
435     end;
436    
437    
438     function TFB25ClientAPI.StatusVector: PISC_STATUS;
439     begin
440     Result := PISC_STATUS(FStatus.StatusVector);
441     end;
442    
443     function TFB25ClientAPI.GetStatus: IStatus;
444     begin
445     Result := FStatus;
446     end;
447    
448     function TFB25ClientAPI.AllocateDPB: IDPB;
449     begin
450 tony 263 Result := TDPB.Create(self);
451 tony 45 end;
452    
453 tony 56 function TFB25ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
454 tony 45 RaiseExceptionOnConnectError: boolean): IAttachment;
455     begin
456 tony 263 Result := TFB25Attachment.Create(self,DatabaseName,DPB,RaiseExceptionOnConnectError);
457 tony 45 if not Result.IsConnected then
458     Result := nil;
459     end;
460    
461 tony 56 function TFB25ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
462 tony 45 RaiseExceptionOnError: boolean): IAttachment;
463     begin
464 tony 263 Result := TFB25Attachment.CreateDatabase(self,DatabaseName, DPB, RaiseExceptionOnError );
465 tony 45 if (Result <> nil) and not Result.IsConnected then
466     Result := nil;
467     end;
468    
469 tony 56 function TFB25ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
470 tony 47 RaiseExceptionOnError: boolean): IAttachment;
471     begin
472 tony 263 Result := TFB25Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError );
473 tony 47 if (Result <> nil) and not Result.IsConnected then
474     Result := nil;
475     end;
476    
477 tony 45 function TFB25ClientAPI.AllocateSPB: ISPB;
478     begin
479 tony 263 Result := TSPB.Create(self);
480 tony 45 end;
481    
482     function TFB25ClientAPI.AllocateTPB: ITPB;
483     begin
484 tony 263 Result := TTPB.Create(self);
485 tony 45 end;
486    
487 tony 56 function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
488 tony 45 Protocol: TProtocol; SPB: ISPB): IServiceManager;
489     begin
490     if HasServiceAPI then
491 tony 263 Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB)
492 tony 45 else
493     Result := nil;
494     end;
495    
496 tony 143 function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
497     Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager;
498     begin
499     if HasServiceAPI then
500 tony 263 Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB,Port)
501 tony 143 else
502     Result := nil;
503     end;
504    
505 tony 45 function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
506     TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
507     begin
508 tony 263 Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
509 tony 45 end;
510    
511     function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
512     TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
513     begin
514 tony 263 Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
515 tony 45 end;
516    
517     function TFB25ClientAPI.HasServiceAPI: boolean;
518     begin
519     Result := IBServiceAPIPresent;
520     end;
521    
522     function TFB25ClientAPI.HasRollbackRetaining: boolean;
523     begin
524     Result := assigned(isc_rollback_retaining);
525     end;
526    
527     function TFB25ClientAPI.IsEmbeddedServer: boolean;
528     begin
529     Result := false;
530     {$IFDEF UNIX}
531 tony 263 Result := Pos('libfbembed',FFBLibrary.GetLibraryName) = 1;
532 tony 45 {$ENDIF}
533     {$IFDEF WINDOWS}
534 tony 263 Result := CompareText(FFBLibrary.GetLibraryName,FIREBIRD_EMBEDDED) = 0;
535 tony 45 {$ENDIF}
536     end;
537    
538 tony 308 function TFB25ClientAPI.GetClientMajor: integer;
539     begin
540     Result := 2;
541     end;
542    
543     function TFB25ClientAPI.GetClientMinor: integer;
544     begin
545     Result := 5;
546     end;
547    
548 tony 45 function TFB25ClientAPI.HasMasterIntf: boolean;
549     begin
550     Result := false;
551     end;
552    
553     function TFB25ClientAPI.GetIMaster: TObject;
554     begin
555     Result := nil;
556     end;
557    
558 tony 56 procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
559 tony 45 var
560     tm_date: TCTimeStructure;
561     Yr, Mn, Dy: Word;
562     begin
563     DecodeDate(aDate, Yr, Mn, Dy);
564     with tm_date do begin
565     tm_sec := 0;
566     tm_min := 0;
567     tm_hour := 0;
568     tm_mday := Dy;
569     tm_mon := Mn - 1;
570     tm_year := Yr - 1900;
571     end;
572     isc_encode_sql_date(@tm_date, PISC_DATE(bufptr));
573     end;
574    
575 tony 56 function TFB25ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime;
576 tony 45 var
577     tm_date: TCTimeStructure;
578     begin
579     isc_decode_sql_date(PISC_DATE(bufptr), @tm_date);
580     try
581     result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
582     Word(tm_date.tm_mday));
583     except
584     on E: EConvertError do begin
585     IBError(ibxeInvalidDataConversion, [nil]);
586     end;
587     end;
588     end;
589    
590 tony 56 procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
591 tony 45 var
592     tm_date: TCTimeStructure;
593 tony 315 Hr, Mt, S: Word;
594     DMs: cardinal; {DMs = decimilliseconds}
595 tony 45 begin
596 tony 315 FBDecodeTime(aTime, Hr, Mt, S, DMs);
597 tony 45 with tm_date do begin
598     tm_sec := S;
599     tm_min := Mt;
600     tm_hour := Hr;
601     tm_mday := 0;
602     tm_mon := 0;
603     tm_year := 0;
604     end;
605 tony 263 isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
606 tony 315 if DMs > 0 then
607     Inc(PISC_TIME(bufptr)^,DMs);
608 tony 45 end;
609    
610 tony 56 function TFB25ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
611 tony 45 var
612     tm_date: TCTimeStructure;
613 tony 315 DMs: cardinal; {DMs = decimilliseconds}
614 tony 45 begin
615     isc_decode_sql_time(PISC_TIME(bufptr), @tm_date);
616     try
617 tony 315 DMs := PISC_TIME(bufptr)^ mod 10000;
618     result := FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
619     Word(tm_date.tm_sec), DMs)
620 tony 45 except
621     on E: EConvertError do begin
622     IBError(ibxeInvalidDataConversion, [nil]);
623     end;
624     end;
625     end;
626    
627 tony 56 procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte);
628 tony 45 var
629     tm_date: TCTimeStructure;
630     Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
631 tony 315 DMs: cardinal;
632 tony 45 begin
633     DecodeDate(aDateTime, Yr, Mn, Dy);
634 tony 315 FBDecodeTime(aDateTime, Hr, Mt, S, DMs);
635 tony 45 with tm_date do begin
636     tm_sec := S;
637     tm_min := Mt;
638     tm_hour := Hr;
639     tm_mday := Dy;
640     tm_mon := Mn - 1;
641     tm_year := Yr - 1900;
642     end;
643     isc_encode_date(@tm_date, PISC_QUAD(bufptr));
644 tony 315 if DMs > 0 then
645     Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,DMs);
646 tony 45 end;
647    
648 tony 56 function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
649 tony 45 var
650     tm_date: TCTimeStructure;
651 tony 315 Dmsecs: Word;
652 tony 45 begin
653     isc_decode_date(PISC_QUAD(bufptr), @tm_date);
654     try
655     result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
656     Word(tm_date.tm_mday));
657 tony 315 Dmsecs := PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000;
658 tony 45 if result >= 0 then
659 tony 315 result := result + FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
660     Word(tm_date.tm_sec), Dmsecs)
661 tony 45 else
662 tony 315 result := result - FBEncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
663     Word(tm_date.tm_sec), Dmsecs)
664 tony 45 except
665     on E: EConvertError do begin
666     IBError(ibxeInvalidDataConversion, [nil]);
667     end;
668     end;
669     end;
670    
671 tony 308 function TFB25ClientAPI.FormatStatus(Status: TFBStatus): AnsiString;
672     var psb: PStatusVector;
673     local_buffer: array[0..IBHugeLocalBufferLength - 1] of AnsiChar;
674     begin
675     psb := Status.StatusVector;
676     Result := '';
677     while isc_interprete(@local_buffer,@psb) > 0 do
678     begin
679     if (Result <> '') and (Result[Length(Result)] <> LF) then
680     Result := Result + LineEnding + '-';
681     Result := Result + strpas(local_buffer);
682     end;
683     end;
684    
685 tony 45 end.
686    
687 tony 56