Browse Source

--- Merging r25025 into '.':
U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r25026 into '.':
G packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r25027 into '.':
U packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r25032 into '.':
U packages/fcl-db/tests/sqldbtoolsunit.pas
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r25035 into '.':
G packages/fcl-db/src/sqldb/odbc/odbcconn.pas
--- Merging r25036 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
G packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r25055 into '.':
U packages/fcl-db/tests/testleaks.sh
U packages/fcl-db/src/sqldb/sqldb.pp
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r25056 into '.':
G packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
G packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Merging r25061 into '.':
G packages/fcl-db/tests/testfieldtypes.pas
--- Merging r25063 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r25064 into '.':
U packages/fcl-db/tests/testsqldb.pas
G packages/fcl-db/tests/testfieldtypes.pas
--- Merging r25065 into '.':
G packages/fcl-db/tests/testsqldb.pas
--- Merging r25084 into '.':
U packages/fcl-db/src/export/XMLXSDExportReadme.TXT
--- Merging r25085 into '.':
U packages/fcl-db/src/export/fpdbexport.pp

# revisions: 25025,25026,25027,25032,25035,25036,25055,25056,25061,25063,25064,25065,25084,25085
r25025 | lacak | 2013-07-02 13:20:04 +0200 (Tue, 02 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

fcl-db: mysql: map UNSIGNED SMALLINT to ftWord fields. TestSupportWordFields
r25026 | lacak | 2013-07-02 13:29:15 +0200 (Tue, 02 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

fcl-db: mysql: formatting (remove unused variables)
r25027 | lacak | 2013-07-02 13:38:33 +0200 (Tue, 02 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

fcl-db: mssql: add comments
r25032 | lacak | 2013-07-03 10:24:51 +0200 (Wed, 03 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas

fcl-db: odbc: map UNSIGNED SMALLINT to ftWord fields. TestSupportWordFields
r25035 | lacak | 2013-07-04 08:46:45 +0200 (Thu, 04 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas

fcl-db: odbc: map ftWord fields to TWordField (avoid potential problem with Big Endian systems)
r25036 | lacak | 2013-07-04 10:25:33 +0200 (Thu, 04 Jul 2013) | 4 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

fcl-db:
- for MSSQL map TINYINT to ftWord
- for SQLite map TINYINT to ftSmallint
- TestTinyint
r25055 | michael | 2013-07-07 20:14:11 +0200 (Sun, 07 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/fcl-db/tests/testleaks.sh

* Fixed Master/Detail relation in SQLDB and fixed memory leak
r25056 | michael | 2013-07-07 20:19:23 +0200 (Sun, 07 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

* Inherited must be called for Internal(Dis)Connect for housekeeping
r25061 | lacak | 2013-07-08 08:55:15 +0200 (Mon, 08 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

fcl-db: tests: more complex test for rev.25036
r25063 | lacak | 2013-07-08 12:40:27 +0200 (Mon, 08 Jul 2013) | 4 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

fcl-db: sqldb:
- do not allocate cursor when opening bufdataset from file
- when closing TSQLQuery do not deallocate cursor while can be prepared (fixes "[SETUP] unable to close due to unfinalised statements" bug for SQLite)
- when unpreparing statement take into account that there are also SQLConnections which does not support [un]preparation of statements ... bur for those we must still call UnRegisterStatement (fixes multiple "[TEARDOWN] Access violation" in tests)
r25064 | lacak | 2013-07-08 13:06:56 +0200 (Mon, 08 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testfieldtypes.pas
M /trunk/packages/fcl-db/tests/testsqldb.pas

fcl-db: tests: move 1 test
r25065 | lacak | 2013-07-08 13:50:15 +0200 (Mon, 08 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testsqldb.pas

fcl-db: tests: Add test for Master-detail (see rev.25055)
r25084 | reiniero | 2013-07-11 13:02:08 +0200 (Thu, 11 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/export/XMLXSDExportReadme.TXT

fcl-db: cosmetic fixed for XMLXSD export readme
r25085 | reiniero | 2013-07-11 13:09:05 +0200 (Thu, 11 Jul 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/export/fpdbexport.pp

fcl-db: cosmetic: corrected fpdbexport.pp comments

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

marco 12 years ago
parent
commit
b3f437e25e

+ 4 - 4
packages/fcl-db/src/export/XMLXSDExportReadme.TXT

@@ -1,7 +1,7 @@
 1. fpXMLXSDExport
 1. fpXMLXSDExport
 =================
 =================
 This export module provides export to various forms of XML, selectable by the ExportFormat setting.
 This export module provides export to various forms of XML, selectable by the ExportFormat setting.
-Note that not exporting indexes appears as a limitation in most formats below, but indexes probably will probably need to be changed anyway in an new environment/database.
+Note that not exporting indexes appears as a limitation in most formats below, but indexes will probably need to be changed anyway in an new environment/database.
 
 
 1.1 AccessCompatible
 1.1 AccessCompatible
 ====================
 ====================
@@ -18,7 +18,7 @@ We cannot replicate this functionality, so we just base64 encode the BLOB, and l
 
 
 1.2 ADONETCompatible
 1.2 ADONETCompatible
 ====================
 ====================
-This format generates XML compatible with the .Net framework (specifically the ADO.NET data access libraries). It should work for versions 2 to 4; version 1/1.1 has not been tested.
+This format generates XML compatible with the .Net framework (specifically the ADO.NET data access libraries). It should work for .Net versions 2 to 4; version 1/1.1 has not been tested.
 In this format you can also specify XSD or no XSD using the CreateXSD setting.
 In this format you can also specify XSD or no XSD using the CreateXSD setting.
 This output format is fairly generic and could be usable for import in other applications, as well.
 This output format is fairly generic and could be usable for import in other applications, as well.
 Limitations:
 Limitations:
@@ -49,7 +49,7 @@ Limitations:
 
 
 2. Other settings
 2. Other settings
 =================
 =================
-As the XML formats used above defines how date/time formats, boolean formats etc are used, these general export settings have no effect:
+As the XML formats used above define how date/time formats, boolean formats etc are used, these general export settings have no effect:
 - BooleanFalse
 - BooleanFalse
 - BooleanTrue
 - BooleanTrue
 - DateFormat
 - DateFormat
@@ -63,6 +63,6 @@ As the XML formats used above defines how date/time formats, boolean formats etc
 3. License
 3. License
 ==========
 ==========
 The fpXMLXSDExport module is freeware, licensed under the MIT license: all use free, but no liability accepted.
 The fpXMLXSDExport module is freeware, licensed under the MIT license: all use free, but no liability accepted.
-It is also licensed under the FreePascal license, so take your pick, but don't blame me for things that go wrong.
+It is also licensed under the FreePascal modified LGPL license, so take your pick, but don't blame me for things that go wrong.
 
 
 Reinier Olislagers, 2011
 Reinier Olislagers, 2011

+ 3 - 2
packages/fcl-db/src/export/fpdbexport.pp

@@ -150,7 +150,7 @@ Type
     Procedure DoDataRowStart; virtual;
     Procedure DoDataRowStart; virtual;
     // Override if a simple loop is not enough.
     // Override if a simple loop is not enough.
     Procedure ExportDataRow; virtual;
     Procedure ExportDataRow; virtual;
-    // Override to write something at row start.
+    // Override to write something at row end.
     Procedure DoDataRowEnd; virtual;
     Procedure DoDataRowEnd; virtual;
     // Called after row was exported
     // Called after row was exported
     Procedure DoProgress(ItemNo : Integer); Virtual;
     Procedure DoProgress(ItemNo : Integer); Virtual;
@@ -221,8 +221,9 @@ Type
     procedure SetFileName(const AValue: String); virtual;
     procedure SetFileName(const AValue: String); virtual;
     // Override if some checking needs to be done prior to opening.
     // Override if some checking needs to be done prior to opening.
     Procedure CheckFileName; virtual;
     Procedure CheckFileName; virtual;
-    // Use to open/close textfile. Creates a file stream.
+    // Use to open textfile. Creates a file stream.
     Procedure OpenTextFile;
     Procedure OpenTextFile;
+    // Use to close textfile.
     Procedure CloseTextFile;
     Procedure CloseTextFile;
     // Access to stream/file
     // Access to stream/file
     Property TextFile : Text Read FTextFile;
     Property TextFile : Text Read FTextFile;

+ 1 - 0
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -356,6 +356,7 @@ end;
 
 
 procedure TIBConnection.DoInternalDisconnect;
 procedure TIBConnection.DoInternalDisconnect;
 begin
 begin
+  Inherited;
   FDialect := INVALID_DATA;
   FDialect := INVALID_DATA;
   if not Connected then
   if not Connected then
   begin
   begin

+ 19 - 4
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -27,11 +27,12 @@
 
 
     TMSSQLConnection properties:
     TMSSQLConnection properties:
       HostName - can be specified also as 'servername:port' or 'servername\instance'
       HostName - can be specified also as 'servername:port' or 'servername\instance'
+                 (SQL Server Browser Service must be running on server to connect to specific instance)
       CharSet - if you use Microsoft DB-Lib and set to 'UTF-8' then char/varchar fields will be UTF8Encoded/Decoded
       CharSet - if you use Microsoft DB-Lib and set to 'UTF-8' then char/varchar fields will be UTF8Encoded/Decoded
                 if you use FreeTDS DB-Lib then you must compile with iconv support (requires libiconv2.dll) or cast char/varchar to nchar/nvarchar in SELECTs
                 if you use FreeTDS DB-Lib then you must compile with iconv support (requires libiconv2.dll) or cast char/varchar to nchar/nvarchar in SELECTs
       Params - "AutoCommit=true" - if you don't want explicitly commit/rollback transactions
       Params - "AutoCommit=true" - if you don't want explicitly commit/rollback transactions
                "TextSize=16777216" - set maximum size of text/image data returned
                "TextSize=16777216" - set maximum size of text/image data returned
-               "ApplicationName=YourAppName" Set the app name for the connection. MSSQL 2000 and higher only
+               "ApplicationName=YourAppName" - Set the app name for the connection. MSSQL 2000 and higher only
 }
 }
 unit mssqlconn;
 unit mssqlconn;
 
 
@@ -395,9 +396,22 @@ const
   ANSI_DEFAULTS_ON: array[boolean] of shortstring = ('SET ANSI_DEFAULTS ON', 'SET QUOTED_IDENTIFIER ON');
   ANSI_DEFAULTS_ON: array[boolean] of shortstring = ('SET ANSI_DEFAULTS ON', 'SET QUOTED_IDENTIFIER ON');
   CURSOR_CLOSE_ON_COMMIT_OFF: array[boolean] of shortstring = ('SET CURSOR_CLOSE_ON_COMMIT OFF', 'SET CLOSE ON ENDTRAN OFF');
   CURSOR_CLOSE_ON_COMMIT_OFF: array[boolean] of shortstring = ('SET CURSOR_CLOSE_ON_COMMIT OFF', 'SET CLOSE ON ENDTRAN OFF');
   VERSION_NUMBER: array[boolean] of shortstring = ('SERVERPROPERTY(''ProductVersion'')', '@@version_number');
   VERSION_NUMBER: array[boolean] of shortstring = ('SERVERPROPERTY(''ProductVersion'')', '@@version_number');
+  
+Var
+  B : Boolean;
+    
 begin
 begin
   // Do not call the inherited method as it checks for a non-empty DatabaseName, empty DatabaseName=default database defined for login
   // Do not call the inherited method as it checks for a non-empty DatabaseName, empty DatabaseName=default database defined for login
-  //inherited DoInternalConnect;
+  // MVC: Inherited MUST be called to do housekeeping.
+  B:=DatabaseName='';
+  if B then
+    DatabaseName:='Dummy';
+  try  
+    inherited DoInternalConnect;
+  finally
+    if B then 
+      DatabaseName:='';
+  end;
 
 
   InitialiseDBLib(DBLibLibraryName);
   InitialiseDBLib(DBLibLibraryName);
 
 
@@ -643,7 +657,8 @@ begin
   case SQLDataType of
   case SQLDataType of
     SQLCHAR:             Result:=ftFixedChar;
     SQLCHAR:             Result:=ftFixedChar;
     SQLVARCHAR:          Result:=ftString;
     SQLVARCHAR:          Result:=ftString;
-    SQLINT1, SQLINT2:    Result:=ftSmallInt;
+    SQLINT1:             Result:=ftWord;
+    SQLINT2:             Result:=ftSmallInt;
     SQLINT4, SQLINTN:    Result:=ftInteger;
     SQLINT4, SQLINTN:    Result:=ftInteger;
     SYBINT8:             Result:=ftLargeInt;
     SYBINT8:             Result:=ftLargeInt;
     SQLFLT4, SQLFLT8,
     SQLFLT4, SQLFLT8,
@@ -760,7 +775,7 @@ begin
       inc(dest, sizeof(Word));
       inc(dest, sizeof(Word));
       desttype:=SQLBINARY;
       desttype:=SQLBINARY;
       end;
       end;
-    ftSmallInt:
+    ftSmallInt, ftWord:
       begin
       begin
       desttype:=SQLINT2;
       desttype:=SQLINT2;
       destlen:=sizeof(DBSMALLINT); //smallint
       destlen:=sizeof(DBSMALLINT); //smallint

+ 88 - 103
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -4,7 +4,7 @@
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils,bufdataset,sqldb,db,dynlibs,ctypes,
+  Classes, SysUtils,bufdataset,sqldb,db,ctypes,
  {$IFDEF mysql55}
  {$IFDEF mysql55}
   mysql55dyn;
   mysql55dyn;
  {$ELSE}
  {$ELSE}
@@ -348,24 +348,24 @@ end;
 
 
 function TConnectionName.GetAsSQLText(Field : TField) : string;
 function TConnectionName.GetAsSQLText(Field : TField) : string;
 
 
-var esc_str : pchar;
-
 begin
 begin
-  if (not assigned(field)) or field.IsNull then Result := 'Null'
-  else if field.DataType = ftString then
-    Result := '''' + EscapeString(field.AsString) + ''''
-  else Result := inherited GetAsSqlText(field);
+  if (not assigned(Field)) or Field.IsNull then
+    Result := 'Null'
+  else if Field.DataType = ftString then
+    Result := '''' + EscapeString(Field.AsString) + ''''
+  else
+    Result := inherited GetAsSqlText(Field);
 end;
 end;
 
 
 function TConnectionName.GetAsSQLText(Param: TParam) : string;
 function TConnectionName.GetAsSQLText(Param: TParam) : string;
 
 
-var esc_str : pchar;
-
 begin
 begin
-  if (not assigned(param)) or param.IsNull then Result := 'Null'
-  else if param.DataType in [ftString,ftFixedChar,ftBlob,ftMemo,ftBytes,ftVarBytes] then
+  if (not assigned(Param)) or Param.IsNull then
+    Result := 'Null'
+  else if Param.DataType in [ftString,ftFixedChar,ftBlob,ftMemo,ftBytes,ftVarBytes] then
     Result := '''' + EscapeString(Param.AsString) + ''''
     Result := '''' + EscapeString(Param.AsString) + ''''
-  else Result := inherited GetAsSqlText(Param);
+  else
+    Result := inherited GetAsSqlText(Param);
 end;
 end;
 
 
 
 
@@ -625,7 +625,10 @@ begin
       end;
       end;
     FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_YEAR:
     FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_YEAR:
       begin
       begin
-      NewType := ftSmallint;
+      if AField^.flags and UNSIGNED_FLAG <> 0 then
+        NewType := ftWord
+      else
+        NewType := ftSmallint;
       end;
       end;
     FIELD_TYPE_LONG, FIELD_TYPE_INT24:
     FIELD_TYPE_LONG, FIELD_TYPE_INT24:
       begin
       begin
@@ -803,6 +806,14 @@ begin
   ABlobBuf^.BlobBuffer^.Size := len;
   ABlobBuf^.BlobBuffer^.Size := len;
 end;
 end;
 
 
+function InternalStrToInt(const S: string): integer;
+begin
+  if S = '' then
+    Result := 0
+  else
+    Result := StrToInt(S);
+end;
+
 function InternalStrToFloat(S: string): Extended;
 function InternalStrToFloat(S: string): Extended;
 
 
 var
 var
@@ -814,7 +825,7 @@ begin
   for I := 1 to Length(S) do
   for I := 1 to Length(S) do
     begin
     begin
     if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
     if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
-      Tmp := Tmp + DecimalSeparator
+      Tmp := Tmp + FormatSettings.DecimalSeparator
     else
     else
       Tmp := Tmp + S[I];
       Tmp := Tmp + S[I];
     end;
     end;
@@ -832,7 +843,7 @@ begin
   for I := 1 to Length(S) do
   for I := 1 to Length(S) do
     begin
     begin
     if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
     if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
-      Tmp := Tmp + DecimalSeparator
+      Tmp := Tmp + FormatSettings.DecimalSeparator
     else
     else
       Tmp := Tmp + S[I];
       Tmp := Tmp + S[I];
     end;
     end;
@@ -923,6 +934,7 @@ var
   VI: Integer;
   VI: Integer;
   VL: LargeInt;
   VL: LargeInt;
   VS: Smallint;
   VS: Smallint;
+  VW: Word;
   VF: Double;
   VF: Double;
   VC: Currency;
   VC: Currency;
   VD: TDateTime;
   VD: TDateTime;
@@ -935,131 +947,104 @@ begin
   if Source = Nil then // If the pointer is NULL, the field is NULL
   if Source = Nil then // If the pointer is NULL, the field is NULL
     exit;
     exit;
   SetString(Src, Source, Len);
   SetString(Src, Source, Len);
-  case AField^.ftype of
-    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_YEAR:
+
+  if Len > FieldDef.Size then
+    Len := FieldDef.Size;
+
+  case FieldDef.DataType of
+    ftSmallint:
       begin
       begin
-      if (Src<>'') then
-        VS := StrToInt(Src)
-      else
-        VS := 0;
-      Move(VS, Dest^, SizeOf(smallint));
+      VS := InternalStrToInt(Src);
+      Move(VS, Dest^, SizeOf(Smallint));
       end;
       end;
-    FIELD_TYPE_LONG, FIELD_TYPE_INT24:
+    ftWord:
       begin
       begin
-      if (Src<>'') then
-        VI := StrToInt(Src)
-      else
-        VI := 0;
+      VW := InternalStrToInt(Src);
+      Move(VW, Dest^, SizeOf(Word));
+      end;
+    ftInteger, ftAutoInc:
+      begin
+      VI := InternalStrToInt(Src);
       Move(VI, Dest^, SizeOf(Integer));
       Move(VI, Dest^, SizeOf(Integer));
       end;
       end;
-    FIELD_TYPE_LONGLONG:
+    ftLargeInt:
       begin
       begin
-      if (Src<>'') then
+      {$IFDEF MYSQL50_UP}
+      if AField^.ftype = FIELD_TYPE_BIT then
+        begin
+        VL := 0;
+        for VI := 0 to Len-1 do
+          VL := VL * 256 + PByte(Source+VI)^;
+        end
+      else
+      {$ENDIF}
+      if Src <> '' then
         VL := StrToInt64(Src)
         VL := StrToInt64(Src)
       else
       else
         VL := 0;
         VL := 0;
       Move(VL, Dest^, SizeOf(LargeInt));
       Move(VL, Dest^, SizeOf(LargeInt));
       end;
       end;
-{$ifdef mysql50_up}
-    FIELD_TYPE_NEWDECIMAL,
-{$endif}      
-    FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
-      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
-          begin
-          if Src <> '' then
-            VF := InternalStrToFloat(Src)
-          else
-            VF := 0;
-          Move(VF, Dest^, SizeOf(Double));
-          end;
-      end;
-    FIELD_TYPE_TIMESTAMP:
+    ftFloat:
       begin
       begin
       if Src <> '' then
       if Src <> '' then
-        VD := InternalStrToTimeStamp(Src)
+        VF := InternalStrToFloat(Src)
       else
       else
-        VD := 0;
-      Move(VD, Dest^, SizeOf(TDateTime));
+        VF := 0;
+      Move(VF, Dest^, SizeOf(Double));
+      end;
+    ftBCD:
+      begin
+      VC := InternalStrToCurrency(Src);
+      Move(VC, Dest^, SizeOf(Currency));
       end;
       end;
-    FIELD_TYPE_DATETIME:
+    ftFmtBCD:
+      begin
+      VB := StrToBCD(Src, FSQLFormatSettings);
+      Move(VB, Dest^, SizeOf(TBCD));
+      end;
+    ftDate:
       begin
       begin
       if Src <> '' then
       if Src <> '' then
-        VD := InternalStrToDateTime(Src)
+        VD := InternalStrToDate(Src)
       else
       else
         VD := 0;
         VD := 0;
       Move(VD, Dest^, SizeOf(TDateTime));
       Move(VD, Dest^, SizeOf(TDateTime));
       end;
       end;
-    FIELD_TYPE_DATE:
+    ftTime:
       begin
       begin
       if Src <> '' then
       if Src <> '' then
-        VD := InternalStrToDate(Src)
+        VD := InternalStrToTime(Src)
       else
       else
         VD := 0;
         VD := 0;
       Move(VD, Dest^, SizeOf(TDateTime));
       Move(VD, Dest^, SizeOf(TDateTime));
       end;
       end;
-    FIELD_TYPE_TIME:
+    ftDateTime:
       begin
       begin
       if Src <> '' then
       if Src <> '' then
-        VD := InternalStrToTime(Src)
+        if AField^.ftype = FIELD_TYPE_TIMESTAMP then
+          VD := InternalStrToTimeStamp(Src)
+        else
+          VD := InternalStrToDateTime(Src)
       else
       else
         VD := 0;
         VD := 0;
       Move(VD, Dest^, SizeOf(TDateTime));
       Move(VD, Dest^, SizeOf(TDateTime));
       end;
       end;
-    FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
+    ftString, ftFixedChar:
+      // String-fields which can contain more then dsMaxStringSize characters
+      // are mapped to ftBlob fields, while their mysql-datatype is FIELD_TYPE_BLOB
       begin
       begin
-{      Write('Moving string of size ',asize,' : ');
-      P:=Source;
-      If (P<>nil) then
-        While P[0]<>#0 do
-          begin
-          Write(p[0]);
-          inc(p);
-          end;
-      Writeln;
-}
-      if Len > FieldDef.Size then
-        Len := FieldDef.Size;
-      case FieldDef.DataType of
-        // String-fields which can contain more then dsMaxStringSize characters
-        // are mapped to ftBlob fields, while their mysql-datatype is FIELD_TYPE_BLOB
-        ftBlob, ftMemo:
-          CreateBlob := True;
-        ftVarBytes:
-          begin
-          PWord(Dest)^ := Len;
-          Move(Source^, (Dest+sizeof(Word))^, Len);
-          end;
-        ftBytes:
-          Move(Source^, Dest^, Len);
-        else // ftString, ftFixedChar
-          begin
-          Move(Source^, Dest^, Len);
-          (Dest+Len)^ := #0;
-          end;
+      Move(Source^, Dest^, Len);
+      (Dest+Len)^ := #0;
       end;
       end;
-      end;
-    FIELD_TYPE_TINY_BLOB..FIELD_TYPE_BLOB:
-      CreateBlob := True;
-{$IFDEF MYSQL50_UP}
-    FIELD_TYPE_BIT:
+    ftVarBytes:
       begin
       begin
-      VL := 0;
-      for VI := 0 to Len-1 do
-        VL := VL * 256 + PByte(Source+VI)^;
-      move(VL, Dest^, sizeof(LargeInt));
+      PWord(Dest)^ := Len;
+      Move(Source^, (Dest+sizeof(Word))^, Len);
       end;
       end;
-{$ENDIF}
+    ftBytes:
+      Move(Source^, Dest^, Len);
+    ftBlob, ftMemo:
+      CreateBlob := True;
   end;
   end;
   Result := True;
   Result := True;
 end;
 end;

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

@@ -843,8 +843,10 @@ begin
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size+1, @StrLenOrInd);
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size+1, @StrLenOrInd);
     ftSmallint:           // mapped to TSmallintField
     ftSmallint:           // mapped to TSmallintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
-    ftInteger,ftWord,ftAutoInc:   // mapped to TLongintField
+    ftInteger,ftAutoInc:  // mapped to TLongintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SLONG, buffer, SizeOf(Longint), @StrLenOrInd);
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SLONG, buffer, SizeOf(Longint), @StrLenOrInd);
+    ftWord:               // mapped to TWordField
+      Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_USHORT, buffer, SizeOf(Word), @StrLenOrInd);
     ftLargeint:           // mapped to TLargeintField
     ftLargeint:           // mapped to TLargeintField
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SBIGINT, buffer, SizeOf(Largeint), @StrLenOrInd);
       Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SBIGINT, buffer, SizeOf(Largeint), @StrLenOrInd);
     ftFloat,ftCurrency:   // mapped to TFloatField
     ftFloat,ftCurrency:   // mapped to TFloatField
@@ -1088,7 +1090,7 @@ var
   ColName,TypeName:string;
   ColName,TypeName:string;
   FieldType:TFieldType;
   FieldType:TFieldType;
   FieldSize:word;
   FieldSize:word;
-  AutoIncAttr, Updatable, FixedPrecScale: SQLLEN;
+  AutoIncAttr, FixedPrecScale, Unsigned, Updatable: SQLLEN;
 begin
 begin
   ODBCCursor:=cursor as TODBCCursor;
   ODBCCursor:=cursor as TODBCCursor;
 
 
@@ -1195,7 +1197,6 @@ begin
     // only one column per table can have identity attr.
     // only one column per table can have identity attr.
     if (FieldType in [ftInteger,ftLargeInt]) and (AutoIncAttr=SQL_FALSE) then
     if (FieldType in [ftInteger,ftLargeInt]) and (AutoIncAttr=SQL_FALSE) then
     begin
     begin
-      AutoIncAttr:=0;
       ODBCCheckResult(
       ODBCCheckResult(
         SQLColAttribute(ODBCCursor.FSTMTHandle,     // statement handle
         SQLColAttribute(ODBCCursor.FSTMTHandle,     // statement handle
                         i,                          // column number
                         i,                          // column number
@@ -1208,22 +1209,11 @@ begin
       );
       );
       if (AutoIncAttr=SQL_TRUE) and (FieldType=ftInteger) then
       if (AutoIncAttr=SQL_TRUE) and (FieldType=ftInteger) then
         FieldType:=ftAutoInc;
         FieldType:=ftAutoInc;
-    end;
-
-    Updatable:=0;
-    ODBCCheckResult(
-      SQLColAttribute(ODBCCursor.FSTMTHandle,
-                      i,
-                      SQL_DESC_UPDATABLE,
-                      nil,
-                      0,
-                      nil,
-                      @Updatable),
-      SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get updatable attribute for column %d.',[i]
-    );
-
+    end
+    else
     if FieldType in [ftFloat] then
     if FieldType in [ftFloat] then
     begin
     begin
+      FixedPrecScale:=0;
       ODBCCheckResult(
       ODBCCheckResult(
         SQLColAttribute(ODBCCursor.FSTMTHandle,
         SQLColAttribute(ODBCCursor.FSTMTHandle,
                         i,
                         i,
@@ -1238,6 +1228,37 @@ begin
         FieldType:=ftCurrency;
         FieldType:=ftCurrency;
     end;
     end;
 
 
+    if FieldType in [ftSmallint] then
+    begin
+      Unsigned:=0;
+      ODBCCheckResult(
+        SQLColAttribute(ODBCCursor.FSTMTHandle,
+                        i,
+                        SQL_DESC_UNSIGNED,
+                        nil,
+                        0,
+                        nil,
+                        @Unsigned),
+        SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get unsigned attribute for column %d.',[i]
+      );
+      if Unsigned=SQL_TRUE then
+        case FieldType of
+          ftSmallint: FieldType:=ftWord;
+        end;
+    end;
+
+    Updatable:=0;
+    ODBCCheckResult(
+      SQLColAttribute(ODBCCursor.FSTMTHandle,
+                      i,
+                      SQL_DESC_UPDATABLE,
+                      nil,
+                      0,
+                      nil,
+                      @Updatable),
+      SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get updatable attribute for column %d.',[i]
+    );
+
     if FieldType=ftUnknown then // if unknown field type encountered, try finding more specific information about the ODBC SQL DataType
     if FieldType=ftUnknown then // if unknown field type encountered, try finding more specific information about the ODBC SQL DataType
     begin
     begin
       SetLength(TypeName,TypeNameDefaultLength); // also garantuees uniqueness
       SetLength(TypeName,TypeNameDefaultLength); // also garantuees uniqueness

+ 1 - 0
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -375,6 +375,7 @@ end;
 procedure TPQConnection.DoInternalDisconnect;
 procedure TPQConnection.DoInternalDisconnect;
 var i:integer;
 var i:integer;
 begin
 begin
+  Inherited;
   for i:=0 to length(FConnectionPool)-1 do
   for i:=0 to length(FConnectionPool)-1 do
     begin
     begin
     if assigned(FConnectionPool[i].FPGConn) then
     if assigned(FConnectionPool[i].FPGConn) then

+ 91 - 71
packages/fcl-db/src/sqldb/sqldb.pp

@@ -41,10 +41,12 @@ type
     WhereStopPos : integer;
     WhereStopPos : integer;
   end;
   end;
 
 
+
 type
 type
   TSQLConnection = class;
   TSQLConnection = class;
   TSQLTransaction = class;
   TSQLTransaction = class;
   TCustomSQLQuery = class;
   TCustomSQLQuery = class;
+  TCustomSQLStatement = Class;
   TSQLQuery = class;
   TSQLQuery = class;
   TSQLScript = class;
   TSQLScript = class;
 
 
@@ -106,7 +108,7 @@ type
     FHostName            : string;
     FHostName            : string;
     FCharSet             : string;
     FCharSet             : string;
     FRole                : String;
     FRole                : String;
-
+    FStatements          : TFPList;
     function GetPort: cardinal;
     function GetPort: cardinal;
     function GetStatementInfo(const ASQL: string; Full: Boolean; ASchema : TSchemaType): TSQLStatementInfo;
     function GetStatementInfo(const ASQL: string; Full: Boolean; ASchema : TSchemaType): TSQLStatementInfo;
     procedure SetPort(const AValue: cardinal);
     procedure SetPort(const AValue: cardinal);
@@ -126,6 +128,8 @@ type
     Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
     Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
     Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
     Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
     Function AllocateTransactionHandle : TSQLHandle; virtual; abstract;
     Function AllocateTransactionHandle : TSQLHandle; virtual; abstract;
+    Procedure RegisterStatement(S : TCustomSQLStatement);
+    Procedure UnRegisterStatement(S : TCustomSQLStatement);
 
 
     procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); virtual; abstract;
     procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); virtual; abstract;
     procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); virtual; abstract;
     procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); virtual; abstract;
@@ -145,6 +149,7 @@ type
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; virtual;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; virtual;
+    Property Statements : TFPList Read FStatements;
     property Port: cardinal read GetPort write SetPort;
     property Port: cardinal read GetPort write SetPort;
   public
   public
     property Handle: Pointer read GetHandle;
     property Handle: Pointer read GetHandle;
@@ -224,17 +229,19 @@ type
     FOrigSQL : String;
     FOrigSQL : String;
     FServerSQL : String;
     FServerSQL : String;
     FTransaction: TSQLTransaction;
     FTransaction: TSQLTransaction;
-    FDatasource : TDatasource;
     FParseSQL: Boolean;
     FParseSQL: Boolean;
+    FDataLink : TDataLink;
     procedure SetDatabase(AValue: TSQLConnection);
     procedure SetDatabase(AValue: TSQLConnection);
     procedure SetParams(AValue: TParams);
     procedure SetParams(AValue: TParams);
     procedure SetSQL(AValue: TStrings);
     procedure SetSQL(AValue: TStrings);
     procedure SetTransaction(AValue: TSQLTransaction);
     procedure SetTransaction(AValue: TSQLTransaction);
     Function GetPrepared : Boolean;
     Function GetPrepared : Boolean;
   Protected
   Protected
+    Function CreateDataLink : TDataLink; virtual;
     procedure OnChangeSQL(Sender : TObject); virtual;
     procedure OnChangeSQL(Sender : TObject); virtual;
     function GetDataSource: TDatasource; Virtual;
     function GetDataSource: TDatasource; Virtual;
     procedure SetDataSource(AValue: TDatasource); virtual;
     procedure SetDataSource(AValue: TDatasource); virtual;
+    Procedure CopyParamsFromMaster(CopyBound : Boolean); virtual;
     procedure AllocateCursor;
     procedure AllocateCursor;
     procedure DeAllocateCursor;
     procedure DeAllocateCursor;
     Function GetSchemaType : TSchemaType; virtual;
     Function GetSchemaType : TSchemaType; virtual;
@@ -285,7 +292,6 @@ type
   private
   private
     // FCheckParams: Boolean;
     // FCheckParams: Boolean;
     // FCursor              : TSQLCursor;
     // FCursor              : TSQLCursor;
-    FParams: TParams;
     FSchemaType: TSchemaType;
     FSchemaType: TSchemaType;
 //    FSQL: TStringlist;
 //    FSQL: TStringlist;
     FUpdateable          : boolean;
     FUpdateable          : boolean;
@@ -673,13 +679,18 @@ end;
 
 
 procedure TCustomSQLStatement.SetDataSource(AValue: TDatasource);
 procedure TCustomSQLStatement.SetDataSource(AValue: TDatasource);
 
 
+
+begin
+  if GetDatasource=AValue then Exit;
+  if (FDataLink=Nil) then
+    FDataLink:=CreateDataLink;
+  FDataLink.DataSource:=AValue;
+end;
+
+procedure TCustomSQLStatement.CopyParamsFromMaster(CopyBound : Boolean);
 begin
 begin
-  if FDatasource=AValue then Exit;
-  If Assigned(FDatasource) then
-    FDatasource.RemoveFreeNotification(Self);
-  FDatasource:=AValue;
-  If Assigned(FDatasource) then
-    FDatasource.FreeNotification(Self);
+  if Assigned(DataSource) and Assigned(DataSource.Dataset) then
+    FParams.CopyParamValuesFromDataset(DataSource.Dataset,CopyBound);
 end;
 end;
 
 
 procedure TCustomSQLStatement.SetParams(AValue: TParams);
 procedure TCustomSQLStatement.SetParams(AValue: TParams);
@@ -711,8 +722,8 @@ end;
 
 
 procedure TCustomSQLStatement.DoExecute;
 procedure TCustomSQLStatement.DoExecute;
 begin
 begin
-  If (FParams.Count>0) and Assigned(FDatasource) then
-    ; // FMasterLink.CopyParamsFromMaster(False);
+  If (FParams.Count>0) and Assigned(Datasource) then
+    CopyParamsFromMaster(False);
   If LogEvent(detExecute) then
   If LogEvent(detExecute) then
     Log(detExecute,FServerSQL);
     Log(detExecute,FServerSQL);
   Database.Execute(FCursor,Transaction, FParams);
   Database.Execute(FCursor,Transaction, FParams);
@@ -723,6 +734,11 @@ begin
   Result := Assigned(FCursor) and FCursor.FPrepared;
   Result := Assigned(FCursor) and FCursor.FPrepared;
 end;
 end;
 
 
+function TCustomSQLStatement.CreateDataLink: TDataLink;
+begin
+  Result:=TDataLink.Create;
+end;
+
 function TCustomSQLStatement.CreateParams: TParams;
 function TCustomSQLStatement.CreateParams: TParams;
 begin
 begin
   Result:=TParams.Create(Nil);
   Result:=TParams.Create(Nil);
@@ -756,7 +772,10 @@ begin
     If (AComponent=FTransaction) then
     If (AComponent=FTransaction) then
       FTransaction:=Nil
       FTransaction:=Nil
     else if (AComponent=FDatabase) then
     else if (AComponent=FDatabase) then
+      begin
+      UnPrepare;
       FDatabase:=Nil;
       FDatabase:=Nil;
+      end;
 end;
 end;
 
 
 constructor TCustomSQLStatement.Create(AOwner: TComponent);
 constructor TCustomSQLStatement.Create(AOwner: TComponent);
@@ -774,6 +793,8 @@ begin
   UnPrepare;
   UnPrepare;
   Transaction:=Nil;
   Transaction:=Nil;
   Database:=Nil;
   Database:=Nil;
+  DataSource:=Nil;
+  FreeAndNil(FDataLink);
   FreeAndNil(Fparams);
   FreeAndNil(Fparams);
   FreeAndNil(FSQL);
   FreeAndNil(FSQL);
   inherited Destroy;
   inherited Destroy;
@@ -812,13 +833,20 @@ procedure TCustomSQLStatement.AllocateCursor;
 
 
 begin
 begin
   if not assigned(FCursor) then
   if not assigned(FCursor) then
+    begin
+    // Do this as late as possible.
     FCursor:=Database.AllocateCursorHandle;
     FCursor:=Database.AllocateCursorHandle;
+    FDatabase.RegisterStatement(Self);
+    end;
 end;
 end;
 
 
 procedure TCustomSQLStatement.DeAllocateCursor;
 procedure TCustomSQLStatement.DeAllocateCursor;
 begin
 begin
   if Assigned(FCursor) and Assigned(Database) then
   if Assigned(FCursor) and Assigned(Database) then
+    begin
     DataBase.DeAllocateCursorHandle(FCursor);
     DataBase.DeAllocateCursorHandle(FCursor);
+    Database.UnRegisterStatement(Self);
+    end;
 end;
 end;
 
 
 procedure TCustomSQLStatement.DoPrepare;
 procedure TCustomSQLStatement.DoPrepare;
@@ -860,8 +888,7 @@ begin
   try
   try
     DoPrepare;
     DoPrepare;
   except
   except
-    if assigned(FCursor) then
-      DataBase.DeAllocateCursorHandle(FCursor);
+    DeAllocateCursor;
     Raise;
     Raise;
   end;
   end;
 end;
 end;
@@ -887,12 +914,18 @@ end;
 
 
 function TCustomSQLStatement.GetDataSource: TDatasource;
 function TCustomSQLStatement.GetDataSource: TDatasource;
 begin
 begin
-  Result:=FDatasource;
+  if Assigned(FDataLink) then
+    Result:=FDataLink.Datasource
+  else
+    Result:=Nil;
 end;
 end;
 
 
 procedure TCustomSQLStatement.Unprepare;
 procedure TCustomSQLStatement.Unprepare;
 begin
 begin
-  if Prepared then
+  // Some SQLConnections does not support statement [un]preparation, but they have allocated local cursor(s)
+  //  so let them do cleanup f.e. cancel pending queries and/or free resultset
+  //  and also do UnRegisterStatement!
+  if assigned(FCursor) then
     DoUnprepare;
     DoUnprepare;
 end;
 end;
 
 
@@ -950,11 +983,20 @@ begin
 end;
 end;
 
 
 procedure TSQLConnection.DoInternalDisconnect;
 procedure TSQLConnection.DoInternalDisconnect;
+
+Var
+  I : integer;
+
 begin
 begin
+  For I:=0 to FStatements.Count-1 do
+    TCustomSQLStatement(FStatements[i]).Unprepare;
+  FStatements.Clear;
 end;
 end;
 
 
 destructor TSQLConnection.Destroy;
 destructor TSQLConnection.Destroy;
 begin
 begin
+  Connected:=False; // needed because we want to de-allocate statements
+  FreeAndNil(FStatements);
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
@@ -974,13 +1016,14 @@ begin
     Transaction.EndTransaction;
     Transaction.EndTransaction;
 end;
 end;
 
 
-Procedure TSQLConnection.ExecuteDirect(SQL: String);
+procedure TSQLConnection.ExecuteDirect(SQL: String);
 
 
 begin
 begin
   ExecuteDirect(SQL,FTransaction);
   ExecuteDirect(SQL,FTransaction);
 end;
 end;
 
 
-Procedure TSQLConnection.ExecuteDirect(SQL: String; ATransaction : TSQLTransaction);
+procedure TSQLConnection.ExecuteDirect(SQL: String;
+  ATransaction: TSQLTransaction);
 
 
 var Cursor : TSQLCursor;
 var Cursor : TSQLCursor;
 
 
@@ -1059,6 +1102,7 @@ begin
   inherited Create(AOwner);
   inherited Create(AOwner);
   FSQLFormatSettings:=DefaultSQLFormatSettings;
   FSQLFormatSettings:=DefaultSQLFormatSettings;
   FFieldNameQuoteChars:=DoubleQuotes;
   FFieldNameQuoteChars:=DoubleQuotes;
+  FStatements:=TFPList.Create;
 end;
 end;
 
 
 procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);
 procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);
@@ -1162,6 +1206,17 @@ begin
     end;
     end;
 end;
 end;
 
 
+procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
+begin
+  if FStatements.IndexOf(S)=-1 then
+    FStatements.Add(S);
+end;
+
+procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);
+begin
+  FStatements.Remove(S);
+end;
+
 procedure TSQLConnection.FreeFldBuffers(cursor: TSQLCursor);
 procedure TSQLConnection.FreeFldBuffers(cursor: TSQLCursor);
 begin
 begin
   // empty
   // empty
@@ -1573,18 +1628,13 @@ end;
 
 
 procedure TCustomSQLQuery.InternalClose;
 procedure TCustomSQLQuery.InternalClose;
 begin
 begin
-  if not IsReadFromPacket then
+  if assigned(Cursor) then
     begin
     begin
-    if assigned(Cursor) and Cursor.FSelectable then
+    if Cursor.FSelectable then
       FreeFldBuffers;
       FreeFldBuffers;
     // Some SQLConnections does not support statement [un]preparation,
     // Some SQLConnections does not support statement [un]preparation,
     //  so let them do cleanup f.e. cancel pending queries and/or free resultset
     //  so let them do cleanup f.e. cancel pending queries and/or free resultset
     if not Prepared then FStatement.DoUnprepare;
     if not Prepared then FStatement.DoUnprepare;
-    end
-  else
-    begin
-    if assigned(Cursor) then
-      FStatement.DeAllocateCursor;
     end;
     end;
   if DefaultFields then
   if DefaultFields then
     DestroyFields;
     DestroyFields;
@@ -1631,7 +1681,8 @@ begin
 end;
 end;
 *)
 *)
 
 
-Function TSQLConnection.GetStatementInfo(const ASQL : string; Full : Boolean; ASchema : TSchemaType) : TSQLStatementInfo;
+function TSQLConnection.GetStatementInfo(const ASQL: string; Full: Boolean;
+  ASchema: TSchemaType): TSQLStatementInfo;
 
 
 
 
 type TParsePart = (ppStart,ppWith,ppSelect,ppTableName,ppFrom,ppWhere,ppGroup,ppOrder,ppBogus);
 type TParsePart = (ppStart,ppWith,ppSelect,ppTableName,ppFrom,ppWhere,ppGroup,ppOrder,ppBogus);
@@ -1810,24 +1861,22 @@ procedure TCustomSQLQuery.InternalOpen;
 var tel, fieldc : integer;
 var tel, fieldc : integer;
     f           : TField;
     f           : TField;
     IndexFields : TStrings;
     IndexFields : TStrings;
-    ReadFromFile: Boolean;
 begin
 begin
-  ReadFromFile:=IsReadFromPacket;
-  if ReadFromFile then
+  if IsReadFromPacket then
     begin
     begin
-    FStatement.AllocateCursor;
-    Cursor.FSelectable:=True;
-    Cursor.FStatementType:=stSelect;
+    // When we read from file there is no need for Cursor, also note that Database may not be assigned
+    //FStatement.AllocateCursor;
+    //Cursor.FSelectable:=True;
+    //Cursor.FStatementType:=stSelect;
     FUpdateable:=True;
     FUpdateable:=True;
+    BindFields(True);
     end
     end
   else
   else
+    begin
     Prepare;
     Prepare;
+    if not Cursor.FSelectable then
+      DatabaseError(SErrNoSelectStatement,Self);
 
 
-  if not Cursor.FSelectable then
-    DatabaseError(SErrNoSelectStatement,Self);
-
-  if not ReadFromFile then
-    begin
     // Call UpdateServerIndexDefs before Execute, to avoid problems with connections
     // Call UpdateServerIndexDefs before Execute, to avoid problems with connections
     // which do not allow processing multiple recordsets at a time. (Microsoft
     // which do not allow processing multiple recordsets at a time. (Microsoft
     // calls this MARS, see bug 13241)
     // calls this MARS, see bug 13241)
@@ -1869,9 +1918,7 @@ begin
       end
       end
     else
     else
       BindFields(True);
       BindFields(True);
-    end
-  else
-    BindFields(True);
+    end;
 
 
   if not ReadOnly and not FUpdateable and (FSchemaType=stNoSchema) then
   if not ReadOnly and not FUpdateable and (FSchemaType=stNoSchema) then
     begin
     begin
@@ -1903,39 +1950,20 @@ Type
 
 
   TQuerySQLStatement = Class(TCustomSQLStatement)
   TQuerySQLStatement = Class(TCustomSQLStatement)
   protected
   protected
-    FMasterLink: TMasterParamsDataLink;
     FQuery : TCustomSQLQuery;
     FQuery : TCustomSQLQuery;
-    function GetDataSource: TDatasource; override;
-    procedure SetDataSource(AValue: TDatasource); override;
+    Function CreateDataLink : TDataLink; override;
     Function GetSchemaType : TSchemaType; override;
     Function GetSchemaType : TSchemaType; override;
     Function GetSchemaObjectName : String; override;
     Function GetSchemaObjectName : String; override;
     Function GetSchemaPattern: String; override;
     Function GetSchemaPattern: String; override;
     procedure GetStatementInfo(Var ASQL: String; Full: Boolean; ASchema: TSchemaType; out Info: TSQLStatementInfo); override;
     procedure GetStatementInfo(Var ASQL: String; Full: Boolean; ASchema: TSchemaType; out Info: TSQLStatementInfo); override;
     procedure OnChangeSQL(Sender : TObject); override;
     procedure OnChangeSQL(Sender : TObject); override;
-  Public
-    destructor Destroy; override;
   end;
   end;
 
 
 { TQuerySQLStatement }
 { TQuerySQLStatement }
 
 
-function TQuerySQLStatement.GetDataSource: TDatasource;
+function TQuerySQLStatement.CreateDataLink: TDataLink;
 begin
 begin
-  Result:=inherited GetDataSource;
-
-end;
-
-procedure TQuerySQLStatement.SetDataSource(AValue: TDatasource);
-begin
-  inherited SetDataSource(AValue);
-  If Assigned(AValue) then
-    begin
-    AValue.FreeNotification(Self);
-    If (FMasterLink=Nil) then
-      FMasterLink:=TMasterParamsDataLink.Create(FQuery);
-    FMasterLink.Datasource:=AValue;
-    end
-  else
-    FreeAndNil(FMasterLink);
+  Result:=TMasterParamsDataLink.Create(FQuery);
 end;
 end;
 
 
 function TQuerySQLStatement.GetSchemaType: TSchemaType;
 function TQuerySQLStatement.GetSchemaType: TSchemaType;
@@ -1981,17 +2009,11 @@ procedure TQuerySQLStatement.OnChangeSQL(Sender: TObject);
 begin
 begin
   UnPrepare;
   UnPrepare;
   inherited OnChangeSQL(Sender);
   inherited OnChangeSQL(Sender);
-  If CheckParams and Assigned(FMasterLink) then
-    FMasterLink.RefreshParamNames;
+  If CheckParams and Assigned(FDataLink) then
+    (FDataLink as TMasterParamsDataLink).RefreshParamNames;
   FQuery.ServerIndexDefs.Updated:=false;
   FQuery.ServerIndexDefs.Updated:=false;
 end;
 end;
 
 
-destructor TQuerySQLStatement.Destroy;
-begin
-  FreeAndNil(FMasterLink);
-  inherited Destroy;
-end;
-
 constructor TCustomSQLQuery.Create(AOwner : TComponent);
 constructor TCustomSQLQuery.Create(AOwner : TComponent);
 
 
 Var
 Var
@@ -1999,7 +2021,6 @@ Var
 
 
 begin
 begin
   inherited Create(AOwner);
   inherited Create(AOwner);
-  FParams := TParams.create(self);
   F:=TQuerySQLStatement.Create(Self);
   F:=TQuerySQLStatement.Create(Self);
   F.FQuery:=Self;
   F.FQuery:=Self;
   FStatement:=F;
   FStatement:=F;
@@ -2034,7 +2055,6 @@ begin
   if Active then Close;
   if Active then Close;
   UnPrepare;
   UnPrepare;
   FreeAndNil(Fstatement);
   FreeAndNil(Fstatement);
-  FreeAndNil(FParams);
 //  FreeAndNil(FSQL);
 //  FreeAndNil(FSQL);
   FreeAndNil(FInsertSQL);
   FreeAndNil(FInsertSQL);
   FreeAndNil(FDeleteSQL);
   FreeAndNil(FDeleteSQL);

+ 9 - 6
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -374,13 +374,14 @@ Type
   end;
   end;
   
   
 Const
 Const
-  FieldMapCount = 27;
+  FieldMapCount = 28;
   FieldMap : Array [1..FieldMapCount] of TFieldMap = (
   FieldMap : Array [1..FieldMapCount] of TFieldMap = (
    (n:'INT'; t: ftInteger),
    (n:'INT'; t: ftInteger),
-   (n:'LARGEINT'; t:ftlargeInt),
-   (n:'BIGINT'; t:ftlargeInt),
-   (n:'WORD'; t: ftWord),
+   (n:'LARGEINT'; t:ftLargeInt),
+   (n:'BIGINT'; t:ftLargeInt),
    (n:'SMALLINT'; t: ftSmallint),
    (n:'SMALLINT'; t: ftSmallint),
+   (n:'TINYINT'; t: ftSmallint),
+   (n:'WORD'; t: ftWord),
    (n:'BOOLEAN'; t: ftBoolean),
    (n:'BOOLEAN'; t: ftBoolean),
    (n:'REAL'; t: ftFloat),
    (n:'REAL'; t: ftFloat),
    (n:'FLOAT'; t: ftFloat),
    (n:'FLOAT'; t: ftFloat),
@@ -395,8 +396,8 @@ Const
    (n:'CHAR'; t: ftFixedChar),
    (n:'CHAR'; t: ftFixedChar),
    (n:'NUMERIC'; t: ftBCD),
    (n:'NUMERIC'; t: ftBCD),
    (n:'DECIMAL'; t: ftBCD),
    (n:'DECIMAL'; t: ftBCD),
-   (n:'TEXT'; t: ftmemo),
-   (n:'CLOB'; t: ftmemo),
+   (n:'TEXT'; t: ftMemo),
+   (n:'CLOB'; t: ftMemo),
    (n:'BLOB'; t: ftBlob),
    (n:'BLOB'; t: ftBlob),
    (n:'NCHAR'; t: ftFixedWideChar),
    (n:'NCHAR'; t: ftFixedWideChar),
    (n:'NVARCHAR'; t: ftWideString),
    (n:'NVARCHAR'; t: ftWideString),
@@ -731,6 +732,7 @@ procedure TSQLite3Connection.DoInternalConnect;
 var
 var
   str1: string;
   str1: string;
 begin
 begin
+  Inherited;
   if Length(databasename)=0 then
   if Length(databasename)=0 then
     DatabaseError(SErrNoDatabaseName,self);
     DatabaseError(SErrNoDatabaseName,self);
   InitializeSqlite(SQLiteDefaultLibrary);
   InitializeSqlite(SQLiteDefaultLibrary);
@@ -745,6 +747,7 @@ end;
 procedure TSQLite3Connection.DoInternalDisconnect;
 procedure TSQLite3Connection.DoInternalDisconnect;
 
 
 begin
 begin
+  Inherited;
   if fhandle <> nil then 
   if fhandle <> nil then 
     begin
     begin
     checkerror(sqlite3_close(fhandle));
     checkerror(sqlite3_close(fhandle));

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

@@ -230,6 +230,7 @@ begin
       end;
       end;
     ssMySQL:
     ssMySQL:
       begin
       begin
+      FieldtypeDefinitions[ftWord] := 'SMALLINT UNSIGNED';
       //MySQL recognizes BOOLEAN, but as synonym for TINYINT, not true sql boolean datatype
       //MySQL recognizes BOOLEAN, but as synonym for TINYINT, not true sql boolean datatype
       FieldtypeDefinitions[ftBoolean]  := '';
       FieldtypeDefinitions[ftBoolean]  := '';
       // Use 'DATETIME' for datetime-fields instead of timestamp, because
       // Use 'DATETIME' for datetime-fields instead of timestamp, because

+ 59 - 30
packages/fcl-db/tests/testfieldtypes.pas

@@ -6,7 +6,7 @@ unit TestFieldTypes;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry,
+  Classes, SysUtils, fpcunit, testregistry,
   db;
   db;
 
 
 type
 type
@@ -24,7 +24,7 @@ type
     procedure TestSQLFieldType(ADatatype: TFieldType; ASQLTypeDecl: string;
     procedure TestSQLFieldType(ADatatype: TFieldType; ASQLTypeDecl: string;
       ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc;
       ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc;
       ACheckFieldValueProc: TCheckFieldValueProc);
       ACheckFieldValueProc: TCheckFieldValueProc);
-    procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
+    procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuesCount : integer; Cross : boolean = false);
     procedure TestSetBlobAsParam(asWhat : integer);
     procedure TestSetBlobAsParam(asWhat : integer);
   protected
   protected
     procedure SetUp; override;
     procedure SetUp; override;
@@ -57,7 +57,6 @@ type
     procedure TestNonNullableParams;
     procedure TestNonNullableParams;
     procedure TestDblQuoteEscComments;
     procedure TestDblQuoteEscComments;
     procedure TestpfInUpdateFlag; // bug 7565
     procedure TestpfInUpdateFlag; // bug 7565
-    procedure TestScript;
     procedure TestInsertReturningQuery;
     procedure TestInsertReturningQuery;
     procedure TestOpenStoredProc;
     procedure TestOpenStoredProc;
     procedure TestOpenSpecialStatements;
     procedure TestOpenSpecialStatements;
@@ -76,6 +75,7 @@ type
 
 
     procedure TestLargeRecordSize;
     procedure TestLargeRecordSize;
     procedure TestInt;
     procedure TestInt;
+    procedure TestTinyint;
     procedure TestNumeric;
     procedure TestNumeric;
     procedure TestFloat;
     procedure TestFloat;
     procedure TestDate;
     procedure TestDate;
@@ -203,33 +203,6 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TTestFieldTypes.TestScript;
-
-var Ascript : TSQLScript;
-
-begin
-  Ascript := tsqlscript.create(nil);
-  try
-    with Ascript do
-      begin
-      DataBase := TSQLDBConnector(DBConnector).Connection;
-      transaction := TSQLDBConnector(DBConnector).Transaction;
-      script.clear;
-      script.append('create table a (id int);');
-      script.append('create table b (id int);');
-      ExecuteScript;
-      // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
-      TSQLDBConnector(DBConnector).CommitDDL;
-      end;
-  finally
-    AScript.Free;
-    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
-    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
-    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
-    TSQLDBConnector(DBConnector).CommitDDL;
-  end;
-end;
-
 procedure TTestFieldTypes.TestLargeRecordSize;
 procedure TTestFieldTypes.TestLargeRecordSize;
 
 
 begin
 begin
@@ -304,6 +277,62 @@ begin
     end;
     end;
 end;
 end;
 
 
+procedure TTestFieldTypes.TestTinyint;
+const
+  testValuesCount = 5;
+  testValues : Array[0..testValuesCount-1] of byte = (0,1,127,128,255);
+var
+  datatype: string;
+  fieldtype: TFieldType;
+  i: integer;
+begin
+  case SQLServerType of
+    ssMSSQL:
+      begin
+      datatype  := 'TINYINT';
+      fieldtype := ftWord;
+      end;
+    ssMySQL:
+      begin
+      datatype  := 'TINYINT UNSIGNED';
+      fieldtype := ftWord;
+      end;
+    ssSQLite:
+      begin
+      datatype  := 'TINYINT';
+      fieldtype := ftSmallint;
+      end;
+    else
+      begin
+      fieldtype := ftSmallint;
+      datatype  := FieldtypeDefinitions[fieldtype];
+      end;
+  end;
+
+  CreateTableWithFieldType(fieldtype, datatype);
+  TestFieldDeclaration(fieldtype, sizeof(Smallint));
+
+  with TSQLDBConnector(DBConnector) do
+  begin
+    Query.Open;
+    for i := 0 to testValuesCount-1 do
+      Query.AppendRecord([testValues[i]]);
+    Query.ApplyUpdates;
+    Query.Close;
+
+    for i := 0 to testValuesCount-1 do
+      ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testValues[i]) + ')');
+
+    Query.Open;
+    for i := 0 to testValuesCount*2-1 do
+    begin
+      AssertEquals(testValues[i mod testValuesCount], Query.Fields[0].AsInteger);
+      Query.Next;
+    end;
+    Query.Close;
+  end;
+end;
+
 procedure TTestFieldTypes.TestNumeric;
 procedure TTestFieldTypes.TestNumeric;
 
 
 const
 const

