HB_FUNC( FBCREATEDB )
{
   if( hb_pcount() == 6 )
   {
      isc_db_handle newdb = NULL;
      isc_tr_handle trans = NULL;
      ISC_STATUS status[ 20 ];
      char create_db[ MAX_BUFFER ];

      char *         db_name = hb_parcx( 1 );
      char *         user    = hb_parcx( 2 );
      char *         pass    = hb_parcx( 3 );
      int            page    = hb_parni( 4 );
      char *         charset = hb_parcx( 5 );
      unsigned short dialect = ( unsigned short ) hb_parni( 6 );
       
      snprintf( create_db, sizeof( create_db ), 
                "CREATE DATABASE '%s' USER '%s' PASSWORD '%s' PAGE_SIZE = %i DEFAULT CHARACTER SET %s",
                db_name, user, pass, page, charset );
      
      if( isc_dsql_execute_immediate( status, &newdb, &trans, 0, create_db, dialect, NULL ) )
         hb_retnl( isc_sqlcode( status ) );
      else
         hb_retnl( 1 );
   }
   else
      hb_retnl( 0 );
}

HB_FUNC( FBCONNECT )
{
   ISC_STATUS    status[ MAX_FIELDS ];
   isc_db_handle db = NULL;
   char *        db_connect = hb_parcx( 1 );
   char *        user = hb_parcx( 2 );
   char *        passwd = hb_parcx( 3 );
   char          dpb[ 128 ];
   short         i = 0;
   int           len;

   /* TOFIX: Possible buffer overflow. Use snprintf(). */
   dpb[ i++ ] = isc_dpb_version1;
   dpb[ i++ ] = isc_dpb_user_name;
   len = strlen( user );
   if( len > ( int ) ( sizeof( dpb ) - i - 4 ) )
      len = ( int ) ( sizeof( dpb ) - i - 4 );
   dpb[ i++ ] = ( char ) len;
   hb_strncpy( &( dpb[ i ] ), user, len );
   i += ( short ) len;
   dpb[ i++ ] = isc_dpb_password;
   len = strlen( passwd );
   if( len > ( int ) ( sizeof( dpb ) - i - 2 ) )
      len = ( int ) ( sizeof( dpb ) - i - 2 );
   dpb[ i++ ] = ( char ) len;
   hb_strncpy( &( dpb[ i ] ), passwd, len );
   i += ( short ) len;

   if( isc_attach_database( status, 0, db_connect, &db, i, dpb ) )
      hb_retnl( isc_sqlcode( status ) );
   else
      hb_retptr( ( void * ) db );
}

HB_FUNC( FBCLOSE )
{
   isc_db_handle db = ( isc_db_handle ) hb_parptr( 1 );
   ISC_STATUS status[ 20 ];

   if( isc_detach_database( status, &db ) )
      hb_retnl( isc_sqlcode( status ) );
   else
      hb_retnl( 1 );
}

HB_FUNC( FBERROR )
{
   char msg[ MAX_BUFFER ];

   isc_sql_interprete( ( short ) hb_parni( 1 ) /* sqlcode */, 
                       msg,
                       sizeof( msg ) );

   hb_retc( msg );
}

HB_FUNC( FBSTARTTRANSACTION )
{
   isc_db_handle db = ( isc_db_handle ) hb_parptr( 1 );
   isc_tr_handle trans = NULL;
   ISC_STATUS status[ MAX_FIELDS ];

   if( isc_start_transaction( status, &trans, 1, &db, 0, NULL ) )
      hb_retnl( isc_sqlcode( status ) );
   else
      hb_retptr( ( void * ) trans );
}

HB_FUNC( FBCOMMIT )
{
   isc_tr_handle trans = ( isc_db_handle ) hb_parptr( 1 );
   ISC_STATUS status[ MAX_FIELDS ];

   if( isc_commit_transaction( status, &trans ) )
      hb_retnl( isc_sqlcode( status ) );
   else
      hb_retnl( 1 );
}

HB_FUNC( FBROLLBACK )
{
   isc_tr_handle trans = ( isc_db_handle ) hb_parptr( 1 );
   ISC_STATUS status[ MAX_FIELDS ];

   if( isc_rollback_transaction( status, &trans ) )
      hb_retnl( isc_sqlcode( status ) );
   else
      hb_retnl( 1 );
}

HB_FUNC( FBEXECUTE )
{
   isc_db_handle   db = ( isc_db_handle ) hb_parptr( 1 );
   isc_tr_handle   trans = NULL;
   char          * exec_str = hb_parcx( 2 );
   ISC_STATUS      status[ 20 ];
   ISC_STATUS      status_rollback[ 20 ];
   unsigned short  dialect = ( unsigned short ) hb_parni( 3 );

   if( ISPOINTER( 4 ) )
   {
      trans = ( isc_tr_handle ) hb_parptr( 4 );
   }
   else
   {
      if( isc_start_transaction( status, &trans, 1, &db, 0, NULL ) )
      {
         hb_retnl( isc_sqlcode( status ) );
         return;
      }
   }

   if( isc_dsql_execute_immediate( status, &db, &trans, 0, exec_str, dialect, NULL ) )
   {
      if( ! ISPOINTER( 4 ) )
         isc_rollback_transaction( status_rollback, &trans );

      hb_retnl( isc_sqlcode( status ) );
      return;
   }

   if( ! ISPOINTER( 4 ) )
   {
      if( isc_commit_transaction( status, &trans ) )
      {
         hb_retnl( isc_sqlcode( status ) );
         return;
      }
   }

   hb_retnl( 1 );
}

