Merged revisions 9060-9061,9070,9072-9073 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
  r9060 | joost | 2007-11-02 16:27:51 +0100 (Fri, 02 Nov 2007) | 2 lines
  
   * RowsAffected should return -1 when there is nu result
   * Set Size for ftBCD fields
........
  r9061 | joost | 2007-11-02 16:51:37 +0100 (Fri, 02 Nov 2007) | 2 lines
  
   * Disabled TestParametersAndDates-test for Mysql
   * Fixed ftMemo-type parameters
........
  r9070 | joost | 2007-11-02 23:07:27 +0100 (Fri, 02 Nov 2007) | 2 lines
  
   * TestGetTables test added
   * tablename in TestGetFieldNames case sensitive for mysql
........
  r9072 | joost | 2007-11-02 23:08:19 +0100 (Fri, 02 Nov 2007) | 1 line
  
   * Close datasets before removing their transaction
........
  r9073 | joost | 2007-11-02 23:10:28 +0100 (Fri, 02 Nov 2007) | 3 lines
  
   * implemented GetFieldNames
   * implemented GetTableNames
  * added support for smallint fields
........

git-svn-id: branches/fixes_2_2@9260 -

packages/fcl-db/src/database.inc

@@ -367,6 +367,7 @@ Destructor TDBTransaction.Destroy;
 
 begin
   Database:=Nil;
+  CloseDataSets;
   RemoveDatasets;
   FDatasets.Free;
   Inherited;

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -82,6 +82,7 @@ Type
     function GetServerStatus: String;
     procedure ConnectMySQL(var HMySQL : PMySQL;H,U,P : pchar);
     procedure ExecuteDirectMySQL(const query : string);
+    function EscapeString(const Str : string) : string;
   protected
     function StrToStatementType(s : string) : TStatementType; override;
     Procedure ConnectToServer; virtual;
@@ -114,10 +115,13 @@ Type
     function StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
     procedure CommitRetaining(trans : TSQLHandle); override;
     procedure RollBackRetaining(trans : TSQLHandle); override;
+    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
   Public
     constructor Create(AOwner : TComponent); override;
+    procedure GetFieldNames(const TableName : string; List :  TStrings); override;
+    procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); override;
     procedure CreateDB; override;
     procedure DropDB; override;
     Property ServerInfo : String Read FServerInfo;
@@ -226,12 +230,7 @@ var esc_str : pchar;
 begin
   if (not assigned(field)) or field.IsNull then Result := 'Null'
   else if field.DataType = ftString then
-    begin
-    Getmem(esc_str,sizeof(field.asstring)*2+1);
-    mysql_real_escape_string(FMySQL,esc_str,pchar(field.asstring),length(field.asstring));
-    Result := '''' + esc_str + '''';
-    Freemem(esc_str);
-    end
+    Result := '''' + EscapeString(field.AsString) + ''''
   else Result := inherited GetAsSqlText(field);
 end;
 
@@ -241,13 +240,8 @@ var esc_str : pchar;
 
 begin
   if (not assigned(param)) or param.IsNull then Result := 'Null'
-  else if param.DataType in [ftString,ftBlob] then
-    begin
-    Getmem(esc_str,length(param.asstring)*2+1);
-    mysql_real_escape_string(FMySQL,esc_str,pchar(param.asstring),length(param.asstring));
-    Result := '''' + esc_str + '''';
-    Freemem(esc_str);
-    end
+  else if param.DataType in [ftString,ftBlob,ftMemo] then
+    Result := '''' + EscapeString(Param.AsString) + ''''
   else Result := inherited GetAsSqlText(Param);
 end;
 
@@ -309,6 +303,16 @@ begin
   ReleaseMysql;
 end;
 
+function TConnectionName.EscapeString(const Str: string): string;
+
+var Len : integer;
+
+begin
+  SetLength(result,length(str)*2+1);
+  Len := mysql_real_escape_string(FMySQL,pchar(Result),pchar(Str),length(Str));
+  SetLength(result,Len);
+end;
+
 procedure TConnectionName.DoInternalConnect;
 begin
   InitialiseMysql;
@@ -443,8 +447,12 @@ begin
       NewType := ftLargeint;
       NewSize := 0;
       end;
-    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG,
-    FIELD_TYPE_INT24:
+    FIELD_TYPE_TINY, FIELD_TYPE_SHORT:
+      begin
+      NewType := ftSmallint;
+      NewSize := 0;
+      end;
+    FIELD_TYPE_LONG, FIELD_TYPE_INT24:
       begin
       NewType := ftInteger;
       NewSize := 0;
@@ -455,7 +463,7 @@ begin
     FIELD_TYPE_DECIMAL: if ADecimals < 5 then
                           begin
                           NewType := ftBCD;
-                          NewSize := 0;
+                          NewSize := ADecimals;
                           end
                         else
                           begin
