Browse Source

* Batch of mostly db merges + TBytes definition that is already used in packages.

git-svn-id: branches/fixes_2_6@20006 -
marco 13 years ago
parent
commit
554ea590e3

+ 1 - 1
.gitattributes

@@ -1975,6 +1975,7 @@ packages/fcl-db/tests/Makefile.fpc -text
 packages/fcl-db/tests/README.txt svneol=native#text/plain
 packages/fcl-db/tests/XMLXSDExportTest.lpi svneol=native#text/plain
 packages/fcl-db/tests/XMLXSDExportTest.lpr svneol=native#text/plain
+packages/fcl-db/tests/bufdatasettoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/database.ini.txt svneol=native#text/plain
 packages/fcl-db/tests/dbftoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/dbtestframework.pas svneol=native#text/plain
@@ -1995,7 +1996,6 @@ packages/fcl-db/tests/testsqlfiles.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlscript.pas svneol=native#text/plain
-packages/fcl-db/tests/testwherenull.lpr svneol=native#text/plain
 packages/fcl-db/tests/toolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/xmlxsdexporttestcase1.pas svneol=native#text/plain
 packages/fcl-extra/Makefile svneol=native#text/plain

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

@@ -916,7 +916,7 @@ begin
         AField := TField(IndexFields[FieldNr]);
         ProcessFieldCompareStruct(AField,DBCompareStruct[FieldNr]);
 
-        DBCompareStruct[FieldNr].Desc := (DescIndexFields.IndexOf(AField)>-1);
+        DBCompareStruct[FieldNr].Desc := (DescIndexFields.IndexOf(AField)>-1) or (ixDescending in Options);
         if (CInsIndexFields.IndexOf(AField)>-1) then
           DBCompareStruct[FieldNr].Options := [loCaseInsensitive]
         else

+ 7 - 1
packages/fcl-db/src/base/db.pas

@@ -324,6 +324,7 @@ type
     procedure FreeBuffers; virtual;
     function GetAsBCD: TBCD; virtual;
     function GetAsBoolean: Boolean; virtual;
+    function GetAsBytes: TBytes; virtual;
     function GetAsCurrency: Currency; virtual;
     function GetAsLargeInt: LargeInt; virtual;
     function GetAsDateTime: TDateTime; virtual;
@@ -350,6 +351,7 @@ type
     procedure ReadState(Reader: TReader); override;
     procedure SetAsBCD(const AValue: TBCD); virtual;
     procedure SetAsBoolean(AValue: Boolean); virtual;
+    procedure SetAsBytes(const AValue: TBytes); virtual;
     procedure SetAsCurrency(AValue: Currency); virtual;
     procedure SetAsDateTime(AValue: TDateTime); virtual;
     procedure SetAsFloat(AValue: Double); virtual;
@@ -384,6 +386,7 @@ type
     procedure Validate(Buffer: Pointer);
     property AsBCD: TBCD read GetAsBCD write SetAsBCD;
     property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
+    property AsBytes: TBytes read GetAsBytes write SetAsBytes;
     property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
     property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
     property AsFloat: Double read GetAsFloat write SetAsFloat;
@@ -732,8 +735,11 @@ type
   TBinaryField = class(TField)
   protected
     class procedure CheckTypeSize(AValue: Longint); override;
+    function GetAsBytes: TBytes; override;
     function GetAsString: string; override;
+    function GetAsVariant: Variant; override;
     procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+    procedure SetAsBytes(const AValue: TBytes); override;
     procedure SetAsString(const AValue: string); override;
     procedure SetText(const AValue: string); override;
     procedure SetVarValue(const AValue: Variant); override;
@@ -1097,7 +1103,7 @@ type
 
   { TParam }
 
-  TBlobData = string;
+  TBlobData = AnsiString;  // Delphi defines it as alias to TBytes
 
   TParamBinding = array of integer;
 

+ 15 - 2
packages/fcl-db/src/base/dsparams.inc

@@ -544,9 +544,20 @@ begin
 end;
 
 Function TParam.GetAsString: string;
+var P: Pointer;
 begin
   If IsNull then
     Result:=''
+  else if (FDataType in [ftBytes, ftVarBytes]) and VarIsArray(FValue) then
+  begin
+    SetLength(Result, (VarArrayHighBound(FValue, 1) + 1) div SizeOf(Char));
+    P := VarArrayLock(FValue);
+    try
+      Move(P^, Result[1], Length(Result) * SizeOf(Char));
+    finally
+      VarArrayUnlock(FValue);
+    end;
+  end
   else
     Result:=FValue;
 end;
@@ -706,6 +717,8 @@ begin
     else
       if VarIsFmtBCD(Value) then
         FDataType:=ftFmtBCD
+      else if VarIsArray(AValue) and (VarType(AValue) and varTypeMask = varByte) then
+        FDataType:=ftBytes
       else
         FDataType:=ftUnknown;
     end;
@@ -818,7 +831,7 @@ begin
       ftDate,
       ftDateTime : Field.AsDateTime:=AsDateTime;
       ftBytes,
-      ftVarBytes : ; // Todo.
+      ftVarBytes : Field.AsVariant:=Value;
       ftFmtBCD   : Field.AsBCD:=AsFMTBCD;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
@@ -856,7 +869,7 @@ begin
       ftDate,
       ftDateTime : AsDateTime:=Field.AsDateTime;
       ftBytes,
-      ftVarBytes : ; // Todo.
+      ftVarBytes : Value:=Field.AsVariant;
       ftFmtBCD   : AsFMTBCD:=Field.AsBCD;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then

+ 108 - 32
packages/fcl-db/src/base/fields.inc

@@ -290,6 +290,7 @@ Const
   SLargeInt = 'LargeInt';
   SVariant = 'Variant';
   SString = 'String';
+  SBytes = 'Bytes';
 
 constructor TField.Create(AOwner: TComponent);
 
@@ -415,12 +416,23 @@ begin
   // TDataset manages the buffers.
 end;
 
-function TField.GetAsBoolean: Boolean;
+function TField.GetAsBCD: TBCD;
+begin
+  raise AccessError(SBCD);
+end;
 
+function TField.GetAsBoolean: Boolean;
 begin
   raise AccessError(SBoolean);
 end;
 
+function TField.GetAsBytes: TBytes;
+begin
+  SetLength(Result, DataSize);
+  if not GetData(@Result[0], False) then
+    Result := nil;
+end;
+
 function TField.GetAsDateTime: TDateTime;
 
 begin
@@ -617,11 +629,6 @@ begin
     Result:=-1;
 end;
 
-function TField.GetAsBCD: TBCD;
-begin
-  raise AccessError(SBCD);
-end;
-
 function TField.GetLookup: Boolean;
 begin
   Result := FieldKind = fkLookup;
@@ -646,11 +653,6 @@ begin
     end;
 end;
 
-procedure TField.SetAsBCD(const AValue: TBCD);
-begin
-  Raise AccessError(SBCD);
-end;
-
 procedure TField.SetIndex(const AValue: Integer);
 begin
   if FFields <> nil then FFields.SetFieldIndex(Self, AValue)
@@ -748,6 +750,16 @@ begin
     DataSet := TDataSet(Reader.Parent);
 end;
 
+procedure TField.SetAsBCD(const AValue: TBCD);
+begin
+  Raise AccessError(SBCD);
+end;
+
+procedure TField.SetAsBytes(const AValue: TBytes);
+begin
+  raise AccessError(SBytes);
+end;
+
 procedure TField.SetAsBoolean(AValue: Boolean);
 
 begin
@@ -1069,10 +1081,7 @@ end;
 function TStringField.GetDataSize: Integer;
 
 begin
-  if DataType=ftFixedChar then
-    Result:=Size+1
-  else
-    Result:=Size+1;
+  Result:=Size+1;
 end;
 
 function TStringField.GetDefaultWidth: Longint;
@@ -2175,12 +2184,40 @@ begin
     DatabaseErrorfmt(SInvalidFieldSize,[Avalue]);
 end;
 
+function TBinaryField.GetAsBytes: TBytes;
+begin
+  SetLength(Result, DataSize);
+  if not GetData(Pointer(Result), True) then
+    SetLength(Result, 0);
+end;
+
 
 function TBinaryField.GetAsString: string;
+var B: TBytes;
+begin
+  B := GetAsBytes;
+  if length(B) = 0 then
+    Result := ''
+  else
+  begin
+    SetLength(Result, length(B) div SizeOf(Char));
+    Move(B[0], Result[1], length(Result) * SizeOf(Char));
+  end;
+end;
 
+
+function TBinaryField.GetAsVariant: Variant;
+var B: TBytes;
+    P: Pointer;
 begin
-  Setlength(Result,DataSize);
-  GetData(Pointer(Result));
+  B := GetAsBytes;
+  Result := VarArrayCreate([0, length(B)-1], varByte);
+  P := VarArrayLock(Result);
+  try
+    Move(B[0], P^, length(B));
+  finally
+    VarArrayUnlock(Result);
+  end;
 end;
 
 
@@ -2191,24 +2228,47 @@ begin
 end;
 
 
-procedure TBinaryField.SetAsString(const AValue: string);
+procedure TBinaryField.SetAsBytes(const AValue: TBytes);
+var Buf: array[0..dsMaxStringSize] of byte;
+    DynBuf: TBytes;
+    Len: Word;
+    P: PByte;
+begin
+  Len := Length(AValue);
+  if Len >= DataSize then
+    P := @AValue[0]
+  else begin
+    if DataSize <= dsMaxStringSize then
+      P := @Buf[0]
+    else begin
+      SetLength(DynBuf, DataSize);
+      P := @DynBuf[0];
+    end;
 
