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, 3 months ago) by tony
Content type: text/x-pascal
File size: 26069 byte(s)
Log Message:
Fixes Merged

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 {$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 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 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 {$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 isc_version: Tisc_Version;
169
170 public
171 {Helper Functions}
172 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
180 public
181 {IFirebirdAPI}
182
183 {Database connections}
184 function AllocateDPB: IDPB;
185 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
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 function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
200 function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
201
202 {Information}
203 function GetStatus: IStatus; override;
204 function HasRollbackRetaining: boolean;
205 function IsEmbeddedServer: boolean; override;
206 function GetImplementationVersion: AnsiString;
207
208 {Firebird 3 API}
209 function HasMasterIntf: boolean;
210 function GetIMaster: TObject;
211
212 end;
213
214 implementation
215
216 uses FBMessages,
217 {$IFDEF WINDOWS}Windows, {$ENDIF}
218 {$IFDEF FPC} Dynlibs, {$ENDIF}
219 FB25Attachment, FB25Transaction, FB25Services, FBParamBlock,
220 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 isc_arg3 : PAnsiChar;
234 service_handle : PISC_SVC_HANDLE;
235 isc_arg5 : UShort;
236 isc_arg6 : PAnsiChar):
237 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 isc_arg5 : PAnsiChar;
256 isc_arg6 : UShort;
257 isc_arg7 : PAnsiChar;
258 isc_arg8 : UShort;
259 isc_arg9 : PAnsiChar):
260 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 isc_arg5 : PAnsiChar):
271 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 { TFB25ActivityReporter }
325
326 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 function TFB25ClientAPI.LoadInterface: boolean;
342 begin
343 Result := inherited LoadInterface;
344 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 isc_version := GetProcAddr('isc_version'); {do not localize}
389
390 FIBServiceAPIPresent := true;
391 isc_rollback_retaining := GetProcAddress(FFBLibrary.IBLibrary, 'isc_rollback_retaining'); {do not localize}
392 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 Result := Result and assigned(isc_attach_database);
420 end;
421
422 function TFB25ClientAPI.GetAPI: IFirebirdAPI;
423 begin
424 Result := self;
425 end;
426
427 constructor TFB25ClientAPI.Create(aFBLibrary: TFBLibrary);
428 begin
429 inherited Create(aFBLibrary);
430 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 Result := TDPB.Create(self);
454 end;
455
456 function TFB25ClientAPI.OpenDatabase(DatabaseName: AnsiString; DPB: IDPB;
457 RaiseExceptionOnConnectError: boolean): IAttachment;
458 begin
459 Result := TFB25Attachment.Create(self,DatabaseName,DPB,RaiseExceptionOnConnectError);
460 if not Result.IsConnected then
461 Result := nil;
462 end;
463
464 function TFB25ClientAPI.CreateDatabase(DatabaseName: AnsiString; DPB: IDPB;
465 RaiseExceptionOnError: boolean): IAttachment;
466 begin
467 Result := TFB25Attachment.CreateDatabase(self,DatabaseName, DPB, RaiseExceptionOnError );
468 if (Result <> nil) and not Result.IsConnected then
469 Result := nil;
470 end;
471
472 function TFB25ClientAPI.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
473 RaiseExceptionOnError: boolean): IAttachment;
474 begin
475 Result := TFB25Attachment.CreateDatabase(self,sql,aSQLDialect, RaiseExceptionOnError );
476 if (Result <> nil) and not Result.IsConnected then
477 Result := nil;
478 end;
479
480 function TFB25ClientAPI.AllocateSPB: ISPB;
481 begin
482 Result := TSPB.Create(self);
483 end;
484
485 function TFB25ClientAPI.AllocateTPB: ITPB;
486 begin
487 Result := TTPB.Create(self);
488 end;
489
490 function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
491 Protocol: TProtocol; SPB: ISPB): IServiceManager;
492 begin
493 if HasServiceAPI then
494 Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB)
495 else
496 Result := nil;
497 end;
498
499 function TFB25ClientAPI.GetServiceManager(ServerName: AnsiString;
500 Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager;
501 begin
502 if HasServiceAPI then
503 Result := TFB25ServiceManager.Create(self,ServerName,Protocol,SPB,Port)
504 else
505 Result := nil;
506 end;
507
508 function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
509 TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction;
510 begin
511 Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
512 end;
513
514 function TFB25ClientAPI.StartTransaction(Attachments: array of IAttachment;
515 TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction;
516 begin
517 Result := TFB25Transaction.Create(self,Attachments,TPB,DefaultCompletion);
518 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 Result := Pos('libfbembed',FFBLibrary.GetLibraryName) = 1;
535 {$ENDIF}
536 {$IFDEF WINDOWS}
537 Result := CompareText(FFBLibrary.GetLibraryName,FIREBIRD_EMBEDDED) = 0;
538 {$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 function TFB25ClientAPI.GetImplementationVersion: AnsiString;
552 begin
553 Result := FBClientInterfaceVersion;
554 end;
555
556 function TFB25ClientAPI.DecodeInteger(bufptr: PByte; len: short): integer;
557 begin
558 Result := isc_portable_integer(bufptr,len);
559 end;
560
561 procedure TFB25ClientAPI.SQLEncodeDate(aDate: TDateTime; bufptr: PByte);
562 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 function TFB25ClientAPI.SQLDecodeDate(bufptr: PByte): TDateTime;
579 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 procedure TFB25ClientAPI.SQLEncodeTime(aTime: TDateTime; bufptr: PByte);
594 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 isc_encode_sql_time(@tm_date, PISC_TIME(bufptr));
608 if Ms > 0 then
609 Inc(PISC_TIME(bufptr)^,Ms*10);
610 end;
611
612 function TFB25ClientAPI.SQLDecodeTime(bufptr: PByte): TDateTime;
613 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 procedure TFB25ClientAPI.SQLEncodeDateTime(aDateTime: TDateTime; bufptr: PByte);
630 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 function TFB25ClientAPI.SQLDecodeDateTime(bufptr: PByte): TDateTime;
650 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