ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/IB.pas
Revision: 371
Committed: Wed Jan 5 15:21:22 2022 UTC (2 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 68989 byte(s)
Log Message:
Beta Release 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 IB;
63 {$IFDEF MSWINDOWS}
64 {$DEFINE WINDOWS}
65 {$ENDIF}
66
67 {$IFDEF FPC}
68 {$mode delphi}
69 {$codepage UTF8}
70 {$interfaces COM}
71 {$IF defined(FPC) and (FPC_FULLVERSION < 30000) }
72 {$ERROR FPC Version 3.0.0 or later is required}
73 {$IFEND}
74 {$ENDIF}
75
76 {$IFNDEF LEGACYFIREBIRDAPIONLY}
77 {$DEFINE USEFIREBIRD3API}
78 {$ENDIF}
79 {$IFNDEF FIREBIRD3APIONLY}
80 {$DEFINE USELEGACYFIREBIRDAPI}
81 {$ENDIF}
82
83 {
84 This unit defines the interfaces used to provide the Pascal Language
85 bindings for the Firebird API. These are COM style references counted interfaces
86 and are automatically freed when they go out of scope.
87
88 The interface definition is independent of the Firebird API version and two
89 implementations are provided. One is for the legacy API (2.5 and earlier) and the
90 other is for the new object orientated API (3.0 and later). By default, both are
91 available with the 3.0 API used if it is available. Otherwise the 2.5 API is used.
92 The above two defines can be used to force only one implementation by undefining
93 the symbol for the unwanted API.
94
95 Note that the FirebirdAPI function defined below is used for initial access to
96 the language bindings.
97
98 The goals of these Pascal Langauge bindings are to provide:
99
100 1. A set of reference counted interfaces providing complete access to the Firebird API.
101
102 2. Application Independence from the Firebird API version.
103
104 3. All data access through strongly typed variables and functions with no need for
105 the end user to manipulate untyped data in buffers such as the legacy API SQLDA
106 or the Firebird 3.0 message buffer.
107
108 4. A stable platform for LCL Packages (e.g. IBX) that implement the TDataSet model
109 with independence from the Firebird API version.
110
111 5. Straightforward progammatic access to the Firebird API from Pascal programs.
112
113 6. FPC and Delphi Support.
114
115 String Types
116 ============
117
118 From FPC 3.0 onwards, ANSISTRINGs include the codepage in their definition. All
119 strings used by the interface are sensitive to the codepage in that the codepage
120 for all strings returned by an interface is consistent with the SQL Character set
121 used for the database connection. Input strings will be transliterated, where possible
122 and if necessary, to the codepage consistent with the character set used for
123 the database connection.
124 }
125
126 interface
127
128 uses
129 Classes,
130 {$IFDEF WINDOWS}Windows, {$ENDIF}
131 {$IFDEF FPC} Dynlibs, {$ENDIF}
132 SysUtils, DB, FBMessages, IBExternals, FmtBcd;
133
134 const
135 {Interface version information}
136 FBIntf_Major = 1;
137 FBIntf_Minor = 4;
138 FBIntf_Release = 0;
139 FBIntf_Version = '1.4.0';
140
141 const
142 {DPB, TPB and SPB Parameter Block Name Prefixes}
143 DPBPrefix = 'isc_dpb_';
144 TPBPrefix = 'isc_tpb_';
145
146 const
147 {Time Zone ID constraint}
148 MaxOffsetTimeZoneID = 2879; {lower values represent a time zone offset between
149 -23:59 and 23:59. Higher values are keys to the
150 Time Zone database.}
151
152 TimeZoneID_GMT = 23*minsPerHour + 59;
153 decimillisecondsPerSecond = 10000;
154 TimeZoneDisplacementDelta = 60*23 + 59; {23:59 in minutes}
155
156 {These include files are converted from the 'C' originals in the Firebird API
157 and define the various constants used by the API}
158
159 {$I 'include/consts_pub.inc'}
160 {$I 'include/dyn_consts.inc'}
161 {$I 'include/inf_pub.inc'}
162 {$I 'include/configkeys.inc'}
163 {$I 'include/blr.inc'}
164
165 {The following constants define the values return by calls to the GetSQLType
166 methods provided by several of the interfaces defined below.}
167
168 (*********************)
169 (** SQL definitions **)
170 (*********************)
171 SQL_VARYING = 448;
172 SQL_TEXT = 452;
173 SQL_DOUBLE = 480;
174 SQL_FLOAT = 482;
175 SQL_LONG = 496;
176 SQL_SHORT = 500;
177 SQL_TIMESTAMP = 510;
178 SQL_BLOB = 520;
179 SQL_D_FLOAT = 530;
180 SQL_ARRAY = 540;
181 SQL_QUAD = 550;
182 SQL_TYPE_TIME = 560;
183 SQL_TYPE_DATE = 570;
184 SQL_INT64 = 580;
185 SQL_TIMESTAMP_TZ_EX = 32748;
186 SQL_TIME_TZ_EX = 32750;
187 SQL_INT128 = 32752;
188 SQL_BOOLEAN = 32764;
189 SQL_TIMESTAMP_TZ = 32754;
190 SQL_TIME_TZ = 32756;
191 SQL_DEC_FIXED = 32758; {FB4 Beta 1 only}
192 SQL_DEC16 = 32760;
193 SQL_DEC34 = 32762;
194 SQL_NULL = 32766;
195 SQL_DATE = SQL_TIMESTAMP;
196
197 type
198 TGDS_QUAD = record
199 gds_quad_high : ISC_LONG;
200 gds_quad_low : UISC_LONG;
201 end;
202 TGDS__QUAD = TGDS_QUAD;
203 TISC_QUAD = TGDS_QUAD;
204 PGDS_QUAD = ^TGDS_QUAD;
205 PGDS__QUAD = ^TGDS__QUAD;
206 PISC_QUAD = ^TISC_QUAD;
207
208 {$IFNDEF FPC}
209 {Delphi missing definitions}
210 type
211 TLibHandle = THandle;
212
213 const
214 NilHandle = 0;
215 DirectorySeparator = '\';
216
217 {Delphi only seems to define CP_UTF8 and CP_UTF16}
218 const
219 CP_ACP = 0; // default to ANSI code page
220 CP_OEMCP = 1; // default to OEM (console) code page
221 CP_UTF16BE = 1201; // unicodeFFFE
222 CP_UTF7 = 65000; // utf-7
223 CP_ASCII = 20127; // us-ascii
224 CP_NONE = $FFFF; // rawbytestring encoding
225
226 {$ENDIF}
227
228 type
229 {$IF not declared(TSystemCodePage)}
230 TSystemCodePage = word; {not defined in Delphi}
231 {$IFEND}
232
233 TIBSQLStatementTypes =
234 (SQLUnknown, SQLSelect, SQLInsert,
235 SQLUpdate, SQLDelete, SQLDDL,
236 SQLGetSegment, SQLPutSegment,
237 SQLExecProcedure, SQLStartTransaction,
238 SQLCommit, SQLRollback,
239 SQLSelectForUpdate, SQLSetGenerator,
240 SQLSavePoint);
241
242 TFBStatusCode = cardinal;
243 TByteArray = array of byte;
244 TFBTimeZoneID = ISC_USHORT;
245
246 IFirebirdAPI = interface;
247 IAttachment = interface;
248 ITransaction = interface;
249 IStatement = interface;
250
251 {The IFBNumeric interface provides a managed type for Fixed Point integers
252 used to hold Firebird Numeric(m,n) types}
253
254 IFBNumeric = interface
255 ['{8bdccfe9-d552-446b-bd82-844ca264455d}']
256 function getRawValue: Int64;
257 function getScale: integer;
258 function clone(aNewScale: integer): IFBNumeric;
259 function getAsString: AnsiString;
260 function getAsDouble: double;
261 function getAsBCD: TBCD;
262 function getAsInt64: Int64; {scaled}
263 function getAsInteger: integer; {scaled - may be truncated}
264 function getAsSmallInt: SmallInt; {scaled - may be truncated}
265 function getAsCurrency: Currency;
266 end;
267
268 {The IParameterBlock interface provides the template for all parameter
269 block interfaces}
270
271 IParameterBlock<_IItem> = interface
272 function getCount: integer;
273 function Add(ParamType: byte): _IItem;
274 function getItems(index: integer): _IItem;
275 function Find(ParamType: byte): _IItem;
276 procedure PrintBuf; {can be used to print buffer in hex for debugging}
277 property Count: integer read getCount;
278 property Items[index: integer]: _IItem read getItems; default;
279 end;
280
281 IParameterBlockWithTypeNames<_IItem> = interface(IParameterBlock<_IItem>)
282 function AddByTypeName(ParamTypeName: AnsiString): _IItem;
283 function GetDPBParamTypeName(ParamType: byte): Ansistring; deprecated 'Use Get ParamTypeName';
284 function GetParamTypeName(ParamType: byte): Ansistring;
285 end;
286
287 {IParameterBlockItem is not used on its own but instead provides a base type for
288 different parameter block items }
289
290 IParameterBlockItem = interface
291 ['{53b23f7b-abda-46a5-9aa5-07bd5e723266}']
292 function getParamType: byte;
293 function getAsInteger: integer;
294 function getAsString: AnsiString;
295 function getAsByte: byte;
296 procedure setAsString(aValue: AnsiString);
297 procedure setAsByte(aValue: byte);
298 procedure SetAsInteger(aValue: integer);
299 property AsString: AnsiString read getAsString write setAsString;
300 property AsByte: byte read getAsByte write setAsByte;
301 property AsInteger: integer read getAsInteger write SetAsInteger;
302 end;
303
304 IParameterBlockItemWithTypeName = interface(IParameterBlockItem)
305 function getParamTypeName: AnsiString;
306 end;
307
308 {The IStatus interface provides access to error information, if any, returned
309 by the last API call. It can also be used to customise the error message
310 returned by a database engine exception - see EIBInterbaseError.
311
312 This interface can be accessed from IFirebirdAPI.
313 }
314
315 TIBDataBaseErrorMessage = (ShowSQLCode,
316 ShowIBMessage,
317 ShowSQLMessage);
318
319 TIBDataBaseErrorMessages = set of TIBDataBaseErrorMessage;
320
321 TStatusCode = long;
322
323 IStatus = interface
324 ['{34167722-af38-4831-b08a-93162d58ede3}']
325 function GetIBErrorCode: TStatusCode;
326 function Getsqlcode: TStatusCode;
327 function GetMessage: AnsiString;
328 function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
329 function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
330 procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
331 end;
332
333 { The array metadata interface provides access to the metadata used to describe
334 an array column in a Firebird table.
335 }
336
337 TArrayBound = record
338 UpperBound: short;
339 LowerBound: short;
340 end;
341 TArrayBounds = array of TArrayBound;
342
343 IArrayMetaData = interface
344 ['{7dd0aea4-59af-4c2a-b958-565d5025c489}']
345 function GetSQLType: cardinal;
346 function GetSQLTypeName: AnsiString;
347 function GetScale: integer;
348 function GetSize: cardinal;
349 function GetCharSetWidth: integer;
350 function GetCharSetID: cardinal;
351 function GetTableName: AnsiString;
352 function GetColumnName: AnsiString;
353 function GetDimensions: integer;
354 function GetBounds: TArrayBounds;
355 end;
356
357 {The array interface provides access to and modification of the array data
358 contained in an array field of a Firebird Table. The array element is
359 selected by specifying its co-ordinates using an integer array. The
360 getter and setter methods used should be appropriate for the type of data
361 contained in the array. Automatic conversion is provided to and from strings.
362 That is GetAsString and SetAsString are safe to use for sql types other than
363 boolean.
364
365 The interface is returned by a GetAsArray getter method (see ISQLData). A new array
366 can be obtained from the IAttachment interface. The SetAsArray setter method
367 (See ISQLParam) is used to apply an updated or new array to the database using
368 an UPDATE or INSERT statement.
369
370 }
371
372 TArrayEventReason = (arChanging,arChanged);
373 IArray = interface;
374 TArrayEventHandler = procedure(Sender: IArray; Reason: TArrayEventReason) of object;
375
376 IArray = interface(IArrayMetaData)
377 ['{631c6bb1-fb49-44fb-a64a-c49859632b88}']
378 function GetArrayID: TISC_QUAD;
379 procedure Clear;
380 function IsEmpty: boolean;
381 procedure PreLoad;
382 procedure CancelChanges;
383 procedure SaveChanges;
384 function GetAsInteger(index: array of integer): integer;
385 function GetAsBoolean(index: array of integer): boolean;
386 function GetAsCurrency(index: array of integer): Currency;
387 function GetAsInt64(index: array of integer): Int64;
388 function GetAsDateTime(index: array of integer): TDateTime; overload;
389 procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
390 procedure GetAsDateTime(index: array of integer; var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
391 procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
392 procedure GetAsTime(index: array of integer; var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
393 function GetAsUTCDateTime(index: array of integer): TDateTime;
394 function GetAsDouble(index: array of integer): Double;
395 function GetAsFloat(index: array of integer): Float;
396 function GetAsLong(index: array of integer): Long;
397 function GetAsShort(index: array of integer): Short;
398 function GetAsString(index: array of integer): AnsiString;
399 function GetAsVariant(index: array of integer): Variant;
400 function GetAsBCD(index: array of integer): tBCD;
401 procedure SetAsInteger(index: array of integer; AValue: integer);
402 procedure SetAsBoolean(index: array of integer; AValue: boolean);
403 procedure SetAsCurrency(index: array of integer; Value: Currency);
404 procedure SetAsInt64(index: array of integer; Value: Int64);
405 procedure SetAsDate(index: array of integer; Value: TDateTime);
406 procedure SetAsDateTime(index: array of integer; Value: TDateTime); overload;
407 procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
408 procedure SetAsDateTime(index: array of integer; aValue: TDateTime; aTimeZone: AnsiString); overload;
409 procedure SetAsTime(index: array of integer; Value: TDateTime); overload;
410 procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
411 procedure SetAsTime(index: array of integer; aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
412 procedure SetAsUTCDateTime(index: array of integer; aUTCTime: TDateTime);
413 procedure SetAsLong(index: array of integer; Value: Long);
414 procedure SetAsDouble(index: array of integer; Value: Double);
415 procedure SetAsFloat(index: array of integer; Value: Float);
416 procedure SetAsShort(index: array of integer; Value: Short);
417 procedure SetAsString(index: array of integer; Value: AnsiString);
418 procedure SetAsVariant(index: array of integer; Value: Variant);
419 procedure SetAsBcd(index: array of integer; aValue: tBCD);
420 procedure SetBounds(dim, UpperBound, LowerBound: integer);
421 function GetAttachment: IAttachment;
422 function GetTransaction: ITransaction;
423 procedure AddEventHandler(Handler: TArrayEventHandler);
424 procedure RemoveEventHandler(Handler: TArrayEventHandler);
425 end;
426
427 { The Blob metadata interface provides access to the metadata used to describe
428 a blob column in a Firebird table.
429 }
430
431 IBlobMetaData = interface
432 ['{575f3c61-bb33-46a5-8975-bb7d1b6e37cc}']
433 function GetSubType: integer;
434 function GetCharSetID: cardinal;
435 function GetCodePage: TSystemCodePage;
436 function GetSegmentSize: cardinal;
437 function GetRelationName: AnsiString;
438 function GetColumnName: AnsiString;
439 end;
440
441 {The Blob Parameter block is used to select a Blob Filter}
442
443 IBPBItem = interface (IParameterBlockItem)
444 ['{660822a5-3114-4c16-b6cb-c1a7b2aba70d}']
445 end;
446
447 IBPB = interface (IParameterBlock<IBPBItem>)
448 ['{e0cb9eb5-17f7-4416-b7d1-3cddd1dfca76}']
449 end;
450
451 { The Blob Interface provides access to a blob data item.
452
453 The interface is returned by a GetAsBlob getter method (see ISQLData). A new Blob
454 can be obtained from the IAttachment interface. The SetAsBlob setter method
455 (See ISQLParam) is used to apply an updated or new array to the database using
456 an UPDATE or INSERT statement.
457 }
458
459 TFBBlobMode = (fbmRead,fbmWrite);
460 TBlobType = (btSegmented,btStream);
461
462 IBlob = interface(IBlobMetaData)
463 ['{3090a145-7780-442b-b15b-efd4568b8611}']
464 function GetBPB: IBPB;
465 procedure Cancel;
466 procedure Close;
467 function GetBlobID: TISC_QUAD;
468 function GetBlobMode: TFBBlobMode;
469 function GetBlobSize: Int64;
470 procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize,
471 TotalSize: Int64; var BlobType: TBlobType);
472 function Read(var Buffer; Count: Longint): Longint;
473 function Write(const Buffer; Count: Longint): Longint;
474 function LoadFromFile(Filename: AnsiString): IBlob;
475 function LoadFromStream(S: TStream) : IBlob;
476 function SaveToFile(Filename: AnsiString): IBlob;
477 function SaveToStream(S: TStream): IBlob;
478 function GetAsString: rawbytestring;
479 procedure SetAsString(aValue: rawbytestring);
480 function SetString(aValue: rawbytestring): IBlob;
481 function GetAttachment: IAttachment;
482 function GetTransaction: ITransaction;
483 property AsString: rawbytestring read GetAsString write SetAsString;
484 end;
485
486 { The IColumnMetaData interface provides access to the per column metadata for
487 the output of an SQL Statement.
488 }
489
490 TIBDateTimeFormats = (dfTimestamp, {SQL TIMESTAMP}
491 dfDateTime, {SQL DATETIME}
492 dfTime, {SQL TIME}
493 dfTimestampTZ, {SQL_TIMESTAMP_TZ}
494 dfTimeTZ); {SQLTIME_TZ
495
496 { IColumnMetaData }
497
498 IColumnMetaData = interface
499 ['{c222e6c3-53c1-469f-9e05-0a5c3ef232d8}']
500 function GetIndex: integer;
501 function GetSQLType: cardinal;
502 function GetSQLTypeName: AnsiString;
503 function getSubtype: integer;
504 function getRelationName: AnsiString;
505 function getOwnerName: AnsiString;
506 function getSQLName: AnsiString; {Name of the column}
507 function getAliasName: AnsiString; {Alias Name of column or Column Name if no alias}
508 function getName: AnsiString; {Disambiguated uppercase Field Name}
509 function getScale: integer;
510 function getCharSetID: cardinal;
511 function getCodePage: TSystemCodePage;
512 function GetCharSetWidth: integer;
513 function getIsNullable: boolean;
514 function GetSize: cardinal;
515 function GetArrayMetaData: IArrayMetaData; {Valid only for Array SQL Type}
516 function GetBlobMetaData: IBlobMetaData; {Valid only for Blob SQL Type}
517 function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
518 function GetStatement: IStatement;
519 function GetTransaction: ITransaction;
520 function GetAttachment: IAttachment;
521 property Name: AnsiString read GetName;
522 property Size: cardinal read GetSize;
523 property SQLType: cardinal read GetSQLType;
524 property Scale: integer read getScale;
525 property SQLSubtype: integer read getSubtype;
526 property IsNullable: Boolean read GetIsNullable;
527 end;
528
529 {
530 The IMetaData interface provides access to the set of column metadata
531 for the output of an SQL Statement
532 }
533
534 { IMetaData }
535
536 IMetaData = interface
537 ['{4dafdbb6-0d36-4f1f-9c95-8b132804b965}']
538 function getCount: integer;
539 function getColumnMetaData(index: integer): IColumnMetaData;
540 function GetUniqueRelationName: AnsiString; {Non empty if all columns come from the same table}
541 function ByName(Idx: AnsiString): IColumnMetaData;
542 property ColMetaData[index: integer]: IColumnMetaData read getColumnMetaData; default;
543 property Count: integer read getCount;
544 end;
545
546 {
547 The ISQLData interface provides access to the data returned in a field in the
548 current row returned from a query or the result of an SQL Execute statement.
549
550 It subclasses IColumnMetaData and so also provides access to the metadata
551 associated with the column.
552
553 The getter and setter methods, and the corresponding properties, provide typed
554 access to the field data. The method/property used should be consistent
555 with the SQL Type. Automatic conversion is provided from strings.
556 That is GetAsString is safe to use for sql types other than boolean.
557 }
558
559
560 ISQLData = interface(IColumnMetaData)
561 ['{3f493e31-7e3f-4606-a07c-b210b9e3619d}']
562 function GetStrDataLength: short;
563 function GetAsBoolean: boolean;
564 function GetAsCurrency: Currency;
565 function GetAsInt64: Int64;
566 function GetAsDateTime: TDateTime; overload;
567 procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
568 procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
569 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
570 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
571 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
572 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
573 function GetAsUTCDateTime: TDateTime;
574 function GetAsDouble: Double;
575 function GetAsFloat: Float;
576 function GetAsLong: Long;
577 function GetAsPointer: Pointer;
578 function GetAsQuad: TISC_QUAD;
579 function GetAsShort: short;
580 function GetAsString: AnsiString;
581 function GetIsNull: Boolean;
582 function GetAsVariant: Variant;
583 function GetAsBlob: IBlob; overload;
584 function GetAsBlob(BPB: IBPB): IBlob; overload;
585 function GetAsArray: IArray;
586 function GetAsBCD: tBCD;
587 function GetAsNumeric: IFBNumeric;
588 property AsDate: TDateTime read GetAsDateTime;
589 property AsBoolean:boolean read GetAsBoolean;
590 property AsTime: TDateTime read GetAsDateTime;
591 property AsDateTime: TDateTime read GetAsDateTime ;
592 property AsDouble: Double read GetAsDouble;
593 property AsFloat: Float read GetAsFloat;
594 property AsCurrency: Currency read GetAsCurrency;
595 property AsInt64: Int64 read GetAsInt64 ;
596 property AsInteger: Integer read GetAsLong;
597 property AsLong: Long read GetAsLong;
598 property AsPointer: Pointer read GetAsPointer;
599 property AsQuad: TISC_QUAD read GetAsQuad;
600 property AsShort: short read GetAsShort;
601 property AsString: AnsiString read GetAsString;
602 property AsVariant: Variant read GetAsVariant ;
603 property AsBlob: IBlob read GetAsBlob;
604 property AsArray: IArray read GetAsArray;
605 property AsBCD: tBCD read GetAsBCD;
606 property AsNumeric: IFBNumeric read GetAsNumeric;
607 property IsNull: Boolean read GetIsNull;
608 property Value: Variant read GetAsVariant;
609 end;
610
611 { An IResults interface is returned as the result of an SQL Execute statement
612 and provides access to the fields returned, if any. It is a collection of
613 ISQLData interfaces which are, in turn, used to access the data returned by
614 each field of the result set.
615 }
616
617 IResults = interface
618 ['{e836b2bb-93d1-4bbf-a8eb-7ce535de3bb5}']
619 function getCount: integer;
620 function GetStatement: IStatement;
621 function GetTransaction: ITransaction;
622 function GetAttachment: IAttachment;
623 function ByName(Idx: AnsiString): ISQLData;
624 function getSQLData(index: integer): ISQLData;
625 procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
626 procedure SetRetainInterfaces(aValue: boolean);
627 property Data[index: integer]: ISQLData read getSQLData; default;
628 property Count: integer read getCount;
629 end;
630
631 { An IResultSet interface is returned as the result of an SQL Open Cursor statement
632 (e.g. Select Statement) and provides access to the fields returned, if any
633 for the current row. It is a collection of ISQLData interfaces which are,
634 in turn, used to access the data returned by each field of the current row.
635 }
636 IResultSet = interface(IResults)
637 ['{0ae4979b-7857-4e8c-8918-ec6f155b51a0}']
638 function FetchNext: boolean; {fetch next record}
639 function FetchPrior: boolean; {fetch previous record}
640 function FetchFirst:boolean; {fetch first record}
641 function FetchLast: boolean; {fetch last record}
642 function FetchAbsolute(position: Integer): boolean; {fetch record by its absolute position in result set}
643 function FetchRelative(offset: Integer): boolean; {fetch record by position relative to current}
644 function GetCursorName: AnsiString;
645 function IsBof: boolean;
646 function IsEof: boolean;
647 procedure Close;
648 end;
649
650 {The ISQLParam interface is used to provide access to each parameter in a
651 parametised SQL Statement. The interface comprises the Setter Methods and properties used to
652 set the value of each parameter.
653
654 Automatic conversion is provided to and from strings. That is GetAsString and
655 SetAsString are safe to use for sql types other than boolean - provided automatic
656 conversion is possible.
657
658 ISQLParam is subclassed from the IParamMetaData interface. This interface provides
659 access to the parameter metadata. This metadata is mutable and can change after
660 a parameter is set to a given value. This is acceptable as long as the parameter
661 metadata is type compatible with the underlying column metadata and hence the
662 parameter value can be converted by Firebird into a value acceptable by the
663 underlying column. The column metadata, which is unmutable, can be obtained
664 by the ISQLParam.getColMetadata interface. When a statement is prepared, the
665 parameter metadata is always initialised to the column metadata.
666 }
667
668 IParamMetaData = interface
669 ['{4e148c4e-2d48-4991-a263-f66eca05c6aa}']
670 function GetSQLType: cardinal;
671 function GetSQLTypeName: AnsiString;
672 function getSubtype: integer;
673 function getScale: integer;
674 function getCharSetID: cardinal;
675 function getCodePage: TSystemCodePage;
676 function getIsNullable: boolean;
677 function GetSize: cardinal;
678 property SQLType: cardinal read GetSQLType;
679 end;
680
681 ISQLParam = interface(IParamMetaData)
682 ['{b22b4578-6d41-4807-a9a9-d2ec8d1d5a14}']
683 function getColMetadata: IParamMetaData;
684 function GetStatement: IStatement;
685 function GetTransaction: ITransaction;
686 function GetAttachment: IAttachment;
687 function GetIndex: integer;
688 function getName: AnsiString;
689 function GetAsBoolean: boolean;
690 function GetAsCurrency: Currency;
691 function GetAsInt64: Int64;
692 function GetAsDateTime: TDateTime; overload;
693 procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
694 procedure GetAsDateTime(var aDateTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
695 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID; OnDate: TDateTime); overload;
696 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString; OnDate: TDateTime); overload;
697 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezoneID: TFBTimeZoneID); overload;
698 procedure GetAsTime(var aTime: TDateTime; var dstOffset: smallint; var aTimezone: AnsiString); overload;
699 function GetAsUTCDateTime: TDateTime;
700 function GetAsDouble: Double;
701 function GetAsFloat: Float;
702 function GetAsLong: Long;
703 function GetAsPointer: Pointer;
704 function GetAsQuad: TISC_QUAD;
705 function GetAsShort: short;
706 function GetAsString: AnsiString;
707 function GetIsNull: boolean;
708 function GetAsVariant: Variant;
709 function GetAsBlob: IBlob;
710 function GetAsArray: IArray;
711 function GetAsBCD: tBCD;
712 function GetAsNumeric: IFBNumeric;
713 procedure Clear;
714 function GetModified: boolean;
715 procedure SetAsBoolean(AValue: boolean);
716 procedure SetAsCurrency(aValue: Currency);
717 procedure SetAsInt64(aValue: Int64);
718 procedure SetAsDate(aValue: TDateTime);
719 procedure SetAsLong(aValue: Long);
720 procedure SetAsTime(aValue: TDateTime); overload;
721 procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
722 procedure SetAsTime(aValue: TDateTime; OnDate: TDateTime; aTimeZone: AnsiString); overload;
723 procedure SetAsTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
724 procedure SetAsTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
725 procedure SetAsDateTime(aValue: TDateTime); overload;
726 procedure SetAsDateTime(aValue: TDateTime; aTimeZoneID: TFBTimeZoneID); overload;
727 procedure SetAsDateTime(aValue: TDateTime; aTimeZone: AnsiString); overload;
728 procedure SetAsUTCDateTime(aUTCTime: TDateTime);
729 procedure SetAsDouble(aValue: Double);
730 procedure SetAsFloat(aValue: Float);
731 procedure SetAsPointer(aValue: Pointer);
732 procedure SetAsShort(aValue: Short);
733 procedure SetAsString(aValue: AnsiString);
734 procedure SetAsVariant(aValue: Variant);
735 procedure SetIsNull(aValue: Boolean);
736 procedure SetAsBlob(aValue: IBlob);
737 procedure SetAsArray(anArray: IArray);
738 procedure SetAsQuad(aValue: TISC_QUAD);
739 procedure SetCharSetID(aValue: cardinal);
740 procedure SetAsBcd(aValue: tBCD);
741 procedure SetAsNumeric(Value: IFBNumeric);
742 property AsDate: TDateTime read GetAsDateTime write SetAsDate;
743 property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
744 property AsTime: TDateTime read GetAsDateTime write SetAsTime;
745 property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
746 property AsDouble: Double read GetAsDouble write SetAsDouble;
747 property AsFloat: Float read GetAsFloat write SetAsFloat;
748 property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
749 property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
750 property AsInteger: Integer read GetAsLong write SetAsLong;
751 property AsLong: Long read GetAsLong write SetAsLong;
752 property AsPointer: Pointer read GetAsPointer write SetAsPointer;
753 property AsShort: Short read GetAsShort write SetAsShort;
754 property AsString: AnsiString read GetAsString write SetAsString;
755 property AsVariant: Variant read GetAsVariant write SetAsVariant;
756 property AsBlob: IBlob read GetAsBlob write SetAsBlob;
757 property AsArray: IArray read GetAsArray write SetAsArray;
758 property AsBCD: tBCD read GetAsBCD write SetAsBCD;
759 property AsNumeric: IFBNumeric read GetAsNumeric write SetAsNumeric;
760 property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
761 property Value: Variant read GetAsVariant write SetAsVariant;
762 property IsNull: Boolean read GetIsNull write SetIsNull;
763 property IsNullable: Boolean read GetIsNullable;
764 property Modified: Boolean read getModified;
765 property Name: AnsiString read GetName;
766 end;
767
768 {
769 The ISQLParams interface provides access to the collection of parameters used
770 for the input to an SQL Statement
771 }
772
773 ISQLParams = interface
774 ['{c6d95ac7-b2b7-461b-b890-afef0acbb077}']
775 function getCount: integer;
776 function getSQLParam(index: integer): ISQLParam;
777 function ByName(Idx: AnsiString): ISQLParam ;
778 function GetModified: Boolean;
779 function GetHasCaseSensitiveParams: Boolean;
780 function GetStatement: IStatement;
781 function GetTransaction: ITransaction;
782 function GetAttachment: IAttachment;
783 procedure Clear;
784 property Modified: Boolean read GetModified;
785 property Params[index: integer]: ISQLParam read getSQLParam; default;
786 property Count: integer read getCount;
787 end;
788
789
790 TPerfStats = (psCurrentMemory, psMaxMemory,
791 psRealTime, psUserTime, psBuffers,
792 psReads, psWrites, psFetches,psDeltaMemory);
793
794 TPerfCounters = array[TPerfStats] of Int64;
795
796 {Batch Query Execution Support}
797
798 TBatchCompletionState = (bcExecuteFailed, bcSuccessNoInfo, bcNoMoreErrors);
799
800 IBatchCompletion = interface
801 ['{9bc3d49d-16d9-4606-94e5-ee987103ad92}']
802 function getTotalProcessed: cardinal;
803 function getState(updateNo: cardinal): TBatchCompletionState;
804 function getStatusMessage(updateNo: cardinal): AnsiString;
805 function getUpdated: integer;
806 function getErrorStatus(var RowNo: integer; var status: IStatus): boolean;
807 end;
808
809 {The IStatement interface provides access to an SQL Statement once it has been
810 initially prepared. The interface is returned from the IAttachment interface.
811 }
812
813 TStatementFlag = (stHasCursor,stRepeatExecute,stScrollable);
814 TStatementFlags = set of TStatementFlag;
815
816 IStatement = interface
817 ['{a260576d-a07d-4a66-b02d-1b72543fd7cf}']
818 function GetMetaData: IMetaData; {Output Metadata}
819 function GetSQLParams: ISQLParams;{Statement Parameters}
820 function GetPlan: AnsiString;
821 function GetRowsAffected(var SelectCount, InsertCount, UpdateCount, DeleteCount: integer): boolean;
822 function GetSQLStatementType: TIBSQLStatementTypes;
823 function GetSQLStatementTypeName: AnsiString;
824 function GetSQLText: AnsiString;
825 function GetProcessedSQLText: AnsiString;
826 function GetSQLDialect: integer;
827 function GetFlags: TStatementFlags;
828 function IsPrepared: boolean;
829 function HasBatchMode: boolean;
830 function IsInBatchMode: boolean;
831 procedure Prepare(aTransaction: ITransaction=nil); overload;
832 procedure Prepare(CursorName: AnsiString; aTransaction: ITransaction=nil); overload;
833 function Execute(aTransaction: ITransaction=nil): IResults;
834 function OpenCursor(aTransaction: ITransaction=nil): IResultSet; overload;
835 function OpenCursor(Scrollable: boolean; aTransaction: ITransaction=nil): IResultSet; overload;
836 function GetAttachment: IAttachment;
837 function GetTransaction: ITransaction;
838 procedure SetRetainInterfaces(aValue: boolean);
839 procedure EnableStatistics(aValue: boolean);
840 function GetPerfStatistics(var stats: TPerfCounters): boolean;
841 {IBatch interface support}
842 procedure AddToBatch;
843 function ExecuteBatch(aTransaction: ITransaction=nil): IBatchCompletion;
844 procedure CancelBatch;
845 function GetBatchCompletion: IBatchCompletion;
846 function GetBatchRowLimit: integer;
847 procedure SetBatchRowLimit(aLimit: integer);
848 {Stale Reference Check}
849 procedure SetStaleReferenceChecks(Enable:boolean); {default true}
850 function GetStaleReferenceChecks: boolean;
851
852 property MetaData: IMetaData read GetMetaData;
853 property SQLParams: ISQLParams read GetSQLParams;
854 property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
855 end;
856
857 ITrInfoItem = interface
858 ['{41455e1a-f84e-4e26-aff0-1a78e8b69cfe}']
859 function getItemType: byte;
860 function getSize: integer;
861 function getAsString: AnsiString;
862 function getAsInteger: int64;
863 procedure DecodeTraIsolation(var IsolationType, RecVersion: byte);
864 end;
865
866 { ITrInformation }
867
868 ITrInformation = interface
869 ['{e6ea4a52-c1a1-44ba-9609-c8bcc7cba7b2}']
870 function GetCount: integer;
871 function GetItem(index: integer): ITrInfoItem;
872 function Find(ItemType: byte): ITrInfoItem;
873 procedure PrintBuf; {can be used to print buffer in hex for debugging}
874 property Count: integer read GetCount;
875 property Items[index: integer]: ITrInfoItem read getItem; default;
876 end;
877
878 {Transaction Parameter Block: (TPB)
879
880 The TPB provides the parameters used when starting a transaction. It is allocated
881 empty by the FirebirdAPI and the parameters are then added to it. Each individual
882 parameter may be accessed by the ITPBItem interface which can be used to set the
883 value, if any, of the parameter.
884
885 The TPB parameters, and the associated symbolic codes and parameter values may be
886 found in the Interbase 6.0 API Guide.
887 }
888
889 ITPBItem = interface(IParameterBlockItemWithTypeName)
890 ['{544c1f2b-7c12-4a87-a4a5-face7ea72671}']
891 end;
892
893 ITPB = interface(IParameterBlockWithTypeNames<ITPBItem>)
894 ['{7369b0ff-defe-437b-81fe-19b211d42d25}']
895 function AsText: AnsiString;
896 end;
897
898 {The ITransactionAction interface provides access to a Transaction once it
899 has been initially started. After a Commit or Rollback, a transaction
900 may be restarted, optinally with a new TPB.
901
902 A multi-database transaction is started from the FirebirdAPI. A single database
903 transaction is started from the IAttachment interface.
904 }
905
906 TTransactionAction = (TARollback, TACommit, TACommitRetaining, TARollbackRetaining);
907 TTransactionCompletion = TARollback.. TACommit;
908
909 ITransaction = interface
910 ['{30928d0e-a9d7-4c61-b7cf-14f4f38abe2a}']
911 function getTPB: ITPB;
912 procedure Start(DefaultCompletion: TTransactionCompletion=taCommit);
913 function GetInTransaction: boolean;
914 function GetIsReadOnly: boolean;
915 function GetTransactionID: integer;
916 function GetJournalingActive(attachment: IAttachment): boolean;
917 function GetDefaultCompletion: TTransactionCompletion;
918 procedure PrepareForCommit; {Two phase commit - stage 1}
919 procedure Commit(Force: boolean=false);
920 procedure CommitRetaining;
921 function HasActivity: boolean;
922 procedure Rollback(Force: boolean=false);
923 procedure RollbackRetaining;
924 function GetAttachmentCount: integer;
925 function GetAttachment(index: integer): IAttachment;
926 function GetTrInformation(Requests: array of byte): ITrInformation; overload;
927 function GetTrInformation(Request: byte): ITrInformation; overload;
928 function GetTransactionName: AnsiString;
929 procedure SetTransactionName(aValue: AnsiString);
930 property InTransaction: boolean read GetInTransaction;
931 property TransactionName: AnsiString read GetTransactionName write SetTransactionName;
932 end;
933
934 { The IEvents Interface is used to handle events from a single database. The
935 interface is allocated from the IAttachment Interface.
936
937 Note that the EventHandler called when an event occurs following AsynWaitForEvent
938 is called in a different thread to the calling program and TThread.Synchronize
939 may be needed to pass the event back to the main thread.
940
941 Neither AsyncWaitForEvent nor WaitForEvent is intended to be thread safe
942 in a multi-threaded environment and should always be called from the main
943 thread.
944 }
945
946 TEventInfo = record
947 EventName: AnsiString;
948 Count: integer;
949 end;
950
951 TEventCounts = array of TEventInfo;
952 IEvents = interface;
953 TEventHandler = procedure(Sender: IEvents) of object;
954
955 { IEvents }
956
957 IEvents = interface
958 ['{6a0be233-ed08-4524-889c-2e45d0c20e5f}']
959 procedure GetEvents(EventNames: TStrings);
960 procedure SetEvents(EventNames: TStrings); overload;
961 procedure SetEvents(EventName: AnsiString); overload;
962 procedure Cancel;
963 function ExtractEventCounts: TEventCounts;
964 procedure WaitForEvent;
965 procedure AsyncWaitForEvent(EventHandler: TEventHandler);
966 function GetAttachment: IAttachment;
967 end;
968
969 TTZTextOptions = (tzOffset, {Time Zone Rendered as an offset to GMT}
970 tzGMT, {No Time Zone. Time part is always rendered in GMT}
971 tzOriginalID); {Time Zone shown as originally entered}
972
973 {The ITimeZoneServices interface provides access to the time zone database
974 used for the attachment. It may be used in support of TIMESTAMP WITH TIME ZONE
975 and TIME WITH TIME ZONE data types.}
976
977 ITimeZoneServices = interface
978 ['{163821f5-ebef-42b9-ac60-8ac4b5c09954}']
979 {utility functions}
980 function TimeZoneID2TimeZoneName(aTimeZoneID: TFBTimeZoneID): AnsiString;
981 function TimeZoneName2TimeZoneID(aTimeZone: AnsiString): TFBTimeZoneID;
982 function LocalTimeToGMT(aLocalTime: TDateTime; aTimeZone: AnsiString): TDateTime; overload;
983 function LocalTimeToGMT(aLocalTime: TDateTime; aTimeZoneID: TFBTimeZoneID): TDateTime; overload;
984 function GMTToLocalTime(aGMTTime: TDateTime; aTimeZone: AnsiString): TDateTime; overload;
985 function GMTToLocalTime(aGMTTime: TDateTime; aTimeZoneID: TFBTimeZoneID): TDateTime; overload;
986 function GetEffectiveOffsetMins(aLocalTime: TDateTime; aTimeZone: AnsiString): integer; overload;
987 function GetEffectiveOffsetMins(aLocalTime: TDateTime; aTimeZoneID: TFBTimeZoneID): integer; overload;
988
989 {Time Zone DB Information}
990 function UsingRemoteTZDB: boolean;
991 procedure SetUseLocalTZDB(useLocalTZDB: boolean);
992 function GetLocalTimeZoneName: AnsiString;
993 function GetLocalTimeZoneID: TFBTimeZoneID;
994 procedure GetTimeZoneInfo(aTimeZone: AnsiString; OnDate: TDateTime;
995 var ZoneOffset, DSTOffset, EffectiveOffset: integer);
996 {Configurable Options}
997 function GetTimeTZDate: TDateTime;
998 procedure SetTimeTZDate(aDate: TDateTime);
999 function GetTZTextOption: TTZTextOptions;
1000 procedure SetTZTextOption(aOptionValue: TTZTextOptions);
1001 end;
1002
1003 {The IDBInformation Interface.
1004
1005 An IDBInformation interface is returned by the IAttachment GetDBInformation
1006 method. The interface provides access to the information requested and
1007 returned by the method.
1008
1009 IDBInformation itself gives access to a collection of IDBInfoItems. Each one
1010 provides information requested, as indicated by the ItemType and the actual
1011 value of the information. In some cases, the returned item is itself a
1012 colletion of IDBInfoItems.
1013
1014 The IDBInformation items, and the associated symbolic codes and parameter values may be
1015 found in the Interbase 6.0 API Guide.
1016 }
1017
1018 TDBOperationCount = record
1019 TableID: UShort;
1020 Count: cardinal;
1021 end;
1022
1023 TDBOperationCounts = array of TDBOperationCount;
1024
1025 IDBInfoItem = interface
1026 ['{eeb97b51-ec0f-473f-9f75-c1721f055fcb}']
1027 function getItemType: byte;
1028 function getSize: integer;
1029 procedure getRawBytes(var Buffer);
1030 function getAsString: AnsiString;
1031 function getAsInteger: int64;
1032 procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: AnsiString);
1033 function getAsBytes: TByteArray;
1034 function getAsDateTime: TDateTime;
1035 procedure DecodeVersionString(var Version: byte; var VersionString: AnsiString);
1036 function getOperationCounts: TDBOperationCounts;
1037 procedure DecodeUserNames(UserNames: TStrings);
1038
1039 {user names only}
1040 function GetCount: integer;
1041 function GetItem(index: integer): IDBInfoItem;
1042 function Find(ItemType: byte): IDBInfoItem;
1043 property AsInteger: int64 read getAsInteger;
1044 property AsString: AnsiString read GetAsString;
1045 property Count: integer read GetCount;
1046 property Items[index: integer]: IDBInfoItem read getItem; default;
1047 end;
1048
1049 { IDBInformation }
1050
1051 IDBInformation = interface
1052 ['{7ac6777f-f0a9-498a-9f5c-4a57a554df81}']
1053 function GetCount: integer;
1054 function GetItem(index: integer): IDBInfoItem;
1055 function Find(ItemType: byte): IDBInfoItem;
1056 procedure PrintBuf; {can be used to print buffer in hex for debugging}
1057 property Count: integer read GetCount;
1058 property Items[index: integer]: IDBInfoItem read getItem; default;
1059 end;
1060
1061 {The Database Information Request Block is used to pass requests for
1062 database information where at least one item requested has a parameter.
1063 At present, this is only fb_info_page_contents which has a single
1064 integer parameter.}
1065
1066 IDIRBItem = interface(IParameterBlockItem)
1067 ['{d34a7511-8435-4a24-81a7-5103d218d234}']
1068 end;
1069
1070 IDIRB = interface(IParameterBlock<IDIRBItem>)
1071 ['{1010e5ac-0a8f-403b-a302-91625e9d9579}']
1072 end;
1073
1074
1075 {The Database Parameter Block (DPB).
1076
1077 The DPB provides the parameters used when connecting to a database. It is allocated
1078 empty by the FirebirdAPI and the parameters are then added to it. Each individual
1079 parameter may be accessed by the IDPBItem interface which can be used to set the
1080 value, if any, of the parameter.
1081
1082 The DPB parameters, and the associated symbolic codes and parameter values may be
1083 found in the Interbase 6.0 API Guide.
1084 }
1085
1086 IDPBItem = interface(IParameterBlockItemWithTypeName)
1087 ['{123d4ad0-087a-4cd1-a344-1b3d03b30673}']
1088 end;
1089
1090 IDPB = interface(IParameterBlockWithTypeNames<IDPBItem>)
1091 ['{e676067b-1cf4-4eba-9256-9724f57e0d16}']
1092 end;
1093
1094 {Journaling options. Default is [joReadWriteTransactions,joModifyQueries] }
1095
1096 TJournalOption = (joReadOnlyTransactions, joReadWriteTransactions,
1097 joModifyQueries, joReadOnlyQueries,joNoServerTable);
1098
1099 TJournalOptions = set of TJournalOption;
1100
1101 {The IAttachment interface provides access to a Database Connection. It may be
1102 used to:
1103
1104 a. Disconnect and reconnect to the database.
1105
1106 b. Start a Transaction on the database
1107
1108 c. Execute directly SQL DDL Statements and others that return no information.
1109
1110 d. OpenCursors (i.e. execute SQL Select statements and return the results)
1111
1112 e. Prepare SQL Statements, returning an IStatement interface for further processing.
1113
1114 f. Provide access to an SQL Event Handler.
1115
1116 g. Access Database Information.
1117
1118 h. Support the handling of Array and Blob data.
1119
1120 Note that SQL statements can be prepared with named parameters (PSQL style).
1121 This then allows the parameters to be accessed by name. The same name can
1122 be used for more than one parameter, allowing a single operation to be used
1123 to set all parameters with the same name.
1124 }
1125
1126 { IAttachment }
1127
1128 IAttachment = interface
1129 ['{466e9b67-9def-4807-b3e7-e08a35e7185c}']
1130 function getFirebirdAPI: IFirebirdAPI;
1131 function getDPB: IDPB;
1132 function AllocateBPB: IBPB;
1133 function AllocateDIRB: IDIRB;
1134 procedure Connect;
1135 procedure Disconnect(Force: boolean=false);
1136 function IsConnected: boolean;
1137 procedure DropDatabase;
1138 function StartTransaction(TPB: array of byte;
1139 DefaultCompletion: TTransactionCompletion=taCommit;
1140 aName: AnsiString=''): ITransaction; overload;
1141 function StartTransaction(TPB: ITPB;
1142 DefaultCompletion: TTransactionCompletion=taCommit;
1143 aName: AnsiString=''): ITransaction; overload;
1144 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; SQLDialect: integer); overload;
1145 procedure ExecImmediate(TPB: array of byte; sql: AnsiString; SQLDialect: integer); overload;
1146 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
1147 procedure ExecImmediate(TPB: array of byte; sql: AnsiString); overload;
1148 function ExecuteSQL(TPB: array of byte; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
1149 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
1150 function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
1151 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
1152 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1153 Scrollable: boolean=false): IResultSet; overload;
1154 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1155 params: array of const): IResultSet; overload;
1156 function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
1157 function OpenCursor(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
1158 params: array of const): IResultSet; overload;
1159 function OpenCursor(transaction: ITransaction; sql: AnsiString;
1160 params: array of const): IResultSet; overload;
1161 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
1162 params: array of const): IResultSet; overload;
1163 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1164 Scrollable: boolean=false): IResultSet; overload;
1165 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
1166 params: array of const): IResultSet; overload;
1167 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; Scrollable: boolean;
1168 params: array of const): IResultSet; overload;
1169 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
1170 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
1171 params: array of const): IResultSet; overload;
1172 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; Scrollable: boolean;
1173 params: array of const): IResultSet; overload;
1174 function OpenCursorAtStart(sql: AnsiString; Scrollable: boolean=false): IResultSet; overload;
1175 function OpenCursorAtStart(sql: AnsiString; Scrollable: boolean;
1176 params: array of const): IResultSet; overload;
1177 function OpenCursorAtStart(sql: AnsiString;
1178 params: array of const): IResultSet; overload;
1179 function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer; CursorName: AnsiString=''): IStatement; overload;
1180 function Prepare(transaction: ITransaction; sql: AnsiString; CursorName: AnsiString=''): IStatement; overload;
1181 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
1182 aSQLDialect: integer; GenerateParamNames: boolean=false;
1183 CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload;
1184 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
1185 GenerateParamNames: boolean=false;
1186 CaseSensitiveParams: boolean = false; CursorName: AnsiString=''): IStatement; overload;
1187
1188 {Events}
1189 function GetEventHandler(Events: TStrings): IEvents; overload;
1190 function GetEventHandler(Event: AnsiString): IEvents; overload;
1191
1192 {Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
1193
1194 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
1195 function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
1196 function CreateBlob(transaction: ITransaction; SubType: integer; CharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
1197 function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
1198 function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
1199 function GetInlineBlobLimit: integer;
1200 procedure SetInlineBlobLimit(limit: integer);
1201
1202 {Array - may use to open existing arrays. However, ISQLData.AsArray is preferred}
1203
1204 function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray; overload;
1205 function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload;
1206 function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
1207 function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
1208 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
1209 Scale: integer; size: cardinal; charSetID: cardinal; dimensions: cardinal;
1210 bounds: TArrayBounds): IArrayMetaData;
1211
1212 {Database Information}
1213 function GetSQLDialect: integer;
1214 function GetAttachmentID: integer;
1215 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
1216 function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
1217 function GetDBInformation(Requests: array of byte): IDBInformation; overload;
1218 function GetDBInformation(Request: byte): IDBInformation; overload;
1219 function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
1220 function GetConnectString: AnsiString;
1221 function GetRemoteProtocol: AnsiString;
1222 function GetAuthenticationMethod: AnsiString;
1223 function GetSecurityDatabase: AnsiString;
1224 function GetODSMajorVersion: integer;
1225 function GetODSMinorVersion: integer;
1226 procedure getFBVersion(version: TStrings);
1227 function HasActivity: boolean;
1228 function HasDecFloatSupport: boolean;
1229 function HasBatchMode: boolean;
1230 function HasScollableCursors: boolean;
1231 function HasTable(aTableName: AnsiString): boolean; {case sensitive}
1232 function HasFunction(aFunctionName: AnsiString): boolean; {case sensitive}
1233 function HasProcedure(aProcName: AnsiString): boolean; {case sensitive}
1234
1235 {Character Sets}
1236 function GetCharSetID: integer; {connection character set}
1237 function HasDefaultCharSet: boolean;
1238 function GetDefaultCharSetID: integer;
1239 function GetCharsetName(CharSetID: integer): AnsiString;
1240 function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
1241 function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
1242 function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
1243 function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
1244 procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
1245 AllowReverseLookup:boolean; out CharSetID: integer);
1246
1247 {Time Zone Database}
1248 function GetTimeZoneServices: ITimeZoneServices;
1249 function HasTimeZoneSupport: boolean;
1250
1251 {Client side Journaling}
1252 function JournalingActive: boolean;
1253 function GetJournalOptions: TJournalOptions;
1254 function StartJournaling(aJournalLogFile: AnsiString): integer; overload;
1255 function StartJournaling(aJournalLogFile: AnsiString; Options: TJournalOptions): integer; overload;
1256 function StartJournaling(S: TStream; Options: TJournalOptions): integer; overload;
1257 procedure StopJournaling(RetainJournal: boolean);
1258 end;
1259
1260 TProtocolAll = (TCP, SPX, NamedPipe, Local, inet, inet4, inet6, wnet, xnet, unknownProtocol);
1261 TProtocol = TCP..xnet;
1262
1263 {Service Parameter Block (SPB).
1264
1265 The SPB provides the parameters used when connecting to a Service Manager. It is
1266 allocated empty by the FirebirdAPI and the parameters are then added to it. Each
1267 individual parameter may be accessed by the ISPBItem interface which can be used
1268 to set the value, if any, of the parameter.
1269
1270 The SPB parameters, and the associated symbolic codes and parameter values may be
1271 found in the Interbase 6.0 API Guide.
1272
1273 }
1274
1275 ISPBItem = interface(IParameterBlockItemWithTypeName)
1276 ['{5d08ae2b-4519-41bd-8b40-97cd451c3f6a}']
1277 end;
1278
1279 ISPB = interface(IParameterBlockWithTypeNames<ISPBItem>)
1280 ['{2c5836fd-41ed-4426-9b7d-5af580ec2659}']
1281 end;
1282
1283 {Service Query Parameter Block (SQPB).
1284
1285 This is a specialised parameter block used to send data to a service manager
1286 in a Query Request.
1287 }
1288
1289 ISQPBItem = interface(IParameterBlockItem)
1290 ['{b07841a6-33b3-47f0-b5a2-028cbc86dc97}']
1291 function CopyFrom(source: TStream; count: integer): integer;
1292 end;
1293
1294 ISQPB = interface(IParameterBlock<ISQPBItem>)
1295 ['{8553e66b-ee62-498b-8431-dff030211447}']
1296 end;
1297
1298 {Service Request Block (SRB).
1299
1300 The SRB specifies what is requested from the Service Manager when starting a
1301 service or querying a service. It is allocated empty by the ServiceManager API and
1302 the parameters are then added to it. Each individual parameter may be accessed
1303 by the ISRBItem interface which can be used to set the value, if any, of the parameter.
1304
1305 The SRB parameters, and the associated symbolic codes and parameter values may be
1306 found in the Interbase 6.0 API Guide.
1307
1308 }
1309
1310 ISRBItem = interface(IParameterBlockItem)
1311 ['{47ec790e-f265-4b30-9dcd-261e51677245}']
1312 end;
1313
1314 ISRB = interface(IParameterBlock<ISRBItem>)
1315 ['{9f2e204f-3c33-4e44-90f9-9135e95dafb9}']
1316 end;
1317
1318 {The Service Query Results Interface.
1319
1320 An IServiceQueryResults interface is returned by the IServiceManager Query
1321 method. The interface provides access to the information requested and
1322 returned by the method.
1323
1324 IServiceQueryResults itself gives access to a collection of IServiceQueryResultItem.
1325 Each one provides information requested, as indicated by the ItemType and the actual
1326 value of the information. In some cases, the returned item is itself a
1327 collection of IServiceQueryResultSubItem.
1328
1329 The IServiceQueryResultItem items, and the associated symbolic codes and parameter values may be
1330 found in the Interbase 6.0 API Guide.
1331 }
1332
1333 IServiceQueryResultSubItem = interface
1334 ['{8a4c381e-9923-4cc9-a96b-553729248640}']
1335 function getItemType: byte;
1336 function getSize: integer;
1337 procedure getRawBytes(var Buffer);
1338 function getAsString: AnsiString;
1339 function getAsInteger: int64;
1340 function getAsByte: byte;
1341 function CopyTo(stream: TStream; count: integer): integer;
1342 property AsString: AnsiString read getAsString;
1343 property AsInteger: int64 read getAsInteger;
1344 property AsByte: byte read getAsByte;
1345 end;
1346
1347 IServiceQueryResultItem = interface(IServiceQueryResultSubItem)
1348 ['{b2806886-206c-4024-8df9-5fe0a7630a5e}']
1349 function getCount: integer;
1350 function getItem(index: integer): IServiceQueryResultSubItem;
1351 function find(ItemType: byte): IServiceQueryResultSubItem;
1352 property Items[index: integer]: IServiceQueryResultSubItem read getItem; default;
1353 property Count: integer read getCount;
1354 end;
1355
1356 IServiceQueryResults = interface
1357 ['{8fbbef7d-fe03-4409-828a-a787d34ef531}']
1358 function getCount: integer;
1359 function getItem(index: integer): IServiceQueryResultItem;
1360 function find(ItemType: byte): IServiceQueryResultItem;
1361 procedure PrintBuf; {can be used to print buffer in hex for debugging}
1362 property Items[index: integer]: IServiceQueryResultItem read getItem; default;
1363 property Count: integer read getCount;
1364 end;
1365
1366 IFirebirdLibrary = interface;
1367
1368 {The IServiceManager interface provides access to a service manager. It can
1369 used to Detach and re-attach to Service Manager, to start services and to
1370 query the service manager.
1371
1372 The interface is returned by the FirebirdAPI GetService Manager method.
1373 }
1374
1375 { IServiceManager }
1376
1377 IServiceManager = interface
1378 ['{905b587d-1e1f-4e40-a3f8-a3519f852e48}']
1379 function getFirebirdAPI: IFirebirdAPI;
1380 function getSPB: ISPB;
1381 function getServerName: AnsiString;
1382 function getProtocol: TProtocol;
1383 function getPortNo: AnsiString;
1384 procedure Attach;
1385 procedure Detach(Force: boolean=false);
1386 function IsAttached: boolean;
1387 function AllocateSRB: ISRB;
1388 function AllocateSQPB: ISQPB;
1389 function Start(Request: ISRB; RaiseExceptionOnError: boolean=true): boolean;
1390 function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true) :IServiceQueryResults; overload;
1391 function Query(Request: ISRB; RaiseExceptionOnError: boolean=true) :IServiceQueryResults; overload;
1392 end;
1393
1394 {Tbe Firebird Library API used to get information about the Firebird library}
1395
1396
1397 IFirebirdLibrary = interface
1398 ['{3c04e0a1-12e0-428a-b2e1-bc6fcd97b79b}']
1399 function GetHandle: TLibHandle;
1400 function GetLibraryName: string;
1401 function GetLibraryFilePath: string;
1402 function GetFirebirdAPI: IFirebirdAPI;
1403 end;
1404
1405 {The Firebird API.
1406
1407 This is the base interface and is used to create/open a database connection, to
1408 start a transaction on multiple databases and the access the service manager.
1409
1410 The interface is returned by the FirebirdAPI function.
1411 }
1412
1413 { IFirebirdAPI }
1414
1415 IFirebirdAPI = interface
1416 ['{edeee691-c8d3-4dcf-a780-cd7e432821d5}']
1417 {Database connections}
1418 function AllocateDPB: IDPB;
1419 function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
1420 function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
1421 function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
1422
1423 {Start Transaction against multiple databases}
1424 function AllocateTPB: ITPB;
1425 function StartTransaction(Attachments: array of IAttachment;
1426 TPB: array of byte; DefaultCompletion: TTransactionCompletion=taCommit;
1427 aName: AnsiString=''): ITransaction; overload;
1428 function StartTransaction(Attachments: array of IAttachment;
1429 TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit;
1430 aName: AnsiString=''): ITransaction; overload;
1431
1432 {Service Manager}
1433 function HasServiceAPI: boolean;
1434 function AllocateSPB: ISPB;
1435 function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
1436 function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
1437
1438 {Information}
1439 function GetStatus: IStatus;
1440 function HasRollbackRetaining: boolean;
1441 function IsEmbeddedServer: boolean;
1442 function GetImplementationVersion: AnsiString;
1443 function GetClientMajor: integer;
1444 function GetClientMinor: integer;
1445 function HasDecFloatSupport: boolean;
1446 function HasLocalTZDB: boolean;
1447 function HasTimeZoneSupport: boolean;
1448 function HasExtendedTZSupport: boolean;
1449
1450 {Firebird 3 API}
1451 function HasMasterIntf: boolean;
1452 function GetIMaster: TObject; deprecated 'Use FirebirdAPI.QueryInterface and FBClientLib.pas IFBIMasterProvider instead';
1453 function GetFBLibrary: IFirebirdLibrary;
1454 end;
1455
1456 type
1457 TOnGetLibraryName = procedure(var libname: string);
1458
1459 const
1460 OnGetLibraryName: TOnGetLibraryName = nil;
1461 AllowUseOfFBLIB: boolean = false;
1462
1463 type
1464 { EIBError }
1465
1466 EIBError = class(EDatabaseError)
1467 private
1468 FSQLCode: Long;
1469 public
1470 constructor Create(ASQLCode: Long; Msg: AnsiString);
1471 property SQLCode: Long read FSQLCode;
1472 end;
1473
1474 { EIBInterBaseError - Firebird Engine errors}
1475
1476 EIBInterBaseError = class(EIBError)
1477 private
1478 FIBErrorCode: Long;
1479 FStatus: IStatus;
1480 public
1481 constructor Create(aStatus: IStatus); overload;
1482 constructor Create(ASQLCode: Long; AIBErrorCode: Long; Msg: AnsiString); overload;
1483 property IBErrorCode: Long read FIBErrorCode;
1484 property Status: IStatus read FStatus;
1485 end;
1486
1487 {IB Client Exceptions}
1488 EIBClientError = class(EIBError);
1489
1490 {Used to explicitly report a Batch Buffer overflow}
1491 EIBBatchBufferOverflow = class(EIBError);
1492
1493 {The Firebird API function is used to access the IFirebirdAPI interface.
1494
1495 It will load the Firebird Client Library if this is not already loaded and
1496 select an implementation of the Firebird API (legacy 2.5 or 3.0.
1497 }
1498
1499 function FirebirdAPI: IFirebirdAPI;
1500
1501 {IBX support functions. Probably best ignored i.e. always used the FirebirdAPI
1502 function to load the library and check if it's loaded.}
1503
1504 function TryIBLoad: Boolean;
1505 procedure CheckIBLoaded;
1506
1507 {If you want to explicitly load the Firebird library from a
1508 non-default location then use this function and its GetFirebirdAPI function
1509 to get the API.}
1510
1511 function LoadFBLibrary(aLibPathName: string): IFirebirdLibrary;
1512
1513 {$if not declared(Null)} {Needed for Delphi}
1514 function Null: Variant; // Null standard constant
1515 {$define NEEDNULLFUNCTION}
1516 {$ifend}
1517
1518 implementation
1519
1520 uses FBClientAPI {$if not declared(NULL)}, Variants {$ifend}
1521 {$IFDEF USELEGACYFIREBIRDAPI}, FB25ClientAPI {$ENDIF}
1522 {$IFDEF USEFIREBIRD3API}, FB30ClientAPI {$ENDIF};
1523
1524 var FDefaultFBLibrary: IFirebirdLibrary;
1525
1526 type
1527
1528 { TFBLibrary }
1529
1530 TFBLibraryImpl = class(TFBLibrary)
1531 protected
1532 function GetFirebird3API: IFirebirdAPI; override;
1533 function GetLegacyFirebirdAPI: IFirebirdAPI; override;
1534 end;
1535
1536 function TFBLibraryImpl.GetFirebird3API: IFirebirdAPI;
1537 begin
1538 {$IFDEF USEFIREBIRD3API}
1539 Result := TFB30ClientAPI.Create(self);
1540 {$ELSE}
1541 Result := nil;
1542 {$ENDIF}
1543 end;
1544
1545 function TFBLibraryImpl.GetLegacyFirebirdAPI: IFirebirdAPI;
1546 begin
1547 {$IFDEF USELEGACYFIREBIRDAPI}
1548 Result := TFB25ClientAPI.Create(self);
1549 {$ELSE}
1550 Result := nil;
1551 {$ENDIF}
1552 end;
1553
1554 function FirebirdAPI: IFirebirdAPI;
1555 begin
1556 if FDefaultFBLibrary = nil then
1557 CheckIBLoaded;
1558 Result := FDefaultFBLibrary.GetFirebirdAPI;
1559 end;
1560
1561 function TryIBLoad: Boolean;
1562 var fblib: IFirebirdLibrary;
1563 begin
1564 Result := FDefaultFBLibrary <> nil;
1565 try
1566 if not Result then
1567 begin
1568 fblib := TFBLibraryImpl.Create;
1569 if (fblib <> nil) and (fblib.GetFirebirdAPI <> nil) then
1570 FDefaultFBLibrary := fblib;
1571 Result := FDefaultFBLibrary <> nil;
1572 end;
1573 except
1574 SysUtils.showexception(ExceptObject,ExceptAddr);
1575 Result := false;
1576 end;
1577 end;
1578
1579 procedure CheckIBLoaded;
1580 begin
1581 if not TryIBLoad then
1582 IBError(ibxeInterBaseMissing, [nil]);
1583 end;
1584
1585 function LoadFBLibrary(aLibPathName: string): IFirebirdLibrary;
1586 var fblib: IFirebirdLibrary;
1587 begin
1588 if trim(aLibPathName) = '' then
1589 begin
1590 CheckIBLoaded;
1591 Result := FDefaultFBLibrary;
1592 end
1593 else
1594 begin
1595 fblib := TFBLibraryImpl.GetFBLibrary(aLibPathName);
1596 if (fblib = nil) or (fblib.GetFirebirdAPI = nil) then
1597 IBError(ibxeInterBaseMissing, [nil]);
1598 Result := fblib;
1599 end;
1600 end;
1601
1602 { EIBError }
1603
1604 constructor EIBError.Create(ASQLCode: Long; Msg: AnsiString);
1605 begin
1606 inherited Create(Msg);
1607 FSQLCode := ASQLCode;
1608 end;
1609
1610 { EIBInterBaseError }
1611
1612 constructor EIBInterBaseError.Create(aStatus: IStatus);
1613 begin
1614 inherited Create(aStatus.Getsqlcode,aStatus.GetMessage);
1615 FIBErrorCode := aStatus.GetIBErrorCode;
1616 FStatus := aStatus;
1617 end;
1618
1619 constructor EIBInterBaseError.Create(ASQLCode: Long; AIBErrorCode: Long;
1620 Msg: AnsiString);
1621 begin
1622 inherited Create(ASQLCode,Msg);
1623 FIBErrorCode := AIBErrorCode;
1624 end;
1625
1626 {$ifdef NEEDNULLFUNCTION}
1627 function Null: Variant; // Null standard constant
1628 begin
1629 VarClearProc(TVarData(Result));
1630 TVarData(Result).VType := varnull;
1631 end;
1632 {$endif}
1633
1634 initialization
1635 FDefaultFBLibrary := nil;
1636
1637 finalization
1638 FDefaultFBLibrary := nil;
1639
1640 end.
1641