-Var Buf : PChar;
-    Allocated : Boolean;
+    if DataType = ftVarBytes then begin
+      Move(AValue[0], P[2], Len);
+      PWord(P)^ := Len;
+    end
+    else begin // ftBytes
+      Move(AValue[0], P^, Len);
+      FillChar(P[Len], DataSize-Len, 0); // right pad with #0
+    end;
+  end;
+  SetData(P, True)
+end;
 
+
+procedure TBinaryField.SetAsString(const AValue: string);
+var B : TBytes;
 begin
-  Allocated:=False;
-  If Length(AVAlue)=DataSize then
-    Buf:=PChar(Avalue)
+  If Length(AValue) = DataSize then
+    SetData(PChar(AValue))
   else
-    begin
-    GetMem(Buf,DataSize);
-    Move(Pchar(Avalue)[0],Buf^,DataSize);
-    Allocated:=True;
-    end;
-  SetData(Buf);
-  If Allocated then
-    FreeMem(Buf,DataSize);
+  begin
+    SetLength(B, Length(AValue) * SizeOf(Char));
+    Move(AValue[1], B[0], Length(B));
+    SetAsBytes(B);
+  end;
 end;
 
 
@@ -2219,8 +2279,24 @@ begin
 end;
 
 procedure TBinaryField.SetVarValue(const AValue: Variant);
+var P: Pointer;
+    B: TBytes;
+    Len: integer;
 begin
-  SetAsString(Avalue);
+  if VarIsArray(AValue) then
+  begin
+    P := VarArrayLock(AValue);
+    try
+      Len := VarArrayHighBound(AValue, 1) + 1;
+      SetLength(B, Len);
+      Move(P^, B[0], Len);
+    finally
+      VarArrayUnlock(AValue);
+    end;
+    SetAsBytes(B);
+  end
+  else
+    SetAsString(AValue);
 end;
 
 

+ 4 - 0
packages/fcl-db/src/memds/memds.pp

@@ -311,7 +311,9 @@ begin
   ftString:   result:=FieldDefs.Items[FieldNo-1].Size+1;
   ftFixedChar:result:=FieldDefs.Items[FieldNo-1].Size+1;
   ftBoolean:  result:=SizeOf(Wordbool);
+  ftCurrency,
   ftFloat:    result:=SizeOf(Double);
+  ftBCD:      result:=SizeOf(currency);
   ftLargeInt: result:=SizeOf(int64);
   ftSmallInt: result:=SizeOf(SmallInt);
   ftInteger:  result:=SizeOf(longint);
@@ -972,6 +974,7 @@ begin
               F1:=TField(L1[i]);
               F2:=TField(L2[I]);
               Case F1.DataType of
+                ftFixedChar,
                 ftString   : F1.AsString:=F2.AsString;
                 ftBoolean  : F1.AsBoolean:=F2.AsBoolean;
                 ftFloat    : F1.AsFloat:=F2.AsFloat;
@@ -981,6 +984,7 @@ begin
                 ftDate     : F1.AsDateTime:=F2.AsDateTime;
                 ftTime     : F1.AsDateTime:=F2.AsDateTime;
                 ftDateTime : F1.AsDateTime:=F2.AsDateTime;
+                else         F1.AsString:=F2.AsString;
               end;
               end;
             Try

+ 6 - 1
packages/fcl-db/src/sql/fpsqlparser.pas

@@ -323,8 +323,13 @@ begin
        T.Params:=ParseValueList(AParent,[eoParamValue]);
        GetNextToken;
        end;
-     if (CurrentToken=tsqlIdentifier) then
+     if (CurrentToken in [tsqlIdentifier,tsqlAs]) then
        begin
+       if CurrentToken=tsqlAs then
+         begin
+         GetNextToken;
+         Expect(tsqlIdentifier);
+         end;
        T.AliasName:=CreateIdentifier(T,CurrentTokenString);
        GetNextToken;
        end;

+ 38 - 35
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -16,6 +16,7 @@ uses
 
 const
   DEFDIALECT = 3;
+  MAXBLOBSEGMENTSIZE = 65535; //Maximum number of bytes that fit in a blob segment.
 
 type
 
@@ -51,7 +52,7 @@ type
     FStatus              : array [0..19] of ISC_STATUS;
     FDialect             : integer;
     FDBDialect           : integer;
-    FBLobSegmentSize     : word;
+    FBLobSegmentSize     : word; //required for backward compatibilty; not used
 
     procedure ConnectFB;
     function GetDialect: integer;
@@ -64,7 +65,6 @@ type
     procedure GetFloat(CurrBuff, Buffer : pointer; Size : Byte);
     procedure SetFloat(CurrBuff: pointer; Dbl: Double; Size: integer);
     procedure CheckError(ProcName : string; Status : PISC_STATUS);
-    function getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
     procedure SetParameters(cursor : TSQLCursor; aTransation : TSQLTransaction; AParams : TParams);
     procedure FreeSQLDABuffer(var aSQLDA : PXSQLDA);
     function  IsDialectStored: boolean;
@@ -99,7 +99,8 @@ type
     constructor Create(AOwner : TComponent); override;
     procedure CreateDB; override;
     procedure DropDB; override;
-    property BlobSegmentSize : word read FBlobSegmentSize write FBlobSegmentSize;
+    //Segment size is not used in the code; property kept for backward compatibility
+    property BlobSegmentSize : word read FBlobSegmentSize write FBlobSegmentSize; deprecated;
     function GetDBDialect: integer;
   published
     property DatabaseName;
@@ -165,7 +166,7 @@ begin
   inherited;
   FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat];
   FieldNameQuoteChars:=DoubleQuotes;
-  FBLobSegmentSize := 80;
+  FBLobSegmentSize := 65535; //Shows we're using the maximum segment size
   FDialect := -1;
   FDBDialect := -1;
 end;
@@ -666,12 +667,19 @@ end;
 
 procedure TIBConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams);
 var tr : pointer;
+    out_SQLDA : PXSQLDA;
 begin
   tr := aTransaction.Handle;
   if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, atransaction, AParams);
   with cursor as TIBCursor do
-    if isc_dsql_execute2(@Status[0], @tr, @Statement, 1, in_SQLDA, nil) <> 0 then
+  begin
+    if FStatementType = stExecProcedure then
+      out_SQLDA := SQLDA
+    else
+      out_SQLDA := nil;
+    if isc_dsql_execute2(@Status[0], @tr, @Statement, 1, in_SQLDA, out_SQLDA) <> 0 then
       CheckError('Execute', Status);
+  end;
 end;
 
 
@@ -718,12 +726,23 @@ var
   retcode : integer;
 begin
   with cursor as TIBCursor do
-    begin
-    retcode := isc_dsql_fetch(@Status[0], @Statement, 1, SQLDA);
+  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'
+      if SQLDA^.SQLD = 0 then
+        retcode := 100 //no more rows to retrieve
+      else
+      begin
+        retcode := 0;
+        SQLDA^.SQLD := 0; //hack: mark after first fetch
+      end
+    else
+      retcode := isc_dsql_fetch(@Status[0], @Statement, 1, SQLDA);
     if (retcode <> 0) and (retcode <> 100) then
       CheckError('Fetch', Status);
-    end;
-  Result := (retcode <> 100);
+  end;
+  Result := (retcode = 0);
 end;
 
 procedure TIBConnection.SetParameters(cursor : TSQLCursor; aTransation : TSQLTransaction; AParams : TParams);
@@ -743,7 +762,7 @@ var ParNr,SQLVarNr : integer;
     BlobBytesWritten  : longint;
     
   procedure SetBlobParam;
-  
+
   begin
 {$R-}
     with cursor as TIBCursor do
@@ -759,14 +778,16 @@ var ParNr,SQLVarNr : integer;
       BlobBytesWritten := 0;
       i := 0;
 
-      while BlobBytesWritten < (BlobSize-BlobSegmentSize) do
+      // Write in segments of MAXBLOBSEGMENTSIZE, as that is the fastest.
+      // We ignore BlobSegmentSize property.
+      while BlobBytesWritten < (BlobSize-MAXBLOBSEGMENTSIZE) do
         begin
-        isc_put_segment(@FStatus[0], @blobHandle, BlobSegmentSize, @s[(i*BlobSegmentSize)+1]);
-        inc(BlobBytesWritten,BlobSegmentSize);
+        isc_put_segment(@FStatus[0], @blobHandle, MAXBLOBSEGMENTSIZE, @s[(i*MAXBLOBSEGMENTSIZE)+1]);
+        inc(BlobBytesWritten,MAXBLOBSEGMENTSIZE);
         inc(i);
         end;
       if BlobBytesWritten <> BlobSize then
-        isc_put_segment(@FStatus[0], @blobHandle, BlobSize-BlobBytesWritten, @s[(i*BlobSegmentSize)+1]);
+        isc_put_segment(@FStatus[0], @blobHandle, BlobSize-BlobBytesWritten, @s[(i*MAXBLOBSEGMENTSIZE)+1]);
 
       if isc_close_blob(@FStatus[0], @blobHandle) <> 0 then
         CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
@@ -1220,22 +1241,6 @@ begin
 end;
 
 
