--- Merging r22471 into '.':

U    packages/fcl-db/src/base/fields.inc
--- Merging r22498 into '.':
U    packages/fcl-db/src/base/db.pas
--- Merging r22610 into '.':
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r22645 into '.':
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp

# revisions: 22471,22498,22610,22645
r22471 | marco | 2012-09-27 13:16:25 +0200 (Thu, 27 Sep 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/fields.inc

 * patch for mantis #22371 TTimeField.SetAsString stores data as NativeFormat corrupting time fields
r22498 | marco | 2012-09-28 21:55:41 +0200 (Fri, 28 Sep 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/db.pas

 * Make validchar writable, Mantis #23002, patch by Anton
r22610 | ludob | 2012-10-10 20:31:10 +0200 (Wed, 10 Oct 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp

pqconnection: use also EPQDatabaseError for Execute and UnPrepareStatement to deliver complete error info
r22645 | reiniero | 2012-10-14 18:05:04 +0200 (Sun, 14 Oct 2012) | 5 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

Firebird/Interbase connection minor+cosmetic fix:
* Use ibase.h time precision constant ISC_TIME_SECONDS_PRECISION instead of fixed value 10 000, making it more resilient against FB code changes
* Use IBTimeFractionsPerDay instead of IBSecsCount as it better matches naming within Firebird and it has nothing to do with counting seconds

git-svn-id: branches/fixes_2_6@22695 -

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

@@ -415,7 +415,7 @@ type
     property Offset: word read FOffset;
     property Size: Integer read FSize write SetSize;
     property Text: string read GetEditText write SetEditText;
-    property ValidChars : TFieldChars Read FValidChars;
+    property ValidChars : TFieldChars read FValidChars write FValidChars;
     property Value: variant read GetAsVariant write SetAsVariant;
     property OldValue: variant read GetOldValue;
     property LookupList: TLookupList read GetLookupList;

packages/fcl-db/src/base/fields.inc

@@ -2179,7 +2179,7 @@ begin
   else
     begin
     R:=StrToTime(AVAlue);
-    SetData(@R);
+    SetData(@R,False);
     end;
 end;
 

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

@@ -1042,7 +1042,7 @@ end;
 {$IFDEF SUPPORT_MSECS}
 const
   IBDateOffset = 15018; //an offset from 17 Nov 1858.
-  IBSecsCount  = SecsPerDay * 10000; //count of 1/10000 seconds since midnight.
+  IBTimeFractionsPerDay  = SecsPerDay * ISC_TIME_SECONDS_PRECISION; //Number of Firebird time fractions per day
 {$ENDIF}
 
 procedure TIBConnection.GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
@@ -1064,7 +1064,7 @@ begin
       {$IFNDEF SUPPORT_MSECS}
       isc_decode_sql_time(PISC_TIME(CurrBuff), @CTime);
       {$ELSE}
-      PTime :=  PISC_TIME(CurrBuff)^ / IBSecsCount;
+      PTime :=  PISC_TIME(CurrBuff)^ / IBTimeFractionsPerDay;
       {$ENDIF}
     SQL_TIMESTAMP :
       begin
@@ -1073,7 +1073,7 @@ begin
       {$ELSE}
       PTime := ComposeDateTime(
                   PISC_TIMESTAMP(CurrBuff)^.timestamp_date - IBDateOffset,
-                  PISC_TIMESTAMP(CurrBuff)^.timestamp_time / IBSecsCount
+                  PISC_TIMESTAMP(CurrBuff)^.timestamp_time / IBTimeFractionsPerDay
                );
       {$ENDIF}
       end
@@ -1123,7 +1123,7 @@ begin
       {$IFNDEF SUPPORT_MSECS}
       isc_encode_sql_time(@CTime, PISC_TIME(CurrBuff));
       {$ELSE}
-      PISC_TIME(CurrBuff)^ := Trunc(abs(Frac(PTime)) * IBSecsCount);
+      PISC_TIME(CurrBuff)^ := Trunc(abs(Frac(PTime)) * IBTimeFractionsPerDay);
       {$ENDIF}
     SQL_TIMESTAMP :
       begin
@@ -1131,7 +1131,7 @@ begin
       isc_encode_timestamp(@CTime, PISC_TIMESTAMP(CurrBuff));
       {$ELSE}
       PISC_TIMESTAMP(CurrBuff)^.timestamp_date := Trunc(PTime) + IBDateOffset;
-      PISC_TIMESTAMP(CurrBuff)^.timestamp_time := Trunc(abs(Frac(PTime)) * IBSecsCount);
+      PISC_TIMESTAMP(CurrBuff)^.timestamp_time := Trunc(abs(Frac(PTime)) * IBTimeFractionsPerDay);
       {$ENDIF}
       end
   else

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

@@ -31,6 +31,16 @@ type
     FieldBinding : array of integer;
   end;
 
+  EPQDatabaseError = class(EDatabaseError)
+    public
+      SEVERITY:string;
+      SQLSTATE: string;
+      MESSAGE_PRIMARY:string;
+      MESSAGE_DETAIL:string;
+      MESSAGE_HINT:string;
+      STATEMENT_POSITION:string;
+  end;
+
   { TPQConnection }
 
   TPQConnection = class (TSQLConnection)
@@ -40,6 +50,7 @@ type
     FSQLDatabaseHandle   : pointer;
     FIntegerDateTimes    : boolean;
     procedure CheckResultError(res: PPGresult; conn:PPGconn; ErrMsg: string);
+    function GetPQDatabaseError(res : PPGresult;ErrMsg: string):EPQDatabaseError;
     function TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer) : TFieldType;
     procedure ExecuteDirectPG(const Query : String);
   protected
@@ -90,16 +101,6 @@ type
     Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
   end;
 
-  EPQDatabaseError = class(EDatabaseError)
-    public
-      SEVERITY:string;
-      SQLSTATE: string;
-      MESSAGE_PRIMARY:string;
-      MESSAGE_DETAIL:string;
-      MESSAGE_HINT:string;
-      STATEMENT_POSITION:string;
-  end;
-
 implementation
 
 uses math, strutils, FmtBCD;
@@ -349,47 +350,56 @@ end;
 procedure TPQConnection.CheckResultError(res: PPGresult; conn: PPGconn;
   ErrMsg: string);
 var
-  serr:string;
   E: EPQDatabaseError;
-  CompName: string;
-  SEVERITY:string;
-  SQLSTATE: string;
-  MESSAGE_PRIMARY:string;
-  MESSAGE_DETAIL:string;
-  MESSAGE_HINT:string;
-  STATEMENT_POSITION:string;
 
 begin
   if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
     begin
-    SEVERITY:=PQresultErrorField(res,ord('S'));
-    SQLSTATE:=PQresultErrorField(res,ord('C'));
-    MESSAGE_PRIMARY:=PQresultErrorField(res,ord('M'));
-    MESSAGE_DETAIL:=PQresultErrorField(res,ord('D'));
-    MESSAGE_HINT:=PQresultErrorField(res,ord('H'));
-    STATEMENT_POSITION:=PQresultErrorField(res,ord('P'));
-    serr:=PQresultErrorMessage(res)+LineEnding+
-      'Severity: '+ SEVERITY +LineEnding+
-      'SQL State: '+ SQLSTATE +LineEnding+
-      'Primary Error: '+ MESSAGE_PRIMARY +LineEnding+
-      'Error Detail: '+ MESSAGE_DETAIL +LineEnding+
-      'Hint: '+ MESSAGE_HINT +LineEnding+
-      'Character: '+ STATEMENT_POSITION +LineEnding;
+    E:=GetPQDatabaseError(res,ErrMsg);
     pqclear(res);
     if assigned(conn) then
       PQFinish(conn);
-    if Self.Name = '' then CompName := Self.ClassName else CompName := Self.Name;
-    E:=EPQDatabaseError.CreateFmt('%s : %s  (PostgreSQL: %s)', [CompName,ErrMsg, serr]);
-    E.SEVERITY:=SEVERITY;
-    E.SQLSTATE:=SQLSTATE;
-    E.MESSAGE_PRIMARY:=MESSAGE_PRIMARY;
-    E.MESSAGE_DETAIL:=MESSAGE_DETAIL;
-    E.MESSAGE_HINT:=MESSAGE_HINT;
-    E.STATEMENT_POSITION:=STATEMENT_POSITION;
     raise E;
     end;
 end;
 
+function TPQConnection.GetPQDatabaseError(res: PPGresult; ErrMsg: string
+  ): EPQDatabaseError;
+var
+  serr:string;
+  E: EPQDatabaseError;
+  CompName: string;
+  SEVERITY:string;
+  SQLSTATE: string;
+  MESSAGE_PRIMARY:string;
+  MESSAGE_DETAIL:string;
+  MESSAGE_HINT:string;
+  STATEMENT_POSITION:string;
+begin
+  SEVERITY:=PQresultErrorField(res,ord('S'));
+  SQLSTATE:=PQresultErrorField(res,ord('C'));
+  MESSAGE_PRIMARY:=PQresultErrorField(res,ord('M'));
+  MESSAGE_DETAIL:=PQresultErrorField(res,ord('D'));
+  MESSAGE_HINT:=PQresultErrorField(res,ord('H'));
+  STATEMENT_POSITION:=PQresultErrorField(res,ord('P'));
+  serr:=PQresultErrorMessage(res)+LineEnding+
+    'Severity: '+ SEVERITY +LineEnding+
+    'SQL State: '+ SQLSTATE +LineEnding+
+    'Primary Error: '+ MESSAGE_PRIMARY +LineEnding+
+    'Error Detail: '+ MESSAGE_DETAIL +LineEnding+
+    'Hint: '+ MESSAGE_HINT +LineEnding+
+    'Character: '+ STATEMENT_POSITION +LineEnding;
+  if Self.Name = '' then CompName := Self.ClassName else CompName := Self.Name;
+  E:=EPQDatabaseError.CreateFmt('%s : %s  (PostgreSQL: %s)', [CompName,ErrMsg, serr]);
+  E.SEVERITY:=SEVERITY;
+  E.SQLSTATE:=SQLSTATE;
+  E.MESSAGE_PRIMARY:=MESSAGE_PRIMARY;
+  E.MESSAGE_DETAIL:=MESSAGE_DETAIL;
+  E.MESSAGE_HINT:=MESSAGE_HINT;
+  E.STATEMENT_POSITION:=STATEMENT_POSITION;
+  result:=E;
+end;
+
 function TPQConnection.TranslateFldType(res : PPGresult; Tuple : integer; out Size : integer) : TFieldType;
 const VARHDRSZ=sizeof(longint);
 var li : longint;
@@ -580,6 +590,8 @@ begin
 end;
 
 procedure TPQConnection.UnPrepareStatement(cursor : TSQLCursor);
+var
+  E: EPQDatabaseError;
 
 begin
   with (cursor as TPQCursor) do if FPrepared then
@@ -590,8 +602,9 @@ begin
       res := pqexec(tr.PGConn,pchar('deallocate '+StmtName));
       if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
         begin
+          E:=GetPQDatabaseError(res,SErrPrepareFailed);
           pqclear(res);
-          DatabaseError(SErrPrepareFailed + ' (PostgreSQL: ' + PQerrorMessage(tr.PGConn) + ')',self)
+          raise E;
         end
       else
         pqclear(res);
@@ -609,6 +622,7 @@ var ar  : array of pchar;
     ParamNames,
     ParamValues : array of string;
     cash: int64;
+    E: EPQDatabaseError;
 
 begin
   with cursor as TPQCursor do
@@ -687,14 +701,14 @@ begin
       end;
     if assigned(res) and not (PQresultStatus(res) in [PGRES_COMMAND_OK,PGRES_TUPLES_OK]) then
       begin
-      s := PQerrorMessage(tr.PGConn);
+      E:=GetPQDatabaseError(res,SErrExecuteFailed);
       pqclear(res);
 
       tr.ErrorOccured := True;
 // Don't perform the rollback, only make it possible to do a rollback.
 // The other databases also don't do this.
 //      atransaction.Rollback;
-      DatabaseError(SErrExecuteFailed + ' (PostgreSQL: ' + s + ')',self);
+      raise E;
       end;
     end;
 end;