+ 3 - 0
packages/fcl-db/tests/testleaks.sh

@@ -5,6 +5,9 @@ if [ $? != 0 ]; then
   echo "Compilation failed";
   echo "Compilation failed";
   exit
   exit
 fi
 fi
+echo "Generating test list"
+./dbtestframework --list 2>/dev/null | sed /TestSuites/d | tr -d '[:blank:]' > test-list.txt 
+exit
 for f in `cat test-list.txt`
 for f in `cat test-list.txt`
 do
 do
   echo -n "Doing test $f"
   echo -n "Doing test $f"

+ 58 - 0
packages/fcl-db/tests/testsqldb.pas

@@ -27,6 +27,7 @@ type
   TTestTSQLQuery = class(TSQLDBTestCase)
   TTestTSQLQuery = class(TSQLDBTestCase)
   private
   private
   published
   published
+    procedure TestMasterDetail;
     procedure TestUpdateServerIndexDefs;
     procedure TestUpdateServerIndexDefs;
   end;
   end;
 
 
@@ -38,13 +39,43 @@ type
     procedure ReplaceMe;
     procedure ReplaceMe;
   end;
   end;
 
 
+  { TTestTSQLScript }
+
+  TTestTSQLScript = class(TSQLDBTestCase)
+  published
+    procedure TestExecuteScript;
+  end;
 
 
 implementation
 implementation
 
 
 uses sqldbtoolsunit, toolsunit, sqldb;
 uses sqldbtoolsunit, toolsunit, sqldb;
 
 
