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: 47
Committed: Mon Jan 9 15:31:51 2017 UTC (7 years, 2 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/client/2.5/FB25ClientAPI.pas
File size: 25159 byte(s)
Log Message:
Committing updates for Release R2-0-1

File Contents

# Content
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
64 {$IFDEF FPC}
65 {$mode delphi}
66 {$interfaces COM}
67 {$ENDIF}
68
69 interface
70
71 uses
72 Classes, SysUtils, FBClientAPI, IBHeader, IBExternals, IB;
73
74 const
75 FBClientInterfaceVersion = '2.5';
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 protected
96 {$IFDEF UNIX}
97 function GetFirebirdLibList: string; override;
98 {$ENDIF}
99 procedure LoadInterface; override;
100 public
101 constructor Create;
102 destructor Destroy; override;
103 function StatusVector: PISC_STATUS;
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_portable_integer: Tisc_portable_integer;
115 isc_blob_info: Tisc_blob_info;
116 isc_blob_lookup_desc: Tisc_blob_lookup_desc;
117 isc_open_blob2: Tisc_open_blob2;
118 isc_close_blob: Tisc_close_blob;
119 isc_get_segment: Tisc_get_segment;
120 isc_put_segment: Tisc_put_segment;
121 isc_create_blob2: Tisc_create_blob2;
122 isc_cancel_blob: Tisc_cancel_blob;
123 isc_service_attach: Tisc_service_attach;
124 isc_service_detach: Tisc_service_detach;
125 isc_service_query: Tisc_service_query;
126 isc_service_start: Tisc_service_start;
127 isc_decode_date: Tisc_decode_date;
128 isc_decode_sql_date: Tisc_decode_sql_date;
129 isc_decode_sql_time: Tisc_decode_sql_time;
130 isc_decode_timestamp: Tisc_decode_timestamp;
131 isc_encode_date: Tisc_encode_date;
132 isc_encode_sql_date: Tisc_encode_sql_date;
133 isc_encode_sql_time: Tisc_encode_sql_time;
134 isc_encode_timestamp: Tisc_encode_timestamp;
135 isc_dsql_free_statement: Tisc_dsql_free_statement;
136 isc_dsql_execute2: Tisc_dsql_execute2;
137 isc_dsql_execute: Tisc_dsql_execute;
138 isc_dsql_set_cursor_name: Tisc_dsql_set_cursor_name;
139 isc_dsql_fetch: Tisc_dsql_fetch;
140 isc_dsql_sql_info: Tisc_dsql_sql_info;
141 isc_dsql_alloc_statement2: Tisc_dsql_alloc_statement2;
142 isc_dsql_prepare: Tisc_dsql_prepare;
143 isc_dsql_describe_bind: Tisc_dsql_describe_bind;
144 isc_dsql_describe: Tisc_dsql_describe;
145 isc_dsql_execute_immediate: Tisc_dsql_execute_immediate;
146 isc_drop_database: Tisc_drop_database;
147 isc_detach_database: Tisc_detach_database;
148 isc_attach_database: Tisc_attach_database;
149 isc_database_info: Tisc_database_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
166 public
167 {Helper Functions}
168 function DecodeInteger(bufptr: PChar; len: short): integer; override;
169 procedure SQLEncodeDate(aDate: TDateTime; bufptr: PChar); override;
170 function SQLDecodeDate(bufptr: PChar): TDateTime; override;
171 procedure SQLEncodeTime(aTime: TDateTime; bufptr: PChar); override;
172 function SQLDecodeTime(bufptr: PChar): TDateTime; override;
173 procedure SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar); override;
174 function SQLDecodeDateTime(bufptr: PChar): TDateTime; override;
175
176 public
177 {IFirebirdAPI}
178
179 {Database connections}
180 function AllocateDPB: IDPB;
181 function OpenDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
182 function CreateDatabase(DatabaseName: string; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
183 function CreateDatabase(sql: string; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
184
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 function GetServiceManager(ServerName: string; Protocol: TProtocol; SPB: ISPB): IServiceManager;
196
197 {Information}
198 function GetStatus: IStatus; override;
199 function HasRollbackRetaining: boolean;
200 function IsEmbeddedServer: boolean; override;
201 function GetImplementationVersion: string;
202
203 {Firebird 3 API}
204 function HasMasterIntf: boolean;
205 function GetIMaster: TObject;
206
207 end;
208
209 const
210 Firebird25ClientAPI: TFB25ClientAPI = nil;
211
212 implementation
213
214 uses FBMessages, dynlibs, FB25Attachment, FB25Transaction, FB25Services, FBParamBlock,
215 IBUtils;
216
217 { Stubs for 6.0 only functions }
218 function isc_rollback_retaining_stub(status_vector : PISC_STATUS;
219 tran_handle : PISC_TR_HANDLE):
220 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
221 begin
222 Result := 0;
223 IBError(ibxeIB60feature, ['isc_rollback_retaining']); {do not localize}
224 end;
225
226 function isc_service_attach_stub(status_vector : PISC_STATUS;
227 isc_arg2 : UShort;
228 isc_arg3 : PChar;
229 service_handle : PISC_SVC_HANDLE;
230 isc_arg5 : UShort;
231 isc_arg6 : PChar):
232 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
233 begin
234 Result := 0;
235 IBError(ibxeIB60feature, ['isc_service_attach']); {do not localize}
236 end;
237
238 function isc_service_detach_stub(status_vector : PISC_STATUS;
239 service_handle : PISC_SVC_HANDLE):
240 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
241 begin
242 Result := 0;
243 IBError(ibxeIB60feature, ['isc_service_detach']); {do not localize}
244 end;
245
246 function isc_service_query_stub(status_vector : PISC_STATUS;
247 service_handle : PISC_SVC_HANDLE;
248 recv_handle : PISC_SVC_HANDLE;
249 isc_arg4 : UShort;
250 isc_arg5 : PChar;
251 isc_arg6 : UShort;
252 isc_arg7 : PChar;
253 isc_arg8 : UShort;
254 isc_arg9 : PChar):
255 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
256 begin
257 Result := 0;
258 IBError(ibxeIB60feature, ['isc_service_query']); {do not localize}
259 end;
260
261 function isc_service_start_stub(status_vector : PISC_STATUS;
262 service_handle : PISC_SVC_HANDLE;
263 recv_handle : PISC_SVC_HANDLE;
264 isc_arg4 : UShort;
265 isc_arg5 : PChar):
266 ISC_STATUS; {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
267 begin
268 Result := 0;
269 IBError(ibxeIB60feature, ['isc_service_start']); {do not localize}
270 end;
271
272 procedure isc_encode_sql_date_stub(tm_date : PCTimeStructure;
273 ib_date : PISC_DATE);
274 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
275 begin
276 IBError(ibxeIB60feature, ['isc_encode_sql_date']); {do not localize}
277 end;
278
279 procedure isc_encode_sql_time_stub(tm_date : PCTimeStructure;
280 ib_time : PISC_TIME);
281 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
282 begin
283 IBError(ibxeIB60feature, ['isc_encode_sql_time']); {do not localize}
284 end;
285
286 procedure isc_encode_timestamp_stub(tm_date : PCTimeStructure;
287 ib_timestamp : PISC_TIMESTAMP);
288 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
289 begin
290 IBError(ibxeIB60feature, ['isc_encode_sql_timestamp']); {do not localize}
291 end;
292
293 procedure isc_decode_sql_date_stub(ib_date : PISC_DATE;
294 tm_date : PCTimeStructure);
295 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
296 begin
297 IBError(ibxeIB60feature, ['isc_decode_sql_date']); {do not localize}
298 end;
299
300 procedure isc_decode_sql_time_stub(ib_time : PISC_TIME;
301 tm_date : PCTimeStructure);
302 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
303 begin
304 IBError(ibxeIB60feature, ['isc_decode_sql_time']); {do not localize}
305 end;
306
307 procedure isc_decode_timestamp_stub(ib_timestamp : PISC_TIMESTAMP;
308 tm_date : PCTimeStructure);
309 {$IFDEF WINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
310 begin
311 IBError(ibxeIB60feature, ['isc_decode_timestamp']); {do not localize}
312 end;
313
314 { TFB25Status }
315
316 threadvar
317 FStatusVector: TStatusVector;
318
319 function TFB25Status.StatusVector: PStatusVector;
320 begin
321 Result := @FStatusVector;
322 end;
323
324
325 { TFB25ClientAPI }
326
327 {$IFDEF UNIX}
328 function TFB25ClientAPI.GetFirebirdLibList: string;
329 begin
330 Result := 'libfbembed.so:libfbembed.so.2.5:libfbembed.so.2.1:libfbclient.so:libfbclient.so.2';
331 end;
332 {$ENDIF}
333
334 procedure TFB25ClientAPI.LoadInterface;
335 begin
336 inherited LoadInterface;
337 BLOB_get := GetProcAddr('BLOB_get'); {do not localize}
338 BLOB_put := GetProcAddr('BLOB_put'); {do not localize}
339 isc_wait_for_event := GetProcAddr('isc_wait_for_event'); {do not localize}
340 isc_vax_integer := GetProcAddr('isc_vax_integer'); {do not localize}
341 isc_portable_integer := GetProcAddr('isc_portable_integer'); {do not localize}
342 isc_blob_info := GetProcAddr('isc_blob_info'); {do not localize}
343 isc_blob_lookup_desc := GetProcAddr('isc_blob_lookup_desc'); {do not localize}
344 isc_open_blob2 := GetProcAddr('isc_open_blob2'); {do not localize}
345 isc_close_blob := GetProcAddr('isc_close_blob'); {do not localize}
346 isc_get_segment := GetProcAddr('isc_get_segment'); {do not localize}
347 isc_put_segment := GetProcAddr('isc_put_segment'); {do not localize}
348 isc_create_blob2 := GetProcAddr('isc_create_blob2'); {do not localize}
349 isc_cancel_blob := GetProcAddr('isc_cancel_blob'); {do not localize}
350 isc_decode_date := GetProcAddr('isc_decode_date'); {do not localize}
351 isc_encode_date := GetProcAddr('isc_encode_date'); {do not localize}
352 isc_dsql_free_statement := GetProcAddr('isc_dsql_free_statement'); {do not localize}
353 isc_dsql_execute2 := GetProcAddr('isc_dsql_execute2'); {do not localize}
354 isc_dsql_execute := GetProcAddr('isc_dsql_execute'); {do not localize}
355 isc_dsql_set_cursor_name := GetProcAddr('isc_dsql_set_cursor_name'); {do not localize}
356 isc_dsql_fetch := GetProcAddr('isc_dsql_fetch'); {do not localize}
357 isc_dsql_sql_info := GetProcAddr('isc_dsql_sql_info'); {do not localize}
358 isc_dsql_alloc_statement2 := GetProcAddr('isc_dsql_alloc_statement2'); {do not localize}
359 isc_dsql_prepare := GetProcAddr('isc_dsql_prepare'); {do not localize}
360 isc_dsql_describe_bind := GetProcAddr('isc_dsql_describe_bind'); {do not localize}
361 isc_dsql_describe := GetProcAddr('isc_dsql_describe'); {do not localize}
362 isc_dsql_execute_immediate := GetProcAddr('isc_dsql_execute_immediate'); {do not localize}
363 isc_drop_database := GetProcAddr('isc_drop_database'); {do not localize}
364 isc_detach_database := GetProcAddr('isc_detach_database'); {do not localize}
365 isc_attach_database := GetProcAddr('isc_attach_database'); {do not localize}
366 isc_database_info := GetProcAddr('isc_database_info'); {do not localize}
367 isc_start_transaction := GetProcAddr('isc_start_transaction'); {do not localize}
368 isc_start_multiple := GetProcAddr('isc_start_multiple'); {do not localize}
369 isc_commit_transaction := GetProcAddr('isc_commit_transaction'); {do not localize}
370 isc_commit_retaining := GetProcAddr('isc_commit_retaining'); {do not localize}
371 isc_rollback_transaction := GetProcAddr('isc_rollback_transaction'); {do not localize}
372 isc_cancel_events := GetProcAddr('isc_cancel_events'); {do not localize}
373 isc_que_events := GetProcAddr('isc_que_events'); {do not localize}
374 isc_add_user := GetProcAddr('isc_add_user'); {do not localize}
375 isc_delete_user := GetProcAddr('isc_delete_user'); {do not localize}
376 isc_modify_user := GetProcAddr('isc_modify_user'); {do not localize}
377 isc_array_lookup_bounds := GetProcAddr('isc_array_lookup_bounds'); {do not localize}
378 isc_array_get_slice := GetProcAddr('isc_array_get_slice'); {do not localize}
379 isc_array_put_slice := GetProcAddr('isc_array_put_slice'); {do not localize}
380 isc_prepare_transaction := GetProcAddr('isc_prepare_transaction'); {do not localize}
381
382 FIBServiceAPIPresent := true;
383 isc_rollback_retaining := GetProcAddress(IBLibrary, 'isc_rollback_retaining'); {do not localize}
384 if Assigned(isc_rollback_retaining) then
385 begin
386 isc_service_attach := GetProcAddr('isc_service_attach'); {do not localize}
387 isc_service_detach := GetProcAddr('isc_service_detach'); {do not localize}
388 isc_service_query := GetProcAddr('isc_service_query'); {do not localize}
389 isc_service_start := GetProcAddr('isc_service_start'); {do not localize}
390 isc_decode_sql_date := GetProcAddr('isc_decode_sql_date'); {do not localize}
391 isc_decode_sql_time := GetProcAddr('isc_decode_sql_time'); {do not localize}
392 isc_decode_timestamp := GetProcAddr('isc_decode_timestamp'); {do not localize}
393 isc_encode_sql_date := GetProcAddr('isc_encode_sql_date'); {do not localize}
394 isc_encode_sql_time := GetProcAddr('isc_encode_sql_time'); {do not localize}
395 isc_encode_timestamp := GetProcAddr('isc_encode_timestamp'); {do not localize}
396 end else
397 begin
398 FIBServiceAPIPresent := false;
399 isc_rollback_retaining := @isc_rollback_retaining_stub;
400 isc_service_attach := @isc_service_attach_stub;
401 isc_service_detach := @isc_service_detach_stub;
402 isc_service_query := @isc_service_query_stub;
403 isc_service_start := @isc_service_start_stub;
404 isc_decode_sql_date := @isc_decode_sql_date_stub;
405 isc_decode_sql_time := @isc_decode_sql_time_stub;
406 isc_decode_timestamp := @isc_decode_timestamp_stub;
407 isc_encode_sql_date := @isc_encode_sql_date_stub;
408 isc_encode_sql_time := @isc_encode_sql_time_stub;
409 isc_encode_timestamp := @isc_encode_timestamp_stub;
410 end;
411 end;
412
413 constructor TFB25ClientAPI.Create;
414 begin
415 inherited;
416 FStatus := TFB25Status.Create(self);
417 FStatusIntf := FStatus;
418 Firebird25ClientAPI := self;
419 end;
420
421 destructor TFB25ClientAPI.Destroy;
422 begin
423 FStatusIntf := nil;
424 Firebird25ClientAPI := nil;
425 inherited Destroy;
426 end;
427
428
429 function TFB25ClientAPI.StatusVector: PISC_STATUS;
430 begin
431 Result := PISC_STATUS(FStatus.StatusVector);
432 end;
433
434 function TFB25ClientAPI.GetStatus: IStatus;
435 begin
436 Result := FStatus;
437 end;
438
439 function TFB25ClientAPI.AllocateDPB: IDPB;
440 begin
441 Result := TDPB.Create;
442 end;
443
444 function TFB25ClientAPI.OpenDatabase(DatabaseName: string; DPB: IDPB;
445 RaiseExceptionOnConnectError: boolean): IAttachment;
446 begin
447 Result := TFB25Attachment.Create(DatabaseName,DPB,RaiseExceptionOnConnectError);
448 if not Result.IsConnected then
449 Result := nil;
450 end;
451
452 function TFB25ClientAPI.CreateDatabase(DatabaseName: string; DPB: IDPB;
453 RaiseExceptionOnError: boolean): IAttachment;
454 begin
455 Result := TFB25Attachment.CreateDatabase(DatabaseName, DPB, RaiseExceptionOnError );
456 if (Result <> nil) and not Result.IsConnected then
457 Result := nil;
458 end;
459
460 function TFB25ClientAPI.CreateDatabase(sql: string; aSQLDialect: integer;
461 RaiseExceptionOnError: boolean): IAttachment;
462 begin
463 Result := TFB25Attachment.CreateDatabase(sql,aSQLDialect, RaiseExceptionOnError );
464 if (Result <> nil) and not Result.IsConnected then
465 Result := nil;
466 end;
467
468 function TFB25ClientAPI.AllocateSPB: ISPB;
469 begin
470 Result := TSPB.Create;
471 end;
472
473 function TFB25ClientAPI.AllocateTPB: ITPB;
474 begin
475 Result := TTPB.Create;
476 end;
477
478 function TFB25ClientAPI.GetServiceManager(ServerName: string;
479 Protocol: TProtocol; SPB: ISPB): IServiceManager;
480 begin
481 if HasServiceAPI then
482 Result := TFB25ServiceManager.Create(ServerName,Protocol,SPB)
483 else
484 Result := nil;
485 end;
486
487 function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
488 TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
489 begin
490 Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion);
491 end;
492
493 function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
494 TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
495 begin
496 Result := TFB25Transaction.Create(Attachments,TPB,DefaultCompletion);
497 end;
498
499 function TFB25ClientAPI.HasServiceAPI: boolean;
500 begin
501 Result := IBServiceAPIPresent;
502 end;
503
504 function TFB25ClientAPI.HasRollbackRetaining: boolean;
505 begin
506 Result := assigned(isc_rollback_retaining);
507 end;
508
509 function TFB25ClientAPI.IsEmbeddedServer: boolean;
510 begin
511 Result := false;
512 {$IFDEF UNIX}
513 Result := Pos('libfbembed',FFBLibraryName) = 1;
514 {$ENDIF}
515 {$IFDEF WINDOWS}
516 Result := CompareText(FFBLibraryName,FIREBIRD_EMBEDDED) = 0;
517 {$ENDIF}
518 end;
519
520 function TFB25ClientAPI.HasMasterIntf: boolean;
521 begin
522 Result := false;
523 end;
524
525 function TFB25ClientAPI.GetIMaster: TObject;
526 begin
527 Result := nil;
528 end;
529
530 function TFB25ClientAPI.GetImplementationVersion: string;
531 begin
532 Result := FBClientInterfaceVersion;
533 end;
534
535 function TFB25ClientAPI.DecodeInteger(bufptr: PChar; len: short): integer;
536 begin
537 Result := isc_portable_integer(bufptr,len);
538 end;
539
540 procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PChar);
541 var
542 tm_date: TCTimeStructure;
543 Yr, Mn, Dy: Word;
544 begin
545 DecodeDate(aDate, Yr, Mn, Dy);
546 with tm_date do begin
547 tm_sec := 0;
548 tm_min := 0;
549 tm_hour := 0;
550 tm_mday := Dy;
551 tm_mon := Mn - 1;
552 tm_year := Yr - 1900;
553 end;
554 isc_encode_sql_date(@tm_date, PISC_DATE(bufptr));
555 end;
556
557 function TFB25ClientAPI.SQLDecodeDate(bufptr: PChar): TDateTime;
558 var
559 tm_date: TCTimeStructure;
560 begin
561 isc_decode_sql_date(PISC_DATE(bufptr), @tm_date);
562 try
563 result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
564 Word(tm_date.tm_mday));
565 except
566 on E: EConvertError do begin
567 IBError(ibxeInvalidDataConversion, [nil]);
568 end;
569 end;
570 end;
571
572 procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PChar);
573 var
574 tm_date: TCTimeStructure;
575 Hr, Mt, S, Ms: Word;
576 begin
577 DecodeTime(aTime, Hr, Mt, S, Ms);
578 with tm_date do begin
579 tm_sec := S;
580 tm_min := Mt;
581 tm_hour := Hr;
582 tm_mday := 0;
583 tm_mon := 0;
584 tm_year := 0;
585 end;
586 with Firebird25ClientAPI do
587 isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
588 if Ms > 0 then
589 Inc(PISC_TIME(bufptr)^,Ms*10);
590 end;
591
592 function TFB25ClientAPI.SQLDecodeTime(bufptr: PChar): TDateTime;
593 var
594 tm_date: TCTimeStructure;
595 msecs: Word;
596 begin
597 isc_decode_sql_time(PISC_TIME(bufptr), @tm_date);
598 try
599 msecs := (PISC_TIME(bufptr)^ mod 10000) div 10;
600 result := EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
601 Word(tm_date.tm_sec), msecs)
602 except
603 on E: EConvertError do begin
604 IBError(ibxeInvalidDataConversion, [nil]);
605 end;
606 end;
607 end;
608
609 procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PChar);
610 var
611 tm_date: TCTimeStructure;
612 Yr, Mn, Dy, Hr, Mt, S, Ms: Word;
613 begin
614 DecodeDate(aDateTime, Yr, Mn, Dy);
615 DecodeTime(aDateTime, Hr, Mt, S, Ms);
616 with tm_date do begin
617 tm_sec := S;
618 tm_min := Mt;
619 tm_hour := Hr;
620 tm_mday := Dy;
621 tm_mon := Mn - 1;
622 tm_year := Yr - 1900;
623 end;
624 isc_encode_date(@tm_date, PISC_QUAD(bufptr));
625 if Ms > 0 then
626 Inc(PISC_TIMESTAMP(bufptr)^.timestamp_time,Ms*10);
627 end;
628
629 function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PChar): TDateTime;
630 var
631 tm_date: TCTimeStructure;
632 msecs: Word;
633 begin
634 isc_decode_date(PISC_QUAD(bufptr), @tm_date);
635 try
636 result := EncodeDate(Word(tm_date.tm_year + 1900), Word(tm_date.tm_mon + 1),
637 Word(tm_date.tm_mday));
638 msecs := (PISC_TIMESTAMP(bufptr)^.timestamp_time mod 10000) div 10;
639 if result >= 0 then
640 result := result + EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
641 Word(tm_date.tm_sec), msecs)
642 else
643 result := result - EncodeTime(Word(tm_date.tm_hour), Word(tm_date.tm_min),
644 Word(tm_date.tm_sec), msecs)
645 except
646 on E: EConvertError do begin
647 IBError(ibxeInvalidDataConversion, [nil]);
648 end;
649 end;
650 end;
651
652 end.
653