-function TIBConnection.getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
-var
-  iscInfoBlobMaxSegment : byte = isc_info_blob_max_segment;
-  blobInfo : array[0..50] of byte;
-
-begin
-  if isc_blob_info(@Fstatus[0], @blobHandle, sizeof(iscInfoBlobMaxSegment), pchar(@iscInfoBlobMaxSegment), sizeof(blobInfo) - 2, pchar(@blobInfo[0])) <> 0 then
-    CheckError('isc_blob_info', FStatus);
-  if blobInfo[0]  = isc_info_blob_max_segment then
-    begin
-      result :=  isc_vax_integer(pchar(@blobInfo[3]), isc_vax_integer(pchar(@blobInfo[1]), 2));
-    end
-  else
-     CheckError('isc_blob_info', FStatus);
-end;
-
 procedure TIBConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction);
 const
   isc_segstr_eof = 335544367; // It's not defined in ibase60 but in ibase40. Would it be better to define in ibase60?
@@ -1244,7 +1249,6 @@ var
   blobHandle : Isc_blob_Handle;
   blobSegment : pointer;
   blobSegLen : word;
-  maxBlobSize : longInt;
   TransactionHandle : pointer;
   blobId : PISC_QUAD;
   ptr : Pointer;
@@ -1257,14 +1261,13 @@ begin
   if isc_open_blob(@FStatus[0], @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, blobId) <> 0 then
     CheckError('TIBConnection.CreateBlobStream', FStatus);
 
-  maxBlobSize := getMaxBlobSize(blobHandle);
-
-  blobSegment := AllocMem(maxBlobSize);
+  //For performance, read as much as we can, regardless of any segment size set in database.
+  blobSegment := AllocMem(MAXBLOBSEGMENTSIZE);
 
   with ABlobBuf^.BlobBuffer^ do
     begin
     Size := 0;
-    while (isc_get_segment(@FStatus[0], @blobHandle, @blobSegLen, maxBlobSize, blobSegment) = 0) do
+    while (isc_get_segment(@FStatus[0], @blobHandle, @blobSegLen, MAXBLOBSEGMENTSIZE, blobSegment) = 0) do
       begin
       ReAllocMem(Buffer,Size+blobSegLen);
       ptr := Buffer+Size;

+ 77 - 58
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -4,7 +4,7 @@
 interface
 
 uses
-  Classes, SysUtils,bufdataset,sqldb,db,dynlibs,
+  Classes, SysUtils,bufdataset,sqldb,db,dynlibs,ctypes,
 {$IFDEF Mysql51}
   mysql51dyn;
 {$ELSE}  
@@ -55,6 +55,7 @@ Type
     FNeedData : Boolean;
     FStatement : String;
     Row : MYSQL_ROW;
+    Lengths : pculong;                { Lengths of the columns of the current row }
     RowsAffected : QWord;
     LastInsertID : QWord;
     ParamBinding : TParamBinding;
@@ -79,7 +80,7 @@ Type
     Procedure ConnectToServer; virtual;
     Procedure SelectDatabase; virtual;
     function MySQLDataType(AField: PMYSQL_FIELD; var NewType: TFieldType; var NewSize: Integer): Boolean;
-    function MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType; Source, Dest: PChar; out CreateBlob : boolean): Boolean;
+    function MySQLWriteData(AField: PMYSQL_FIELD; FieldDef: TFieldDef; Source, Dest: PChar; Len: integer; out CreateBlob : boolean): Boolean;
     // SQLConnection methods
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
@@ -177,7 +178,6 @@ implementation
 
 uses
   dbconst,
-  ctypes,
   strutils,
   dateutils,
   FmtBCD;
@@ -246,6 +246,7 @@ function TConnectionName.StrToStatementType(s : string) : TStatementType;
 begin
   S:=Lowercase(s);
   if s = 'show' then exit(stSelect);
+  if s = 'call' then exit(stExecProcedure);
   result := inherited StrToStatementType(s);
 end;
 
@@ -297,7 +298,7 @@ begin
       end;
     end;
 
-  HMySQL:=mysql_real_connect(HMySQL,PChar(H),PChar(U),Pchar(P),Nil,APort,Nil,0);
+  HMySQL:=mysql_real_connect(HMySQL,PChar(H),PChar(U),Pchar(P),Nil,APort,Nil,CLIENT_MULTI_RESULTS); //CLIENT_MULTI_RESULTS is required by CALL SQL statement(executes stored procedure), that produces result sets
   If (HMySQL=Nil) then
     MySQlError(Nil,SErrServerConnectFailed,Self);
 
@@ -329,7 +330,7 @@ var esc_str : pchar;
 
 begin
   if (not assigned(param)) or param.IsNull then Result := 'Null'
-  else if param.DataType in [ftString,ftFixedChar,ftBlob,ftMemo] then
+  else if param.DataType in [ftString,ftFixedChar,ftBlob,ftMemo,ftBytes,ftVarBytes] then
     Result := '''' + EscapeString(Param.AsString) + ''''
   else Result := inherited GetAsSqlText(Param);
 end;
@@ -476,7 +477,7 @@ begin
     FStatement:=Buf;
     if assigned(AParams) and (AParams.count > 0) then
       FStatement := AParams.ParseSQL(FStatement,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psSimulated,paramBinding,ParamReplaceString);
-    if FStatementType=stSelect then
+    if FStatementType in [stSelect,stExecProcedure] then
       FNeedData:=True;
     end
 end;
@@ -493,7 +494,7 @@ Var
 
 begin
   C:=Cursor as TCursorName;
-  if c.FStatementType=stSelect then
+  if c.FStatementType in [stSelect,stExecProcedure] then
     c.FNeedData:=False;
   If (C.FRes<>Nil) then
     begin
@@ -511,6 +512,7 @@ Var
   C : TCursorName;
   i : integer;
   ParamNames,ParamValues : array of string;
+  Res: PMYSQL_RES;
 
 begin
   C:=Cursor as TCursorName;
@@ -535,7 +537,14 @@ begin
       C.RowsAffected := mysql_affected_rows(FMYSQL);
       C.LastInsertID := mysql_insert_id(FMYSQL);
       if C.FNeedData then
-        C.FRes:=mysql_store_result(FMySQL);
+        repeat
+        Res:=mysql_store_result(FMySQL); //returns a null pointer if the statement didn't return a result set
+        if Res<>nil then
+          begin
+          mysql_free_result(C.FRes);
+          C.FRes:=Res;
+          end;
+        until mysql_next_result(FMySQL)<>0;
       end;
     end;
 end;
@@ -569,13 +578,10 @@ begin
         ADecimals:=AField^.decimals;
         if (ADecimals < 5) and (ASize-2-ADecimals < 15) then //ASize is display size i.e. with sign and decimal point
           NewType := ftBCD
-        else 
-          begin
-            if (ADecimals = 0) and (ASize < 20) then
-              NewType := ftLargeInt
-            else
-              NewType := ftFmtBCD;
-          end;
+        else if (ADecimals = 0) and (ASize < 20) then
+          NewType := ftLargeInt
+        else
+          NewType := ftFmtBCD;
         NewSize := ADecimals;
       end;
     FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
@@ -609,7 +615,17 @@ begin
         end
       else
         begin
-        NewType := ftString;
+        if AField^.ftype = FIELD_TYPE_STRING then
+          NewType := ftFixedChar
+        else
+          NewType := ftString;
+{$IFDEF MYSQL50_UP}
+        if AField^.charsetnr = 63 then //BINARY vs. CHAR, VARBINARY vs. VARCHAR
+          if NewType = ftFixedChar then
+            NewType := ftBytes
+          else
+            NewType := ftVarBytes;
+{$ENDIF}
         NewSize := ASize;
         end;
       end;
@@ -660,7 +676,9 @@ begin
 
     if MySQLDataType(field, DFT, DFS) then
       begin
-      TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(field^.name), DFT, DFS, False, TF);
+      TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(field^.name), DFT, DFS,
+                       (field^.flags and (AUTO_INCREMENT_FLAG or NOT_NULL_FLAG {$IFDEF MYSQL50_UP}or NO_DEFAULT_VALUE_FLAG{$ENDIF})) = (NOT_NULL_FLAG {$IFDEF MYSQL50_UP}or NO_DEFAULT_VALUE_FLAG{$ENDIF}),
+                       TF);
       c.MapDSRowToMSQLRow[TF-1] := I;
       inc(TF);
       end
@@ -677,6 +695,10 @@ begin
   C:=Cursor as TCursorName;
   C.Row:=MySQL_Fetch_row(C.FRes);
   Result:=(C.Row<>Nil);
+  if Result then
+    C.Lengths := mysql_fetch_lengths(C.FRes)
+  else
+    C.Lengths := nil;
 end;
 
 function TConnectionName.LoadField(cursor : TSQLCursor;
@@ -684,46 +706,41 @@ function TConnectionName.LoadField(cursor : TSQLCursor;
 
 var
   field: PMYSQL_FIELD;
-  row : MYSQL_ROW;
   C : TCursorName;
+  i : integer;
 
 begin
 //  Writeln('LoadFieldsFromBuffer');
   C:=Cursor as TCursorName;
-  if C.Row=nil then
+  if (C.Row=nil) or (C.Lengths=nil) then
      begin
   //   Writeln('LoadFieldsFromBuffer: row=nil');
      MySQLError(FMySQL,SErrFetchingData,Self);
      end;
-  Row:=C.Row;
-  
-  inc(Row,c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
-  field := mysql_fetch_field_direct(C.FRES, c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
 
-  Result := MySQLWriteData(field^.ftype, field^.length, FieldDef.DataType, Row^, Buffer, CreateBlob);
+  i := c.MapDSRowToMSQLRow[FieldDef.FieldNo-1];
+  field := mysql_fetch_field_direct(C.FRES, i);
+
+  Result := MySQLWriteData(field, FieldDef, C.Row[i], Buffer, C.Lengths[i], CreateBlob);
 end;
 
 procedure TConnectionName.LoadBlobIntoBuffer(FieldDef: TFieldDef;
   ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
 var
-  row : MYSQL_ROW;
   C : TCursorName;
-  li : longint;
-  Lengths : pculong;
+  i : integer;
+  len : longint;
 begin
   C:=Cursor as TCursorName;
-  if C.Row=nil then
+  if (C.Row=nil) or (C.Lengths=nil) then
     MySQLError(FMySQL,SErrFetchingData,Self);
-  Row:=C.Row;
-
-  inc(Row,c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
 
-  Lengths := mysql_fetch_lengths(c.FRes);
-  li := Lengths[c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]];
+  i := c.MapDSRowToMSQLRow[FieldDef.FieldNo-1];
+  len := C.Lengths[i];
 
-  ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer,li);
-  Move(pchar(row^)^, ABlobBuf^.BlobBuffer^.Buffer^, li);
-  ABlobBuf^.BlobBuffer^.Size := li;
+  ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, len);
+  Move(C.Row[i]^, ABlobBuf^.BlobBuffer^.Buffer^, len);
+  ABlobBuf^.BlobBuffer^.Size := len;
 end;
 
 function InternalStrToFloat(S: string): Extended;
@@ -838,7 +855,7 @@ begin
   Result := Result + EncodeTime(EH, EN, ES, 0);;
 end;
 
-function TConnectionName.MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType; Source, Dest: PChar; out CreateBlob : boolean): Boolean;
+function TConnectionName.MySQLWriteData(AField: PMYSQL_FIELD; FieldDef: TFieldDef; Source, Dest: PChar; Len: integer; out CreateBlob : boolean): Boolean;
 
 var
   VI: Integer;
@@ -855,8 +872,8 @@ begin
   CreateBlob := False;
   if Source = Nil then
     exit;
-  Src:=StrPas(Source);
-  case AType of
+  SetString(Src, Source, Len);
+  case AField^.ftype of
     FIELD_TYPE_TINY, FIELD_TYPE_SHORT:
       begin
       if (Src<>'') then
@@ -885,24 +902,26 @@ begin
     FIELD_TYPE_NEWDECIMAL,
 {$endif}      
     FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
-      if AFieldType = ftBCD then
-        begin
-        VC := InternalStrToCurrency(Src);
-        Move(VC, Dest^, SizeOf(Currency));
-        end
-      else if AFieldType = ftFmtBCD then
-        begin
-        VB:=StrToBCD(Src, FSQLFormatSettings);
-        Move(VB, Dest^, SizeOf(TBCD));
-        end
-      else
-        begin
-        if Src <> '' then
-          VF := InternalStrToFloat(Src)
+      case FieldDef.DataType of
+        ftBCD:
+          begin
+          VC := InternalStrToCurrency(Src);
+          Move(VC, Dest^, SizeOf(Currency));
+          end;
+        ftFmtBCD:
+          begin
+          VB := StrToBCD(Src, FSQLFormatSettings);
+          Move(VB, Dest^, SizeOf(TBCD));
+          end
         else
-          VF := 0;
-        Move(VF, Dest^, SizeOf(Double));
-        end;
+          begin
+          if Src <> '' then
+            VF := InternalStrToFloat(Src)
+          else
+            VF := 0;
+          Move(VF, Dest^, SizeOf(Double));
+          end;
+      end;
     FIELD_TYPE_TIMESTAMP:
       begin
       if Src <> '' then
@@ -949,10 +968,10 @@ begin
 }
       // String-fields which can contain more then dsMaxStringSize characters
       // are mapped to ftBlob fields, while their mysql-datatype is FIELD_TYPE_BLOB
-      if AFieldType in [ftBlob,ftMemo] then
+      if FieldDef.DataType in [ftBlob,ftMemo] then
         CreateBlob := True
       else if Src<> '' then
-        Move(Source^, Dest^, ASize)
+        Move(Source^, Dest^, FieldDef.Size)
       else
         Dest^ := #0;
       end;

+ 22 - 17
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -324,6 +324,8 @@ begin
       raise EODBCException.CreateFmt('The query has parameter markers in it, but no actual parameters were passed',[]);
 
   SetLength(ODBCCursor.FParamBuf, Length(ODBCCursor.FParamIndex));
+  for i:=0 to High(ODBCCursor.FParamIndex) do
+    ODBCCursor.FParamBuf[i]:=nil;
   for i:=0 to High(ODBCCursor.FParamIndex) do
   begin
     ParamIndex:=ODBCCursor.FParamIndex[i];
@@ -487,7 +489,8 @@ var
   i:integer;
 begin
   for i:=0 to High(ODBCCursor.FParamBuf) do
-    FreeMem(ODBCCursor.FParamBuf[i]);
+    if assigned(ODBCCursor.FParamBuf[i]) then
+      FreeMem(ODBCCursor.FParamBuf[i]);
   SetLength(ODBCCursor.FParamBuf,0);
 end;
 
@@ -685,23 +688,25 @@ var
 begin
   ODBCCursor:=cursor as TODBCCursor;
 
-  // set parameters
+  try
+    // set parameters
     if Assigned(APArams) and (AParams.count > 0) then SetParameters(ODBCCursor, AParams);
+    // execute the statement
+    case ODBCCursor.FSchemaType of
+      stNoSchema  : Res:=SQLExecute(ODBCCursor.FSTMTHandle); //SQL_NO_DATA returns searched update or delete statement that does not affect any rows
+      stTables    : Res:=SQLTables (ODBCCursor.FSTMTHandle, nil, 0, nil, 0, nil, 0, TABLE_TYPE_USER, length(TABLE_TYPE_USER) );
+      stSysTables : Res:=SQLTables (ODBCCursor.FSTMTHandle, nil, 0, nil, 0, nil, 0, TABLE_TYPE_SYSTEM, length(TABLE_TYPE_SYSTEM) );
+      stColumns   : Res:=SQLColumns(ODBCCursor.FSTMTHandle, nil, 0, nil, 0, @ODBCCursor.FQuery[1], length(ODBCCursor.FQuery), nil, 0 );
+      stProcedures: Res:=SQLProcedures(ODBCCursor.FSTMTHandle, nil, 0, nil, 0, nil, 0 );
+      else          Res:=SQL_NO_DATA;
+    end; {case}
+
+    if (Res<>SQL_NO_DATA) then ODBCCheckResult( Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.' );
 
-  // execute the statement
-  case ODBCCursor.FSchemaType of
-    stNoSchema  : Res:=SQLExecute(ODBCCursor.FSTMTHandle); //SQL_NO_DATA returns searched update or delete statement that does not affect any rows
-    stTables    : Res:=SQLTables (ODBCCursor.FSTMTHandle, nil, 0, nil, 0, nil, 0, TABLE_TYPE_USER, length(TABLE_TYPE_USER) );
-    stSysTables : Res:=SQLTables (ODBCCursor.FSTMTHandle, nil, 0, nil, 0, nil, 0, TABLE_TYPE_SYSTEM, length(TABLE_TYPE_SYSTEM) );
-    stColumns   : Res:=SQLColumns(ODBCCursor.FSTMTHandle, nil, 0, nil, 0, @ODBCCursor.FQuery[1], length(ODBCCursor.FQuery), nil, 0 );
-    stProcedures: Res:=SQLProcedures(ODBCCursor.FSTMTHandle, nil, 0, nil, 0, nil, 0 );
-    else          Res:=SQL_NO_DATA;
-  end; {case}
-
-  if (Res<>SQL_NO_DATA) then ODBCCheckResult( Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.' );
-
-  // free parameter buffers
-  FreeParamBuffers(ODBCCursor);
+  finally
+    // free parameter buffers
+    FreeParamBuffers(ODBCCursor);
+  end;
 end;
 
 function TODBCConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
@@ -1164,7 +1169,7 @@ begin
     end;
 
     // add FieldDef
-    TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(ColName), FieldType, FieldSize, False, i);
+    TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(ColName), FieldType, FieldSize, (Nullable=SQL_NO_NULLS) and (FieldType<>ftAutoInc), i);
   end;
 end;
 

+ 192 - 13
packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

@@ -1,8 +1,4 @@
 unit oracleconnection;
-//
-// For usage of "returning" like clauses see mantis #18133
-//
-
 
 {$mode objfpc}{$H+}
 
@@ -105,7 +101,7 @@ type
 implementation
 
 uses
-  math, StrUtils;
+  math, StrUtils, FmtBCD;
 
 ResourceString
   SErrEnvCreateFailed = 'The creation of an Oracle environment failed.';
@@ -140,6 +136,167 @@ begin
   result:=OCI_CONTINUE;
 end;
 
+//conversions
+
+Procedure FmtBCD2Nvu(bcd:tBCD;b:pByte);
+var
+  i,j,cnt   : integer;
+  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
+  exp       : shortint;
+  bb        : byte;
+begin
+  fillchar(b[0],22,#0);
+  if BCDPrecision(bcd)=0 then // zero, special case
+    begin
+    b[0]:=1;
+    b[1]:=$80;
+    end
+  else
+    begin
+    if (BCDPrecision(bcd)-BCDScale(bcd)) mod 2 <>0 then // odd number before decimal point
+      begin
+      nibbles[0]:=0;
+      j:=1;
+      end
+    else
+      j:=0;
+    for i:=0 to bcd.Precision -1 do
+      if i mod 2 =0 then
+        nibbles[i+j]:=bcd.Fraction[i div 2] shr 4
+      else
+        nibbles[i+j]:=bcd.Fraction[i div 2] and $0f;
+    nibbles[bcd.Precision+j]:=0; // make sure last nibble is also 0 in case we have odd scale
+    exp:=(BCDPrecision(bcd)-BCDScale(bcd)+1) div 2;
+    cnt:=exp+(BCDScale(bcd)+1) div 2;
+    // to avoid "ora 01438: value larger than specified precision allowed for this column"
+    // remove trailing zeros (scale < 0)
+    while (nibbles[cnt*2-2]*10+nibbles[cnt*2-1])=0 do
+      cnt:=cnt-1;
+    // and remove leading zeros (scale > precision)
+    j:=0;
+    while (nibbles[j*2]*10+nibbles[j*2+1])=0 do
+      begin
+      j:=j+1;
+      exp:=exp-1;
+      end;
+    if IsBCDNegative(bcd) then
+      begin
+      b[0]:=cnt-j+1;
+      b[1]:=not(exp+64) and $7f ;
+      for i:=j to cnt-1 do
+        begin
+        bb:=nibbles[i*2]*10+nibbles[i*2+1];
+        b[2+i-j]:=101-bb;
+        end;
+      if 2+cnt-j<22 then  // add a 102 at the end of the number if place left.
+        begin
+        b[0]:=b[0]+1;
+        b[2+cnt-j]:=102;
+        end;
+      end
+    else
+      begin
+      b[0]:=cnt-j+1;
+      b[1]:=(exp+64) or $80 ;
+      for i:=j to cnt-1 do
+        begin
+        bb:=nibbles[i*2]*10+nibbles[i*2+1];
+        b[2+i-j]:=1+bb;
+        end;
+      end;
+    end;
+end;
+
+function Nvu2FmtBCE(b:pbyte):tBCD;
+var
+  i,j       : integer;
+  bb,size   : byte;
+  exp       : shortint;
+  nibbles   : array [0..maxfmtbcdfractionsize-1] of byte;
+  scale     : integer;
+begin
+  size := b[0];
+  if (size=1) and (b[1]=$80) then // special representation for 0
+    result:=IntegerToBCD(0)
+  else
+    begin
+    result.SignSpecialPlaces:=0; //sign positive, non blank, scale 0
+    result.Precision:=1;         //BCDNegate works only if Precision <>0
+    if (b[1] and $80)=$80 then // then the number is positive
+      begin
+      exp := (b[1] and $7f)-65;
+      for i := 0 to size-2 do
+        begin
+        bb := b[i+2]-1;
+        nibbles[i*2]:=bb div 10;
+        nibbles[i*2+1]:=(bb mod 10);
+        end;
+      end
+    else
+      begin
+      BCDNegate(result);
+      exp := (not(b[1]) and $7f)-65;
+      if b[size]=102 then  // last byte doesn't count if = 102
+        size:=size-1;
+      for i := 0 to size-2 do
+        begin
+        bb := 101-b[i+2];
+        nibbles[i*2]:=bb div 10;
+        nibbles[i*2+1]:=(bb mod 10);
+        end;
+      end;
+    nibbles[(size-1)*2]:=0;
+    result.Precision:=(size-1)*2;
+    scale:=result.Precision-(exp*2+2);
+    if scale>=0 then
+      begin
+      if (scale>result.Precision) then  // need to add leading 0's
+        begin
+        for i:=0 to (scale-result.Precision+1) div 2 do
+          result.Fraction[i]:=0;
+        i:=scale-result.Precision;
+        result.Precision:=scale;
+        end
+      else
+        i:=0;
+      j:=i;
+      if (i=0) and (nibbles[0]=0) then // get rid of leading zero received from oci
+        begin
+        result.Precision:=result.Precision-1;
+        j:=-1;
+        end;
+      while i<=result.Precision do // copy nibbles
+        begin
+        if i mod 2 =0 then
+          result.Fraction[i div 2]:=nibbles[i-j] shl 4
+        else
+          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i-j];
+        i:=i+1;
+        end;
+      result.SignSpecialPlaces:=result.SignSpecialPlaces or scale;
+      end
+    else
+      begin // add trailing zero's, increase precision to take them into account
+      i:=0;
+      while i<=result.Precision do // copy nibbles
+        begin
+        if i mod 2 =0 then
+          result.Fraction[i div 2]:=nibbles[i] shl 4
+        else
+          result.Fraction[i div 2]:=result.Fraction[i div 2] or nibbles[i];
+        i:=i+1;
+        end;
+      result.Precision:=result.Precision-scale;
+      for i := size -1 to High(result.Fraction) do
+        result.Fraction[i] := 0;
+      end;
+    end;
+end;
+
+
+
+// TOracleConnection
+
 procedure TOracleConnection.HandleError;
 
 var errcode : sb4;
@@ -197,7 +354,10 @@ begin
                             day:=pb[3];
                             asDateTime:=EncodeDate(year,month,day);
                             end;
-      end;
+        ftFMTBcd          : begin
+                            AsFMTBCD:=Nvu2FmtBCE(parambuffers[SQLVarNr].buffer);
+                            end;
+        end;
 
       end;
 
@@ -369,6 +529,7 @@ begin
           ftFloat : begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
           ftDate, ftDateTime : begin OFieldType := SQLT_DAT; OFieldSize := 7; end;
           ftString  : begin OFieldType := SQLT_STR; OFieldSize := 4000; end;
+          ftFMTBcd : begin OFieldType := SQLT_VNU; OFieldSize := 22; end;
 
         end;
         parambuffers[tel].buffer := getmem(OFieldSize);
@@ -437,6 +598,9 @@ begin
                             pb[5] := 1;
                             pb[6] := 1;
                             end;
+        ftFmtBCD          : begin
+                            FmtBCD2Nvu(asFmtBCD,parambuffers[SQLVarNr].buffer);
+                            end;
       end;
 
       end;
@@ -549,7 +713,7 @@ var Param      : POCIParam;
 
     FieldType  : TFieldType;
     FieldName  : string;
-    FieldSize  : word;
+    FieldSize  : integer;
 
     OFieldType   : ub2;
     OFieldName   : Pchar;
@@ -589,11 +753,11 @@ begin
                                   HandleError;
                                 if OCIAttrGet(Param,OCI_DTYPE_PARAM,@Oscale,nil,OCI_ATTR_SCALE,FOciError) = OCI_ERROR then
                                   HandleError;
-                                if Oscale = 0 then
+                                if (Oscale = 0) and (Oprecision<9) then
                                   begin
                                   if Oprecision=0 then //Number(0,0) = number(32,4)
-                                    begin              //Warning ftBCD is limited to precision 12
-                                    FieldType := ftBCD;
+                                    begin
+                                    FieldType := ftFMTBCD;
                                     FieldSize := 4;
                                     OFieldType := SQLT_VNU;
                                     OFieldSize:= 22;
@@ -605,20 +769,32 @@ begin
                                     OFieldSize:= sizeof(integer);
                                     end;
                                   end
-                                else if (oscale = -127) {and (OPrecision=0)} then
+                                else if (Oscale = -127) {and (OPrecision=0)} then
                                   begin
                                   FieldType := ftFloat;
                                   OFieldType := SQLT_FLT;
                                   OFieldSize:=sizeof(double);
                                   end
-                                else if (oscale <=4) and (OPrecision<=12) then
+                                else if (Oscale >=0) and (Oscale <=4) and (OPrecision<=12) then
                                   begin
                                   FieldType := ftBCD;
                                   FieldSize := oscale;
                                   OFieldType := SQLT_VNU;
                                   OFieldSize:= 22;
                                   end
-                                else FieldType := ftUnknown;
+                                else if (OPrecision-Oscale<64) and (Oscale < 64) then // limited to 63 digits before or after decimal point
+                                  begin
+                                  FieldType := ftFMTBCD;
+                                  FieldSize := oscale;
+                                  OFieldType := SQLT_VNU;
+                                  OFieldSize:= 22;
+                                  end
+                                else //approximation with double, best can do
+                                  begin
+                                  FieldType := ftFloat;
+                                  OFieldType := SQLT_FLT;
+                                  OFieldSize:=sizeof(double);
+                                  end;
                                 end;
         OCI_TYPECODE_CHAR,
         OCI_TYPECODE_VARCHAR,
@@ -704,6 +880,9 @@ begin
                              end;
                            move(cur,buffer^,SizeOf(Currency));
                            end;
+      ftFMTBCD             :  begin
+                           pBCD(buffer)^:= Nvu2FmtBCE(fieldbuffers[FieldDef.FieldNo-1].buffer);
+                           end;
       ftFloat           : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(double));
       ftInteger         : move(fieldbuffers[FieldDef.FieldNo-1].buffer^,buffer^,sizeof(integer));
       ftDate  : begin