HB_FUNC( FBQUERY )
{
   isc_db_handle       db = ( isc_db_handle ) hb_parptr( 1 );
   isc_tr_handle       trans = NULL;
   ISC_STATUS          status[ MAX_FIELDS ];
   XSQLDA *            sqlda;
   isc_stmt_handle     stmt = NULL;
   XSQLVAR           * var;

   char                sel_str[ MAX_LEN ];
   unsigned short      dialect = ISNUM( 3 ) ? ( unsigned short ) hb_parni( 3 ) : DIALECT;
   int                 i;
   int                 dtype;
   int                 num_cols;

   PHB_ITEM qry_handle;
   PHB_ITEM aTemp;
   PHB_ITEM aNew;

   hb_strncpy( sel_str, hb_parcx( 2 ), sizeof( sel_str ) - 1 );

   if( ISPOINTER( 4 ) )
   {
      trans = ( isc_tr_handle ) hb_parptr( 4 );
   }
   else if( isc_start_transaction( status, &trans, 1, &db, 0, NULL ) )
   {
      ERREXIT( status );
   }

   /* Allocate an output SQLDA. Just to check number of columns */
   sqlda = ( XSQLDA * ) hb_xgrab( XSQLDA_LENGTH ( 1 ) );
   sqlda->sqln = 1;
   sqlda->version = 1;

   /* Allocate a statement */
   if( isc_dsql_allocate_statement( status, &db, &stmt ) )
   {
      ERREXIT( status );
   }

   /* Prepare the statement. */
   if( isc_dsql_prepare( status, &trans, &stmt, 0, sel_str, dialect, sqlda ) )
   {
      ERREXIT( status );
   }

   /* Describe sql contents */
   if( isc_dsql_describe( status, &stmt, dialect, sqlda ) )
   {
      ERREXIT( status );
   }

   num_cols = sqlda->sqld;
   aNew = hb_itemArrayNew( num_cols );

   /* Relocate necessary number of columns */
   if( sqlda->sqld > sqlda->sqln )
   {
      ISC_SHORT n;

      n = sqlda->sqld;
      hb_xfree( sqlda );
      sqlda = ( XSQLDA * ) hb_xgrab( XSQLDA_LENGTH( n ) );
      sqlda->sqln = n;
      sqlda->version = 1;

      if( isc_dsql_describe( status, &stmt, dialect, sqlda ) )
      {
         ERREXIT( status );
      }
   }

   for( i = 0, var = sqlda->sqlvar; i < sqlda->sqld; i++, var++ )
   {
      dtype = ( var->sqltype & ~1 );
      switch( dtype )
      {
      case SQL_VARYING:
         var->sqltype = SQL_TEXT;
         var->sqldata = ( char * ) hb_xgrab( sizeof ( char ) * var->sqllen + 2 );
         break;
      case SQL_TEXT:
         var->sqldata = ( char * ) hb_xgrab( sizeof ( char ) * var->sqllen + 2 );
         break;
      case SQL_LONG:
         var->sqltype = SQL_LONG;
         var->sqldata = ( char * ) hb_xgrab( sizeof ( long ) );
         break;
      default:
         var->sqldata = ( char * ) hb_xgrab( sizeof ( char ) * var->sqllen );
         break;
      }

      if( var->sqltype & 1 )
         var->sqlind = ( short * ) hb_xgrab( sizeof ( short ) );

      aTemp = hb_itemArrayNew( 5 );

      hb_arraySetC(  aTemp, 1, sqlda->sqlvar[ i ].sqlname );
      hb_arraySetNL( aTemp, 2, ( long ) dtype );
      hb_arraySetNL( aTemp, 3, sqlda->sqlvar[ i ].sqllen );
      hb_arraySetNL( aTemp, 4, sqlda->sqlvar[ i ].sqlscale );
      hb_arraySetC(  aTemp, 5, sqlda->sqlvar[ i ].relname );

      hb_itemArrayPut( aNew, i+1, aTemp );

      hb_itemRelease( aTemp );
   }

   if( ! sqlda->sqld )
   {
      /* Execute and commit non-select querys */
      if( isc_dsql_execute( status, &trans, &stmt, dialect, NULL ) )
      {
         ERREXIT( status );
      }
   }
   else
   {
      if( isc_dsql_execute( status, &trans, &stmt, dialect, sqlda ) )
      {
         ERREXIT( status );
      }
   }

   qry_handle = hb_itemArrayNew( 6 );

   hb_arraySetPtr( qry_handle, 1, ( void * ) stmt );
   hb_arraySetPtr( qry_handle, 2, ( void * ) sqlda );

   if( ! ISPOINTER( 4 ) )
      hb_arraySetPtr( qry_handle, 3, ( void * ) trans );

   hb_arraySetNL( qry_handle, 4, ( long ) num_cols );
   hb_arraySetNI( qry_handle, 5, ( int ) dialect );
   hb_arraySet(   qry_handle, 6, aNew );

   hb_itemReturnRelease( qry_handle );
   hb_itemRelease( aNew );
}

HB_FUNC( FBFETCH )
{
   if( ISARRAY( 1 ) )
   {
      PHB_ITEM aParam = hb_param( 1, HB_IT_ARRAY );

      isc_stmt_handle stmt = ( isc_stmt_handle ) hb_itemGetPtr( hb_itemArrayGet( aParam, 1 ) );
      ISC_STATUS      status[ MAX_FIELDS ];
      XSQLDA *        sqlda = ( XSQLDA * ) hb_itemGetPtr( hb_itemArrayGet( aParam, 2 ) );
      unsigned short  dialect = ( unsigned short ) hb_itemGetNI( hb_itemArrayGet( aParam, 5 ) );
      long            fetch_stat;

      /* TOFIX */
      fetch_stat = isc_dsql_fetch( status, &stmt, dialect, sqlda );

      if( fetch_stat != 100L )
      {
         ERREXIT( status );
      }
   }

   hb_retnl( 0 );
}

