Browse Source

--- Merging r20109 into '.':
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r20146 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r20154 into '.':
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r20182 into '.':
U packages/fcl-db/src/memds/memds.pp
--- Merging r20194 into '.':
U packages/fcl-db/src/sqlite/customsqliteds.pas
--- Merging r20195 into '.':
G packages/fcl-db/src/sqlite/customsqliteds.pas
--- Merging r20208 into '.':
U packages/fcl-db/src/base/fields.inc
--- Merging r20267 into '.':
U rtl/objpas/fmtbcd.pp

# revisions: 20109,20146,20154,20182,20194,20195,20208,20267
------------------------------------------------------------------------
r20109 | marco | 2012-01-19 11:15:54 +0100 (Thu, 19 Jan 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

* ftBytes,ftVarBytes support in odbcconnection.setparameters
Patch by Lacak2, Mantis #21116

------------------------------------------------------------------------
------------------------------------------------------------------------
r20146 | marco | 2012-01-21 22:46:31 +0100 (Sat, 21 Jan 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* LoadExtension, patch by BigChimp, Mantis #20640

------------------------------------------------------------------------
------------------------------------------------------------------------
r20154 | marco | 2012-01-22 19:53:43 +0100 (Sun, 22 Jan 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

* Use own power of ten scaling routine to avoid problems with FPU precision.
Patch by Lacak2, mantis #20011

------------------------------------------------------------------------
------------------------------------------------------------------------
r20182 | marco | 2012-01-27 09:50:37 +0100 (Fri, 27 Jan 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/memds/memds.pp

* changed bookmarksize to sizeof(longint) Mantis #13967

------------------------------------------------------------------------
------------------------------------------------------------------------
r20194 | blikblum | 2012-01-30 00:36:15 +0100 (Mon, 30 Jan 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqlite/customsqliteds.pas

sqliteds: fix compilation with 2.4 and 2.6 fpc compiler
------------------------------------------------------------------------
------------------------------------------------------------------------
r20195 | blikblum | 2012-01-30 00:40:24 +0100 (Mon, 30 Jan 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqlite/customsqliteds.pas

sqliteds: better approach to fix compilation with 2.4 and 2.6 fpc compiler
------------------------------------------------------------------------
------------------------------------------------------------------------
r20208 | marco | 2012-02-01 15:29:01 +0100 (Wed, 01 Feb 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/fields.inc

* set BCD and time fields to NULL when an empty string is passed. Mantis #21204, patch by Ludo

------------------------------------------------------------------------
------------------------------------------------------------------------
r20267 | sekelsenmat | 2012-02-06 10:07:35 +0100 (Mon, 06 Feb 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/fmtbcd.pp

Fixes stack check crash in fmtbcd.pp see bug #21208
------------------------------------------------------------------------

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

marco 13 years ago
parent
commit
75ae8f0db1

+ 15 - 4
packages/fcl-db/src/base/fields.inc

@@ -2167,8 +2167,13 @@ end;
 procedure TTimeField.SetAsString(const AValue: string);
 procedure TTimeField.SetAsString(const AValue: string);
 Var R : TDateTime;
 Var R : TDateTime;
 begin
 begin
-  R:=StrToTime(AVAlue);
-  SetData(@R);
+  if AValue='' then
+    Clear    // set to NULL
+  else
+    begin
+    R:=StrToTime(AVAlue);
+    SetData(@R);
+    end;
 end;
 end;
 
 
 
 
@@ -2483,7 +2488,10 @@ end;
 procedure TBCDField.SetAsString(const AValue: string);
 procedure TBCDField.SetAsString(const AValue: string);
 
 
 begin
 begin
-  SetAsCurrency(strtocurr(AValue));
+  if AValue='' then
+    Clear    // set to NULL
+  else
+    SetAsCurrency(strtocurr(AValue));
 end;
 end;
 
 
 constructor TBCDField.Create(AOwner: TComponent);
 constructor TBCDField.Create(AOwner: TComponent);
@@ -2664,7 +2672,10 @@ end;
 
 
 procedure TFMTBCDField.SetAsString(const AValue: string);
 procedure TFMTBCDField.SetAsString(const AValue: string);
 begin
 begin
-  SetAsBCD(StrToBCD(AValue));
+  if AValue='' then
+    Clear    // set to NULL
+  else
+    SetAsBCD(StrToBCD(AValue));
 end;
 end;
 
 
 
 

+ 1 - 1
packages/fcl-db/src/memds/memds.pp

@@ -265,7 +265,7 @@ begin
   FRecBufferSize:=0;
   FRecBufferSize:=0;
   FRecInfoOffset:=0;
   FRecInfoOffset:=0;
   FCurrRecNo:=-1;
   FCurrRecNo:=-1;
-  BookmarkSize := sizeof(TMTRecInfo);
+  BookmarkSize := sizeof(Longint);
   FIsOpen:=False;
   FIsOpen:=False;
 end;
 end;
 
 

+ 32 - 37
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -7,7 +7,7 @@ unit IBConnection;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, sqldb, db, math, dbconst, bufdataset,
+  Classes, SysUtils, sqldb, db, dbconst, bufdataset,
 {$IfDef LinkDynamically}
 {$IfDef LinkDynamically}
   ibase60dyn;
   ibase60dyn;
 {$Else}
 {$Else}
@@ -745,6 +745,19 @@ begin
   Result := (retcode = 0);
   Result := (retcode = 0);
 end;
 end;
 
 
+function IntPower10(e: integer): double;
+const PreComputedPower10: array[0..9] of integer = (1,10,100,1000,10000,100000,1000000,10000000,100000000,1000000000);
+var n: integer;
+begin
+  n := abs(e); //exponent can't be greater than 18
+  if n <= 9 then
+    Result := PreComputedPower10[n]
+  else
+    Result := PreComputedPower10[9] * PreComputedPower10[n-9];
+  if e < 0 then
+    Result := 1 / Result;
+end;
+
 procedure TIBConnection.SetParameters(cursor : TSQLCursor; aTransation : TSQLTransaction; AParams : TParams);
 procedure TIBConnection.SetParameters(cursor : TSQLCursor; aTransation : TSQLTransaction; AParams : TParams);
 
 
 var ParNr,SQLVarNr : integer;
 var ParNr,SQLVarNr : integer;
@@ -800,8 +813,7 @@ var
   // This should be a pointer, because the ORIGINAL variables must
   // This should be a pointer, because the ORIGINAL variables must
   // be modified.
   // be modified.
   VSQLVar: ^XSQLVAR;
   VSQLVar: ^XSQLVAR;
-  d : double;
-  
+
 begin
 begin
 {$R-}
 {$R-}
   with cursor as TIBCursor do for SQLVarNr := 0 to High(ParamBinding){AParams.count-1} do
   with cursor as TIBCursor do for SQLVarNr := 0 to High(ParamBinding){AParams.count-1} do
@@ -820,7 +832,7 @@ begin
             if VSQLVar^.sqlscale = 0 then
             if VSQLVar^.sqlscale = 0 then
               i := AParams[ParNr].AsInteger
               i := AParams[ParNr].AsInteger
             else
             else
-              i := Round(AParams[ParNr].AsCurrency * IntPower(10, -VSQLVar^.sqlscale));
+              i := Round(AParams[ParNr].AsCurrency * IntPower10(-VSQLVar^.sqlscale));
             Move(i, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
             Move(i, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
           end;
           end;
         SQL_SHORT :
         SQL_SHORT :
@@ -828,7 +840,7 @@ begin
             if VSQLVar^.sqlscale = 0 then
             if VSQLVar^.sqlscale = 0 then
               si := AParams[ParNr].AsSmallint
               si := AParams[ParNr].AsSmallint
             else
             else
-              si := Round(AParams[ParNr].AsCurrency * IntPower(10, -VSQLVar^.sqlscale));
+              si := Round(AParams[ParNr].AsCurrency * IntPower10(-VSQLVar^.sqlscale));
             i := si;
             i := si;
             Move(i, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
             Move(i, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
           end;
           end;
@@ -864,12 +876,9 @@ begin
             if VSQLVar^.sqlscale = 0 then
             if VSQLVar^.sqlscale = 0 then
               li := AParams[ParNr].AsLargeInt
               li := AParams[ParNr].AsLargeInt
             else if AParams[ParNr].DataType = ftFMTBcd then
             else if AParams[ParNr].DataType = ftFMTBcd then
-              begin
-              d:=AParams[ParNr].AsFMTBCD * IntPower(10, -VSQLVar^.sqlscale);
-              li := Round(d)
-              end
+              li := AParams[ParNr].AsFMTBCD * IntPower10(-VSQLVar^.sqlscale)
             else
             else
-              li := Round(AParams[ParNr].AsCurrency * IntPower(10, -VSQLVar^.sqlscale));
+              li := Round(AParams[ParNr].AsCurrency * IntPower10(-VSQLVar^.sqlscale));
             Move(li, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
             Move(li, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
           end;
           end;
         SQL_DOUBLE, SQL_FLOAT:
         SQL_DOUBLE, SQL_FLOAT:
@@ -890,9 +899,13 @@ var
   CurrBuff     : pchar;
   CurrBuff     : pchar;
   c            : currency;
   c            : currency;
   AFmtBcd      : tBCD;
   AFmtBcd      : tBCD;
-  smalli       : smallint;
-  longi        : longint;
-  largei       : largeint;
+
+  function BcdDivPower10(Dividend: largeint; e: integer): TBCD;
+  var d: double;
+  begin
+    d := Dividend / IntPower10(e);
+    Result := StrToBCD( FloatToStr(d) );
+  end;
 
 
 begin
 begin
   CreateBlob := False;
   CreateBlob := False;
@@ -930,18 +943,9 @@ begin
         ftBCD :
         ftBCD :
           begin
           begin
             case SQLDA^.SQLVar[x].SQLLen of
             case SQLDA^.SQLVar[x].SQLLen of
-              2 : begin
-                  Move(CurrBuff^, smalli, 2);
-                  c := smalli*intpower(10,SQLDA^.SQLVar[x].SQLScale);
-                  end;
-              4 : begin
-                  Move(CurrBuff^, longi, 4);
-                  c := longi*intpower(10,SQLDA^.SQLVar[x].SQLScale);
-                  end;
-              8 : begin
-                  Move(CurrBuff^, largei, 8);
-                  c := largei*intpower(10,SQLDA^.SQLVar[x].SQLScale);
-                  end;
+              2 : c := PSmallint(CurrBuff)^ / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
+              4 : c := PLongint(CurrBuff)^  / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
+              8 : c := PLargeint(CurrBuff)^ / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
               else
               else
                 Result := False; // Just to be sure, in principle this will never happen
                 Result := False; // Just to be sure, in principle this will never happen
             end; {case}
             end; {case}
@@ -950,18 +954,9 @@ begin
         ftFMTBcd :
         ftFMTBcd :
           begin
           begin
             case SQLDA^.SQLVar[x].SQLLen of
             case SQLDA^.SQLVar[x].SQLLen of
-              2 : begin
-                  Move(CurrBuff^, smalli, 2);
-                  AFmtBCD:= smalli*intpower(10,SQLDA^.SQLVar[x].SQLScale);
-                  end;
-              4 : begin
-                  Move(CurrBuff^, longi, 4);
-                  AFmtBcd := longi*intpower(10,SQLDA^.SQLVar[x].SQLScale);
-                  end;
-              8 : begin
-                  Move(CurrBuff^, largei, 8);
-                  AFmtBcd := largei*intpower(10,SQLDA^.SQLVar[x].SQLScale);
-                  end;
+              2 : AFmtBcd := BcdDivPower10(PSmallint(CurrBuff)^, -SQLDA^.SQLVar[x].SQLScale);
+              4 : AFmtBcd := BcdDivPower10(PLongint(CurrBuff)^,  -SQLDA^.SQLVar[x].SQLScale);
+              8 : AFmtBcd := BcdDivPower10(PLargeint(CurrBuff)^, -SQLDA^.SQLVar[x].SQLScale);
               else
               else
                 Result := False; // Just to be sure, in principle this will never happen
                 Result := False; // Just to be sure, in principle this will never happen
             end; {case}
             end; {case}

+ 14 - 2
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -364,7 +364,8 @@ begin
           SqlType:=SQL_BIGINT;
           SqlType:=SQL_BIGINT;
           ColumnSize:=19;
           ColumnSize:=19;
         end;
         end;
-      ftString, ftFixedChar, ftBlob, ftMemo, ftGuid:
+      ftString, ftFixedChar, ftBlob, ftMemo, ftGuid,
+      ftBytes, ftVarBytes:
         begin
         begin
           StrVal:=AParams[ParamIndex].AsString;
           StrVal:=AParams[ParamIndex].AsString;
           StrLenOrInd:=Length(StrVal);
           StrLenOrInd:=Length(StrVal);
@@ -378,6 +379,11 @@ begin
           ColumnSize:=Size;
           ColumnSize:=Size;
           BufferLength:=Size;
           BufferLength:=Size;
           case AParams[ParamIndex].DataType of
           case AParams[ParamIndex].DataType of
+            ftBytes, ftVarBytes:
+              begin
+              CType:=SQL_C_BINARY;
+              SqlType:=SQL_VARBINARY;
+              end;
             ftBlob:
             ftBlob:
               begin
               begin
               CType:=SQL_C_BINARY;
               CType:=SQL_C_BINARY;
@@ -825,7 +831,13 @@ begin
     ftBytes:              // mapped to TBytesField
     ftBytes:              // mapped to TBytesField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, FieldDef.Size, @StrLenOrInd);
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, FieldDef.Size, @StrLenOrInd);
     ftVarBytes:           // mapped to TVarBytesField
     ftVarBytes:           // mapped to TVarBytesField
-      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer, FieldDef.Size, @StrLenOrInd);
+    begin
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, buffer+SizeOf(Word), FieldDef.Size, @StrLenOrInd);
+      if StrLenOrInd < 0 then
+        PWord(buffer)^ := 0
+      else
+        PWord(buffer)^ := StrLenOrInd;
+    end;
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
     ftWideMemo,
     ftWideMemo,
 {$ENDIF}
 {$ENDIF}

+ 26 - 0
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -94,6 +94,7 @@ type
     constructor Create(AOwner : TComponent); override;
     constructor Create(AOwner : TComponent); override;
     function GetInsertID: int64;
     function GetInsertID: int64;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
+    procedure LoadExtension(LibraryFile: string);
   published
   published
     property Options: TSqliteOptions read FOptions write SetOptions;
     property Options: TSqliteOptions read FOptions write SetOptions;
   end;
   end;
@@ -910,6 +911,31 @@ begin
   GetDBInfo(stColumns,TableName,'name',List);
   GetDBInfo(stColumns,TableName,'name',List);
 end;
 end;
 
 
+procedure Tsqlite3connection.LoadExtension(Libraryfile: String);
+var
+  LoadResult: integer;
+begin
+  CheckConnected; //Apparently we need a connection before we can load extensions.
+  LoadResult:=SQLITE_ERROR; //Default to failed  
+  try    
+    LoadResult:=sqlite3_enable_load_extension(fhandle, 1); //Make sure we are allowed to load
+    if LoadResult=SQLITE_OK then
+      begin
+      LoadResult:=sqlite3_load_extension(fhandle, PChar(LibraryFile), nil, nil); //Actually load extension
+      if LoadResult=SQLITE_ERROR then
+        begin
+        DatabaseError('LoadExtension: failed to load SQLite extension (SQLite returned an error while loading).',Self);
+        end;
+      end
+      else
+      begin
+        DatabaseError('LoadExtension: failed to load SQLite extension (SQLite returned an error while enabling extensions).',Self);
+      end;
+  except
+    DatabaseError('LoadExtension: failed to load SQLite extension.',Self)
+  end;
+end;
+
 procedure TSQLite3Connection.setoptions(const avalue: tsqliteoptions);
 procedure TSQLite3Connection.setoptions(const avalue: tsqliteoptions);
 begin
 begin
  if avalue <> foptions then 
  if avalue <> foptions then 

+ 3 - 0
packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -45,6 +45,9 @@ const
   DefaultStringSize = 255;
   DefaultStringSize = 255;
 
 
 type
 type
+  {$if defined(ver2_6_0) or defined(ver2_4)}
+  TRecordBuffer = PAnsiChar;
+  {$endif}
   TCustomSqliteDataset = class;
   TCustomSqliteDataset = class;
 
 
   PDataRecord = ^DataRecord;
   PDataRecord = ^DataRecord;

+ 2 - 2
rtl/objpas/fmtbcd.pp

@@ -43,8 +43,8 @@
 
 
 { $define debug_version}
 { $define debug_version}
 
 
-{$r+,q+,s+}
-{ $r-,q-,s-}
+// Dont use s+ (Stack checking on) because it crashes libraries, see bug 21208
+{$r+,q+,s-}
 
 
 {$mode objfpc}
 {$mode objfpc}
 {$h-}
 {$h-}