ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/IB.pas
(Generate patch)

Comparing ibx/trunk/fbintf/IB.pas (file contents):
Revision 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 UTC

# Line 73 | Line 73 | unit IB;
73   {$IFEND}
74   {$ENDIF}
75  
76 + {$IFNDEF LEGACYFIREBIRDAPIONLY}
77   {$DEFINE USEFIREBIRD3API}
78 + {$ENDIF}
79 + {$IFNDEF FIREBIRD3APIONLY}
80   {$DEFINE USELEGACYFIREBIRDAPI}
81 + {$ENDIF}
82  
83   {
84    This unit defines the interfaces used to provide the Pascal Language
# Line 122 | Line 126 | unit IB;
126   interface
127  
128   uses
129 <  Classes, SysUtils, DB, FBMessages, IBExternals;
129 >  Classes,
130 >  {$IFDEF WINDOWS}Windows, {$ENDIF}
131 >  {$IFDEF FPC} Dynlibs, {$ENDIF}
132 >  SysUtils, DB, FBMessages, IBExternals;
133  
134   const
135    {Interface version information}
136    FBIntf_Major = 1;
137 <  FBIntf_Minor = 0;
138 <  FBIntf_Release = 2;
139 <  FBIntf_Version = '1.0.2';
137 >  FBIntf_Minor = 1;
138 >  FBIntf_Release = 5;
139 >  FBIntf_Version = '1.1.5';
140  
141   {These include files are converted from the 'C' originals in the Firebird API
142   and define the various constants used by the API}
# Line 173 | Line 180 | type
180     PISC_QUAD            = ^TISC_QUAD;
181  
182   {$IFNDEF FPC}
183 + {Delphi missing definitions}
184 + type
185 +  TLibHandle = THandle;
186 +
187 + const
188 +  NilHandle = 0;
189 +  DirectorySeparator = '\';
190 +
191   {Delphi only seems to define CP_UTF8 and CP_UTF16}
192   const
193    CP_ACP     = 0;     // default to ANSI code page
# Line 195 | Line 210 | type
210                    SQLGetSegment, SQLPutSegment,
211                    SQLExecProcedure, SQLStartTransaction,
212                    SQLCommit, SQLRollback,
213 <                  SQLSelectForUpdate, SQLSetGenerator);
213 >                  SQLSelectForUpdate, SQLSetGenerator,
214 >                  SQLSavePoint);
215  
216    TFBStatusCode = cardinal;
217    TByteArray = array of byte;
218  
219 +  IFirebirdAPI = interface;
220    IAttachment = interface;
221    ITransaction = interface;
222 +  IStatement = interface;
223  
224    {The IParameterBlock interface provides the template for all parameter
225     block interfaces}
# Line 241 | Line 259 | type
259     This interface can be accessed from IFirebirdAPI.
260     }
261  
262 +   TIBDataBaseErrorMessage    = (ShowSQLCode,
263 +                                   ShowIBMessage,
264 +                                   ShowSQLMessage);
265 +
266 +   TIBDataBaseErrorMessages   = set of TIBDataBaseErrorMessage;
267 +
268    IStatus = interface
269      ['{34167722-af38-4831-b08a-93162d58ede3}']
270      function GetIBErrorCode: Long;
# Line 352 | Line 376 | type
376      ['{660822a5-3114-4c16-b6cb-c1a7b2aba70d}']
377    end;
378  
379 <  IBPB = interface(IParameterBlock<IBPBItem>)
379 >  IBPB = interface (IParameterBlock<IBPBItem>)
380      ['{e0cb9eb5-17f7-4416-b7d1-3cddd1dfca76}']
381    end;
382  
# Line 395 | Line 419 | type
419      the output of an SQL Statement.
420    }
421  
422 +  TIBDateTimeFormats = (dfTimestamp, {SQL TIMESTAMP}
423 +                        dfDateTime,   {SQL DATETIME}
424 +                        dfTime);      {SQL TIME}
425 +
426    { IColumnMetaData }
427  
428    IColumnMetaData = interface
# Line 415 | Line 443 | type
443      function GetSize: cardinal;
444      function GetArrayMetaData: IArrayMetaData; {Valid only for Array SQL Type}
445      function GetBlobMetaData: IBlobMetaData; {Valid only for Blob SQL Type}
446 +    function GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats): integer;
447 +    function GetStatement: IStatement;
448 +    function GetTransaction: ITransaction;
449      property Name: AnsiString read GetName;
450      property Size: cardinal read GetSize;
451      property SQLType: cardinal read GetSQLType;
# Line 456 | Line 487 | type
487  
488    ISQLData = interface(IColumnMetaData)
489      ['{3f493e31-7e3f-4606-a07c-b210b9e3619d}']
490 +    function GetStrDataLength: short;
491      function GetAsBoolean: boolean;
492      function GetAsCurrency: Currency;
493      function GetAsInt64: Int64;
# Line 502 | Line 534 | type
534    IResults = interface
535      ['{e836b2bb-93d1-4bbf-a8eb-7ce535de3bb5}']
536     function getCount: integer;
537 +   function GetStatement: IStatement;
538     function GetTransaction: ITransaction;
539     function ByName(Idx: AnsiString): ISQLData;
540     function getSQLData(index: integer): ISQLData;
# Line 622 | Line 655 | type
655      function getSQLParam(index: integer): ISQLParam;
656      function ByName(Idx: AnsiString): ISQLParam ;
657      function GetModified: Boolean;
658 +    function GetHasCaseSensitiveParams: Boolean;
659      property Modified: Boolean read GetModified;
660      property Params[index: integer]: ISQLParam read getSQLParam; default;
661      property Count: integer read getCount;
# Line 632 | Line 666 | type
666                  psRealTime, psUserTime, psBuffers,
667                  psReads, psWrites, psFetches,psDeltaMemory);
668  
669 <  TPerfCounters = array[TPerfStats] of comp;
669 >  TPerfCounters = array[TPerfStats] of Int64;
670  
671    {The IStatement interface provides access to an SQL Statement once it has been
672     initially prepared. The interface is returned from the IAttachment interface.
# Line 646 | Line 680 | type
680      function GetRowsAffected(var SelectCount, InsertCount, UpdateCount, DeleteCount: integer): boolean;
681      function GetSQLStatementType: TIBSQLStatementTypes;
682      function GetSQLText: AnsiString;
683 +    function GetProcessedSQLText: AnsiString;
684      function GetSQLDialect: integer;
685      function IsPrepared: boolean;
686      procedure Prepare(aTransaction: ITransaction=nil);
# Line 773 | Line 808 | type
808      function getAsInteger: integer;
809      procedure DecodeIDCluster(var ConnectionType: integer; var DBFileName, DBSiteName: AnsiString);
810      function getAsBytes: TByteArray;
811 +    function getAsDateTime: TDateTime;
812      procedure DecodeVersionString(var Version: byte; var VersionString: AnsiString);
813      function getOperationCounts: TDBOperationCounts;
814      procedure DecodeUserNames(UserNames: TStrings);
# Line 799 | Line 835 | type
835      property Items[index: integer]: IDBInfoItem read getItem; default;
836    end;
837  
838 +  {The Database Information Request Block is used to pass requests for
839 +   database information where at least one item requested has a parameter.
840 +   At present, this is only fb_info_page_contents which has a single
841 +   integer parameter.}
842 +
843 +  IDIRBItem = interface(IParameterBlockItem)
844 +    ['{d34a7511-8435-4a24-81a7-5103d218d234}']
845 +  end;
846 +
847 +  IDIRB = interface(IParameterBlock<IDIRBItem>)
848 +    ['{1010e5ac-0a8f-403b-a302-91625e9d9579}']
849 +  end;
850 +
851 +
852    {The Database Parameter Block (DPB).
853  
854     The DPB provides the parameters used when connecting to a database. It is allocated
# Line 847 | Line 897 | type
897  
898    IAttachment = interface
899      ['{466e9b67-9def-4807-b3e7-e08a35e7185c}']
900 +    function getFirebirdAPI: IFirebirdAPI;
901      function getDPB: IDPB;
902      function AllocateBPB: IBPB;
903 +    function AllocateDIRB: IDIRB;
904      procedure Connect;
905      procedure Disconnect(Force: boolean=false);
906      function IsConnected: boolean;
# Line 881 | Line 933 | type
933      function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload;
934      function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload;
935      function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
936 <                       aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload;
936 >                       aSQLDialect: integer; GenerateParamNames: boolean=false;
937 >                       CaseSensitiveParams: boolean = false): IStatement; overload;
938      function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
939 <                       GenerateParamNames: boolean=false): IStatement; overload;
939 >                       GenerateParamNames: boolean=false;
940 >                       CaseSensitiveParams: boolean = false): IStatement; overload;
941  
942      {Events}
943      function GetEventHandler(Events: TStrings): IEvents; overload;
# Line 894 | Line 948 | type
948      function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
949      function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
950      function CreateBlob(transaction: ITransaction; SubType: integer; CharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
951 <    function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
951 >    function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
952 >    function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;  overload;
953  
954      {Array - may use to open existing arrays. However, ISQLData.AsArray is preferred}
955  
956 <    function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
956 >    function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray; overload;
957 >    function OpenArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData; ArrayID: TISC_QUAD): IArray; overload;
958      function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
959      function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
960      function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
# Line 911 | Line 967 | type
967      function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
968      function GetDBInformation(Requests: array of byte): IDBInformation; overload;
969      function GetDBInformation(Request: byte): IDBInformation; overload;
970 +    function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
971 +    function GetConnectString: AnsiString;
972 +    function GetRemoteProtocol: AnsiString;
973 +    function GetAuthenticationMethod: AnsiString;
974 +    function GetSecurityDatabase: AnsiString;
975 +    function GetODSMajorVersion: integer;
976 +    function GetODSMinorVersion: integer;
977 +    procedure getFBVersion(version: TStrings);
978      function HasActivity: boolean;
979  
980      {Character Sets}
981 +    function HasDefaultCharSet: boolean;
982 +    function GetDefaultCharSetID: integer;
983      function GetCharsetName(CharSetID: integer): AnsiString;
984      function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
985      function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
# Line 923 | Line 989 | type
989        AllowReverseLookup:boolean; out CharSetID: integer);
990    end;
991  
992 <  TProtocol = (TCP, SPX, NamedPipe, Local);
992 >  TProtocolAll = (TCP, SPX, NamedPipe, Local, inet, inet4, inet6, wnet, xnet, unknownProtocol);
993 >  TProtocol = TCP..xnet;
994  
995    {Service Parameter Block (SPB).
996  
# Line 1028 | Line 1095 | type
1095      property Count: integer read getCount;
1096    end;
1097  
1098 +  IFirebirdLibrary = interface;
1099 +
1100    {The IServiceManager interface provides access to a service manager. It can
1101     used to Detach and re-attach to Service Manager, to start services and to
1102     query the service manager.
# Line 1039 | Line 1108 | type
1108  
1109    IServiceManager = interface
1110      ['{905b587d-1e1f-4e40-a3f8-a3519f852e48}']
1111 +    function getFirebirdAPI: IFirebirdAPI;
1112      function getSPB: ISPB;
1113      function getServerName: AnsiString;
1114 +    function getProtocol: TProtocol;
1115 +    function getPortNo: AnsiString;
1116      procedure Attach;
1117      procedure Detach(Force: boolean=false);
1118      function IsAttached: boolean;
1119      function AllocateSRB: ISRB;
1120      function AllocateSQPB: ISQPB;
1121 <    procedure Start(Request: ISRB);
1122 <    function Query(SQPB: ISQPB; Request: ISRB) :IServiceQueryResults; overload;
1123 <    function Query(Request: ISRB) :IServiceQueryResults; overload;
1121 >    function Start(Request: ISRB; RaiseExceptionOnError: boolean=true): boolean;
1122 >    function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true) :IServiceQueryResults; overload;
1123 >    function Query(Request: ISRB; RaiseExceptionOnError: boolean=true) :IServiceQueryResults; overload;
1124 >  end;
1125 >
1126 >  {Tbe Firebird Library API used to get information about the Firebird library}
1127 >
1128 >
1129 >  IFirebirdLibrary = interface
1130 >    ['{3c04e0a1-12e0-428a-b2e1-bc6fcd97b79b}']
1131 >    function GetHandle: TLibHandle;
1132 >    function GetLibraryName: string;
1133 >    function GetLibraryFilePath: string;
1134 >    function GetFirebirdAPI: IFirebirdAPI;
1135    end;
1136  
1137    {The Firebird API.
# Line 1077 | Line 1160 | type
1160      {Service Manager}
1161      function HasServiceAPI: boolean;
1162      function AllocateSPB: ISPB;
1163 <    function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager;
1163 >    function GetServiceManager(ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
1164 >    function GetServiceManager(ServerName: AnsiString; Port: AnsiString; Protocol: TProtocol; SPB: ISPB): IServiceManager; overload;
1165  
1166      {Information}
1167      function GetStatus: IStatus;
1084    function GetLibraryName: string;
1168      function HasRollbackRetaining: boolean;
1169      function IsEmbeddedServer: boolean;
1170      function GetImplementationVersion: AnsiString;
# Line 1089 | Line 1172 | type
1172      {Firebird 3 API}
1173      function HasMasterIntf: boolean;
1174      function GetIMaster: TObject;
1175 +    function GetFBLibrary: IFirebirdLibrary;
1176   end;
1177  
1178   type
# Line 1123 | Line 1207 | type
1207     {IB Client Exceptions}
1208     EIBClientError = class(EIBError);
1209  
1126 {IBError is used internally and by IBX to throw an EIBClientError}
1127
1128 procedure IBError(ErrMess: TIBClientError; const Args: array of const);
1129
1210   {The Firebird API function is used to access the IFirebirdAPI interface.
1211  
1212   It will load the Firebird Client Library if this is not already loaded and
# Line 1141 | Line 1221 | function FirebirdAPI: IFirebirdAPI;
1221   function TryIBLoad: Boolean;
1222   procedure CheckIBLoaded;
1223  
1224 + {If you want to explicitly load the Firebird library from a
1225 + non-default location then use this function and its GetFirebirdAPI function
1226 + to get the API.}
1227 +
1228 + function LoadFBLibrary(aLibPathName: string): IFirebirdLibrary;
1229 +
1230   implementation
1231  
1232   uses FBClientAPI
1233    {$IFDEF USELEGACYFIREBIRDAPI}, FB25ClientAPI {$ENDIF}
1234    {$IFDEF USEFIREBIRD3API}, FB30ClientAPI {$ENDIF};
1235  
1236 < var FFirebirdAPI: IFirebirdAPI;
1236 > var FDefaultFBLibrary: IFirebirdLibrary;
1237 >
1238 > type
1239 >
1240 >  { TFBLibrary }
1241 >
1242 >  TFBLibraryImpl = class(TFBLibrary)
1243 >  protected
1244 >    function GetFirebird3API: IFirebirdAPI; override;
1245 >    function GetLegacyFirebirdAPI: IFirebirdAPI; override;
1246 >  end;
1247 >
1248 > function TFBLibraryImpl.GetFirebird3API: IFirebirdAPI;
1249 > begin
1250 > {$IFDEF USEFIREBIRD3API}
1251 > Result := TFB30ClientAPI.Create(self);
1252 > {$ELSE}
1253 > Result := nil;
1254 > {$ENDIF}
1255 > end;
1256 >
1257 > function TFBLibraryImpl.GetLegacyFirebirdAPI: IFirebirdAPI;
1258 > begin
1259 >  {$IFDEF USELEGACYFIREBIRDAPI}
1260 >  Result := TFB25ClientAPI.Create(self);
1261 >  {$ELSE}
1262 >  Result := nil;
1263 >  {$ENDIF}
1264 > end;
1265  
1266   function FirebirdAPI: IFirebirdAPI;
1267   begin
1268 <  if FFirebirdAPI = nil then
1268 >  if FDefaultFBLibrary = nil then
1269      CheckIBLoaded;
1270 <  Result := FFirebirdAPI;
1270 >  Result := FDefaultFBLibrary.GetFirebirdAPI;
1271   end;
1272  
1273   function TryIBLoad: Boolean;
1274 + var fblib: IFirebirdLibrary;
1275   begin
1276 < Result := FFirebirdAPI <> nil;
1276 > Result := FDefaultFBLibrary <> nil;
1277   try
1163  {$IFDEF USEFIREBIRD3API}
1164  if not Result then
1165  begin
1166    FFirebirdAPI := TFB30ClientAPI.Create;
1167    Result := FFirebirdAPI.HasMasterIntf;
1168  end;
1169  {$ENDIF}
1170  {$IFDEF USELEGACYFIREBIRDAPI}
1278    if not Result then
1279    begin
1280 <    FFirebirdAPI := nil;
1281 <    FFirebirdAPI := TFB25ClientAPI.Create;
1282 <    Result := true;
1283 <  end;
1177 <  {$ENDIF}
1178 <  if Result and not (FFirebirdAPI as TFBClientAPI).IsLibraryLoaded then
1179 <  begin
1180 <    Result := false;
1181 <    FFirebirdAPI := nil;
1280 >    fblib := TFBLibraryImpl.Create;
1281 >    if (fblib <> nil) and (fblib.GetFirebirdAPI <> nil) then
1282 >      FDefaultFBLibrary := fblib;
1283 >    Result := FDefaultFBLibrary <> nil;
1284    end;
1285   except
1286     SysUtils.showexception(ExceptObject,ExceptAddr);
# Line 1192 | Line 1294 | begin
1294      IBError(ibxeInterBaseMissing, [nil]);
1295   end;
1296  
1297 + function LoadFBLibrary(aLibPathName: string): IFirebirdLibrary;
1298 + var fblib: IFirebirdLibrary;
1299 + begin
1300 +  if trim(aLibPathName) = '' then
1301 +  begin
1302 +    CheckIBLoaded;
1303 +    Result := FDefaultFBLibrary;
1304 +  end
1305 +  else
1306 +  begin
1307 +    fblib := TFBLibraryImpl.GetFBLibrary(aLibPathName);
1308 +    if (fblib = nil) or (fblib.GetFirebirdAPI = nil) then
1309 +      IBError(ibxeInterBaseMissing, [nil]);
1310 +    Result := fblib;
1311 +  end;
1312 + end;
1313 +
1314   { EIBError }
1315  
1316   constructor EIBError.Create(ASQLCode: Long; Msg: AnsiString);
# Line 1215 | Line 1334 | begin
1334    FIBErrorCode := AIBErrorCode;
1335   end;
1336  
1218 procedure IBError(ErrMess: TIBClientError; const Args: array of const);
1219 begin
1220  raise EIBClientError.Create(Ord(ErrMess),
1221                              Format(GetErrorMessage(ErrMess), Args));
1222 end;
1337  
1338   initialization
1339 <  FFirebirdAPI := nil;
1339 >  FDefaultFBLibrary := nil;
1340  
1341 + finalization
1342 +  FDefaultFBLibrary := nil;
1343  
1344   end.
1345  

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines