# revisions: 44530,44531,44634,45363,45494,46756,46065

git-svn-id: branches/fixes_3_2@47086 -

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

@@ -998,10 +998,13 @@ procedure TCustomBufDataset.SetPacketRecords(aValue : integer);
 begin
   if (aValue = -1) or (aValue > 0) then
     begin
-    if (IndexFieldNames='') then
+    if (IndexFieldNames<>'') and (aValue<>-1) then
+      DatabaseError(SInvPacketRecordsValueFieldNames)
+    else
+    if UniDirectional and (aValue=-1) then
+      DatabaseError(SInvPacketRecordsValueUniDirectional)
+    else
       FPacketRecords := aValue
-    else if AValue<>-1 then
-      DatabaseError(SInvPacketRecordsValueFieldNames);
     end
   else
     DatabaseError(SInvPacketRecordsValue);

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

@@ -85,6 +85,7 @@ Resourcestring
   SUnsupportedFieldType    = 'Fieldtype %s is not supported';
   SInvPacketRecordsValue   = 'PacketRecords has to be larger then 0';
   SInvPacketRecordsValueFieldNames = 'PacketRecords must be -1 if IndexFieldNames is set';
+  SInvPacketRecordsValueUniDirectional = 'PacketRecords must not be -1 on an unidirectional dataset';
   SInvalidSearchFieldType  = 'Searching in fields of type %s is not supported';
   SDatasetEmpty            = 'The dataset is empty';
   SFieldIsNull             = 'The field is null';

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

@@ -389,7 +389,7 @@ begin
               else
                 begin
                 ParamNameStart:=p;
-                while not (p^ in (SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'])) do
+                while not (p^ in (SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|','<','>'])) do
                   Inc(p);
                 ParamName:=Copy(ParamNameStart,1,p-ParamNameStart);
                 end;

packages/fcl-db/src/codegen/fpcgdbcoll.pp

@@ -88,7 +88,6 @@ Type
     Procedure DoGenerateImplementation(Strings: TStrings); override;
     procedure WriteVisibilityStart(V: TVisibility; Strings: TStrings); override;
     procedure CreateImplementation(Strings: TStrings); override;
-    Class Function NeedsFieldDefs : Boolean; override;
     Function CreateOptions : TCodeGeneratorOptions; override;
     //
     //  New methods
@@ -116,6 +115,7 @@ Type
     // Code to Load object from fataset (should check usefieldmap)
     procedure CreateObjectLoadFromDataset(Strings: TStrings; const ObjectClassName: String); virtual;
   Public
+    Class Function NeedsFieldDefs : Boolean; override;
     procedure CreateFieldMapDeclaration(Strings: TStrings; const ObjectClassName,MapClassName,
       MapAncestorName: String);
     procedure CreateListDeclaration(Strings: TStrings; ListMode: TListMode;

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

@@ -164,6 +164,7 @@ uses
 const
   SQL_BOOLEAN_INTERBASE = 590;
   SQL_BOOLEAN_FIREBIRD = 32764;
+  SQL_NULL = 32767;
   INVALID_DATA = -1;
 
 procedure TIBConnection.CheckError(ProcName : string; Status : PISC_STATUS);
@@ -834,7 +835,7 @@ begin
         begin
         if ((SQLType and not 1) = SQL_VARYING) then
           SQLData := AllocMem(in_SQLDA^.SQLVar[x].SQLLen+2)
-        else
+        else if SQLType <> SQL_NULL then
           SQLData := AllocMem(in_SQLDA^.SQLVar[x].SQLLen);
         // Always force the creation of slqind for parameters. It could be
         // that a database trigger takes care of inserting null values, so
@@ -1211,7 +1212,8 @@ begin
         SQL_BOOLEAN_FIREBIRD:
           PByte(VSQLVar^.SQLData)^ := Byte(AParam.AsBoolean);
       else
-        DatabaseErrorFmt(SUnsupportedParameter,[FieldTypeNames[AParam.DataType]],self);
+        if (VSQLVar^.sqltype <> SQL_NULL) then
+          DatabaseErrorFmt(SUnsupportedParameter,[FieldTypeNames[AParam.DataType]],self);
       end {case}
       end;
     end;

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -999,7 +999,14 @@ begin
       SQL_TINYINT:       begin FieldType:=ftSmallint;   FieldSize:=0; end;
       SQL_BIGINT:        begin FieldType:=ftLargeint;   FieldSize:=0; end;
       SQL_BINARY:        begin FieldType:=ftBytes;      FieldSize:=ColumnSize; end;
-      SQL_VARBINARY:     begin FieldType:=ftVarBytes;   FieldSize:=ColumnSize; end;
+      SQL_VARBINARY:
+      begin
+        FieldSize:=ColumnSize;
+        if FieldSize=BLOB_BUF_SIZE then // SQL_VARBINARY declared as VARBINARY(MAX) must be ftBlob - variable data size
+          FieldType:=ftBlob
+        else
+          FieldType:=ftVarBytes;
+      end;
       SQL_LONGVARBINARY: begin FieldType:=ftBlob;       FieldSize:=BLOB_BUF_SIZE; end; // is a blob
       SQL_TYPE_DATE:     begin FieldType:=ftDate;       FieldSize:=0; end;
       SQL_SS_TIME2,

packages/fcl-db/tests/testsqldb.pas

@@ -60,6 +60,7 @@ type
     procedure TestReturningUpdate;
     procedure TestMacros;
     Procedure TestPrepareCount;
+    Procedure TestNullTypeParam;
   end;
 
   { TTestTSQLConnection }
@@ -797,6 +798,30 @@ begin
 
 end;
 
+procedure TTestTSQLQuery.TestNullTypeParam;
+begin
+  if not (SQLServerType in [ssSQLite, ssFirebird]) then
+    Ignore(STestNotApplicable);
+  CreateAndFillIDField;
+  try
+    With SQLDBConnector.Query do
+      begin
+      UsePrimaryKeyAsKey:=False; // Disable server index defs etc
+      SQL.Text:='Select ID from FPDEV2 where (:ID IS NULL or ID = :ID)';
+      Open;
+      AssertEquals('Correct record count param NULL',10,RecordCount);
+      Close;
+      ParamByname('ID').AsInteger:=1;
+      Open;
+      AssertEquals('Correct record count param 1',1,RecordCount);
+      AssertEquals('Correct field value: ',1,Fields[0].AsInteger);
+      Close;
+      end;
+  finally
+    SQLDBConnector.Connection.OnLog:=Nil;
+  end;
+end;
+
 
 { TTestTSQLConnection }