ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/IB.pas
Revision: 47
Committed: Mon Jan 9 15:31:51 2017 UTC (7 years, 2 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/fbintf/IB.pas
File size: 46295 byte(s)
Log Message:
Committing updates for Release R2-0-1

File Contents

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