+ 15 - 5
packages/fcl-db/src/sqldb/sqldb.pp

@@ -930,6 +930,7 @@ end;
 procedure TCustomSQLQuery.OnChangeSQL(Sender : TObject);
 
 var ConnOptions : TConnOptions;
+    NewParams: TParams;
 
 begin
   UnPrepare;
@@ -940,7 +941,15 @@ begin
       ConnOptions := TSQLConnection(DataBase).ConnOptions
     else
       ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
-    Fparams.ParseSQL(FSQL.Text,True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psInterbase);
+    //preserve existing param. values
+    NewParams := TParams.Create(Self);
+    try
+      NewParams.ParseSQL(FSQL.Text, True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psInterbase);
+      NewParams.AssignValues(FParams);
+      FParams.Assign(NewParams);
+    finally
+      NewParams.Free;
+    end;
     If Assigned(FMasterLink) then
       FMasterLink.RefreshParamNames;
     end;
@@ -1142,8 +1151,6 @@ begin
 
   if not FIsEof then FIsEOF := not TSQLConnection(Database).Fetch(Fcursor);
   Result := not FIsEOF;
-  // A stored procedure is always at EOF after its first fetch
-  if FCursor.FStatementType = stExecProcedure then FIsEOF := True;
 end;
 
 procedure TCustomSQLQuery.Execute;