+
 { TTestTSQLQuery }
 { TTestTSQLQuery }
 
 
+procedure TTestTSQLQuery.TestMasterDetail;
+var MasterQuery, DetailQuery: TSQLQuery;
+    MasterSource: TDataSource;
+begin
+  with TSQLDBConnector(DBConnector) do
+  try
+    MasterQuery := GetNDataset(10) as TSQLQuery;
+    MasterSource := TDatasource.Create(nil);
+    MasterSource.DataSet := MasterQuery;
+    DetailQuery := Query;
+    DetailQuery.SQL.Text := 'select NAME from FPDEV where ID=:ID';
+    DetailQuery.DataSource := MasterSource;
+
+    MasterQuery.Open;
+    DetailQuery.Open;
+    CheckEquals('TestName1', DetailQuery.Fields[0].AsString);
+    MasterQuery.MoveBy(3);
+    CheckEquals('TestName4', DetailQuery.Fields[0].AsString);
+  finally
+    MasterSource.Free;
+  end;
+end;
+
 procedure TTestTSQLQuery.TestUpdateServerIndexDefs;
 procedure TTestTSQLQuery.TestUpdateServerIndexDefs;
 var Q: TSQLQuery;
 var Q: TSQLQuery;
     name1, name2, name3: string;
     name1, name2, name3: string;
