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: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 24731 byte(s)
Log Message: 
Committing updates for Release R2-0-0

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