@@ -1978,7 +1985,7 @@ procedure TSQLConnector.SetTransaction(Value: TSQLTransaction);
 begin
   inherited SetTransaction(Value);
   If Assigned(FProxy) and (FProxy.Transaction<>Value) then
-    FProxy.Transaction:=Value;
+    FProxy.FTransaction:=Value;
 end;
 
 procedure TSQLConnector.DoInternalConnect;
@@ -1989,11 +1996,13 @@ Var
 begin
   inherited DoInternalConnect;
   CreateProxy;
+  FProxy.CharSet:=Self.CharSet;
+  FProxy.Role:=self.Role;
   FProxy.DatabaseName:=Self.DatabaseName;
   FProxy.HostName:=Self.HostName;
   FProxy.UserName:=Self.UserName;
   FProxy.Password:=Self.Password;
-  FProxy.Transaction:=Self.Transaction;
+  FProxy.FTransaction:=Self.Transaction;
   D:=GetConnectionDef(ConnectorType);
   D.ApplyParams(Params,FProxy);
   FProxy.Connected:=True;
@@ -2021,6 +2030,7 @@ begin
   If (D=Nil) then
     DatabaseErrorFmt(SErrUnknownConnectorType,[ConnectorType],Self);
   FProxy:=D.ConnectionClass.Create(Self);
+  FFieldNameQuoteChars := FProxy.FieldNameQuoteChars;
 end;
 
 procedure TSQLConnector.FreeProxy;