HB_FUNC( FBFREE )
{
   if( ISARRAY( 1 ) )
   {
      PHB_ITEM aParam = hb_param( 1, HB_IT_ARRAY );

      isc_stmt_handle stmt = ( isc_stmt_handle ) hb_itemGetPtr( hb_itemArrayGet( aParam, 1 ) );
      XSQLDA *        sqlda = ( XSQLDA * ) hb_itemGetPtr( hb_itemArrayGet( aParam, 2 ) );
      isc_tr_handle   trans = ( isc_tr_handle ) hb_itemGetPtr( hb_itemArrayGet( aParam, 3 ) );
      ISC_STATUS      status[ MAX_FIELDS ];

      if( isc_dsql_free_statement( status, &stmt, DSQL_drop ) )
      {
         ERREXIT( status );
      }

      if( trans )
      {
         if( isc_commit_transaction( status, &trans ) )
         {
            ERREXIT( status );
         }
      }

      /* TOFIX: Freeing pointer received as parameter? We should at least set the item NULL. */
      if( sqlda )
         hb_xfree( sqlda );

      hb_retnl( 1 );
   }
   else
      hb_retnl( 0 );
}

HB_FUNC( FBGETDATA )
{
   PHB_ITEM aParam = hb_param( 1, HB_IT_ARRAY );

   int        pos = hb_parni( 2 ) - 1;
   short      dtype;
   char       data[ MAX_BUFFER ];
   char       date_s[ 25 ];

   struct tm  times;
   XSQLVAR *  var;
   XSQLDA *   sqlda = ( XSQLDA * ) hb_itemGetPtr( hb_itemArrayGet( aParam, 2 ) );
   ISC_STATUS status[ MAX_FIELDS ];
   ISC_QUAD * blob_id;

   if( ( pos + 1 ) > sqlda->sqln )
   {
      ERREXIT( status );
   }

   var = sqlda->sqlvar + pos;
   dtype = var->sqltype & ~1;

   if( ( var->sqltype & 1 ) && ( *var->sqlind < 0 ) )
   {
      /* null field */
      hb_ret();
   }
   else
   {
      switch( dtype )
      {
      case SQL_TEXT:
      case SQL_VARYING:
         hb_retclen( var->sqldata, var->sqllen );
         break;

      case SQL_TIMESTAMP:
         isc_decode_timestamp ( ( ISC_TIMESTAMP * ) var->sqldata, × );
         snprintf( date_s, sizeof( date_s ), "%04d-%02d-%02d %02d:%02d:%02d.%04d",
                   times.tm_year + 1900,
                   times.tm_mon + 1,
                   times.tm_mday,
                   times.tm_hour,
                   times.tm_min,
                   times.tm_sec,
                   ( int ) ( ( ( ISC_TIMESTAMP * ) var->sqldata )->timestamp_time % 10000 ) );
         snprintf( data, sizeof( data ), "%*s ", 24, date_s );

         hb_retc( data );
         break;

      case SQL_TYPE_DATE:
         isc_decode_sql_date( ( ISC_DATE * ) var->sqldata, × );
         snprintf( date_s, sizeof( date_s ), "%04d-%02d-%02d", times.tm_year + 1900, times.tm_mon + 1, times.tm_mday );
         snprintf( data, sizeof( data ), "%*s ", 8, date_s );

         hb_retc( data );
         break;

      case SQL_TYPE_TIME:
         isc_decode_sql_time ( ( ISC_TIME * ) var->sqldata, × );
         snprintf( date_s, sizeof( date_s ), "%02d:%02d:%02d.%04d",
                   times.tm_hour,
                   times.tm_min,
                   times.tm_sec,
                   ( int ) ( ( *( ( ISC_TIME * ) var->sqldata ) ) % 10000 ) );
         snprintf( data, sizeof( data ), "%*s ", 13, date_s );

         hb_retc( data );
         break;

      case SQL_BLOB:
         blob_id = ( ISC_QUAD * ) var->sqldata;
         hb_retptr( ( void * ) blob_id );
         break;

      case SQL_SHORT:
      case SQL_LONG:
      case SQL_INT64:
         {
            ISC_INT64 value;
            short field_width;
            short dscale;

            switch( dtype )
            {
            case SQL_SHORT:
               value = ( ISC_INT64 ) *( short * ) var->sqldata;
               field_width = 6;
               break;

            case SQL_LONG:
               value = ( ISC_INT64 ) *( long * ) var->sqldata;
               field_width = 11;
               break;

            case SQL_INT64:
               value = ( ISC_INT64 ) *( ISC_INT64 * ) var->sqldata;
               field_width = 21;
               break;

            default:
               value = 0;
               field_width = 10;
               break;
            }

            dscale = var->sqlscale;

            if( dscale < 0 )
            {
               ISC_INT64 tens = 1;
               short     i;
           
               for( i = 0; i > dscale; i-- )
                  tens *= 10;

               if( value >= 0 )
                  snprintf( data, sizeof( data ), "%*" ISC_INT64_FORMAT "d.%0*" ISC_INT64_FORMAT "d",
                            field_width - 1 + dscale,
                            ( ISC_INT64 ) value / tens,
                            -dscale,
                            ( ISC_INT64 ) value % tens);
               else if( ( value / tens ) != 0 )
                  snprintf( data, sizeof( data ), "%*" ISC_INT64_FORMAT "d.%0*" ISC_INT64_FORMAT "d",
                            field_width - 1 + dscale,
                            ( ISC_INT64 ) ( value / tens ),
                            -dscale,
                            ( ISC_INT64 ) -( value % tens ) );
               else
                  snprintf( data, sizeof( data ), "%*s.%0*" ISC_INT64_FORMAT "d",
                            field_width - 1 + dscale,
                            "-0",
                            -dscale,
                            ( ISC_INT64 ) -( value % tens ) );
            }
            else if( dscale )
               snprintf( data, sizeof( data ), "%*" ISC_INT64_FORMAT "d%0*d", field_width, ( ISC_INT64 ) value, dscale, 0 );
            else
               snprintf( data, sizeof( data ), "%*" ISC_INT64_FORMAT "d", field_width, ( ISC_INT64 ) value );
         }

         hb_retc( data );
         break;

      case SQL_FLOAT:
         snprintf( data, sizeof( data ), "%15g ", *( float * ) ( var->sqldata ) );
         hb_retc( data );
         break;

      case SQL_DOUBLE:
         snprintf( data, sizeof( data ), "%24f ", *( double * ) ( var->sqldata ) );
         hb_retc( data );
         break;

      default:
         hb_ret();
         break;
      }
   }
}

