ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/IB.pas
Revision: 154
Committed: Tue Feb 27 16:51:42 2018 UTC (6 years, 8 months ago) by tony
Content type: text/x-pascal
File size: 50177 byte(s)
Log Message:
Fixes Merged

File Contents

# Content
1 (*
2 * Firebird Interface (fbintf). The fbintf components provide a set of
3 * Pascal language bindings for the Firebird API. Although predominantly
4 * a new development they include source code taken from IBX and may be
5 * considered a derived product. This software thus also includes the copyright
6 * notice and license conditions from IBX.
7 *
8 * Except for those parts dervied from IBX, contents of this file are subject
9 * to the Initial Developer's Public License Version 1.0 (the "License"); you
10 * may not use this file except in compliance with the License. You may obtain a
11 * copy of the License here:
12 *
13 * http://www.firebirdsql.org/index.php?op=doc&id=idpl
14 *
15 * Software distributed under the License is distributed on an "AS
16 * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
17 * implied. See the License for the specific language governing rights
18 * and limitations under the License.
19 *
20 * The Initial Developer of the Original Code is Tony Whyman.
21 *
22 * The Original Code is (C) 2016 Tony Whyman, MWA Software
23 * (http://www.mwasoftware.co.uk).
24 *
25 * All Rights Reserved.
26 *
27 * Contributor(s): ______________________________________.
28 *
29 *)
30 {************************************************************************}
31 { }
32 { Borland Delphi Visual Component Library }
33 { InterBase Express core components }
34 { }
35 { Copyright (c) 1998-2000 Inprise Corporation }
36 { }
37 { InterBase Express is based in part on the product }
38 { Free IB Components, written by Gregory H. Deatz for }
39 { Hoagland, Longo, Moran, Dunst & Doukas Company. }
40 { Free IB Components is used under license. }
41 { }
42 { The contents of this file are subject to the InterBase }
43 { Public License Version 1.0 (the "License"); you may not }
44 { use this file except in compliance with the License. You }
45 { may obtain a copy of the License at http://www.Inprise.com/IPL.html }
46 { Software distributed under the License is distributed on }
47 { an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either }
48 { express or implied. See the License for the specific language }
49 { governing rights and limitations under the License. }
50 { The Original Code was created by InterBase Software Corporation }
51 { and its successors. }
52 { Portions created by Inprise Corporation are Copyright (C) Inprise }
53 { Corporation. All Rights Reserved. }
54 { Contributor(s): Jeff Overcash }
55 { }
56 { IBX For Lazarus (Firebird Express) }
57 { Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
58 { Portions created by MWA Software are copyright McCallum Whyman }
59 { Associates Ltd 2011 - 2015 }
60 { }
61 {************************************************************************}
62 unit 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 {$DEFINE USEFIREBIRD3API}
77 {$DEFINE USELEGACYFIREBIRDAPI}
78
79 {
80 This unit defines the interfaces used to provide the Pascal Language
81 bindings for the Firebird API. These are COM style references counted interfaces
82 and are automatically freed when they go out of scope.
83
84 The interface definition is independent of the Firebird API version and two
85 implementations are provided. One is for the legacy API (2.5 and earlier) and the
86 other is for the new object orientated API (3.0 and later). By default, both are
87 available with the 3.0 API used if it is available. Otherwise the 2.5 API is used.
88 The above two defines can be used to force only one implementation by undefining
89 the symbol for the unwanted API.
90
91 Note that the FirebirdAPI function defined below is used for initial access to
92 the language bindings.
93
94 The goals of these Pascal Langauge bindings are to provide:
95
96 1. A set of reference counted interfaces providing complete access to the Firebird API.
97
98 2. Application Independence from the Firebird API version.
99
100 3. All data access through strongly typed variables and functions with no need for
101 the end user to manipulate untyped data in buffers such as the legacy API SQLDA
102 or the Firebird 3.0 message buffer.
103
104 4. A stable platform for LCL Packages (e.g. IBX) that implement the TDataSet model
105 with independence from the Firebird API version.
106
107 5. Straightforward progammatic access to the Firebird API from Pascal programs.
108
109 6. FPC and Delphi Support.
110
111 String Types
112 ============
113
114 From FPC 3.0 onwards, ANSISTRINGs include the codepage in their definition. All
115 strings used by the interface are sensitive to the codepage in that the codepage
116 for all strings returned by an interface is consistent with the SQL Character set
117 used for the database connection. Input strings will be transliterated, where possible
118 and if necessary, to the codepage consistent with the character set used for
119 the database connection.
120 }
121
122 interface
123
124 uses
125 Classes, SysUtils, DB, FBMessages, IBExternals;
126
127 const
128 {Interface version information}
129 FBIntf_Major = 1;
130 FBIntf_Minor = 1;
131 FBIntf_Release = 1;
132 FBIntf_Version = '1.1.1';
133
134 {These include files are converted from the 'C' originals in the Firebird API
135 and define the various constants used by the API}
136
137 {$I 'include/consts_pub.inc'}
138 {$I 'include/inf_pub.inc'}
139 {$I 'include/configkeys.inc'}
140
141 {The following constants define the values return by calls to the GetSQLType
142 methods provided by several of the interfaces defined below.}
143
144 (*********************)
145 (** SQL definitions **)
146 (*********************)
147 SQL_VARYING = 448;
148 SQL_TEXT = 452;
149 SQL_DOUBLE = 480;
150 SQL_FLOAT = 482;
151 SQL_LONG = 496;
152 SQL_SHORT = 500;
153 SQL_TIMESTAMP = 510;
154 SQL_BLOB = 520;
155 SQL_D_FLOAT = 530;
156 SQL_ARRAY = 540;
157 SQL_QUAD = 550;
158 SQL_TYPE_TIME = 560;
159 SQL_TYPE_DATE = 570;
160 SQL_INT64 = 580;
161 SQL_BOOLEAN = 32764;
162 SQL_DATE = SQL_TIMESTAMP;
163
164 type
165 TGDS_QUAD = record
166 gds_quad_high : ISC_LONG;
167 gds_quad_low : UISC_LONG;
168 end;
169 TGDS__QUAD = TGDS_QUAD;
170 TISC_QUAD = TGDS_QUAD;
171 PGDS_QUAD = ^TGDS_QUAD;
172 PGDS__QUAD = ^TGDS__QUAD;
173 PISC_QUAD = ^TISC_QUAD;
174
175 {$IFNDEF FPC}
176 {Delphi only seems to define CP_UTF8 and CP_UTF16}
177 const
178 CP_ACP = 0; // default to ANSI code page
179 CP_OEMCP = 1; // default to OEM (console) code page
180 CP_UTF16BE = 1201; // unicodeFFFE
181 CP_UTF7 = 65000; // utf-7
182 CP_ASCII = 20127; // us-ascii
183 CP_NONE = $FFFF; // rawbytestring encoding
184
185 {$ENDIF}
186
187 type
188 {$IF not declared(TSystemCodePage)}
189 TSystemCodePage = word; {not defined in Delphi}
190 {$IFEND}
191
192 TIBSQLStatementTypes =
193 (SQLUnknown, SQLSelect, SQLInsert,
194 SQLUpdate, SQLDelete, SQLDDL,
195 SQLGetSegment, SQLPutSegment,
196 SQLExecProcedure, SQLStartTransaction,
197 SQLCommit, SQLRollback,
198 SQLSelectForUpdate, SQLSetGenerator);
199
200 TFBStatusCode = cardinal;
201 TByteArray = array of byte;
202
203 IAttachment = interface;
204 ITransaction = interface;
205
206 {The IParameterBlock interface provides the template for all parameter
207 block interfaces}
208
209 IParameterBlock<_IItem> = interface
210 function getCount: integer;
211 function Add(ParamType: byte): _IItem;
212 function getItems(index: integer): _IItem;
213 function Find(ParamType: byte): _IItem;
214 procedure PrintBuf; {can be used to print buffer in hex for debugging}
215 property Count: integer read getCount;
216 property Items[index: integer]: _IItem read getItems; default;
217 end;
218
219 {IParameterBlockItem is not used on its own but instead provides a base type for
220 different parameter block items }
221
222 IParameterBlockItem = interface
223 ['{53b23f7b-abda-46a5-9aa5-07bd5e723266}']
224 function getParamType: byte;
225 function getAsInteger: integer;
226 function getAsString: AnsiString;
227 function getAsByte: byte;
228 procedure setAsString(aValue: AnsiString);
229 procedure setAsByte(aValue: byte);
230 procedure SetAsInteger(aValue: integer);
231 property AsString: AnsiString read getAsString write setAsString;
232 property AsByte: byte read getAsByte write setAsByte;
233 property AsInteger: integer read getAsInteger write SetAsInteger;
234 end;
235
236
237 {The IStatus interface provides access to error information, if any, returned
238 by the last API call. It can also be used to customise the error message
239 returned by a database engine exception - see EIBInterbaseError.
240
241 This interface can be accessed from IFirebirdAPI.
242 }
243
244 IStatus = interface
245 ['{34167722-af38-4831-b08a-93162d58ede3}']
246 function GetIBErrorCode: Long;
247 function Getsqlcode: Long;
248 function GetMessage: AnsiString;
249 function CheckStatusVector(ErrorCodes: array of TFBStatusCode): Boolean;
250 function GetIBDataBaseErrorMessages: TIBDataBaseErrorMessages;
251 procedure SetIBDataBaseErrorMessages(Value: TIBDataBaseErrorMessages);
252 end;
253
254 { The array metadata interface provides access to the metadata used to describe
255 an array column in a Firebird table.
256 }
257
258 TArrayBound = record
259 UpperBound: short;
260 LowerBound: short;
261 end;
262 TArrayBounds = array of TArrayBound;
263
264 IArrayMetaData = interface
265 ['{7dd0aea4-59af-4c2a-b958-565d5025c489}']
266 function GetSQLType: cardinal;
267 function GetSQLTypeName: AnsiString;
268 function GetScale: integer;
269 function GetSize: cardinal;
270 function GetCharSetID: cardinal;
271 function GetTableName: AnsiString;
272 function GetColumnName: AnsiString;
273 function GetDimensions: integer;
274 function GetBounds: TArrayBounds;
275 end;
276
277 {The array interface provides access to and modification of the array data
278 contained in an array field of a Firebird Table. The array element is
279 selected by specifying its co-ordinates using an integer array. The
280 getter and setter methods used should be appropriate for the type of data
281 contained in the array. Automatic conversion is provided to and from strings.
282 That is GetAsString and SetAsString are safe to use for sql types other than
283 boolean.
284
285 The interface is returned by a GetAsArray getter method (see ISQLData). A new array
286 can be obtained from the IAttachment interface. The SetAsArray setter method
287 (See ISQLParam) is used to apply an updated or new array to the database using
288 an UPDATE or INSERT statement.
289
290 }
291
292 TArrayEventReason = (arChanging,arChanged);
293 IArray = interface;
294 TArrayEventHandler = procedure(Sender: IArray; Reason: TArrayEventReason) of object;
295
296 IArray = interface(IArrayMetaData)
297 ['{631c6bb1-fb49-44fb-a64a-c49859632b88}']
298 function GetArrayID: TISC_QUAD;
299 procedure Clear;
300 function IsEmpty: boolean;
301 procedure PreLoad;
302 procedure CancelChanges;
303 procedure SaveChanges;
304 function GetAsInteger(index: array of integer): integer;
305 function GetAsBoolean(index: array of integer): boolean;
306 function GetAsCurrency(index: array of integer): Currency;
307 function GetAsInt64(index: array of integer): Int64;
308 function GetAsDateTime(index: array of integer): TDateTime;
309 function GetAsDouble(index: array of integer): Double;
310 function GetAsFloat(index: array of integer): Float;
311 function GetAsLong(index: array of integer): Long;
312 function GetAsShort(index: array of integer): Short;
313 function GetAsString(index: array of integer): AnsiString;
314 function GetAsVariant(index: array of integer): Variant;
315 procedure SetAsInteger(index: array of integer; AValue: integer);
316 procedure SetAsBoolean(index: array of integer; AValue: boolean);
317 procedure SetAsCurrency(index: array of integer; Value: Currency);
318 procedure SetAsInt64(index: array of integer; Value: Int64);
319 procedure SetAsDate(index: array of integer; Value: TDateTime);
320 procedure SetAsLong(index: array of integer; Value: Long);
321 procedure SetAsTime(index: array of integer; Value: TDateTime);
322 procedure SetAsDateTime(index: array of integer; Value: TDateTime);
323 procedure SetAsDouble(index: array of integer; Value: Double);
324 procedure SetAsFloat(index: array of integer; Value: Float);
325 procedure SetAsShort(index: array of integer; Value: Short);
326 procedure SetAsString(index: array of integer; Value: AnsiString);
327 procedure SetAsVariant(index: array of integer; Value: Variant);
328 procedure SetBounds(dim, UpperBound, LowerBound: integer);
329 function GetAttachment: IAttachment;
330 function GetTransaction: ITransaction;
331 procedure AddEventHandler(Handler: TArrayEventHandler);
332 procedure RemoveEventHandler(Handler: TArrayEventHandler);
333 end;
334
335 { The Blob metadata interface provides access to the metadata used to describe
336 a blob column in a Firebird table.
337 }
338
339 IBlobMetaData = interface
340 ['{575f3c61-bb33-46a5-8975-bb7d1b6e37cc}']
341 function GetSubType: integer;
342 function GetCharSetID: cardinal;
343 function GetCodePage: TSystemCodePage;
344 function GetSegmentSize: cardinal;
345 function GetRelationName: AnsiString;
346 function GetColumnName: AnsiString;
347 end;
348
349 {The Blob Parameter block is used to select a Blob Filter}
350
351 IBPBItem = interface (IParameterBlockItem)
352 ['{660822a5-3114-4c16-b6cb-c1a7b2aba70d}']
353 end;
354
355 IBPB = interface (IParameterBlock<IBPBItem>)
356 ['{e0cb9eb5-17f7-4416-b7d1-3cddd1dfca76}']
357 end;
358
359 { The Blob Interface provides access to a blob data item.
360
361 The interface is returned by a GetAsBlob getter method (see ISQLData). A new Blob
362 can be obtained from the IAttachment interface. The SetAsBlob setter method
363 (See ISQLParam) is used to apply an updated or new array to the database using
364 an UPDATE or INSERT statement.
365 }
366
367 TFBBlobMode = (fbmRead,fbmWrite);
368 TBlobType = (btSegmented,btStream);
369
370 IBlob = interface(IBlobMetaData)
371 ['{3090a145-7780-442b-b15b-efd4568b8611}']
372 function GetBPB: IBPB;
373 procedure Cancel;
374 procedure Close;
375 function GetBlobID: TISC_QUAD;
376 function GetBlobMode: TFBBlobMode;
377 function GetBlobSize: Int64;
378 procedure GetInfo(var NumSegments: Int64; var MaxSegmentSize,
379 TotalSize: Int64; var BlobType: TBlobType);
380 function Read(var Buffer; Count: Longint): Longint;
381 function Write(const Buffer; Count: Longint): Longint;
382 function LoadFromFile(Filename: AnsiString): IBlob;
383 function LoadFromStream(S: TStream) : IBlob;
384 function SaveToFile(Filename: AnsiString): IBlob;
385 function SaveToStream(S: TStream): IBlob;
386 function GetAsString: rawbytestring;
387 procedure SetAsString(aValue: rawbytestring);
388 function SetString(aValue: rawbytestring): IBlob;
389 function GetAttachment: IAttachment;
390 function GetTransaction: ITransaction;
391 property AsString: rawbytestring read GetAsString write SetAsString;
392 end;
393
394 { The IColumnMetaData interface provides access to the per column metadata for
395 the output of an SQL Statement.
396 }
397
398 { IColumnMetaData }
399
400 IColumnMetaData = interface
401 ['{c222e6c3-53c1-469f-9e05-0a5c3ef232d8}']
402 function GetIndex: integer;
403 function GetSQLType: cardinal;
404 function GetSQLTypeName: AnsiString;
405 function getSubtype: integer;
406 function getRelationName: AnsiString;
407 function getOwnerName: AnsiString;
408 function getSQLName: AnsiString; {Name of the column}
409 function getAliasName: AnsiString; {Alias Name of column or Column Name if no alias}
410 function getName: AnsiString; {Disambiguated uppercase Field Name}
411 function getScale: integer;
412 function getCharSetID: cardinal;
413 function getCodePage: TSystemCodePage;
414 function getIsNullable: boolean;
415 function GetSize: cardinal;
416 function GetArrayMetaData: IArrayMetaData; {Valid only for Array SQL Type}
417 function GetBlobMetaData: IBlobMetaData; {Valid only for Blob SQL Type}
418 property Name: AnsiString read GetName;
419 property Size: cardinal read GetSize;
420 property SQLType: cardinal read GetSQLType;
421 property Scale: integer read getScale;
422 property SQLSubtype: integer read getSubtype;
423 property IsNullable: Boolean read GetIsNullable;
424 end;
425
426 {
427 The IMetaData interface provides access to the set of column metadata
428 for the output of an SQL Statement
429 }
430
431 { IMetaData }
432
433 IMetaData = interface
434 ['{4dafdbb6-0d36-4f1f-9c95-8b132804b965}']
435 function getCount: integer;
436 function getColumnMetaData(index: integer): IColumnMetaData;
437 function GetUniqueRelationName: AnsiString; {Non empty if all columns come from the same table}
438 function ByName(Idx: AnsiString): IColumnMetaData;
439 property ColMetaData[index: integer]: IColumnMetaData read getColumnMetaData; default;
440 property Count: integer read getCount;
441 end;
442
443 {
444 The ISQLData interface provides access to the data returned in a field in the
445 current row returned from a query or the result of an SQL Execute statement.
446
447 It subclasses IColumnMetaData and so also provides access to the metadata
448 associated with the column.
449
450 The getter and setter methods, and the corresponding properties, provide typed
451 access to the field data. The method/property used should be consistent
452 with the SQL Type. Automatic conversion is provided from strings.
453 That is GetAsString is safe to use for sql types other than boolean.
454 }
455
456
457 ISQLData = interface(IColumnMetaData)
458 ['{3f493e31-7e3f-4606-a07c-b210b9e3619d}']
459 function GetAsBoolean: boolean;
460 function GetAsCurrency: Currency;
461 function GetAsInt64: Int64;
462 function GetAsDateTime: TDateTime;
463 function GetAsDouble: Double;
464 function GetAsFloat: Float;
465 function GetAsLong: Long;
466 function GetAsPointer: Pointer;
467 function GetAsQuad: TISC_QUAD;
468 function GetAsShort: short;
469 function GetAsString: AnsiString;
470 function GetIsNull: Boolean;
471 function GetAsVariant: Variant;
472 function GetAsBlob: IBlob; overload;
473 function GetAsBlob(BPB: IBPB): IBlob; overload;
474 function GetAsArray: IArray;
475 property AsDate: TDateTime read GetAsDateTime;
476 property AsBoolean:boolean read GetAsBoolean;
477 property AsTime: TDateTime read GetAsDateTime;
478 property AsDateTime: TDateTime read GetAsDateTime ;
479 property AsDouble: Double read GetAsDouble;
480 property AsFloat: Float read GetAsFloat;
481 property AsCurrency: Currency read GetAsCurrency;
482 property AsInt64: Int64 read GetAsInt64 ;
483 property AsInteger: Integer read GetAsLong;
484 property AsLong: Long read GetAsLong;
485 property AsPointer: Pointer read GetAsPointer;
486 property AsQuad: TISC_QUAD read GetAsQuad;
487 property AsShort: short read GetAsShort;
488 property AsString: AnsiString read GetAsString;
489 property AsVariant: Variant read GetAsVariant ;
490 property AsBlob: IBlob read GetAsBlob;
491 property AsArray: IArray read GetAsArray;
492 property IsNull: Boolean read GetIsNull;
493 property Value: Variant read GetAsVariant;
494 end;
495
496 { An IResults interface is returned as the result of an SQL Execute statement
497 and provides access to the fields returned, if any. It is a collection of
498 ISQLData interfaces which are, in turn, used to access the data returned by
499 each field of the result set.
500 }
501
502 IResults = interface
503 ['{e836b2bb-93d1-4bbf-a8eb-7ce535de3bb5}']
504 function getCount: integer;
505 function GetTransaction: ITransaction;
506 function ByName(Idx: AnsiString): ISQLData;
507 function getSQLData(index: integer): ISQLData;
508 procedure GetData(index: integer; var IsNull:boolean; var len: short; var data: PByte);
509 procedure SetRetainInterfaces(aValue: boolean);
510 property Data[index: integer]: ISQLData read getSQLData; default;
511 property Count: integer read getCount;
512 end;
513
514 { An IResultSet interface is returned as the result of an SQL Open Cursor statement
515 (e.g. Select Statement) and provides access to the fields returned, if any
516 for the current row. It is a collection of ISQLData interfaces which are,
517 in turn, used to access the data returned by each field of the current row.
518 }
519 IResultSet = interface(IResults)
520 ['{0ae4979b-7857-4e8c-8918-ec6f155b51a0}']
521 function FetchNext: boolean;
522 function GetCursorName: AnsiString;
523 function IsEof: boolean;
524 procedure Close;
525 end;
526
527 {The ISQLParam interface is used to provide access to each parameter in a
528 parametised SQL Statement. It subclasses IColumnMetaData and this part of
529 the interface may be used to access information on the expected SQL Type, etc.
530
531 It also subclasses ISQLData and this part of the interface may be used to access
532 current values for each parameter.
533
534 Otherwise, the interface comprises the Setter Methods and properties used to
535 set the value of each parameter.
536
537 Automatic conversion is provided to and from strings. That is GetAsString and
538 SetAsString are safe to use for sql types other than boolean - provided automatic
539 conversion is possible.
540 }
541
542 ISQLParam = interface
543 ['{b22b4578-6d41-4807-a9a9-d2ec8d1d5a14}']
544 function GetIndex: integer;
545 function GetSQLType: cardinal;
546 function GetSQLTypeName: AnsiString;
547 function getSubtype: integer;
548 function getName: AnsiString;
549 function getScale: integer;
550 function getCharSetID: cardinal;
551 function getCodePage: TSystemCodePage;
552 function getIsNullable: boolean;
553 function GetSize: cardinal;
554 function GetAsBoolean: boolean;
555 function GetAsCurrency: Currency;
556 function GetAsInt64: Int64;
557 function GetAsDateTime: TDateTime;
558 function GetAsDouble: Double;
559 function GetAsFloat: Float;
560 function GetAsLong: Long;
561 function GetAsPointer: Pointer;
562 function GetAsQuad: TISC_QUAD;
563 function GetAsShort: short;
564 function GetAsString: AnsiString;
565 function GetIsNull: boolean;
566 function GetAsVariant: Variant;
567 function GetAsBlob: IBlob;
568 function GetAsArray: IArray;
569 procedure Clear;
570 function GetModified: boolean;
571 procedure SetAsBoolean(AValue: boolean);
572 procedure SetAsCurrency(aValue: Currency);
573 procedure SetAsInt64(aValue: Int64);
574 procedure SetAsDate(aValue: TDateTime);
575 procedure SetAsLong(aValue: Long);
576 procedure SetAsTime(aValue: TDateTime);
577 procedure SetAsDateTime(aValue: TDateTime);
578 procedure SetAsDouble(aValue: Double);
579 procedure SetAsFloat(aValue: Float);
580 procedure SetAsPointer(aValue: Pointer);
581 procedure SetAsShort(aValue: Short);
582 procedure SetAsString(aValue: AnsiString);
583 procedure SetAsVariant(aValue: Variant);
584 procedure SetIsNull(aValue: Boolean);
585 procedure SetAsBlob(aValue: IBlob);
586 procedure SetAsArray(anArray: IArray);
587 procedure SetAsQuad(aValue: TISC_QUAD);
588 procedure SetCharSetID(aValue: cardinal);
589 property AsDate: TDateTime read GetAsDateTime write SetAsDate;
590 property AsBoolean:boolean read GetAsBoolean write SetAsBoolean;
591 property AsTime: TDateTime read GetAsDateTime write SetAsTime;
592 property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
593 property AsDouble: Double read GetAsDouble write SetAsDouble;
594 property AsFloat: Float read GetAsFloat write SetAsFloat;
595 property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
596 property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
597 property AsInteger: Integer read GetAsLong write SetAsLong;
598 property AsLong: Long read GetAsLong write SetAsLong;
599 property AsPointer: Pointer read GetAsPointer write SetAsPointer;
600 property AsShort: Short read GetAsShort write SetAsShort;
601 property AsString: AnsiString read GetAsString write SetAsString;
602 property AsVariant: Variant read GetAsVariant write SetAsVariant;
603 property AsBlob: IBlob read GetAsBlob write SetAsBlob;
604 property AsArray: IArray read GetAsArray write SetAsArray;
605 property AsQuad: TISC_QUAD read GetAsQuad write SetAsQuad;
606 property Value: Variant read GetAsVariant write SetAsVariant;
607 property IsNull: Boolean read GetIsNull write SetIsNull;
608 property IsNullable: Boolean read GetIsNullable;
609 property Modified: Boolean read getModified;
610 property Name: AnsiString read GetName;
611 property SQLType: cardinal read GetSQLType;
612 end;
613
614 {
615 The ISQLParams interface provides access to the collection of parameters used
616 for the input to an SQL Statement
617 }
618
619 ISQLParams = interface
620 ['{c6d95ac7-b2b7-461b-b890-afef0acbb077}']
621 function getCount: integer;
622 function getSQLParam(index: integer): ISQLParam;
623 function ByName(Idx: AnsiString): ISQLParam ;
624 function GetModified: Boolean;
625 property Modified: Boolean read GetModified;
626 property Params[index: integer]: ISQLParam read getSQLParam; default;
627 property Count: integer read getCount;
628 end;
629
630
631 TPerfStats = (psCurrentMemory, psMaxMemory,
632 psRealTime, psUserTime, psBuffers,
633 psReads, psWrites, psFetches,psDeltaMemory);
634
635 TPerfCounters = array[TPerfStats] of comp;
636
637 {The IStatement interface provides access to an SQL Statement once it has been
638 initially prepared. The interface is returned from the IAttachment interface.
639 }
640
641 IStatement = interface
642 ['{a260576d-a07d-4a66-b02d-1b72543fd7cf}']
643 function GetMetaData: IMetaData; {Output Metadata}
644 function GetSQLParams: ISQLParams;{Statement Parameters}
645 function GetPlan: AnsiString;
646 function GetRowsAffected(var SelectCount, InsertCount, UpdateCount, DeleteCount: integer): boolean;
647 function GetSQLStatementType: TIBSQLStatementTypes;
648 function GetSQLText: AnsiString;
649 function GetSQLDialect: integer;
650 function IsPrepared: boolean;
651 procedure Prepare(aTransaction: ITransaction=nil);
652 function Execute(aTransaction: ITransaction=nil): IResults;
653 function OpenCursor(aTransaction: ITransaction=nil): IResultSet;
654 function GetAttachment: IAttachment;
655 function GetTransaction: ITransaction;
656 procedure SetRetainInterfaces(aValue: boolean);
657 procedure EnableStatistics(aValue: boolean);
658 function GetPerfStatistics(var stats: TPerfCounters): boolean;
659 property MetaData: IMetaData read GetMetaData;
660 property SQLParams: ISQLParams read GetSQLParams;
661 property SQLStatementType: TIBSQLStatementTypes read GetSQLStatementType;
662 end;
663
664 {Transaction Parameter Block: (TPB)
665
666 The TPB provides the parameters used when starting a transaction. It is allocated
667 empty by the FirebirdAPI and the parameters are then added to it. Each individual
668 parameter may be accessed by the ITPBItem interface which can be used to set the
669 value, if any, of the parameter.
670
671 The TPB parameters, and the associated symbolic codes and parameter values may be
672 found in the Interbase 6.0 API Guide.
673 }
674
675 ITPBItem = interface(IParameterBlockItem)
676 ['{544c1f2b-7c12-4a87-a4a5-face7ea72671}']
677 end;
678
679 ITPB = interface(IParameterBlock<ITPBItem>)
680 ['{7369b0ff-defe-437b-81fe-19b211d42d25}']
681 end;
682
683 {The ITransactionAction interface provides access to a Transaction once it
684 has been initially started. After a Commit or Rollback, a transaction
685 may be restarted, optinally with a new TPB.
686
687 A multi-database transaction is started from the FirebirdAPI. A single database
688 transaction is started from the IAttachment interface.
689 }
690
691 TTransactionAction = (TARollback, TACommit, TACommitRetaining, TARollbackRetaining);
692 TTransactionCompletion = TARollback.. TACommit;
693
694 ITransaction = interface
695 ['{30928d0e-a9d7-4c61-b7cf-14f4f38abe2a}']
696 function getTPB: ITPB;
697 procedure Start(DefaultCompletion: TTransactionCompletion=taCommit);
698 function GetInTransaction: boolean;
699 procedure PrepareForCommit; {Two phase commit - stage 1}
700 procedure Commit(Force: boolean=false);
701 procedure CommitRetaining;
702 function HasActivity: boolean;
703 procedure Rollback(Force: boolean=false);
704 procedure RollbackRetaining;
705 function GetAttachmentCount: integer;
706 function GetAttachment(index: integer): IAttachment;
707 property InTransaction: boolean read GetInTransaction;
708 end;
709
710 { The IEvents Interface is used to handle events from a single database. The
711 interface is allocated from the IAttachment Interface.
712
713 Note that the EventHandler called when an event occurs following AsynWaitForEvent
714 is called in a different thread to the calling program and TThread.Synchronize
715 may be needed to pass the event back to the main thread.
716
717 Neither AsyncWaitForEvent nor WaitForEvent is intended to be thread safe
718 in a multi-threaded environment and should always be called from the main
719 thread.
720 }
721
722 TEventInfo = record
723 EventName: AnsiString;
724 Count: integer;
725 end;
726
727 TEventCounts = array of TEventInfo;
728 IEvents = interface;
729 TEventHandler = procedure(Sender: IEvents) of object;
730
731 { IEvents }
732
733 IEvents = interface
734 ['{6a0be233-ed08-4524-889c-2e45d0c20e5f}']
735 procedure GetEvents(EventNames: TStrings);
736 procedure SetEvents(EventNames: TStrings); overload;
737 procedure SetEvents(EventName: AnsiString); overload;
738 procedure Cancel;
739 function ExtractEventCounts: TEventCounts;
740 procedure WaitForEvent;
741 procedure AsyncWaitForEvent(EventHandler: TEventHandler);
742 function GetAttachment: IAttachment;
743 end;
744
745 {The IDBInformation Interface.
746
747 An IDBInformation interface is returned by the IAttachment GetDBInformation
748 method. The interface provides access to the information requested and
749 returned by the method.
750
751 IDBInformation itself gives access to a collection of IDBInfoItems. Each one
752 provides information requested, as indicated by the ItemType and the actual
753 value of the information. In some cases, the returned item is itself a
754 colletion of IDBInfoItems.
755
756 The IDBInformation items, and the associated symbolic codes and parameter values may be
757 found in the Interbase 6.0 API Guide.
758 }
759
760 TDBOperationCount = record
761 TableID: UShort;
762 Count: cardinal;
763 end;
764
765 TDBOperationCounts = array of TDBOperationCount;
766
767 IDBInfoItem = interface
768 ['{eeb97b51-ec0f-473f-9f75-c1721f055fcb}']
769 function getItemType: byte;
770 function getSize: integer;
771 procedure getRawBytes(var Buffer);
772 function getAsString: AnsiString;
773 function getAsInteger: integer;
774 procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: AnsiString);
775 function getAsBytes: TByteArray;
776 function getAsDateTime: TDateTime;
777 procedure DecodeVersionString(var Version: byte; var VersionString: AnsiString);
778 function getOperationCounts: TDBOperationCounts;
779 procedure DecodeUserNames(UserNames: TStrings);
780
781 {user names only}
782 function GetCount: integer;
783 function GetItem(index: integer): IDBInfoItem;
784 function Find(ItemType: byte): IDBInfoItem;
785 property AsInteger: integer read getAsInteger;
786 property AsString: AnsiString read GetAsString;
787 property Count: integer read GetCount;
788 property Items[index: integer]: IDBInfoItem read getItem; default;
789 end;
790
791 { IDBInformation }
792
793 IDBInformation = interface
794 ['{7ac6777f-f0a9-498a-9f5c-4a57a554df81}']
795 function GetCount: integer;
796 function GetItem(index: integer): IDBInfoItem;
797 function Find(ItemType: byte): IDBInfoItem;
798 procedure PrintBuf; {can be used to print buffer in hex for debugging}
799 property Count: integer read GetCount;
800 property Items[index: integer]: IDBInfoItem read getItem; default;
801 end;
802
803 {The Database Information Request Block is used to pass requests for
804 database information where at least one item requested has a parameter.
805 At present, this is only fb_info_page_contents which has a single
806 integer parameter.}
807
808 IDIRBItem = interface(IParameterBlockItem)
809 ['{d34a7511-8435-4a24-81a7-5103d218d234}']
810 end;
811
812 IDIRB = interface(IParameterBlock<IDIRBItem>)
813 ['{1010e5ac-0a8f-403b-a302-91625e9d9579}']
814 end;
815
816
817 {The Database Parameter Block (DPB).
818
819 The DPB provides the parameters used when connecting to a database. It is allocated
820 empty by the FirebirdAPI and the parameters are then added to it. Each individual
821 parameter may be accessed by the IDPBItem interface which can be used to set the
822 value, if any, of the parameter.
823
824 The DPB parameters, and the associated symbolic codes and parameter values may be
825 found in the Interbase 6.0 API Guide.
826 }
827
828 IDPBItem = interface(IParameterBlockItem)
829 ['{123d4ad0-087a-4cd1-a344-1b3d03b30673}']
830 end;
831
832 IDPB = interface(IParameterBlock<IDPBItem>)
833 ['{e676067b-1cf4-4eba-9256-9724f57e0d16}']
834 end;
835
836 {The IAttachment interface provides access to a Database Connection. It may be
837 used to:
838
839 a. Disconnect and reconnect to the database.
840
841 b. Start a Transaction on the database
842
843 c. Execute directly SQL DDL Statements and others that return no information.
844
845 d. OpenCursors (i.e. execute SQL Select statements and return the results)
846
847 e. Prepare SQL Statements, returning an IStatement interface for further processing.
848
849 f. Provide access to an SQL Event Handler.
850
851 g. Access Database Information.
852
853 h. Support the handling of Array and Blob data.
854
855 Note that SQL statements can be prepared with named parameters (PSQL style).
856 This then allows the parameters to be accessed by name. The same name can
857 be used for more than one parameter, allowing a single operation to be used
858 to set all parameters with the same name.
859 }
860
861 { IAttachment }
862
863 IAttachment = interface
864 ['{466e9b67-9def-4807-b3e7-e08a35e7185c}']
865 function getDPB: IDPB;
866 function AllocateBPB: IBPB;
867 function AllocateDIRB: IDIRB;
868 procedure Connect;
869 procedure Disconnect(Force: boolean=false);
870 function IsConnected: boolean;
871 procedure DropDatabase;
872 function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion=taCommit): ITransaction; overload;
873 function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit): ITransaction; overload;
874 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; SQLDialect: integer); overload;
875 procedure ExecImmediate(TPB: array of byte; sql: AnsiString; SQLDialect: integer); overload;
876 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
877 procedure ExecImmediate(TPB: array of byte; sql: AnsiString); overload;
878 function ExecuteSQL(TPB: array of byte; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
879 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
880 function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
881 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
882 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
883 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
884 params: array of const): IResultSet; overload;
885 function OpenCursor(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
886 function OpenCursor(transaction: ITransaction; sql: AnsiString;
887 params: array of const): IResultSet; overload;
888 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
889 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
890 params: array of const): IResultSet; overload;
891 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
892 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
893 params: array of const): IResultSet; overload;
894 function OpenCursorAtStart(sql: AnsiString): IResultSet; overload;
895 function OpenCursorAtStart(sql: AnsiString;
896 params: array of const): IResultSet; overload;
897 function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload;
898 function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
899 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
900 aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload;
901 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
902 GenerateParamNames: boolean=false): IStatement; overload;
903
904 {Events}
905 function GetEventHandler(Events: TStrings): IEvents; overload;
906 function GetEventHandler(Event: AnsiString): IEvents; overload;
907
908 {Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
909
910 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
911 function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
912 function CreateBlob(transaction: ITransaction; SubType: integer; CharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
913 function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
914
915 {Array - may use to open existing arrays. However, ISQLData.AsArray is preferred}
916
917 function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
918 function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
919 function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
920 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
921 Scale: integer; size: cardinal; charSetID: cardinal; dimensions: cardinal;
922 bounds: TArrayBounds): IArrayMetaData;
923
924 {Database Information}
925 function GetSQLDialect: integer;
926 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
927 function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
928 function GetDBInformation(Requests: array of byte): IDBInformation; overload;
929 function GetDBInformation(Request: byte): IDBInformation; overload;
930 function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
931 function GetConnectString: AnsiString;
932 function GetRemoteProtocol: AnsiString;
933 function GetAuthenticationMethod: AnsiString;
934 function GetODSMajorVersion: integer;
935 function GetODSMinorVersion: integer;
936 function HasActivity: boolean;
937
938 {Character Sets}
939 function HasDefaultCharSet: boolean;
940 function GetDefaultCharSetID: integer;
941 function GetCharsetName(CharSetID: integer): AnsiString;
942 function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
943 function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
944 function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
945 function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
946 procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
947 AllowReverseLookup:boolean; out CharSetID: integer);
948 end;
949
950 TProtocolAll = (TCP, SPX, NamedPipe, Local, inet, wnet, xnet, unknownProtocol);
951 TProtocol = TCP..xnet;
952
953 {Service Parameter Block (SPB).
954
955 The SPB provides the parameters used when connecting to a Service Manager. It is
956 allocated empty by the FirebirdAPI and the parameters are then added to it. Each
957 individual parameter may be accessed by the ISPBItem interface which can be used
958 to set the value, if any, of the parameter.
959
960 The SPB parameters, and the associated symbolic codes and parameter values may be
961 found in the Interbase 6.0 API Guide.
962
963 }
964
965 ISPBItem = interface(IParameterBlockItem)
966 ['{5d08ae2b-4519-41bd-8b40-97cd451c3f6a}']
967 end;
968
969 ISPB = interface(IParameterBlock<ISPBItem>)
970 ['{2c5836fd-41ed-4426-9b7d-5af580ec2659}']
971 end;
972
973 {Service Query Parameter Block (SQPB).
974
975 This is a specialised parameter block used to send data to a service manager
976 in a Query Request.
977 }
978
979 ISQPBItem = interface(IParameterBlockItem)
980 ['{b07841a6-33b3-47f0-b5a2-028cbc86dc97}']
981 function CopyFrom(source: TStream; count: integer): integer;
982 end;
983
984 ISQPB = interface(IParameterBlock<ISQPBItem>)
985 ['{8553e66b-ee62-498b-8431-dff030211447}']
986 end;
987
988 {Service Request Block (SRB).
989
990 The SRB specifies what is requested from the Service Manager when starting a
991 service or querying a service. It is allocated empty by the ServiceManager API and
992 the parameters are then added to it. Each individual parameter may be accessed
993 by the ISRBItem interface which can be used to set the value, if any, of the parameter.
994
995 The SRB parameters, and the associated symbolic codes and parameter values may be
996 found in the Interbase 6.0 API Guide.
997
998 }
999
1000 ISRBItem = interface(IParameterBlockItem)
1001 ['{47ec790e-f265-4b30-9dcd-261e51677245}']
1002 end;
1003
1004 ISRB = interface(IParameterBlock<ISRBItem>)
1005 ['{9f2e204f-3c33-4e44-90f9-9135e95dafb9}']
1006 end;
1007
1008 {The Service Query Results Interface.
1009
1010 An IServiceQueryResults interface is returned by the IServiceManager Query
1011 method. The interface provides access to the information requested and
1012 returned by the method.
1013
1014 IServiceQueryResults itself gives access to a collection of IServiceQueryResultItem.
1015 Each one provides information requested, as indicated by the ItemType and the actual
1016 value of the information. In some cases, the returned item is itself a
1017 collection of IServiceQueryResultSubItem.
1018
1019 The IServiceQueryResultItem items, and the associated symbolic codes and parameter values may be
1020 found in the Interbase 6.0 API Guide.
1021 }
1022
1023 IServiceQueryResultSubItem = interface
1024 ['{8a4c381e-9923-4cc9-a96b-553729248640}']
1025 function getItemType: byte;
1026 function getSize: integer;
1027 procedure getRawBytes(var Buffer);
1028 function getAsString: AnsiString;
1029 function getAsInteger: integer;
1030 function getAsByte: byte;
1031 function CopyTo(stream: TStream; count: integer): integer;
1032 property AsString: AnsiString read getAsString;
1033 property AsInteger: integer read getAsInteger;
1034 property AsByte: byte read getAsByte;
1035 end;
1036
1037 IServiceQueryResultItem = interface(IServiceQueryResultSubItem)
1038 ['{b2806886-206c-4024-8df9-5fe0a7630a5e}']
1039 function getCount: integer;
1040 function getItem(index: integer): IServiceQueryResultSubItem;
1041 function find(ItemType: byte): IServiceQueryResultSubItem;
1042 property Items[index: integer]: IServiceQueryResultSubItem read getItem; default;
1043 property Count: integer read getCount;
1044 end;
1045
1046 IServiceQueryResults = interface
1047 ['{8fbbef7d-fe03-4409-828a-a787d34ef531}']
1048 function getCount: integer;
1049 function getItem(index: integer): IServiceQueryResultItem;
1050 function find(ItemType: byte): IServiceQueryResultItem;
1051 procedure PrintBuf; {can be used to print buffer in hex for debugging}
1052 property Items[index: integer]: IServiceQueryResultItem read getItem; default;
1053 property Count: integer read getCount;
1054 end;
1055
1056 {The IServiceManager interface provides access to a service manager. It can
1057 used to Detach and re-attach to Service Manager, to start services and to
1058 query the service manager.
1059
1060 The interface is returned by the FirebirdAPI GetService Manager method.
1061 }
1062
1063 { IServiceManager }
1064
1065 IServiceManager = interface
1066 ['{905b587d-1e1f-4e40-a3f8-a3519f852e48}']
1067 function getSPB: ISPB;
1068 function getServerName: AnsiString;
1069 procedure Attach;
1070 procedure Detach(Force: boolean=false);
1071 function IsAttached: boolean;
1072 function AllocateSRB: ISRB;
1073 function AllocateSQPB: ISQPB;
1074 procedure Start(Request: ISRB);
1075 function Query(SQPB: ISQPB; Request: ISRB) :IServiceQueryResults; overload;
1076 function Query(Request: ISRB) :IServiceQueryResults; overload;
1077 end;
1078
1079 {The Firebird API.
1080
1081 This is the base interface and is used to create/open a database connection, to
1082 start a transaction on multiple databases and the access the service manager.
1083
1084 The interface is returned by the FirebirdAPI function.
1085 }
1086
1087 IFirebirdAPI = interface
1088 ['{edeee691-c8d3-4dcf-a780-cd7e432821d5}']
1089 {Database connections}
1090 function AllocateDPB: IDPB;
1091 function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
1092 function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
1093 function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
1094
1095 {Start Transaction against multiple databases}
1096 function AllocateTPB: ITPB;
1097 function StartTransaction(Attachments: array of IAttachment;
1098 TPB: array of byte; DefaultCompletion: TTransactionCompletion=taCommit): ITransaction; overload;
1099 function StartTransaction(Attachments: array of IAttachment;
1100 TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit): ITransaction; overload;
1101
1102 {Service Manager}
1103 function HasServiceAPI: boolean;
1104 function AllocateSPB: ISPB;
1105 function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
1106 function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
1107
1108 {Information}
1109 function GetStatus: IStatus;
1110 function GetLibraryName: string;
1111 function HasRollbackRetaining: boolean;
1112 function IsEmbeddedServer: boolean;
1113 function GetImplementationVersion: AnsiString;
1114
1115 {Firebird 3 API}
1116 function HasMasterIntf: boolean;
1117 function GetIMaster: TObject;
1118 end;
1119
1120 type
1121 TOnGetLibraryName = procedure(var libname: string);
1122
1123 const
1124 OnGetLibraryName: TOnGetLibraryName = nil;
1125 AllowUseOfFBLIB: boolean = false;
1126
1127 type
1128 { EIBError }
1129
1130 EIBError = class(EDatabaseError)
1131 private
1132 FSQLCode: Long;
1133 public
1134 constructor Create(ASQLCode: Long; Msg: AnsiString);
1135 property SQLCode: Long read FSQLCode;
1136 end;
1137
1138 { EIBInterBaseError - Firebird Engine errors}
1139
1140 EIBInterBaseError = class(EIBError)
1141 private
1142 FIBErrorCode: Long;
1143 public
1144 constructor Create(Status: IStatus); overload;
1145 constructor Create(ASQLCode: Long; AIBErrorCode: Long; Msg: AnsiString); overload;
1146 property IBErrorCode: Long read FIBErrorCode;
1147 end;
1148
1149 {IB Client Exceptions}
1150 EIBClientError = class(EIBError);
1151
1152 {IBError is used internally and by IBX to throw an EIBClientError}
1153
1154 procedure IBError(ErrMess: TIBClientError; const Args: array of const);
1155
1156 {The Firebird API function is used to access the IFirebirdAPI interface.
1157
1158 It will load the Firebird Client Library if this is not already loaded and
1159 select an implementation of the Firebird API (legacy 2.5 or 3.0.
1160 }
1161
1162 function FirebirdAPI: IFirebirdAPI;
1163
1164 {IBX support functions. Probably best ignored i.e. always used the FirebirdAPI
1165 functino to load the library and check if it's loaded.}
1166
1167 function TryIBLoad: Boolean;
1168 procedure CheckIBLoaded;
1169
1170 implementation
1171
1172 uses FBClientAPI
1173 {$IFDEF USELEGACYFIREBIRDAPI}, FB25ClientAPI {$ENDIF}
1174 {$IFDEF USEFIREBIRD3API}, FB30ClientAPI {$ENDIF};
1175
1176 var FFirebirdAPI: IFirebirdAPI;
1177
1178 function FirebirdAPI: IFirebirdAPI;
1179 begin
1180 if FFirebirdAPI = nil then
1181 CheckIBLoaded;
1182 Result := FFirebirdAPI;
1183 end;
1184
1185 function TryIBLoad: Boolean;
1186 begin
1187 Result := FFirebirdAPI <> nil;
1188 try
1189 {$IFDEF USEFIREBIRD3API}
1190 if not Result then
1191 begin
1192 FFirebirdAPI := TFB30ClientAPI.Create;
1193 Result := FFirebirdAPI.HasMasterIntf;
1194 end;
1195 {$ENDIF}
1196 {$IFDEF USELEGACYFIREBIRDAPI}
1197 if not Result then
1198 begin
1199 FFirebirdAPI := nil;
1200 FFirebirdAPI := TFB25ClientAPI.Create;
1201 Result := true;
1202 end;
1203 {$ENDIF}
1204 if Result and not (FFirebirdAPI as TFBClientAPI).IsLibraryLoaded then
1205 begin
1206 Result := false;
1207 FFirebirdAPI := nil;
1208 end;
1209 except
1210 SysUtils.showexception(ExceptObject,ExceptAddr);
1211 Result := false;
1212 end;
1213 end;
1214
1215 procedure CheckIBLoaded;
1216 begin
1217 if not TryIBLoad then
1218 IBError(ibxeInterBaseMissing, [nil]);
1219 end;
1220
1221 { EIBError }
1222
1223 constructor EIBError.Create(ASQLCode: Long; Msg: AnsiString);
1224 begin
1225 inherited Create(Msg);
1226 FSQLCode := ASQLCode;
1227 end;
1228
1229 { EIBInterBaseError }
1230
1231 constructor EIBInterBaseError.Create(Status: IStatus);
1232 begin
1233 inherited Create(Status.Getsqlcode,Status.GetMessage);
1234 FIBErrorCode := Status.GetIBErrorCode;
1235 end;
1236
1237 constructor EIBInterBaseError.Create(ASQLCode: Long; AIBErrorCode: Long;
1238 Msg: AnsiString);
1239 begin
1240 inherited Create(ASQLCode,Msg);
1241 FIBErrorCode := AIBErrorCode;
1242 end;
1243
1244 procedure IBError(ErrMess: TIBClientError; const Args: array of const);
1245 begin
1246 raise EIBClientError.Create(Ord(ErrMess),
1247 Format(GetErrorMessage(ErrMess), Args));
1248 end;
1249
1250 initialization
1251 FFirebirdAPI := nil;
1252
1253
1254 end.
1255