+ 19 - 5
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -201,7 +201,9 @@ begin
                 str1:= p.asstring;
                 checkerror(sqlite3_bind_text(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
                 end;
-        ftblob: begin
+        ftBytes,
+        ftVarBytes,
+        ftBlob: begin
                 str1:= P.asstring;
                 checkerror(sqlite3_bind_blob(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
                 end; 
@@ -351,7 +353,7 @@ Type
   end;
   
 Const
-  FieldMapCount = 24;
+  FieldMapCount = 26;
   FieldMap : Array [1..FieldMapCount] of TFieldMap = (
    (n:'INT'; t: ftInteger),
    (n:'LARGEINT'; t:ftlargeInt),
@@ -368,7 +370,7 @@ Const
    (n:'TIME'; t: ftTime),
    (n:'CURRENCY'; t: ftCurrency),
    (n:'VARCHAR'; t: ftString),
-   (n:'CHAR'; t: ftString),
+   (n:'CHAR'; t: ftFixedChar),
    (n:'NUMERIC'; t: ftBCD),
    (n:'DECIMAL'; t: ftBCD),
    (n:'TEXT'; t: ftmemo),
@@ -376,7 +378,9 @@ Const
    (n:'BLOB'; t: ftBlob),
    (n:'NCHAR'; t: ftFixedWideChar),
    (n:'NVARCHAR'; t: ftWideString),
-   (n:'NCLOB'; t: ftWideMemo)
+   (n:'NCLOB'; t: ftWideMemo),
+   (n:'VARBINARY'; t: ftVarBytes),
+   (n:'BINARY'; t: ftBytes)
 { Template:
   (n:''; t: ft)
 }
@@ -446,7 +450,9 @@ begin
       ftString,
       ftFixedChar,
       ftFixedWideChar,
-      ftWideString:
+      ftWideString,
+      ftBytes,
+      ftVarBytes:
                begin
                  size1 := 255; //sql: if length is omitted then length is 1
                  size2 := 0;
@@ -630,6 +636,14 @@ begin
       if int1 > 0 then
         move(sqlite3_column_text16(st,fnum)^, buffer^, int1); //Strings returned by sqlite3_column_text() and sqlite3_column_text16(), even empty strings, are always zero terminated.
       end;
+    ftBytes:
+      begin
+      int1 := sqlite3_column_bytes(st,fnum);
+      if int1 > FieldDef.Size then
+        int1 := FieldDef.Size;
+      if int1 > 0 then
+         move(sqlite3_column_blob(st,fnum)^, buffer^, int1);
+      end;
     ftWideMemo,
     ftMemo,
     ftBlob: CreateBlob:=True;

+ 20 - 23
packages/fcl-db/src/sqlite/customsqliteds.pas

@@ -1067,6 +1067,19 @@ begin
     Result := False;
 end;
 
+function CompDouble(UTF8Value: PChar; const UTF8Key: String): Boolean;
+var e1,e2:double;
+begin
+  if UTF8Value <> nil then
+    begin
+      val(UTF8Value,e1);
+      val(UTF8Key,e2);
+      result:=e1=e2;
+    end
+  else
+    Result := False;
+end;
+
 function CompInsensitiveWild(UTF8Value: PChar; const AnsiKey: String): Boolean;
 begin
   //IsWild does not work with UTF8 encoded strings for case insensitive searches,
@@ -1086,7 +1099,6 @@ var
   AFieldList: TList;
   i, AFieldCount: Integer;
   MatchRecord: Boolean;
-  AValue: String;
   TempItem: PDataRecord;
   
 begin
@@ -1153,13 +1165,12 @@ begin
         end
         else
         begin
-          LocateFields[i].CompFunction := @CompSensitive;
+          LocateFields[i].CompFunction := @CompDouble;
           //get float types in appropriate format
           if VarIsArray(KeyValues) then
-            Str(VarToDateTime(keyvalues[i]), AValue)
+            Str(VarToDateTime(keyvalues[i]), LocateFields[i].Key)
           else
-            Str(VarToDateTime(keyvalues), AValue);
-          LocateFields[i].Key := Trim(AValue);
+            Str(VarToDateTime(keyvalues), LocateFields[i].Key);
         end;
         LocateFields[i].Index := FieldNo - 1;
       end;
@@ -1311,8 +1322,7 @@ procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer;
   NativeFormat: Boolean);
 var
   TempStr: String;
-  FloatStr: PChar;
-  FloatLen, FieldOffset: Integer;
+  FieldOffset: Integer;
   EditItem: PDataRecord;
 begin
   if not (State in [dsEdit, dsInsert, dsCalcFields]) then
@@ -1358,21 +1368,8 @@ begin
     ftFloat, ftDateTime, ftDate, ftTime, ftCurrency:
       begin
         Str(Double(Buffer^), TempStr);
-        //Str returns an space as the first character for positive values
-        //and the - sign for negative values. It's necessary to remove the extra
-        //space while keeping the - sign
-        if TempStr[1] = ' ' then
-        begin
-          FloatStr := PChar(TempStr) + 1;
-          FloatLen := Length(TempStr);
-        end
-        else
-        begin
-          FloatStr := PChar(TempStr);
-          FloatLen := Length(TempStr) + 1;
-        end;
-        EditItem^.Row[FieldOffset] := StrAlloc(FloatLen);
-        Move(FloatStr^, (EditItem^.Row[FieldOffset])^, FloatLen);
+        EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
+        Move(PChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
       end;
     ftLargeInt:
       begin
@@ -1439,7 +1436,7 @@ var
   AFilter: String;
   i: Integer;
 begin
-  if (FMasterLink.Dataset.RecordCount = 0) or not FMasterLink.Active then //Retrieve all data
+  if not FMasterLink.Active or (FMasterLink.Dataset.RecordCount = 0) then //Retrieve all data
     FEffectiveSQL := FSqlFilterTemplate
   else
   begin

+ 118 - 0
packages/fcl-db/tests/bufdatasettoolsunit.pas

@@ -0,0 +1,118 @@
+unit BufDatasetToolsUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, toolsunit,
+  db,
+  BufDataset;
+
+type
+{ TbufdatasetConnector }
+  TbufdatasetDBConnector = class(TDBConnector)
+  protected
+    procedure CreateNDatasets; override;
+    procedure CreateFieldDataset; override;
+    procedure DropNDatasets; override;
+    procedure DropFieldDataset; override;
+    Function InternalGetNDataset(n : integer) : TDataset; override;
+    Function InternalGetFieldDataset : TDataSet; override;
+  end;
+
+implementation
+
+{ TbufdatasetDBConnector }
+
+procedure TbufdatasetDBConnector.CreateNDatasets;
+begin
+// All datasets only exist in memory, so nothing has to be done
+end;
+
+procedure TbufdatasetDBConnector.CreateFieldDataset;
+begin
+// All datasets only exist in memory, so nothing has to be done
+end;
+
+procedure TbufdatasetDBConnector.DropNDatasets;
+begin
+// All datasets only exist in memory, so nothing has to be done
+end;
+
+procedure TbufdatasetDBConnector.DropFieldDataset;
+begin
+// All datasets only exist in memory, so nothing has to be done
+end;
+
+function TbufdatasetDBConnector.InternalGetNDataset(n: integer): TDataset;
+var BufDataset  : TBufDataset;
+    i      : integer;
+
+begin
+  BufDataset := TBufDataset.Create(nil);
+  BufDataset.FieldDefs.Add('ID',ftInteger);
+  BufDataset.FieldDefs.Add('NAME',ftString,50);
+  BufDataset.CreateDataset;
+  BufDataset.Open;
+  for i := 1 to n do
+    begin
+    BufDataset.Append;
+    BufDataset.FieldByName('ID').AsInteger := i;
+    BufDataset.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
+    BufDataset.Post;
+    end;
+  BufDataset.Close;
+  Result := BufDataset;
+end;
+
+function TbufdatasetDBConnector.InternalGetFieldDataset : TDataSet;
+
+
+var BufDataset  : TBufDataset;
+    i      : integer;
+
+begin
+  BufDataset := TBufDataset.Create(nil);
+  with BufDataset do
+    begin
+    //todo: this is based on memds.
+    //check and add bufdataset supported fields
+    FieldDefs.Add('ID',ftInteger);
+    FieldDefs.Add('FSTRING',ftString,10);
+    FieldDefs.Add('FSMALLINT',ftSmallint);
+    FieldDefs.Add('FINTEGER',ftInteger);
+//    FieldDefs.Add('FWORD',ftWord);
+    FieldDefs.Add('FBOOLEAN',ftBoolean);
+    FieldDefs.Add('FFLOAT',ftFloat);
+//    FieldDefs.Add('FCURRENCY',ftCurrency);
+//    FieldDefs.Add('FBCD',ftBCD);
+    FieldDefs.Add('FDATE',ftDate);
+    FieldDefs.Add('FTIME',ftTime);
+    FieldDefs.Add('FDATETIME',ftDateTime);
+    FieldDefs.Add('FLARGEINT',ftLargeint);
+    CreateDataset;
+    Open;
+    for i := 0 to testValuesCount-1 do
+      begin
+      Append;
+      FieldByName('ID').AsInteger := i;
+      FieldByName('FSTRING').AsString := testStringValues[i];
+      FieldByName('FSMALLINT').AsInteger := testSmallIntValues[i];
+      FieldByName('FINTEGER').AsInteger := testIntValues[i];
+      FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
+      FieldByName('FFLOAT').AsFloat := testFloatValues[i];
+      ShortDateFormat := 'yyyy-mm-dd';
+      FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i]);
+      FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
+      Post;
+      end;
+    Close;
+    end;
+  Result := BufDataset;
+end;
+
+initialization
+  RegisterClass(TbufdatasetDBConnector);
+end.
+

+ 4 - 1
packages/fcl-db/tests/database.ini.txt

@@ -10,7 +10,6 @@ type=interbase
 
 ; PostgreSQL database:
 [postgresql]
-
 ; The connector specifies the DB-component that has to be used. The 'sql'
 ; connector tests the SQLDB components
 connector=sql
@@ -105,3 +104,7 @@ name=/tmp
 ; MemDS in memory dataset:
 [memds]
 connector=memds
+
+; BufDataset in memory dataset:
+[bufdataset]
+connector=bufdataset

+ 1 - 0
packages/fcl-db/tests/dbtestframework.pas

@@ -14,6 +14,7 @@ uses
 // List of supported database-connectors
   sqldbtoolsunit,
   dbftoolsunit,
+  bufdatasettoolsunit,
   memdstoolsunit,
   SdfDSToolsUnit,
 // Units wich contains the tests

+ 15 - 2
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -94,6 +94,8 @@ var SQLDbType : TSQLDBTypes;
     
 implementation
 
+uses StrUtils;
+
 { TSQLDBConnector }
 
 procedure TSQLDBConnector.CreateFConnection;
@@ -124,14 +126,17 @@ begin
     // mysql's timestamps are only valid in the range 1970-2038.
     // Downside is that fields defined as 'TIMESTAMP' aren't tested
     FieldtypeDefinitions[ftDateTime] := 'DATETIME';
+    FieldtypeDefinitions[ftBytes] := 'BINARY(5)';
+    FieldtypeDefinitions[ftVarBytes] := 'VARBINARY(10)';
     FieldtypeDefinitions[ftMemo] := 'TEXT';
     end;
   if SQLDbType = sqlite3 then
     begin
     Fconnection := TSQLite3Connection.Create(nil);
     FieldtypeDefinitions[ftCurrency] := 'CURRENCY';
+    FieldtypeDefinitions[ftBytes] := 'BINARY(5)';
+    FieldtypeDefinitions[ftVarBytes] := 'VARBINARY(10)';
     FieldtypeDefinitions[ftMemo] := 'CLOB'; //or TEXT SQLite supports both, but CLOB is sql standard (TEXT not)
-    FieldtypeDefinitions[ftFixedChar] := '';
     end;
   if SQLDbType = POSTGRESQL then
     begin
@@ -174,9 +179,17 @@ begin
       testValues[ftTime,2]:='23:00:00.000';
       end;
     end;
+
   if SQLDbType in [sqlite3] then
     testValues[ftCurrency]:=testValues[ftBCD]; //decimal separator for currencies must be decimal point
 
+  // SQLite does not support fixed length CHAR datatype
+  // MySQL by default trimms trailing spaces on retrieval; so set sql-mode="PAD_CHAR_TO_FULL_LENGTH" - supported from MySQL 5.1.20
+  if SQLDbType in [sqlite3] then
+    for t := 0 to testValuesCount-1 do
+      testValues[ftFixedChar,t] := PadRight(testValues[ftFixedChar,t], 10);
+
+
   if not assigned(Fconnection) then writeln('Invalid database-type, check if a valid database-type was provided in the file ''database.ini''');
 
   with Fconnection do
@@ -190,7 +203,7 @@ begin
       FieldNameQuoteChars[0] := dbQuoteChars[1];
       FieldNameQuoteChars[1] := dbQuoteChars[2];
       end;
-    open;
+    Open;
     end;
 end;
 

+ 10 - 0
packages/fcl-db/tests/tcparser.pas

@@ -377,6 +377,7 @@ type
     procedure TestSelectAsteriskOneTable;
     procedure TestSelectDistinctAsteriskOneTable;
     procedure TestSelectOneFieldOneTableAlias;
+    procedure TestSelectOneFieldOneTableAsAlias;
     procedure TestSelectTwoFieldsTwoTables;
     procedure TestSelectTwoFieldsTwoTablesJoin;
     procedure TestSelectTwoFieldsTwoInnerTablesJoin;
@@ -3680,6 +3681,15 @@ begin
   AssertTable(Select.Tables[0],'A');
 end;
 
+procedure TTestSelectParser.TestSelectOneFieldOneTableAsAlias;
+begin
+  TestSelect('SELECT C.B FROM A AS C');
+  AssertEquals('One field',1,Select.Fields.Count);
+  AssertField(Select.Fields[0],'C.B');
+  AssertEquals('One table',1,Select.Tables.Count);
+  AssertTable(Select.Tables[0],'A');
+end;
+
 procedure TTestSelectParser.TestSelectTwoFieldsTwoTables;
 begin
   TestSelect('SELECT B,C FROM A,D');

+ 9 - 0
packages/fcl-db/tests/testbasics.pas

@@ -36,6 +36,8 @@ procedure TTestBasics.TestParseSQL;
 var Params  : TParams;
     ReplStr : string;
     pb      : TParamBinding;
+    i       : integer;
+    SQLStr  : string;
 begin
   Params := TParams.Create;
 
@@ -105,6 +107,13 @@ begin
   AssertEquals(     'select * from table where "field-name" = ?',
     params.ParseSQL('select * from table where "field-name" = :"field-name',true,True,True,psInterbase));
 
+// Test more than 99 params - bug 19645
+  SQLStr := 'update test set';
+  for i := 1 to 101 do
+    SQLStr := format('%s field%d=:par%d', [SQLStr,i,i]);
+  AssertEquals( StringReplace(SQLStr, ':par', '$', [rfReplaceAll]),
+    Params.ParseSQL(SQLStr, True, True, True, psPostgreSQL) );
+
   Params.Free;
 end;
 

+ 1 - 1
packages/fcl-db/tests/testdbbasics.pas

@@ -2005,7 +2005,7 @@ var i          : byte;
     Fld        : TField;
 
 begin
-  TestfieldDefinition(ftFixedChar,10,ds,Fld);
+  TestfieldDefinition(ftFixedChar,11,ds,Fld);
   for i := 0 to testValuesCount-1 do
     begin
     if Fld.IsNull then // If the field is null, .AsString always returns an empty, non-padded string

+ 64 - 7
packages/fcl-db/tests/testfieldtypes.pas

@@ -60,6 +60,7 @@ type
     procedure TestInt;
     procedure TestScript;
     procedure TestInsertReturningQuery;
+    procedure TestOpenStoredProc;
 
     procedure TestTemporaryTable;
     procedure TestRefresh;
@@ -92,6 +93,7 @@ type
     procedure TestFmtBCDParamQuery;
     procedure TestFloatParamQuery;
     procedure TestBCDParamQuery;
+    procedure TestBytesParamQuery;
     procedure TestAggregates;
 
     procedure TestStringLargerThen8192;
@@ -147,6 +149,8 @@ const
     '1900-01-01'
   );
 
+  testBytesValuesCount = 5;
+  testBytesValues : Array[0..testBytesValuesCount-1] of shortstring = (#1#0#1#0#1, #0#0#1#0#1, #0''''#13#0#1, '\'#0'"\'#13, #13#13#0#10#10);
 
 procedure TTestFieldTypes.TestpfInUpdateFlag;
 var ds   : TCustomBufDataset;
@@ -792,6 +796,11 @@ begin
   TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount);
 end;
 
+procedure TTestFieldTypes.TestBytesParamQuery;
+begin
+  TestXXParamQuery(ftBytes, FieldtypeDefinitions[ftBytes], testBytesValuesCount, true);
+end;
+
 procedure TTestFieldTypes.TestStringParamQuery;
 
 begin
@@ -815,6 +824,9 @@ procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl
 var i : integer;
 
 begin
+  if ASQLTypeDecl = '' then
+    Ignore('Fields of the type ' + FieldTypeNames[ADatatype] + ' are not supported by this sqldb-connection type');
+
   TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID INT, FIELD1 '+ASQLTypeDecl+')');
 
 // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
@@ -838,14 +850,18 @@ begin
         ftFloat  : Params.ParamByName('field1').AsFloat   := testFloatValues[i];
         ftBCD    : Params.ParamByName('field1').AsCurrency:= testBCDValues[i];
         ftFixedChar,
-        ftString : Params.ParamByName('field1').AsString  := testStringValues[i];
+        ftString : Params.ParamByName('field1').AsString  := testValues[ADataType,i];
         ftTime   : Params.ParamByName('field1').AsTime  := TimeStringToDateTime(testTimeValues[i]);
         ftDate   : if cross then
                      Params.ParamByName('field1').AsString:= testDateValues[i]
                    else
                      Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-');
         ftDateTime:Params.ParamByName('field1').AsDateTime := StrToDateTime(testValues[ADataType,i], DBConnector.FormatSettings);
-        ftFMTBcd : Params.ParamByName('field1').AsFMTBCD:= StrToBCD(testFmtBCDValues[i],DBConnector.FormatSettings)
+        ftFMTBcd : Params.ParamByName('field1').AsFMTBCD := StrToBCD(testFmtBCDValues[i],DBConnector.FormatSettings);
+        ftBytes  : if cross then
+                     Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i])
+                   else
+                     Params.ParamByName('field1').AsBlob := testBytesValues[i];
       else
         AssertTrue('no test for paramtype available',False);
       end;
