fcl-db: reverts rev.29118, because there are 3rd party libraries (like ZEOS), which define own EDatabaseError descendants, where they define members FErrorCode and/or ErrorCode.

This patch also fixes bugs #27078 and #26684, what was intention of rev.29118

git-svn-id: trunk@29163 -

packages/fcl-db/src/base/bufdataset.pas

@@ -2355,7 +2355,7 @@ var r            : Integer;
     FailedCount  : integer;
     Response     : TResolverResponse;
     StoreCurrRec : TBufBookmark;
-    AUpdateErr   : EUpdateError;
+    AUpdateError : EUpdateError;
 
 begin
   CheckBrowseMode;
@@ -2382,18 +2382,23 @@ begin
           on E: EDatabaseError do
             begin
             Inc(FailedCount);
-            if FailedCount > word(MaxErrors) then Response := rrAbort
-            else Response := rrSkip;
+            if FailedCount > word(MaxErrors) then
+              Response := rrAbort
+            else
+              Response := rrSkip;
             if assigned(FOnUpdateError) then
               begin
-              AUpdateErr := PSGetUpdateException(Exception(AcquireExceptionObject), nil);
-              FOnUpdateError(Self,Self,AUpdateErr,FUpdateBuffer[r].UpdateKind,Response);
-              AUpdateErr.Free;
+              AUpdateError := PSGetUpdateException(Exception(AcquireExceptionObject), nil);
+              FOnUpdateError(Self, Self, AUpdateError, FUpdateBuffer[r].UpdateKind, Response);
+              AUpdateError.Free;
               if Response in [rrApply, rrIgnore] then dec(FailedCount);
               if Response = rrApply then dec(r);
               end
             else if Response = rrAbort then
-              Raise EUpdateError.Create(SOnUpdateError,E.Message,E.ErrorCode,0,Exception(AcquireExceptionObject));
+              begin
+              AUpdateError := PSGetUpdateException(Exception(AcquireExceptionObject), nil);
+              raise AUpdateError;
+              end;
             end
           else
             raise;

packages/fcl-db/src/base/db.pas

@@ -78,18 +78,12 @@ type
 
 { Exception classes }
 
-  { EDatabaseError }
-
-  EDatabaseError = class(Exception)
-  Protected
-    FErrorCode: integer;
-  Public
-    Property ErrorCode: integer Read FErrorCode;
-  end;
+  EDatabaseError = class(Exception);
 
   EUpdateError   = class(EDatabaseError)
   private
     FContext           : String;
+    FErrorCode         : integer;
     FOriginalException : Exception;
     FPreviousError     : Integer;
   public
@@ -97,6 +91,7 @@ type
       ErrCode, PrevError : integer; E: Exception);
     Destructor Destroy; override;
     property Context : String read FContext;
+    property ErrorCode : integer read FErrorcode;
     property OriginalException : Exception read FOriginalException;
     property PreviousError : Integer read FPreviousError;
   end;

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -27,8 +27,8 @@ type
   end;
 
   EIBDatabaseError = class(ESQLDatabaseError)
-  public
-    property GDSErrorCode: integer read FErrorCode Write FErrorCode;
+    public
+      property GDSErrorCode: integer read ErrorCode; deprecated 'Please use ErrorCode instead of GDSErrorCode'; // Nov 2014
   end;
 
   { TIBCursor }
@@ -152,20 +152,26 @@ const
 
 procedure TIBConnection.CheckError(ProcName : string; Status : PISC_STATUS);
 var
-  buf : array [0..1023] of char;
-  Msg : string;
-  E   : EIBDatabaseError;
   Err : longint;
-  
+  Msg : string;
+  Buf : array [0..1023] of char;
+  E   : EIBDatabaseError;
+
 begin
   if ((Status[0] = 1) and (Status[1] <> 0)) then
   begin
     Err := Status[1];
-    msg := '';
+    Msg := '';
     while isc_interprete(Buf, @Status) > 0 do
-      Msg := Msg + LineEnding +' -' + StrPas(Buf);
-    E := EIBDatabaseError.CreateFmt('%s : %s : %s',[self.Name,ProcName,Msg]);
-    E.GDSErrorCode := Err;
+      Msg := Msg + LineEnding + ' -' + StrPas(Buf);
+    E := EIBDatabaseError.CreateFmt('%s : %s', [ProcName,Msg], Self, Err, '');
+{$IFDEF LinkDynamically}
+    if assigned(fb_sqlstate) then // >= Firebird 2.5
+    begin
+      fb_sqlstate(Buf, Status);
+      E.SQLState := StrPas(Buf);
+    end;
+{$ENDIF}
     Raise E;
   end;
 end;

packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -140,7 +140,7 @@ type
 
   EMSSQLDatabaseError = class(ESQLDatabaseError)
     public