HB_FUNC( FBGETBLOB )
{
   ISC_STATUS      status[ MAX_FIELDS ];
   isc_db_handle   db = ( isc_db_handle ) hb_parptr( 1 );
   isc_tr_handle   trans = NULL;
   isc_blob_handle blob_handle = NULL;
   short           blob_seg_len;
   char            blob_segment[ 512 ];
   ISC_QUAD *      blob_id = ( ISC_QUAD * ) hb_parptr( 2 );
   char            p[ MAX_BUFFER ];
   long            blob_stat;

   if( ISPOINTER( 3 ) )
   {
      trans = ( isc_tr_handle ) hb_parptr( 3 );
   }
   else
   {
      if( isc_start_transaction( status, &trans, 1, &db, 0, NULL ) )
      {
         ERREXIT( status );
      }
   }

   if( isc_open_blob2( status, &db, &trans, &blob_handle, blob_id, 0, NULL ) )
   {
      ERREXIT( status );
   }

   /* Get blob segments and their lengths and print each segment. */
   blob_stat = isc_get_segment( status, &blob_handle,
                                ( unsigned short * ) &blob_seg_len,
                                sizeof( blob_segment ), blob_segment );

   if( blob_stat == 0 || status[ 1 ] == isc_segment )
   {
      PHB_ITEM aNew = hb_itemArrayNew( 0 );

      while( blob_stat == 0 || status[ 1 ] == isc_segment )
      {
         PHB_ITEM temp;

         /* p = ( char * ) hb_xgrab( blob_seg_len + 1 ); */
         snprintf( p, sizeof( p ), "%*.*s", blob_seg_len, blob_seg_len, blob_segment );
      
         temp = hb_itemPutC( NULL, p );
         hb_arrayAdd( aNew, temp );
         hb_itemRelease( temp );
      
         /* hb_xfree(p); */
         blob_stat = isc_get_segment( status, &blob_handle,
                                      ( unsigned short * ) &blob_seg_len,
                                      sizeof( blob_segment ), blob_segment );
      }

      hb_itemReturnRelease( aNew );
   }

   if( isc_close_blob( status, &blob_handle ) )
   {
      ERREXIT( status );
   }

   if( ! ISPOINTER( 3 ) )
   {
      if( isc_commit_transaction( status, &trans ) )
      {
         ERREXIT( status );
      }
   }
}

CLASS TFbServer
    DATA     db
    DATA     trans
    DATA     StartedTrans
    DATA     nError
    DATA     lError
    DATA     dialect
   
    METHOD   New( cServer, cUser, cPassword, nDialect )

    METHOD   Destroy()  INLINE FBClose(::db)

    METHOD   Close()    INLINE FBClose(::db)

    METHOD   TableExists( cTable )
    METHOD   ListTables()
    METHOD   TableStruct( cTable )

    METHOD   StartTransaction()
    METHOD   Commit()
    METHOD   Rollback()

    METHOD   Execute( cQuery )
    METHOD   Query( cQuery )

    METHOD   Update( oRow, cWhere )
    METHOD   Delete( oRow, cWhere )
    METHOD   Append( oRow )

    METHOD   NetErr()   INLINE ::lError 

    METHOD   Error()    INLINE FBError(::nError)

    METHOD   ErrorNo()  INLINE ::nError
ENDCLASS

METHOD New( cServer, cUser, cPassword, nDialect ) CLASS TFbServer

    Default nDialect TO 1

    ::lError := .F.
    ::nError := 0
    ::StartedTrans := .F.
    ::Dialect := nDialect
    
    ::db := FBConnect(cServer, cUser, cPassword)

    if ISNUMBER(::db)
        ::lError := .T.
        ::nError := ::db
    end
RETURN self

METHOD StartTransaction() CLASS TFbServer
    Local result := .F.   
    
    ::trans := FBStartTransaction(::db)
    
    if ISNUMBER(::trans)
        ::lError := .T.
        ::nError := ::trans        
    else
        result := .T.            
        ::lError := .F.
        ::lnError := 0
        ::StartedTrans := .T.
    end
RETURN result

METHOD Rollback() CLASS TFbServer
    Local result := .F., n
    
    if ::StartedTrans
        if (n := FBRollback(::trans)) < 0
            ::lError := .T.
            ::nError := n
        else
            ::lError := .F.
            ::nError := 0
            result := .T.            
            ::StartedTrans := .F.            
        end
    end       
RETURN result

METHOD Commit() CLASS TFbServer
    Local result := .F., n
    
    if ::StartedTrans
        if (n := FBCommit(::trans)) < 0
            ::lError := .T.
            ::nError := n
        else
            ::lError := .F.
            ::nError := 0
            result := .T.            
            ::StartedTrans := .F.            
        end
    end       