@@ -869,7 +885,8 @@ begin
         ftTime   : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime));
         ftDate   : AssertEquals(testDateValues[i],DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
         ftDateTime : AssertEquals(testValues[ADataType,i], DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
-        ftFMTBcd : AssertEquals(testFmtBCDValues[i],BCDToStr(FieldByName('FIELD1').AsBCD,DBConnector.FormatSettings))
+        ftFMTBcd : AssertEquals(testFmtBCDValues[i], BCDToStr(FieldByName('FIELD1').AsBCD, DBConnector.FormatSettings));
+        ftBytes  : AssertEquals(testBytesValues[i], shortstring(FieldByName('FIELD1').AsString));
       else
         AssertTrue('no test for paramtype available',False);
       end;
@@ -1185,6 +1202,46 @@ begin
     end;
 end;
 
+procedure TTestFieldTypes.TestOpenStoredProc;
+begin
+  with TSQLDBConnector(DBConnector) do
+  begin
+    if SQLDbType in MySQLdbTypes then
+    begin
+      Connection.ExecuteDirect('create procedure FPDEV_PROC() select 1 union select 2;');
+      Query.SQL.Text:='call FPDEV_PROC';
+    end
+    else if SQLDbType = interbase then
+    begin
+      Connection.ExecuteDirect('create procedure FPDEV_PROC returns (r integer) as begin r=1; end');
+      Query.SQL.Text:='execute procedure FPDEV_PROC';
+    end
+    else
+    begin
+      Ignore('This test does not apply to this sqldb-connection type, since it does not support selectable stored procedures.');
+      Exit;
+    end;
+    Transaction.CommitRetaining;
+
+    try
+      Query.Open;
+      AssertEquals(1, Query.Fields[0].AsInteger);
+      Query.Next;
+      if not(SQLDbType in [interbase]) then
+      begin
+        AssertFalse('Eof after 1st row', Query.Eof);
+        AssertEquals(2, Query.Fields[0].AsInteger);
+        Query.Next;
+      end;
+      AssertTrue('No Eof after last row', Query.Eof);
+      Query.Close;
+    finally
+      Connection.ExecuteDirect('drop procedure FPDEV_PROC');
+      Transaction.CommitRetaining;
+    end;
+  end;
+end;
+
 procedure TTestFieldTypes.TestClearUpdateableStatus;
 // Test if CanModify is correctly disabled in case of a select query without
 // a from-statement.
@@ -1364,13 +1421,13 @@ begin
                               ')                            ');
 // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
     TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
-    Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
-    Query.ExecSQL;
     query.sql.Text:='select * from FPDEV2';
     Query.Open;
+    Query.InsertRecord([1,'test1']);
+    Query.ApplyUpdates;
+    Query.Close;
+    Query.Open;
     AssertEquals(query.FieldByName('NAME').AsString,'test1');
-    Query.insert;
-    query.fields[1].AsString:='11';
     query.Close;
     end;
 end;

+ 0 - 85
packages/fcl-db/tests/testwherenull.lpr

@@ -1,85 +0,0 @@
-program testWhereNULL;
-
-{$mode objfpc}{$H+}
-
-uses
-  {$IFDEF UNIX}{$IFDEF UseCThreads}
-  cthreads,
-  {$ENDIF}{$ENDIF}
-  Classes, SysUtils,
-  db, sqldb, sqlite3conn, variants;
-
-
-var
-  Conn: TSQLite3Connection;
-  Tran: TSQLTransaction;
-  Q: TSQLQuery;
-
-  sql: string;
-  i: integer;
-
-begin
-  Conn:=TSQLite3Connection.Create(nil);
-  Conn.DatabaseName:='test.db';
-
-  Tran:=TSQLTransaction.Create(nil);
-  Tran.DataBase:=Conn;
-
-  Q:=TSQLQuery.Create(nil);
-  Q.DataBase:=Conn;
-
-  Conn.Open;
-  writeln('Connected');
-
-  Conn.ExecuteDirect('CREATE TEMPORARY TABLE t (int_field INT, string_field VARCHAR(30))');
-  writeln('Temporary table created');
-
-  Q.SQL.Text:='SELECT * FROM t';
-  Q.UpdateMode:=upWhereAll; // <-- UpdateMode is upWhereAll or upWhereCahnged
-  Q.Open;
-  Q.AppendRecord([NULL,'a']);
-  Q.AppendRecord([2,'c']);
-  Q.ApplyUpdates;
-  Q.Close;
-
-  writeln('1. Bug: second row has instead of 2 in first column NULL');
-  Q.Open;
-  Q.Next;
-  writeln('Value of ', Q.Fields[0].FieldName,' is: ', Q.Fields[0].AsString, ' expected: 2');
-  Q.Close;
-
-  writeln;
-  writeln('2. Case update of record, where some value is null (upWhereAll or upWhereChanged)');
-  Q.Open;
-  Q.Edit;
-  Q.Fields[1].AsString:='b';
-  Q.Post;
-  Q.ApplyUpdates;
-  Q.Close;
-
-  Q.Open;
-  writeln('Value of ', Q.Fields[1].FieldName,' is: ', Q.Fields[1].AsString,' expected: b');
-  Q.Close;
-
-  writeln;
-  writeln('3. Case delete of record, where some value is null (upWhereAll or upWhereChanged)');
-  Q.Open;
-  Q.Delete;
-  Q.ApplyUpdates;
-  Q.Close;
-
-  Q.Open;
-  writeln('Number of rows: ', Q.RecordCount, ' expected: 1');
-  Q.Close;
-
-  //END
-  Tran.Commit;
-  Conn.Close;
-
-  Q.Free;
-  Tran.Free;
-  Conn.Free;
-  writeln('End. Press any key');
-  readln;
-end.
-

+ 18 - 3
packages/fcl-db/tests/toolsunit.pas

@@ -7,7 +7,7 @@ unit ToolsUnit;
 interface
 
 uses
-  Classes, SysUtils, DB, testdecorator, FmtBCD;
+  Classes, SysUtils, DB, testdecorator;
   
 Const MaxDataSet = 35;
   
@@ -206,11 +206,12 @@ procedure FreeDBConnector;
 
 function DateTimeToTimeString(d: tdatetime) : string;
 function TimeStringToDateTime(d: String): TDateTime;
+function StringToByteArray(s: ansistring): Variant;
 
 implementation
 
 uses
-  inifiles;
+  inifiles, FmtBCD, Variants;
 
 var DBConnectorRefCount: integer;
 
@@ -330,7 +331,7 @@ begin
   DBConnectorClass := GetClass('T'+dbconnectorname+'DBConnector');
   if assigned(DBConnectorClass) then
     DBConnector := TDBConnectorClass(DBConnectorClass).create
-  else Raise Exception.Create('Unknown db-connector specified');
+  else Raise Exception.Create('Unknown db-connector specified: ' + 'T'+dbconnectorname+'DBConnector');
   inc(DBConnectorRefCount);
 end;
 
@@ -374,6 +375,20 @@ begin
   result := ComposeDateTime(days,EncodeTime(hour,minute,second,millisecond));
 end;
 
+function StringToByteArray(s: ansistring): Variant;
+var P: Pointer;
+    Len: integer;
+begin
+  Len := Length(s) * SizeOf(AnsiChar);
+  Result := VarArrayCreate([0, Len-1], varByte);
+  P := VarArrayLock(Result);
+  try
+    Move(s[1], P^, Len);
+  finally
+    VarArrayUnlock(Result);
+  end;
+end;
+
 
 { TTestDataLink }
 

+ 3 - 0
rtl/objpas/sysutils/sysunih.inc

@@ -18,6 +18,9 @@
     *********************************************************************
 }
 
+type
+  TUnicodeCharArray = array of UnicodeChar;
+
 function Trim(const S: unicodestring): unicodestring;
 function TrimLeft(const S: unicodestring): unicodestring;
 function TrimRight(const S: unicodestring): unicodestring;

+ 2 - 0
rtl/objpas/sysutils/sysutilh.inc

@@ -98,6 +98,8 @@ type
    PWordarray = ^TWordArray;
    TWordArray = array[0..16383] of Word;
 
+   TBytes = array of Byte;   
+
    { exceptions }
    Exception = class(TObject)
     private