paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 11:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Merging revisions r45503 from trunk:

Browse Source 
------------------------------------------------------------------------
    r45503 | michael | 2020-05-26 09:20:44 +0200 (Tue, 26 May 2020) | 1 line
    
    * Expose status vector in interbase code, adapted patch by Joeny Ang. bug ID #0037143
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46593 -
This commit is contained in:
michael 2020-08-23 09:22:28 +00:00
parent f80252e809
commit e0febe8a29
1 changed files with 23 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
packages/fcl-db/src/sqldb/interbase/ibconnection.pp
View File

@ -26,16 +26,23 @@ type
ServerVersionString : string; //Complete version string, including name, platform
end;
TStatusVector = array [0..19] of ISC_STATUS;
{ EIBDatabaseError }
EIBDatabaseError = class(ESQLDatabaseError)
public
property GDSErrorCode: integer read ErrorCode; deprecated 'Please use ErrorCode instead of GDSErrorCode'; // Nov 2014
private
FStatusVector: TStatusVector;
public
Property StatusVector: TStatusVector Read FStatusVector Write FStatusVector;
property GDSErrorCode: integer read ErrorCode; deprecated 'Please use ErrorCode instead of GDSErrorCode'; // Nov 2014
end;
{ TIBCursor }
TIBCursor = Class(TSQLCursor)
protected
Status : array [0..19] of ISC_STATUS;
Status : TStatusVector;
TransactionHandle : pointer;
StatementHandle : pointer;
SQLDA : PXSQLDA;
@ -48,7 +55,7 @@ type
protected
TransactionHandle : pointer;
TPB : string; // Transaction parameter buffer
Status : array [0..19] of ISC_STATUS;
Status : TStatusVector;
end;
{ TIBConnection }
@ -57,7 +64,7 @@ type
private
FCheckTransactionParams: Boolean;
FDatabaseHandle : pointer;
FStatus : array [0..19] of ISC_STATUS;
FStatus : TStatusVector;
FDatabaseInfo : TDatabaseInfo;
FDialect : integer;
FBlobSegmentSize : word; //required for backward compatibilty; not used
@ -159,16 +166,17 @@ const
SQL_BOOLEAN_FIREBIRD = 32764;
INVALID_DATA = -1;
procedure TIBConnection.CheckError(ProcName : string; Status : PISC_STATUS);
var
ErrorCode : longint;
i,ErrorCode : longint;
Msg, SQLState : string;
Buf : array [0..1023] of char;
aStatusVector: TStatusVector;
Exc : EIBDatabaseError;
begin
if ((Status[0] = 1) and (Status[1] <> 0)) then
begin
begin
ErrorCode := Status[1];
{$IFDEF LinkDynamically}
if assigned(fb_sqlstate) then // >= Firebird 2.5
@ -177,11 +185,16 @@ begin
SQLState := StrPas(Buf);
end;
{$ENDIF}
{ get a local copy of status vector }
for i := 0 to 19 do
aStatusVector[i] := Status[i];
Msg := '';
while isc_interprete(Buf, @Status) > 0 do
Msg := Msg + LineEnding + ' -' + StrPas(Buf);
raise EIBDatabaseError.CreateFmt('%s : %s', [ProcName,Msg], Self, ErrorCode, SQLState);
end;
Exc:=EIBDatabaseError.CreateFmt('%s : %s', [ProcName,Msg], Self, ErrorCode, SQLState);
Exc.StatusVector:=aStatusVector;
raise Exc;
end;
end;