RETURN result

METHOD Execute( cQuery ) CLASS TFbServer
    Local result, n

    cQuery := RemoveSpaces(cQuery)
    
    if ::StartedTrans
        n := FBExecute( ::db, cQuery, ::dialect, ::trans )
    else
        n := FBExecute( ::db, cQuery, ::dialect )
    end

    if n < 0
        ::lError := .T.
        ::nError := n
        result := .F.
    else
        ::lError := .F.
        ::nError := 0
        result := .T.        
    end        
RETURN result

METHOD Query( cQuery ) CLASS TFbServer
    Local oQuery 
    
    oQuery := TFbQuery():New(::db, cQuery, ::dialect)
RETURN oQuery

METHOD TableExists( cTable ) CLASS TFbServer
    Local cQuery, result := .F., qry

    cQuery := 'select rdb$relation_name from rdb$relations where rdb$relation_name = "' + Upper(cTable) + '"'

    qry := FBQuery(::db, cQuery, ::dialect) 

    if ISARRAY(qry)    
        result := (FBFetch(qry) == 0)
                     
        FBFree(qry)    
    end        
    
RETURN result

METHOD ListTables() CLASS TFbServer
    Local result := {}, cQuery, qry, fetch_stmt
    
    cQuery := 'select rdb$relation_name '
    cQuery += '  from rdb$relations '
    cQuery += ' where rdb$relation_name not like "RDB$%" '
    cQuery += '   and rdb$view_blr is null '
    cQuery += ' order by 1 '

    qry := FBQuery(::db, RemoveSpaces(cQuery), ::dialect) 

    if ISARRAY(qry)    
        do while (fetch_stmt := FBFetch(qry)) == 0
            aadd( result, FBGetdata(qry, 1) )
        end                     

        FBFree(qry)    
    end            
RETURN result

METHOD TableStruct( cTable ) CLASS TFbServer
    Local result := {}, cQuery, cType, nSize, cDomain, cField, nType, nDec, fetch_stmt
    Local qry
    
    
    cQuery := 'select '
    cQuery += '  a.rdb$field_name,'
    cQuery += '  b.rdb$field_type,'
    cQuery += '  b.rdb$field_length,'
    cQuery += '  b.rdb$field_scale * -1,'
    cQuery += '  a.rdb$field_source '
    cQuery += 'from '
    cQuery += '  rdb$relation_fields a, rdb$fields b '
    cQuery += 'where '
    cQuery += '  a.rdb$field_source = b.rdb$field_name '
    cQuery += '  and a.rdb$relation_name = "' + Upper(ctable) + '" '
    cQuery += 'order by '
    cQuery += '  a.rdb$field_position '
    
    qry := FBQuery(::db, RemoveSpaces(cQuery), ::dialect) 
    
    if ISARRAY(qry)    
        do while (fetch_stmt := FBFetch(qry)) == 0
            cField  := FBGetData(qry, 1)
            nType   := val(FBGetData(qry, 2))
            nSize   := val(FBGetData(qry, 3))
            nDec    := val(FBGetData(qry, 4))
            cDomain := FBGetData(qry, 5)

            switch nType
                case 7 // SMALLINT
                    if "BOOL" $ cDomain
                        cType := "L"
                        nSize := 1
                        nDec := 0
                    else
                        cType := 'N'
                        nSize := 5
                    end
              
                    exit
              
                case 8 // INTEGER
                case 9
                    cType := 'N'
                    nSize := 9
                    exit
            
                case 10 // FLOAT
                case 11
                    cType := 'N'
                    nSize := 15
                    exit

                case 12 // DATE
                    cType := 'D'
                    nSize := 8
                    exit
              
                case 13 // TIME
                    cType := 'C'
                    nSize := 10
                    exit
              
                case 14 // CHAR
                    cType := 'C'
                    exit
              
                case 16 // INT64
                    cType := 'N'
                    nSize := 9
                    exit
              
                case 27 // DOUBLE
                    cType := 'N'
                    nSize := 15
                    exit

                case 35 // TIMESTAMP
                    cType := 'D'
                    nSize := 8
                    exit
              
                case 37 // VARCHAR
                case 40
                    cType := 'C'
                    exit
              
                case 261 // BLOB
                    cType := 'M'
                    nSize := 10
                    exit
              
                otherwise
                    cType := 'C'
                    nDec := 0
            end

            aadd( result, { cField, cType, nSize, nDec } )

        end                     

        FBFree(qry)    
    end    
RETURN result

METHOD Delete( oRow, cWhere ) CLASS TFbServer
    Local result := .F., aKeys, i, nField, xField, cQuery, aTables 
    
    aTables := oRow:GetTables()
    
    if ! ISNUMBER(::db) .and. len(aTables) == 1
        // Cannot delete joined tables 
        
        if ISNIL(cWhere)
            aKeys := oRow:GetKeyField()
            
            cWhere := ''
            For i := 1 to len(aKeys)
                nField := oRow:Fieldpos(aKeys[i])
                xField := oRow:Fieldget(nField)

                cWhere += aKeys[i] + '=' + DataToSql(xField)                    

                if i != len(aKeys)
                    cWhere += ','
                end                    
            Next                        
        end

        if ! (cWhere == '')
            cQuery := 'DELETE FROM ' + aTables[1] + ' WHERE ' + cWhere            
            
            result := ::Execute(cQuery)            
        end            
    end
RETURN result

