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