ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/IB.pas
Revision: 56
Committed: Mon Mar 6 10:20:02 2017 UTC (7 years ago) by tony
Content type: text/x-pascal
File size: 48927 byte(s)
Log Message:
Committing updates for Trunk

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 = 0;
131 FBIntf_Release = 2;
132 FBIntf_Version = '1.0.2';
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 procedure DecodeVersionString(var Version: byte; var VersionString: AnsiString);
777 function getOperationCounts: TDBOperationCounts;
778 procedure DecodeUserNames(UserNames: TStrings);
779
780 {user names only}
781 function GetCount: integer;
782 function GetItem(index: integer): IDBInfoItem;
783 function Find(ItemType: byte): IDBInfoItem;
784 property AsInteger: integer read getAsInteger;
785 property AsString: AnsiString read GetAsString;
786 property Count: integer read GetCount;
787 property Items[index: integer]: IDBInfoItem read getItem; default;
788 end;
789
790 { IDBInformation }
791
792 IDBInformation = interface
793 ['{7ac6777f-f0a9-498a-9f5c-4a57a554df81}']
794 function GetCount: integer;
795 function GetItem(index: integer): IDBInfoItem;
796 function Find(ItemType: byte): IDBInfoItem;
797 procedure PrintBuf; {can be used to print buffer in hex for debugging}
798 property Count: integer read GetCount;
799 property Items[index: integer]: IDBInfoItem read getItem; default;
800 end;
801
802 {The Database Parameter Block (DPB).
803
804 The DPB provides the parameters used when connecting to a database. It is allocated
805 empty by the FirebirdAPI and the parameters are then added to it. Each individual
806 parameter may be accessed by the IDPBItem interface which can be used to set the
807 value, if any, of the parameter.
808
809 The DPB parameters, and the associated symbolic codes and parameter values may be
810 found in the Interbase 6.0 API Guide.
811 }
812
813 IDPBItem = interface(IParameterBlockItem)
814 ['{123d4ad0-087a-4cd1-a344-1b3d03b30673}']
815 end;
816
817 IDPB = interface(IParameterBlock<IDPBItem>)
818 ['{e676067b-1cf4-4eba-9256-9724f57e0d16}']
819 end;
820
821 {The IAttachment interface provides access to a Database Connection. It may be
822 used to:
823
824 a. Disconnect and reconnect to the database.
825
826 b. Start a Transaction on the database
827
828 c. Execute directly SQL DDL Statements and others that return no information.
829
830 d. OpenCursors (i.e. execute SQL Select statements and return the results)
831
832 e. Prepare SQL Statements, returning an IStatement interface for further processing.
833
834 f. Provide access to an SQL Event Handler.
835
836 g. Access Database Information.
837
838 h. Support the handling of Array and Blob data.
839
840 Note that SQL statements can be prepared with named parameters (PSQL style).
841 This then allows the parameters to be accessed by name. The same name can
842 be used for more than one parameter, allowing a single operation to be used
843 to set all parameters with the same name.
844 }
845
846 { IAttachment }
847
848 IAttachment = interface
849 ['{466e9b67-9def-4807-b3e7-e08a35e7185c}']
850 function getDPB: IDPB;
851 function AllocateBPB: IBPB;
852 procedure Connect;
853 procedure Disconnect(Force: boolean=false);
854 function IsConnected: boolean;
855 procedure DropDatabase;
856 function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion=taCommit): ITransaction; overload;
857 function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit): ITransaction; overload;
858 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; SQLDialect: integer); overload;
859 procedure ExecImmediate(TPB: array of byte; sql: AnsiString; SQLDialect: integer); overload;
860 procedure ExecImmediate(transaction: ITransaction; sql: AnsiString); overload;
861 procedure ExecImmediate(TPB: array of byte; sql: AnsiString); overload;
862 function ExecuteSQL(TPB: array of byte; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
863 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; SQLDialect: integer; params: array of const): IResults; overload;
864 function ExecuteSQL(TPB: array of byte; sql: AnsiString; params: array of const): IResults; overload;
865 function ExecuteSQL(transaction: ITransaction; sql: AnsiString; params: array of const): IResults; overload;
866 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
867 function OpenCursor(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
868 params: array of const): IResultSet; overload;
869 function OpenCursor(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
870 function OpenCursor(transaction: ITransaction; sql: AnsiString;
871 params: array of const): IResultSet; overload;
872 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IResultSet; overload;
873 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer;
874 params: array of const): IResultSet; overload;
875 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString): IResultSet; overload;
876 function OpenCursorAtStart(transaction: ITransaction; sql: AnsiString;
877 params: array of const): IResultSet; overload;
878 function OpenCursorAtStart(sql: AnsiString): IResultSet; overload;
879 function OpenCursorAtStart(sql: AnsiString;
880 params: array of const): IResultSet; overload;
881 function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload;
882 function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
883 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
884 aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload;
885 function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
886 GenerateParamNames: boolean=false): IStatement; overload;
887
888 {Events}
889 function GetEventHandler(Events: TStrings): IEvents; overload;
890 function GetEventHandler(Event: AnsiString): IEvents; overload;
891
892 {Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
893
894 function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
895 function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
896 function CreateBlob(transaction: ITransaction; SubType: integer; CharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
897 function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
898
899 {Array - may use to open existing arrays. However, ISQLData.AsArray is preferred}
900
901 function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
902 function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
903 function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
904 function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
905 Scale: integer; size: cardinal; charSetID: cardinal; dimensions: cardinal;
906 bounds: TArrayBounds): IArrayMetaData;
907
908 {Database Information}
909 function GetSQLDialect: integer;
910 function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
911 function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
912 function GetDBInformation(Requests: array of byte): IDBInformation; overload;
913 function GetDBInformation(Request: byte): IDBInformation; overload;
914 function HasActivity: boolean;
915 end;
916
917 TProtocol = (TCP, SPX, NamedPipe, Local);
918
919 {Service Parameter Block (SPB).
920
921 The SPB provides the parameters used when connecting to a Service Manager. It is
922 allocated empty by the FirebirdAPI and the parameters are then added to it. Each
923 individual parameter may be accessed by the ISPBItem interface which can be used
924 to set the value, if any, of the parameter.
925
926 The SPB parameters, and the associated symbolic codes and parameter values may be
927 found in the Interbase 6.0 API Guide.
928
929 }
930
931 ISPBItem = interface(IParameterBlockItem)
932 ['{5d08ae2b-4519-41bd-8b40-97cd451c3f6a}']
933 end;
934
935 ISPB = interface(IParameterBlock<ISPBItem>)
936 ['{2c5836fd-41ed-4426-9b7d-5af580ec2659}']
937 end;
938
939 {Service Query Parameter Block (SQPB).
940
941 This is a specialised parameter block used to send data to a service manager
942 in a Query Request.
943 }
944
945 ISQPBItem = interface(IParameterBlockItem)
946 ['{b07841a6-33b3-47f0-b5a2-028cbc86dc97}']
947 function CopyFrom(source: TStream; count: integer): integer;
948 end;
949
950 ISQPB = interface(IParameterBlock<ISQPBItem>)
951 ['{8553e66b-ee62-498b-8431-dff030211447}']
952 end;
953
954 {Service Request Block (SRB).
955
956 The SRB specifies what is requested from the Service Manager when starting a
957 service or querying a service. It is allocated empty by the ServiceManager API and
958 the parameters are then added to it. Each individual parameter may be accessed
959 by the ISRBItem interface which can be used to set the value, if any, of the parameter.
960
961 The SRB parameters, and the associated symbolic codes and parameter values may be
962 found in the Interbase 6.0 API Guide.
963
964 }
965
966 ISRBItem = interface(IParameterBlockItem)
967 ['{47ec790e-f265-4b30-9dcd-261e51677245}']
968 end;
969
970 ISRB = interface(IParameterBlock<ISRBItem>)
971 ['{9f2e204f-3c33-4e44-90f9-9135e95dafb9}']
972 end;
973
974 {The Service Query Results Interface.
975
976 An IServiceQueryResults interface is returned by the IServiceManager Query
977 method. The interface provides access to the information requested and
978 returned by the method.
979
980 IServiceQueryResults itself gives access to a collection of IServiceQueryResultItem.
981 Each one provides information requested, as indicated by the ItemType and the actual
982 value of the information. In some cases, the returned item is itself a
983 collection of IServiceQueryResultSubItem.
984
985 The IServiceQueryResultItem items, and the associated symbolic codes and parameter values may be
986 found in the Interbase 6.0 API Guide.
987 }
988
989 IServiceQueryResultSubItem = interface
990 ['{8a4c381e-9923-4cc9-a96b-553729248640}']
991 function getItemType: byte;
992 function getSize: integer;
993 procedure getRawBytes(var Buffer);
994 function getAsString: AnsiString;
995 function getAsInteger: integer;
996 function getAsByte: byte;
997 function CopyTo(stream: TStream; count: integer): integer;
998 property AsString: AnsiString read getAsString;
999 property AsInteger: integer read getAsInteger;
1000 property AsByte: byte read getAsByte;
1001 end;
1002
1003 IServiceQueryResultItem = interface(IServiceQueryResultSubItem)
1004 ['{b2806886-206c-4024-8df9-5fe0a7630a5e}']
1005 function getCount: integer;
1006 function getItem(index: integer): IServiceQueryResultSubItem;
1007 function find(ItemType: byte): IServiceQueryResultSubItem;
1008 property Items[index: integer]: IServiceQueryResultSubItem read getItem; default;
1009 property Count: integer read getCount;
1010 end;
1011
1012 IServiceQueryResults = interface
1013 ['{8fbbef7d-fe03-4409-828a-a787d34ef531}']
1014 function getCount: integer;
1015 function getItem(index: integer): IServiceQueryResultItem;
1016 function find(ItemType: byte): IServiceQueryResultItem;
1017 procedure PrintBuf; {can be used to print buffer in hex for debugging}
1018 property Items[index: integer]: IServiceQueryResultItem read getItem; default;
1019 property Count: integer read getCount;
1020 end;
1021
1022 {The IServiceManager interface provides access to a service manager. It can
1023 used to Detach and re-attach to Service Manager, to start services and to
1024 query the service manager.
1025
1026 The interface is returned by the FirebirdAPI GetService Manager method.
1027 }
1028
1029 { IServiceManager }
1030
1031 IServiceManager = interface
1032 ['{905b587d-1e1f-4e40-a3f8-a3519f852e48}']
1033 function getSPB: ISPB;
1034 function getServerName: AnsiString;
1035 procedure Attach;
1036 procedure Detach(Force: boolean=false);
1037 function IsAttached: boolean;
1038 function AllocateSRB: ISRB;
1039 function AllocateSQPB: ISQPB;
1040 procedure Start(Request: ISRB);
1041 function Query(SQPB: ISQPB; Request: ISRB) :IServiceQueryResults; overload;
1042 function Query(Request: ISRB) :IServiceQueryResults; overload;
1043 end;
1044
1045 {The Firebird API.
1046
1047 This is the base interface and is used to create/open a database connection, to
1048 start a transaction on multiple databases and the access the service manager.
1049
1050 The interface is returned by the FirebirdAPI function.
1051 }
1052
1053 IFirebirdAPI = interface
1054 ['{edeee691-c8d3-4dcf-a780-cd7e432821d5}']
1055 {Database connections}
1056 function AllocateDPB: IDPB;
1057 function OpenDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnConnectError: boolean=true): IAttachment;
1058 function CreateDatabase(DatabaseName: AnsiString; DPB: IDPB; RaiseExceptionOnError: boolean=true): IAttachment; overload;
1059 function CreateDatabase(sql: AnsiString; aSQLDialect: integer; RaiseExceptionOnError: boolean=true): IAttachment; overload;
1060
1061 {Start Transaction against multiple databases}
1062 function AllocateTPB: ITPB;
1063 function StartTransaction(Attachments: array of IAttachment;
1064 TPB: array of byte; DefaultCompletion: TTransactionCompletion=taCommit): ITransaction; overload;
1065 function StartTransaction(Attachments: array of IAttachment;
1066 TPB: ITPB; DefaultCompletion: TTransactionCompletion=taCommit): ITransaction; overload;
1067
1068 {Service Manager}
1069 function HasServiceAPI: boolean;
1070 function AllocateSPB: ISPB;
1071 function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager;
1072
1073 {Information}
1074 function GetStatus: IStatus;
1075 function GetLibraryName: string;
1076 function HasRollbackRetaining: boolean;
1077 function IsEmbeddedServer: boolean;
1078 function GetImplementationVersion: AnsiString;
1079
1080 {Firebird 3 API}
1081 function HasMasterIntf: boolean;
1082 function GetIMaster: TObject;
1083
1084 {utility}
1085 function GetCharsetName(CharSetID: integer): AnsiString;
1086 function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
1087 function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
1088 function CharSetName2CharSetID(CharSetName: AnsiString; var CharSetID: integer): boolean;
1089 function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
1090 end;
1091
1092 type
1093 TOnGetLibraryName = procedure(var libname: string);
1094
1095 const
1096 OnGetLibraryName: TOnGetLibraryName = nil;
1097 AllowUseOfFBLIB: boolean = false;
1098
1099 type
1100 { EIBError }
1101
1102 EIBError = class(EDatabaseError)
1103 private
1104 FSQLCode: Long;
1105 public
1106 constructor Create(ASQLCode: Long; Msg: AnsiString);
1107 property SQLCode: Long read FSQLCode;
1108 end;
1109
1110 { EIBInterBaseError - Firebird Engine errors}
1111
1112 EIBInterBaseError = class(EIBError)
1113 private
1114 FIBErrorCode: Long;
1115 public
1116 constructor Create(Status: IStatus); overload;
1117 constructor Create(ASQLCode: Long; AIBErrorCode: Long; Msg: AnsiString); overload;
1118 property IBErrorCode: Long read FIBErrorCode;
1119 end;
1120
1121 {IB Client Exceptions}
1122 EIBClientError = class(EIBError);
1123
1124 {IBError is used internally and by IBX to throw an EIBClientError}
1125
1126 procedure IBError(ErrMess: TIBClientError; const Args: array of const);
1127
1128 {The Firebird API function is used to access the IFirebirdAPI interface.
1129
1130 It will load the Firebird Client Library if this is not already loaded and
1131 select an implementation of the Firebird API (legacy 2.5 or 3.0.
1132 }
1133
1134 function FirebirdAPI: IFirebirdAPI;
1135
1136 {IBX support functions. Probably best ignored i.e. always used the FirebirdAPI
1137 functino to load the library and check if it's loaded.}
1138
1139 function TryIBLoad: Boolean;
1140 procedure CheckIBLoaded;
1141
1142 implementation
1143
1144 uses FBClientAPI
1145 {$IFDEF USELEGACYFIREBIRDAPI}, FB25ClientAPI {$ENDIF}
1146 {$IFDEF USEFIREBIRD3API}, FB30ClientAPI {$ENDIF};
1147
1148 var FFirebirdAPI: IFirebirdAPI;
1149
1150 function FirebirdAPI: IFirebirdAPI;
1151 begin
1152 if FFirebirdAPI = nil then
1153 CheckIBLoaded;
1154 Result := FFirebirdAPI;
1155 end;
1156
1157 function TryIBLoad: Boolean;
1158 begin
1159 Result := FFirebirdAPI <> nil;
1160 try
1161 {$IFDEF USEFIREBIRD3API}
1162 if not Result then
1163 begin
1164 FFirebirdAPI := TFB30ClientAPI.Create;
1165 Result := FFirebirdAPI.HasMasterIntf;
1166 end;
1167 {$ENDIF}
1168 {$IFDEF USELEGACYFIREBIRDAPI}
1169 if not Result then
1170 begin
1171 FFirebirdAPI := nil;
1172 FFirebirdAPI := TFB25ClientAPI.Create;
1173 Result := true;
1174 end;
1175 {$ENDIF}
1176 if Result and not (FFirebirdAPI as TFBClientAPI).IsLibraryLoaded then
1177 begin
1178 Result := false;
1179 FFirebirdAPI := nil;
1180 end;
1181 except
1182 SysUtils.showexception(ExceptObject,ExceptAddr);
1183 Result := false;
1184 end;
1185 end;
1186
1187 procedure CheckIBLoaded;
1188 begin
1189 if not TryIBLoad then
1190 IBError(ibxeInterBaseMissing, [nil]);
1191 end;
1192
1193 { EIBError }
1194
1195 constructor EIBError.Create(ASQLCode: Long; Msg: AnsiString);
1196 begin
1197 inherited Create(Msg);
1198 FSQLCode := ASQLCode;
1199 end;
1200
1201 { EIBInterBaseError }
1202
1203 constructor EIBInterBaseError.Create(Status: IStatus);
1204 begin
1205 inherited Create(Status.Getsqlcode,Status.GetMessage);
1206 FIBErrorCode := Status.GetIBErrorCode;
1207 end;
1208
1209 constructor EIBInterBaseError.Create(ASQLCode: Long; AIBErrorCode: Long;
1210 Msg: AnsiString);
1211 begin
1212 inherited Create(ASQLCode,Msg);
1213 FIBErrorCode := AIBErrorCode;
1214 end;
1215
1216 procedure IBError(ErrMess: TIBClientError; const Args: array of const);
1217 begin
1218 raise EIBClientError.Create(Ord(ErrMess),
1219 Format(GetErrorMessage(ErrMess), Args));
1220 end;
1221
1222 initialization
1223 FFirebirdAPI := nil;
1224
1225
1226 end.
1227