METHOD Append( oRow ) CLASS TFbServer
    Local result := .F., cQuery, i, aTables
    
    aTables := oRow:GetTables()
        
    if ! ISNUMBER(::db)  .and. len(aTables) == 1
        // Can insert only one table, not in joined tables 
                
        cQuery := 'INSERT INTO ' + aTables[1] + '('
        For i := 1 to oRow:FCount()
            if oRow:Changed(i)
                // Send only changed field
                cQuery += oRow:Fieldname(i) + ','
            end
        Next

        cQuery := Left( cQuery, len(cQuery) - 1 ) +  ') VALUES (' 

        For i := 1 to oRow:FCount()
            if oRow:Changed(i)
                cQuery += DataToSql(oRow:FieldGet(i)) + ','
            end                
        Next
        
        cQuery := Left( cQuery, len(cQuery) - 1  ) + ')'

        result := ::Execute(cQuery)            
    end            
RETURN result

METHOD Update( oRow, cWhere ) CLASS TFbServer
    Local result := .F., aKeys, cQuery, i, nField, xField, aTables 
    
    aTables := oRow:GetTables()

    if ! ISNUMBER(::db)  .and. len(aTables) == 1
         // Can't insert joined tables

        if ISNIL(cWhere)
            aKeys := oRow:GetKeyField()
            
            cWhere := ''
            For i := 1 to len(aKeys)
                nField := oRow:Fieldpos(aKeys[i])
                xField := oRow:Fieldget(nField)

                cWhere += aKeys[i] + '=' + DataToSql(xField)
                
                if i != len(aKeys)
                    cWhere += ', '
                end
            Next                        
        end
                
        cQuery := 'UPDATE ' + aTables[1] + ' SET '
        For i := 1 to oRow:FCount()
            if oRow:Changed(i)
                cQuery += oRow:Fieldname(i) + ' = ' + DataToSql(oRow:FieldGet(i)) + ','
            end                
        Next
        
        if ! (cWhere == '')
            cQuery := Left( cQuery, len(cQuery) - 1 ) + ' WHERE ' + cWhere            
            
            result := ::Execute(cQuery)            
        end            
    end            
RETURN result

CLASS TFbQuery
    DATA     nError
    DATA     lError
    DATA     Dialect
    DATA     lBof
    DATA     lEof
    DATA     nRecno
    DATA     qry
    DATA     aStruct
    DATA     numcols
    DATA     closed
    DATA     db
    DATA     query
    DATA     aKeys
    DATA     aTables

    METHOD   New( db, cQuery, nDialect )
    METHOD   Destroy()

    METHOD   Close()            INLINE ::Destroy()

    METHOD   Refresh()                      
    METHOD   Fetch()

    METHOD   Skip()             INLINE ::Fetch()

    METHOD   Bof()              INLINE ::lBof

    METHOD   Eof()              INLINE ::lEof

    METHOD   RecNo()            INLINE ::nRecno

    METHOD   NetErr()           INLINE ::lError

    METHOD   Error()            INLINE FBError(::nError)

    METHOD   ErrorNo()          INLINE ::nError

    METHOD   FCount()           INLINE ::numcols
    METHOD   Struct()
    METHOD   FieldName( nField )
    METHOD   FieldPos( cField )
    METHOD   FieldLen( nField )
    METHOD   FieldDec( nField )
    METHOD   FieldType( nField )

    METHOD   FieldGet( nField )
    METHOD   GetRow()   
    METHOD   GetBlankRow()  

    METHOD   Blank()            INLINE ::GetBlankRow()
    METHOD   GetKeyField()

ENDCLASS

METHOD New( nDB, cQuery, nDialect ) CLASS TFbQuery
    ::db := nDb
    ::query := RemoveSpaces(cQuery)
    ::dialect := nDialect
    ::closed := .T.
    ::aKeys := NIL
    
    ::Refresh()        
    
RETURN self

METHOD Refresh() CLASS TFbQuery
    Local qry, result := .F., i, aTable := {}
    
    if ! ::closed
        ::Destroy()    
    end

    ::lBof := .T.
    ::lEof := .F.
    ::nRecno := 0
    ::closed := .F.
    ::numcols := 0
    ::aStruct := {}
    ::nError := 0
    ::lError := .F.

    result := .T.            

    qry := FBQuery( ::db, ::query, ::dialect )
        
    if ISARRAY(qry)
        ::numcols := qry[4] 

        ::aStruct := StructConvert(qry[6], ::db, ::dialect)
        
        ::lError := .F.
        ::nError := 0
        ::qry := qry

        /* Tables in query */            
        For i := 1 To len(::aStruct)
            if (ASCAN(aTable, ::aStruct[i,5]) == 0)
                aadd( aTable, ::aStruct[i,5])
            end                        
        Next
            
        ::aTables := aTable
            
    else
        ::lError := .T.
        ::nError := qry
    end        
    
RETURN result    

METHOD Destroy() CLASS TFbQuery
    Local result := .T., n
    
    if (! ::lError) .and. ((n := FBFree(::qry)) < 0)
        ::lError := .T.
        ::nError := n
    end
    
    ::closed := .T.  

RETURN result    

METHOD Fetch() CLASS TFbQuery
    Local result := .F., fetch_stat

    if ! ::lError .and. ! ::lEof
    
        if ! ::Closed
            fetch_stat := FBFetch(::qry)

            ::nRecno++
    
            if fetch_stat == 0
                ::lBof := .F.
                result := .T.
            
            else
                ::lEof := .T.

            end
        end            
    end        
RETURN result

METHOD Struct() CLASS TFbQuery
    Local result := {}, i
    
    if ! ::lError
        for i := 1 to Len(::aStruct)
            aadd( result, { ::aStruct[i,1], ::aStruct[i,2], ::aStruct[i,3], ::aStruct[i,4] } )
        next
    end

RETURN result

METHOD FieldPos( cField ) CLASS TFbQuery
    Local result  := 0
    
    if ! ::lError
        result := AScan( ::aStruct, {|x| x[1] == trim(Upper(cField)) })
    end        