@@ -115,6 +146,32 @@ begin
   // replace this procedure with any test for TSQLConnection
   // replace this procedure with any test for TSQLConnection
 end;
 end;
 
 
+{ TTestTSQLScript }
+
+procedure TTestTSQLScript.TestExecuteScript;
+var Ascript : TSQLScript;
+begin
+  Ascript := TSQLScript.Create(nil);
+  try
+    with Ascript do
+      begin
+      DataBase := TSQLDBConnector(DBConnector).Connection;
+      Transaction := TSQLDBConnector(DBConnector).Transaction;
+      Script.Clear;
+      Script.Append('create table a (id int);');
+      Script.Append('create table b (id int);');
+      ExecuteScript;
+      // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+      TSQLDBConnector(DBConnector).CommitDDL;
+      end;
+  finally
+    AScript.Free;
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
+    // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
+    TSQLDBConnector(DBConnector).CommitDDL;
+  end;
+end;
 
 
 { TSQLDBTestCase }
 { TSQLDBTestCase }
 
 
@@ -141,5 +198,6 @@ initialization
   begin
   begin
     RegisterTest(TTestTSQLQuery);
     RegisterTest(TTestTSQLQuery);
     RegisterTest(TTestTSQLConnection);
     RegisterTest(TTestTSQLConnection);
+    RegisterTest(TTestTSQLScript);
   end;
   end;
 end.
 end.