fcl-db: sqldb: implemented TSQLConnection.GetSchemaNames

Added stSchemata to TSchemaType (Delphi has strange stUserNames instead)
At TSQLConnection level stSchemata defaults to 'select *  from INFORMATION_SCHEMA.SCHEMATA', which can be overriden in descendants.

git-svn-id: trunk@23921 -

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

@@ -945,8 +945,7 @@ begin
                              'from syscolumns c join sysobjects o on c.id=o.id '+
                              'where c.id=object_id(''' + SchemaObjectName + ''') '+
                              'order by colid';
-  else
+    else           Result := inherited;
-    DatabaseError(SMetadataUnavailable)
   end;
 end;
 

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

@@ -663,14 +663,14 @@ begin
 
   // prepare statement
   ODBCCursor.FQuery:=Buf;
-  if ODBCCursor.FSchemaType=stNoSchema then
+  if not (ODBCCursor.FSchemaType in [stTables, stSysTables, stColumns, stProcedures]) then
     begin
       ODBCCheckResult(
         SQLPrepare(ODBCCursor.FSTMTHandle, PChar(buf), Length(buf)),
         SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not prepare statement.'
       );
-    end
+    end;
-  else
+  if ODBCCursor.FSchemaType <> stNoSchema then
     ODBCCursor.FStatementType:=stSelect;
 end;
 
@@ -757,12 +757,11 @@ begin
     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;
+      else          Res:=SQLExecute(ODBCCursor.FSTMTHandle); //SQL_NO_DATA returns searched update or delete statement that does not affect any rows
     end; {case}
 
     if (Res<>SQL_NO_DATA) then ODBCCheckResult( Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.' );
@@ -1450,12 +1449,15 @@ end;
 
 function TODBCConnection.GetSchemaInfoSQL(SchemaType: TSchemaType; SchemaObjectName, SchemaObjectPattern: string): string;
 begin
-  if SchemaObjectName<>'' then
+  if SchemaType in [stTables, stSysTables, stColumns, stProcedures] then
-    Result := SchemaObjectName
+  begin
+    if SchemaObjectName<>'' then
+      Result := SchemaObjectName
+    else
+      Result := ' ';
+  end
   else
-    Result := ' ';
+    Result := inherited;
-  if not (SchemaType in [stNoSchema, stTables, stSysTables, stColumns, stProcedures]) then
-    DatabaseError(SMetadataUnavailable);
 end;
 
 function TODBCConnection.GetConnectionInfo(InfoType: TConnInfoType): string;

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

@@ -1124,7 +1124,7 @@ begin
                         'where (a.attnum>0) and (not a.attisdropped) and (upper(c.relname)=''' + Uppercase(SchemaObjectName) + ''') '+
                         'order by a.attname';
   else
-    DatabaseError(SMetadataUnavailable)
+    s := inherited;
   end; {case}
   result := s;
 end;

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

@@ -22,7 +22,7 @@ interface
 
 uses SysUtils, Classes, DB, bufdataset, sqlscript;
 
-type TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages);
+type TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata);
      TConnOption = (sqSupportParams,sqEscapeSlash,sqEscapeRepeat);
      TConnOptions= set of TConnOption;
      TConnInfoType=(citAll=-1, citServerType, citServerVersion, citServerVersionString, citClientName, citClientVersion);
@@ -149,6 +149,7 @@ type
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); virtual;
     procedure GetProcedureNames(List : TStrings); virtual;
     procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
+    procedure GetSchemaNames(List: TStrings); virtual;
     function GetConnectionInfo(InfoType:TConnInfoType): string; virtual;
     procedure CreateDB; virtual;
     procedure DropDB; virtual;
@@ -691,8 +692,10 @@ end;
 
 procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);
 begin
-  if not systemtables then GetDBInfo(stTables,'','table_name',List)
+  if not SystemTables then
-    else GetDBInfo(stSysTables,'','table_name',List);
+    GetDBInfo(stTables,'','table_name',List)
+  else
+    GetDBInfo(stSysTables,'','table_name',List);
 end;
 
 procedure TSQLConnection.GetProcedureNames(List: TStrings);
@@ -705,6 +708,11 @@ begin
   GetDBInfo(stColumns,TableName,'column_name',List);
 end;
 
+procedure TSQLConnection.GetSchemaNames(List: TStrings);
+begin
+  GetDBInfo(stSchemata,'','SCHEMA_NAME',List);
+end;
+
 function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
 var i: TConnInfoType;
 begin
@@ -791,7 +799,10 @@ end;
 function TSQLConnection.GetSchemaInfoSQL( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string;
 
 begin
-  DatabaseError(SMetadataUnavailable);
+  case SchemaType of
+    stSchemata: Result := 'SELECT * FROM INFORMATION_SCHEMA.SCHEMATA';
+    else DatabaseError(SMetadataUnavailable);
+  end;
 end;
 
 procedure TSQLConnection.CreateDB;