RETURN result

METHOD FieldName( nField ) CLASS TFbQuery
    Local result
        
    if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct)
        result := ::aStruct[nField, 1]    
    end
    
RETURN result

METHOD FieldType( nField ) CLASS TFbQuery
    Local result
    
    if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct)
        result := ::aStruct[nField, 2]    
    end
    
RETURN result

METHOD FieldLen( nField ) CLASS TFbQuery
    Local result
    
    if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct)
        result := ::aStruct[nField, 3]    
    end
RETURN result

METHOD FieldDec( nField ) CLASS TFbQuery
    Local result
    
    if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct)
        result := ::aStruct[nField, 4]    
    end
RETURN result

METHOD FieldGet( nField ) CLASS TFbQuery
    Local result, aBlob, i, cType
    
    if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct) .and. ! ::closed
    
        /* TODO: Convert to right data type */
        
        result := FBGetData(::qry, nField)
        cType := ::aStruct[ nField, 2 ] 
                    
        if cType == "M"
            /* Blob */
    
            if ! ISNIL(result)
                aBlob := FBGetBlob( ::db, result)
                
                result := ''
                For i := 1 to Len(aBlob)
                    result += aBlob[i]            
                Next                        
            
                //result := FBGetBlob( ::db, result)
             else
                result := ''
             end
            
        elseif cType == "N"
            if ! ISNIL(result)
                result := val(result)
            else
                result := 0
            end
        
        elseif cType == "D"
            if ! ISNIL(result)
                result := StoD(left(result,4) + substr(result, 5, 2) + substr(result, 7, 2))
            else
                result := CtoD('')
            end
            
        elseif cType == "L"
            if ! ISNIL(result)
                result := (val(result) == 1)
            else
                result := .F.
            end
        end
    end                    
RETURN result

METHOD Getrow() CLASS TFbQuery
    Local result, aRow := {}, i
    
    if ! ::lError .and. ! ::closed
        ASize(aRow, ::numcols)

        For i := 1 to ::numcols
            aRow[i] := ::Fieldget(i)    
        Next
    
        result := TFbRow():New( aRow, ::aStruct, ::db, ::dialect, ::aTables )
    end            
RETURN result

METHOD GetBlankRow() CLASS TFbQuery
    Local result, aRow := {}, i
    
    if ! ::lError       
        ASize(aRow, ::numcols)
    
        For i := 1 to ::numcols
            if ::aStruct[i, 2] == 'C'
                aRow[i] := ''
            elseif ::aStruct[i, 2] == 'N'
                aRow[i] := 0
            elseif ::aStruct[i, 2] == 'L'
                aRow[i] := .F.
            elseif ::aStruct[i, 2] == 'D'
                aRow[i] := CtoD('')
            elseif ::aStruct[i, 2] == 'M'
                aRow[i] := ''
            end                                
        Next
    
        result := TFbRow():New( aRow, ::aStruct, ::db, ::dialect, ::aTables )
    end            
RETURN result

METHOD GetKeyField() CLASS TFbQuery
    
    if ISNIL(::aKeys)
       ::aKeys := KeyField( ::aTables, ::db, ::dialect )
    end
RETURN ::aKeys

CLASS TFbRow
   DATA     aRow
   DATA     aStruct
   DATA     aChanged
   DATA     aKeys
   DATA     db
   DATA     dialect
   DATA     aTables
   
   METHOD   New( row, struct, db, dialect )
   METHOD   Changed(nField)       

   METHOD   GetTables()        INLINE ::aTables

   METHOD   FCount()           INLINE Len(::aRow)
   METHOD   FieldGet( nField )
   METHOD   FieldPut( nField, Value )  
   METHOD   FieldName( nField )
   METHOD   FieldPos( cFieldName )
   METHOD   FieldLen( nField )             
   METHOD   FieldDec( nField )             
   METHOD   FieldType( nField )            
   METHOD   GetKeyField()
ENDCLASS

METHOD new( row, struct, nDb, nDialect, aTable ) CLASS TFbRow
    ::aRow := row
    ::aStruct := struct            
    ::db := nDB
    ::dialect := nDialect
    ::aTables := aTable
    ::aChanged := Array(len(row))
RETURN self

METHOD Changed( nField ) CLASS TFbRow
    Local result
    
    if nField >= 1 .and. nField <= len(::aRow)
        result := ! ISNIL(::aChanged[nField])    
    end
    
RETURN result

METHOD FieldGet( nField ) CLASS TFbRow
    Local result
    
    if nField >= 1 .and. nField <= len(::aRow)
        result := ::aRow[nField]    
    end
    
RETURN result

METHOD FieldPut( nField, Value ) CLASS TFbRow
    Local result
    
    if nField >= 1 .and. nField <= len(::aRow)
        ::aChanged[nField] := .T.
        result := ::aRow[nField] := Value
    end
    
RETURN result

METHOD FieldName( nField ) CLASS TFbRow
    Local result
    
    if nField >= 1 .and. nField <= len(::aStruct)
        result := ::aStruct[nField, 1]    
    end
    
RETURN result

METHOD FieldPos( cField ) CLASS TFbRow
    Local result  := 0
    
    result := AScan( ::aStruct, {|x| x[1] == trim(Upper(cField)) })

RETURN result

METHOD FieldType( nField ) CLASS TFbRow
    Local result
    
    if nField >= 1 .and. nField <= len(::aStruct)
        result := ::aStruct[nField, 2]    
    end
    
RETURN result

METHOD FieldLen( nField ) CLASS TFbRow
    Local result
    
    if nField >= 1 .and. nField <= len(::aStruct)
        result := ::aStruct[nField, 3]    
    end
