From 2ba03a9df709e38e574e9d7c66f1c3b942a7d6ce Mon Sep 17 00:00:00 2001 From: reiniero Date: Tue, 27 Nov 2012 08:31:32 +0000 Subject: [PATCH] + fcl-db: Firebird/Interbase: add some metadata support: GetConnectionInfo and ODS major version git-svn-id: trunk@23066 - --- .../src/sqldb/interbase/ibconnection.pp | 224 +++++++++++++++--- 1 file changed, 188 insertions(+), 36 deletions(-) diff --git a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp index 7c3aa68ea1..c0d904b876 100644 --- a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp +++ b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp @@ -19,6 +19,12 @@ const MAXBLOBSEGMENTSIZE = 65535; //Maximum number of bytes that fit in a blob segment. type + TDatabaseInfo = record + Dialect : integer; //Dialect set in database + ODSMajorVersion : integer; //On-Disk Structure version of file + ServerVersion : string; //Representation of major.minor (.build) + ServerVersionString : string; //Complete version string, including name, platform + end; EIBDatabaseError = class(EDatabaseError) public @@ -48,22 +54,31 @@ type TIBConnection = class (TSQLConnection) private - FSQLDatabaseHandle : pointer; - FStatus : array [0..19] of ISC_STATUS; - FDialect : integer; - FDBDialect : integer; - FBLobSegmentSize : word; //required for backward compatibilty; not used + FSQLDatabaseHandle : pointer; + FStatus : array [0..19] of ISC_STATUS; + FDatabaseInfo : TDatabaseInfo; + FDialect : integer; + FBlobSegmentSize : word; //required for backward compatibilty; not used procedure ConnectFB; - function GetDialect: integer; + procedure AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer); + + // Metadata: + procedure GetDatabaseInfo; //Queries for various information from server once connected + procedure ResetDatabaseInfo; //Useful when disconnecting + function GetDialect: integer; + function GetODSMajorVersion: integer; + function ParseServerVersion(const CompleteVersion: string): string; //Extract version info from complete version identification string + + // conversion methods procedure TranslateFldType(SQLType, SQLSubType, SQLLen, SQLScale : integer; var TrType : TFieldType; var TrLen : word); - // conversion methods procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer); procedure SetDateTime(CurrBuff: pointer; PTime : TDateTime; AType : integer); procedure GetFloat(CurrBuff, Buffer : pointer; Size : Byte); procedure SetFloat(CurrBuff: pointer; Dbl: Double; Size: integer); + procedure CheckError(ProcName : string; Status : PISC_STATUS); procedure SetParameters(cursor : TSQLCursor; aTransation : TSQLTransaction; AParams : TParams); procedure FreeSQLDABuffer(var aSQLDA : PXSQLDA); @@ -99,10 +114,11 @@ type public constructor Create(AOwner : TComponent); override; procedure CreateDB; override; + function GetConnectionInfo(InfoType:TConnInfoType): string; override; procedure DropDB; override; //Segment size is not used in the code; property kept for backward compatibility property BlobSegmentSize : word read FBlobSegmentSize write FBlobSegmentSize; deprecated; - function GetDBDialect: integer; + property ODSMajorVersion : integer read GetODSMajorVersion; //ODS major version number; influences database compatibility/feature level. published property DatabaseName; property Dialect : integer read GetDialect write FDialect stored IsDialectStored default DEFDIALECT; @@ -121,6 +137,7 @@ type Class Function DefaultLibraryName : String; override; Class Function LoadFunction : TLibraryLoadFunction; override; Class Function UnLoadFunction : TLibraryUnLoadFunction; override; + Class Function LoadedLibraryName: string; override; end; implementation @@ -131,6 +148,7 @@ uses const SQL_BOOLEAN_INTERBASE = 590; SQL_BOOLEAN_FIREBIRD = 32764; + INVALID_DATA = -1; type TTm = packed record @@ -173,9 +191,9 @@ constructor TIBConnection.Create(AOwner : TComponent); begin inherited; FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat]; - FBLobSegmentSize := 65535; //Shows we're using the maximum segment size - FDialect := -1; - FDBDialect := -1; + FBlobSegmentSize := 65535; //Shows we're using the maximum segment size + FDialect := INVALID_DATA; + ResetDatabaseInfo; end; @@ -267,6 +285,8 @@ begin if isc_rollback_retaining(@Status[0], @TransactionHandle) <> 0 then CheckError('RollBackRetaining', Status); end; + + procedure TIBConnection.DropDB; begin @@ -286,6 +306,7 @@ begin {$EndIf} end; + procedure TIBConnection.CreateDB; var ASQLDatabaseHandle, @@ -324,7 +345,6 @@ begin end; procedure TIBConnection.DoInternalConnect; - begin {$IfDef LinkDynamically} InitialiseIBase60; @@ -336,10 +356,10 @@ end; procedure TIBConnection.DoInternalDisconnect; begin - FDialect := -1; - FDBDialect := -1; + FDialect := INVALID_DATA; if not Connected then begin + ResetDatabaseInfo; FSQLDatabaseHandle := nil; Exit; end; @@ -351,40 +371,164 @@ begin {$EndIf} end; +function TIBConnection.GetConnectionInfo(InfoType: TConnInfoType): string; +begin + result:=''; + {$IFDEF LinkDynamically} + InitialiseIBase60; + {$ENDIF} + try + case InfoType of + citServerType: + // Firebird returns own name in ServerVersion; Interbase 7.5 doesn't. + if pos('FIREBIRD',UpperCase(FDatabaseInfo.ServerVersionString))=0 then + result := 'Interbase' + else + result := 'Firebird'; + citServerVersion: + // Firebird returns major.minor, Interbase major.minor.build + result := FDatabaseInfo.ServerVersion; + citServerVersionString: + result := FDatabaseInfo.ServerVersionString; + citClientName: + result:=TIBConnectionDef.LoadedLibraryName; + else + //including citClientVersion, for which no single IB+FB and Win+*nux solution exists + result:=inherited GetConnectionInfo(InfoType); + end; + finally + {$IFDEF LinkDynamically} + ReleaseIBase60; + {$ENDIF} + end; +end; -function TIBConnection.GetDBDialect: integer; +procedure TIBConnection.GetDatabaseInfo; +// Asks server for multiple values +const + ResBufHigh = 512; //hopefully enough to include version string as well. var x : integer; Len : integer; - Buffer : array [0..1] of byte; - ResBuf : array [0..39] of byte; + ReqBuf : array [0..3] of byte; + ResBuf : array [0..ResBufHigh] of byte; // should be big enough for version string etc begin - result := -1; + ResetDatabaseInfo; if Connected then - begin - Buffer[0] := isc_info_db_sql_dialect; - Buffer[1] := isc_info_end; - if isc_database_info(@FStatus[0], @FSQLDatabaseHandle, Length(Buffer), - pchar(@Buffer[0]), SizeOf(ResBuf), pchar(@ResBuf[0])) <> 0 then - CheckError('SetDBDialect', FStatus); + begin + ReqBuf[0] := isc_info_ods_version; + ReqBuf[1] := isc_info_version; + ReqBuf[2] := isc_info_db_sql_dialect; + ReqBuf[3] := isc_info_end; + if isc_database_info(@FStatus[0], @FSQLDatabaseHandle, Length(ReqBuf), + pchar(@ReqBuf[0]), SizeOf(ResBuf), pchar(@ResBuf[0])) <> 0 then + CheckError('CacheServerInfo', FStatus); x := 0; - while x < 40 do + while x < ResBufHigh+1 do case ResBuf[x] of isc_info_db_sql_dialect : begin Inc(x); Len := isc_vax_integer(pchar(@ResBuf[x]), 2); Inc(x, 2); - Result := isc_vax_integer(pchar(@ResBuf[x]), Len); + FDatabaseInfo.Dialect := isc_vax_integer(pchar(@ResBuf[x]), Len); Inc(x, Len); end; - isc_info_end : Break; + isc_info_ods_version : + begin + Inc(x); + Len := isc_vax_integer(pchar(@ResBuf[x]), 2); + Inc(x, 2); + FDatabaseInfo.ODSMajorVersion := isc_vax_integer(pchar(@ResBuf[x]), Len); + Inc(x, Len); + end; + isc_info_version : + begin + Inc(x); + Len := isc_vax_integer(pchar(@ResBuf[x]), 2); + Inc(x, 2); + SetString(FDatabaseInfo.ServerVersionString, PAnsiChar(@ResBuf[x + 2]), Len-2); + FDatabaseInfo.ServerVersion := ParseServerVersion(FDatabaseInfo.ServerVersionString); + Inc(x, Len); + end; + isc_info_end, isc_info_error : Break; + isc_info_truncated : Break; //result buffer too small; fix your code! else inc(x); end; - end; + end; end; +procedure TIBConnection.ResetDatabaseInfo; +begin + FDatabaseInfo.Dialect:=0; + FDatabaseInfo.ODSMajorVersion:=0; + FDatabaseInfo.ServerVersion:=''; + FDatabaseInfo.ServerVersionString:=''; // don't confuse applications with 'Firebird' or 'Interbase' +end; + + +function TIBConnection.GetODSMajorVersion: integer; +begin + result:=FDatabaseInfo.ODSMajorVersion; +end; + +function TIBConnection.ParseServerVersion(const CompleteVersion: string): string; +// String representation of integer version number derived from +// major.minor.build => should give e.g. 020501 +const + Delimiter = '.'; + DigitsPerNumber = 2; + MaxNumbers = 3; +var + BeginPos,EndPos,StartLook,i: integer; + NumericPart: string; + Version: integer; +begin + result := ''; + // Ignore 6.x version number in front of "Firebird" + StartLook := Pos('Firebird', CompleteVersion); + if StartLook = 0 then + StartLook := 1; + BeginPos := 0; + // Catch all numerics + decimal point: + for i := StartLook to Length(CompleteVersion) do + begin + if (BeginPos > 0) and + ((CompleteVersion[i] < '0') or (CompleteVersion[i] > '9')) and (CompleteVersion[i] <> '.') then + begin + EndPos := i - 1; + break; + end; + if (BeginPos = 0) and + (CompleteVersion[i] >= '0') and (CompleteVersion[i] <= '9') then + begin + BeginPos := i; + end; + end; + if BeginPos > 0 then + begin + NumericPart := copy(CompleteVersion, BeginPos, 1+EndPos-BeginPos); + BeginPos := 1; + for i := 1 to MaxNumbers do + begin + EndPos := PosEx(Delimiter,NumericPart,BeginPos); + if EndPos > 0 then + begin + result := result + rightstr(StringOfChar('0',DigitsPerNumber)+copy(NumericPart,BeginPos,EndPos-BeginPos),DigitsPerNumber); + BeginPos := EndPos+1; + end + else + begin + result := result + rightstr(StringOfChar('0',DigitsPerNumber)+copy(NumericPart,BeginPos,Length(NumericPart)),DigitsPerNumber); + break; + end; + end; + result := leftstr(result + StringOfChar('0',DigitsPerNumber * MaxNumbers), DigitsPerNumber * MaxNumbers); + end; +end; + + procedure TIBConnection.ConnectFB; var ADatabaseName: String; @@ -413,12 +557,12 @@ end; function TIBConnection.GetDialect: integer; begin - if FDialect = -1 then + if FDialect = INVALID_DATA then begin - if FDBDialect = -1 then + if FDatabaseInfo.Dialect=0 then Result := DEFDIALECT else - Result := FDBDialect; + Result := FDatabaseInfo.Dialect; end else Result := FDialect; end; @@ -655,21 +799,20 @@ begin Dispose(aSQLDA^.SQLVar[x].sqlind); aSQLDA^.SQLVar[x].sqlind := nil; end - end; {$pop} end; function TIBConnection.IsDialectStored: boolean; begin - result := (FDialect<>-1); + result := (FDialect<>INVALID_DATA); end; procedure TIBConnection.DoConnect; const NoQuotes: TQuoteChars = (' ',' '); begin inherited DoConnect; - FDBDialect := GetDBDialect; + GetDatabaseInfo; //Get db dialect, db metadata if Dialect < 3 then FieldNameQuoteChars := NoQuotes else @@ -752,8 +895,8 @@ begin with cursor as TIBCursor do begin if FStatementType = stExecProcedure then - //it is not recommended fetch from non-select statement, i.e. statement which have no cursor - //starting from Firebird 2.5 it leads to error 'Invalid cursor reference' + //do not fetch from a non-select statement, i.e. statement which has no cursor + //on Firebird 2.5+ it leads to error 'Invalid cursor reference' if SQLDA^.SQLD = 0 then retcode := 100 //no more rows to retrieve else @@ -1473,6 +1616,15 @@ begin Result:=@ReleaseIBase60 end; +class function TIBConnectionDef.LoadedLibraryName: string; +begin + {$IfDef LinkDynamically} + Result:=IBaseLoadedLibrary; + {$else} + Result:=''; + {$endif} +end; + initialization RegisterConnection(TIBConnectionDef);