-      property DBErrorCode: integer read FErrorCode; deprecated 'Please use ErrorCode instead of DBErrorCode'; // Feb 2014
+      property DBErrorCode: integer read ErrorCode; deprecated 'Please use ErrorCode instead of DBErrorCode'; // Feb 2014
   end;
 
   { TMSSQLConnectionDef }
@@ -298,13 +298,13 @@ var E: EMSSQLDatabaseError;
 begin
   if (Ret=FAIL) or (DBErrorStr<>'') then
   begin
+    // try clear all pending results to allow ROLLBACK and prevent error 10038 "Results pending"
+    if assigned(FDBProc) then dbcancel(FDBProc);
     if DBErrorStr = '' then
       case DBErrorNo of
         SYBEFCON: DBErrorStr:='SQL Server connection failed!';
       end;
     E:=EMSSQLDatabaseError.CreateFmt('Error %d : %s'+LineEnding+'%s', [DBErrorNo, DBErrorStr, DBMsgStr], Self, DBErrorNo, '');
-    // try clear all pending results to allow ROLLBACK and prevent error 10038 "Results pending"
-    if assigned(FDBProc) then dbcancel(FDBProc);
     DBErrorStr:='';
     DBMsgStr:='';
     raise E;

packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

@@ -31,7 +31,7 @@ const
 type
   EOraDatabaseError = class(ESQLDatabaseError)
     public
-      property ORAErrorCode: integer read FErrorCode; deprecated 'Please use ErrorCode instead of ORAErrorCode'; // June 2014
+      property ORAErrorCode: integer read ErrorCode; deprecated 'Please use ErrorCode instead of ORAErrorCode'; // June 2014
   end;
 
   TOracleTrans = Class(TSQLHandle)
@@ -332,13 +332,13 @@ end;
 
 procedure TOracleConnection.HandleError;
 
-var
-  errcode : sb4;
-  buf     : array[0..1023] of char;
-
+var errcode : sb4;
+    buf     : array[0..1023] of char;
+    E       : EOraDatabaseError;
 begin
   OCIErrorGet(FOciError,1,nil,errcode,@buf[0],1024,OCI_HTYPE_ERROR);
-  Raise EOraDatabaseError.Create(pchar(buf),Self,ErrCode,'');;
+
+  raise EOraDatabaseError.CreateFmt('%s', [pchar(buf)], Self, errcode, '')
 end;
 
 procedure TOracleConnection.GetParameters(cursor: TSQLCursor; ATransaction : TSQLTransaction; AParams: TParams);

packages/fcl-db/src/sqldb/sqldb.pp

@@ -70,13 +70,11 @@ type
   { ESQLDatabaseError}
 
   ESQLDatabaseError = class(EDatabaseError)
-    Private
-      Function GetNamePrefix (comp : TComponent; Fmt: String) :String;
     public
+      ErrorCode: integer;
       SQLState : string;
       constructor CreateFmt(const Fmt: string; const Args: array of const;
                             Comp : TComponent; AErrorCode: integer; ASQLState: string); overload;
-      constructor Create(AMessage: string; Comp : TComponent; AErrorCode: integer; ASQLState: string); overload;
   end;
 
   { TSQLDBFieldDef }
@@ -747,36 +745,20 @@ end;
 
 { ESQLDatabaseError }
 
-Function ESQLDatabaseError.GetNamePrefix(comp: TComponent; Fmt: String): String;
-
-const
-   CompNameFmt='%s : %s';
-
-begin
-  if not assigned(Comp) then
-    Result := Fmt
-  else if Comp.Name = '' then
-    Result := Format(CompNameFmt, [Comp.ClassName,Fmt])
-  else
-    Result := Format(CompNameFmt, [Comp.Name,Fmt]);
-end;
-
 constructor ESQLDatabaseError.CreateFmt(const Fmt: string; const Args: array of const;
   Comp: TComponent; AErrorCode: integer; ASQLState: string);
+const CompNameFmt='%s : %s';
 var Msg: string;
 begin
-  Msg:=GetNamePrefix(Comp,Fmt);
-  inherited CreateFmt(Msg, Args);
-  FErrorCode := AErrorCode;
-  SQLState  := ASQLState;
-end;
+  if not assigned(Comp) then
+    Msg := Fmt
+  else if Comp.Name = '' then
+    Msg := Format(CompNameFmt, [Comp.ClassName,Fmt])
+  else
+    Msg := Format(CompNameFmt, [Comp.Name,Fmt]);
 
-constructor ESQLDatabaseError.Create(AMessage: string; Comp: TComponent;
-  AErrorCode: integer; ASQLState: string);
-begin
-  AMessage:=GetNamePrefix(Comp,AMessage);
-  inherited Create(AMessage);
-  FErrorCode := AErrorCode;
+  inherited CreateFmt(Msg, Args);
+  ErrorCode := AErrorCode;
   SQLState  := ASQLState;
 end;