RETURN result

METHOD FieldDec( nField ) CLASS TFbRow
    Local result
    
    if nField >= 1 .and. nField <= len(::aStruct)
        result := ::aStruct[nField, 4]    
    end
RETURN result

METHOD GetKeyField() CLASS TFbRow
    
    if ISNIL(::aKeys)
       ::aKeys := KeyField( ::aTables, ::db, ::dialect )
    end
RETURN ::aKeys

Static Function KeyField( aTables, db, dialect ) 
    Local cTable, cQuery
    Local qry, fetch_stmt
    Local aKeys := {}
    
    /* Check row, many tables exists in current query, so we must have only one table */

    if Len(aTables) = 1
        cTable := aTables[1]
        
        cQuery := ' select                                      '
        cQuery += '   a.rdb$field_name                          '
        cQuery += ' from                                        '
        cQuery += '   rdb$index_segments a,                     '
        cQuery += '   rdb$relation_constraints b                '
        cQuery += ' where                                       '
        cQuery += '   a.rdb$index_name = b.rdb$index_name and   '
        cQuery += '   b.rdb$constraint_type = "PRIMARY KEY" and '
        cQuery += '   b.rdb$relation_name = ' + DataToSql(cTable)
        cQuery += ' order by                                    '
        cQuery += '   b.rdb$relation_name,                      '
        cQuery += '   a.rdb$field_position                      '   

        qry := FBQuery(db, RemoveSpaces(cQuery), dialect) 
        
        if ISARRAY(qry)    
            do while (fetch_stmt := FBFetch(qry)) == 0
                aadd(aKeys, trim(FBGetdata(qry, 1)))
            end                    

            FBFree(qry)    
        end            
    end
    
RETURN aKeys

Static Function DataToSql(xField)
        Local cType, result 

        cType := ValType(xField)
        
        if cType == "C"
                result := '"' + strtran(xField, '"', ' ') + '"'
        elseif cType == "D"
                result := '"' + StrZero(month(xField),2) + '/' + StrZero(day(xField),2) + '/' + StrZero(Year(xField),4) + '"'
        elseif cType == "N"
                result := str(xField)
        elseif cType == "L"
                result := iif( xField, '1', '0' )
        end
        
return result           

Static Function StructConvert( aStru, db, dialect)
    Local aNew := {}
    Local cField
    Local nType
    Local cType
    Local nSize
    Local nDec
    Local cTable
    Local cDomain
    Local i
    Local qry
    Local cQuery
    Local aDomains := {}
    Local fetch_stmt
    Local nVal
    
    Local xTables := ''
    Local xFields := ''

    /* create table list and field list */    

    For i := 1 to Len(aStru)
        xtables += DataToSql(aStru[i, 5])
        xfields += DataToSql(aStru[i, 1])
        
        if i != len(aStru)
            xtables += ','
            xfields += ','
         end
    Next

    /* Look for domains */
    cQuery := 'select rdb$relation_name, rdb$field_name, rdb$field_source '
    cQuery += '  from rdb$relation_fields '
    cQuery += ' where rdb$field_name not like "RDB$%" '
    cQuery += '   and rdb$relation_name in (' + xtables + ')'
    cQuery += '   and rdb$field_name in (' + xfields + ')'

    qry := FBQuery(db, RemoveSpaces(cQuery), dialect) 
    
    if ISARRAY(qry)                     

        do while (fetch_stmt := FBFetch(qry)) == 0
            aadd( aDomains, { FBGetdata(qry, 1), FBGetdata(qry,2), FBGetdata(qry,3) } )
        end                     

        FBFree(qry)    
    
        For i := 1 to Len(aStru)
            cField := trim(aStru[i,1])
            nType := aStru[i,2]
            nSize := aStru[i,3]
            nDec := aStru[i,4] * -1
            cTable := trim(aStru[i,5])

            nVal := AScan(aDomains, {|x| trim(x[1]) == cTable .and. trim(x[2]) == cField})

            if nVal != 0
                cDomain := aDomains[ nVal, 3 ]
            else
                cDomain := ''
            end            
            
            switch nType
                case SQL_TEXT
                    cType := "C"
                    exit
                case SQL_VARYING
                    cType := "C"
                    exit
                case SQL_SHORT
                    /* Firebird doesn't have boolean field, so if you define domain with BOOL then i will consider logical, ex:
                   create domain boolean_field as smallint default 0 not null check (value in (0,1)) */

                    if "BOOL" $ cDomain
                        cType := "L"
                        nSize := 1
                        nDec := 0
                    else                    
                        cType := "N"
                        nSize := 5
                    end
                    exit
                case SQL_LONG
                    cType := "N"
                    nSize := 9
                    exit
                case SQL_INT64
                    cType := "N"
                    nSize := 9
                    exit
                case SQL_FLOAT
                    cType := "N"
                    nSize := 15
                    exit
                case SQL_DOUBLE
                    cType := "N"
                    nSize := 15
                    exit
                case SQL_TIMESTAMP
                    cType := "D"
                    nSize := 8
                    exit
                case SQL_TYPE_DATE
                    cType := "D"
                    nSize := 8
                    exit
                case SQL_TYPE_TIME
                    cType := "C"
                    nSize := 8
                    exit
                case SQL_BLOB
                    cType := "M"
                    nSize := 10
                    exit
                otherwise
                    cType := "C"
                    nDec := 0
            end
        
            aadd( aNew, { cField, cType, nSize, nDec, cTable, cDomain } )
        Next                
    End        

return aNew

Static Function RemoveSpaces( cQuery )
    Do While AT("  ", cQuery) != 0
        cQuery := Strtran(cQuery, "  ", " ")
    end
Return cQuery