@@ -709,6 +717,7 @@ function TConnectionName.MySQLWriteData(AType: enum_field_types;ASize: Integer;
 
 var
   VI: Integer;
+  VS: Smallint;
   VF: Double;
   VC: Currency;
   VD: TDateTime;
@@ -721,8 +730,15 @@ begin
     exit;
   Src:=StrPas(Source);
   case AType of
-    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG,
-    FIELD_TYPE_INT24:
+    FIELD_TYPE_TINY, FIELD_TYPE_SHORT:
+      begin
+      if (Src<>'') then
+        VS := StrToInt(Src)
+      else
+        VS := 0;
+      Move(VS, Dest^, SizeOf(smallint));
+      end;
+    FIELD_TYPE_LONG, FIELD_TYPE_INT24:
       begin
       if (Src<>'') then
         VI := StrToInt(Src)
@@ -847,7 +863,10 @@ end;
 
 function TConnectionName.RowsAffected(cursor: TSQLCursor): TRowsCount;
 begin
-  Result := (cursor as TCursorName).RowsAffected;
+  if assigned(cursor) then
+    Result := (cursor as TCursorName).RowsAffected
+  else
+    Result := -1;
 end;
 
 constructor TConnectionName.Create(AOwner: TComponent);
@@ -857,6 +876,16 @@ begin
   FMySQL := Nil;
 end;
 
+procedure TConnectionName.GetFieldNames(const TableName: string; List: TStrings);
+begin
+  GetDBInfo(stColumns,TableName,'field',List);
+end;
+
+procedure TConnectionName.GetTableNames(List: TStrings; SystemTables: Boolean);
+begin
+  GetDBInfo(stTables,'','tables_in_'+DatabaseName,List)
+end;
+
 function TConnectionName.GetTransactionHandle(trans: TSQLHandle): pointer;
 begin
   Result:=Nil;
@@ -887,6 +916,18 @@ begin
   // Do nothing
 end;
 
+function TConnectionName.GetSchemaInfoSQL(SchemaType: TSchemaType;
+  SchemaObjectName, SchemaPattern: string): string;
+
+begin
+  case SchemaType of
+    stTables     : result := 'show tables';
+    stColumns    : result := 'show columns from ' + EscapeString(SchemaObjectName);
+  else
+    DatabaseError(SMetadataUnavailable)
+  end; {case}
+end;
+
 { TMySQLConnectionDef }
 
 class function TMySQLConnectionDef.TypeName: String;

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

@@ -75,9 +75,9 @@ type
     FCharSet             : string;
     FRole                : String;
 
-    procedure GetDBInfo(const SchemaType : TSchemaType; const SchemaObjectName, ReturnField : string; List: TStrings);
   protected
     FConnOptions         : TConnOptions;
+    procedure GetDBInfo(const SchemaType : TSchemaType; const SchemaObjectName, ReturnField : string; List: TStrings);
     procedure SetTransaction(Value : TSQLTransaction);virtual;
     function StrToStatementType(s : string) : TStatementType; virtual;
     procedure DoInternalConnect; override;

packages/fcl-db/tests/testsqlfieldtypes.pas

@@ -34,6 +34,7 @@ type
     procedure TestBug9744;
     procedure TestCrossStringDateParam;
     procedure TestGetFieldNames;
+    procedure TestGetTables;
     procedure TestUpdateIndexDefs;
     procedure TestSetBlobAsMemoParam;
     procedure TestSetBlobAsStringParam;
@@ -1048,7 +1049,10 @@ begin
     begin
     FieldNames := TStringList.Create;
     try
-      Connection.GetFieldNames('FpDEv',FieldNames);
+      if SQLDbType in MySQLdbTypes then
+        Connection.GetFieldNames('FPDEV',FieldNames)
+      else
+        Connection.GetFieldNames('fpDEv',FieldNames);
       AssertEquals(2,FieldNames.Count);
       AssertEquals('ID',UpperCase(FieldNames[0]));
       AssertEquals('NAME',UpperCase(FieldNames[1]));
@@ -1058,6 +1062,23 @@ begin
     end;
 end;
 
+procedure TTestFieldTypes.TestGetTables;
+var TableNames : TStringList;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+    TableNames := TStringList.Create;
+    try
+      Connection.GetTableNames(TableNames);
+      AssertTrue(TableNames.Count>0);
+      AssertTrue(TableNames.IndexOf('FPDEV')>-1);
+      AssertTrue(TableNames.IndexOf('FPDEV_FIELD')>-1);
+    finally
+      TableNames.Free;
+      end;
+    end;
+end;
+
 procedure TTestFieldTypes.TestUpdateIndexDefs;
 var ds : TSQLQuery;
 begin
@@ -1159,7 +1180,7 @@ procedure TTestFieldTypes.TestParametersAndDates;
 // See bug 7205
 var ADateStr : String;
 begin
-  if SQLDbType=interbase then Ignore('This test does not apply to Interbase/Firebird, since it doesn''t use semicolons for casts');
+  if SQLDbType in [interbase,mysql40,mysql41,mysql50] then Ignore('This test does not apply to this sqldb-connection type, since it doesn''t use semicolons for casts');
 
   with TSQLDBConnector(DBConnector).Query do
     begin