1087 lines
24 KiB
Plaintext
1087 lines
24 KiB
Plaintext
/*
|
|
* Firebird RDBMS low-level (client API) interface code.
|
|
*
|
|
* Copyright 2003 Rodrigo Moreno rodrigo_moreno@yahoo.com
|
|
*
|
|
* This program is free software; you can redistribute it and/or modify
|
|
* it under the terms of the GNU General Public License as published by
|
|
* the Free Software Foundation; either version 2, or (at your option)
|
|
* any later version.
|
|
*
|
|
* This program is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
* GNU General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU General Public License
|
|
* along with this program; see the file LICENSE.txt. If not, write to
|
|
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
* Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/).
|
|
*
|
|
* As a special exception, the Harbour Project gives permission for
|
|
* additional uses of the text contained in its release of Harbour.
|
|
*
|
|
* The exception is that, if you link the Harbour libraries with other
|
|
* files to produce an executable, this does not by itself cause the
|
|
* resulting executable to be covered by the GNU General Public License.
|
|
* Your use of that executable is in no way restricted on account of
|
|
* linking the Harbour library code into it.
|
|
*
|
|
* This exception does not however invalidate any other reasons why
|
|
* the executable file might be covered by the GNU General Public License.
|
|
*
|
|
* This exception applies only to the code released by the Harbour
|
|
* Project under the name Harbour. If you copy code from other
|
|
* Harbour Project or Free Software Foundation releases into a copy of
|
|
* Harbour, as the General Public License permits, the exception does
|
|
* not apply to the code that you add in this way. To avoid misleading
|
|
* anyone as to the status of such modified files, you must delete
|
|
* this exception notice from them.
|
|
*
|
|
* If you write modifications of your own for Harbour, it is your choice
|
|
* whether to permit this exception to apply to your modifications.
|
|
* If you do not wish that, delete this exception notice.
|
|
*
|
|
*/
|
|
|
|
#include "hbclass.ch"
|
|
|
|
#define SQL_TEXT 452
|
|
#define SQL_VARYING 448
|
|
#define SQL_SHORT 500
|
|
#define SQL_LONG 496
|
|
#define SQL_FLOAT 482
|
|
#define SQL_DOUBLE 480
|
|
#define SQL_D_FLOAT 530
|
|
#define SQL_TIMESTAMP 510
|
|
#define SQL_BLOB 520
|
|
#define SQL_ARRAY 540
|
|
#define SQL_QUAD 550
|
|
#define SQL_TYPE_TIME 560
|
|
#define SQL_TYPE_DATE 570
|
|
#define SQL_INT64 580
|
|
#define SQL_DATE SQL_TIMESTAMP
|
|
|
|
CREATE CLASS TFbServer
|
|
|
|
VAR db
|
|
VAR trans
|
|
VAR StartedTrans
|
|
VAR nError
|
|
VAR lError
|
|
VAR 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
|
|
|
|
hb_default( @nDialect, 1 )
|
|
|
|
::lError := .F.
|
|
::nError := 0
|
|
::StartedTrans := .F.
|
|
::Dialect := nDialect
|
|
|
|
::db := FBConnect( cServer, cUser, cPassword )
|
|
|
|
IF HB_ISNUMERIC( ::db )
|
|
::lError := .T.
|
|
::nError := ::db
|
|
ENDIF
|
|
|
|
RETURN Self
|
|
|
|
METHOD StartTransaction() CLASS TFbServer
|
|
|
|
LOCAL result := .F.
|
|
|
|
::trans := FBStartTransaction( ::db )
|
|
|
|
IF HB_ISNUMERIC( ::trans )
|
|
::lError := .T.
|
|
::nError := ::trans
|
|
ELSE
|
|
result := .T.
|
|
::lError := .F.
|
|
::lnError := 0
|
|
::StartedTrans := .T.
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Rollback() CLASS TFbServer
|
|
|
|
LOCAL result := .F.
|
|
LOCAL n
|
|
|
|
IF ::StartedTrans
|
|
IF ( n := FBRollback( ::trans ) ) < 0
|
|
::lError := .T.
|
|
::nError := n
|
|
ELSE
|
|
::lError := .F.
|
|
::nError := 0
|
|
result := .T.
|
|
::StartedTrans := .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Commit() CLASS TFbServer
|
|
|
|
LOCAL result := .F.
|
|
LOCAL n
|
|
|
|
IF ::StartedTrans
|
|
IF ( n := FBCommit( ::trans ) ) < 0
|
|
::lError := .T.
|
|
::nError := n
|
|
ELSE
|
|
::lError := .F.
|
|
::nError := 0
|
|
result := .T.
|
|
::StartedTrans := .F.
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Execute( cQuery ) CLASS TFbServer
|
|
|
|
LOCAL result
|
|
LOCAL n
|
|
|
|
cQuery := RemoveSpaces( cQuery )
|
|
|
|
IF ::StartedTrans
|
|
n := FBExecute( ::db, cQuery, ::dialect, ::trans )
|
|
ELSE
|
|
n := FBExecute( ::db, cQuery, ::dialect )
|
|
ENDIF
|
|
|
|
IF n < 0
|
|
::lError := .T.
|
|
::nError := n
|
|
result := .F.
|
|
ELSE
|
|
::lError := .F.
|
|
::nError := 0
|
|
result := .T.
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Query( cQuery ) CLASS TFbServer
|
|
RETURN TFBQuery():New( ::db, cQuery, ::dialect )
|
|
|
|
METHOD TableExists( cTable ) CLASS TFbServer
|
|
|
|
LOCAL cQuery
|
|
LOCAL result := .F.
|
|
LOCAL qry
|
|
|
|
cQuery := 'select rdb$relation_name from rdb$relations where rdb$relation_name = "' + Upper( cTable ) + '"'
|
|
|
|
qry := FBQuery( ::db, cQuery, ::dialect )
|
|
|
|
IF HB_ISARRAY( qry )
|
|
result := ( FBFetch( qry ) == 0 )
|
|
|
|
FBFree( qry )
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD ListTables() CLASS TFbServer
|
|
|
|
LOCAL result := {}
|
|
LOCAL cQuery
|
|
LOCAL qry
|
|
|
|
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 HB_ISARRAY( qry )
|
|
DO WHILE FBFetch( qry ) == 0
|
|
AAdd( result, FBGetData( qry, 1 ) )
|
|
ENDDO
|
|
|
|
FBFree( qry )
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD TableStruct( cTable ) CLASS TFbServer
|
|
|
|
LOCAL result := {}
|
|
LOCAL cQuery, cType, nSize, cDomain, cField, nType, nDec
|
|
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 HB_ISARRAY( qry )
|
|
DO WHILE 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
|
|
ENDIF
|
|
|
|
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
|
|
ENDSWITCH
|
|
|
|
AAdd( result, { cField, cType, nSize, nDec } )
|
|
|
|
ENDDO
|
|
|
|
FBFree( qry )
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Delete( oRow, cWhere ) CLASS TFbServer
|
|
|
|
LOCAL result := .F.
|
|
LOCAL aKeys, i, nField, xField, cQuery, aTables
|
|
|
|
aTables := oRow:GetTables()
|
|
|
|
IF ! HB_ISNUMERIC( ::db ) .AND. Len( aTables ) == 1
|
|
// Cannot delete joined tables
|
|
|
|
IF cWhere == NIL
|
|
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 += ","
|
|
ENDIF
|
|
NEXT
|
|
ENDIF
|
|
|
|
IF !( cWhere == "" )
|
|
cQuery := 'DELETE FROM ' + aTables[ 1 ] + ' WHERE ' + cWhere
|
|
|
|
result := ::Execute( cQuery )
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Append( oRow ) CLASS TFbServer
|
|
|
|
LOCAL result := .F.
|
|
LOCAL cQuery, i, aTables
|
|
|
|
aTables := oRow:GetTables()
|
|
|
|
IF ! HB_ISNUMERIC( ::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 ) + ","
|
|
ENDIF
|
|
NEXT
|
|
|
|
cQuery := Left( cQuery, Len( cQuery ) - 1 ) + ") VALUES ("
|
|
|
|
FOR i := 1 TO oRow:FCount()
|
|
IF oRow:Changed( i )
|
|
cQuery += DataToSql( oRow:FieldGet( i ) ) + ","
|
|
ENDIF
|
|
NEXT
|
|
|
|
cQuery := Left( cQuery, Len( cQuery ) - 1 ) + ")"
|
|
|
|
result := ::Execute( cQuery )
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Update( oRow, cWhere ) CLASS TFbServer
|
|
|
|
LOCAL result := .F.
|
|
LOCAL aKeys, cQuery, i, nField, xField, aTables
|
|
|
|
aTables := oRow:GetTables()
|
|
|
|
IF ! HB_ISNUMERIC( ::db ) .AND. Len( aTables ) == 1
|
|
// Can't insert joined tables
|
|
|
|
IF cWhere == NIL
|
|
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 += ", "
|
|
ENDIF
|
|
NEXT
|
|
ENDIF
|
|
|
|
cQuery := "UPDATE " + aTables[ 1 ] + " SET "
|
|
FOR i := 1 TO oRow:FCount()
|
|
IF oRow:Changed( i )
|
|
cQuery += oRow:FieldName( i ) + " = " + DataToSql( oRow:FieldGet( i ) ) + ","
|
|
ENDIF
|
|
NEXT
|
|
|
|
IF !( cWhere == "" )
|
|
cQuery := Left( cQuery, Len( cQuery ) - 1 ) + " WHERE " + cWhere
|
|
|
|
result := ::Execute( cQuery )
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
CREATE CLASS TFbQuery
|
|
|
|
VAR nError
|
|
VAR lError
|
|
VAR Dialect
|
|
VAR lBof
|
|
VAR lEof
|
|
VAR nRecno
|
|
VAR qry
|
|
VAR aStruct
|
|
VAR numcols
|
|
VAR closed
|
|
VAR db
|
|
VAR query
|
|
VAR aKeys
|
|
VAR aTables
|
|
|
|
METHOD New( nDB, 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, i, aTable := {}
|
|
|
|
IF ! ::closed
|
|
::Destroy()
|
|
ENDIF
|
|
|
|
::lBof := .T.
|
|
::lEof := .F.
|
|
::nRecno := 0
|
|
::closed := .F.
|
|
::numcols := 0
|
|
::aStruct := {}
|
|
::nError := 0
|
|
::lError := .F.
|
|
|
|
result := .T.
|
|
|
|
qry := FBQuery( ::db, ::query, ::dialect )
|
|
|
|
IF HB_ISARRAY( qry )
|
|
::numcols := qry[ 4 ]
|
|
|
|
/* FIXME: This is faulty code. ::aStruct will become zero length, out of sync with ::numcols. */
|
|
::aStruct := StructConvert( qry[ 6 ], ::db, ::dialect )
|
|
|
|
::lError := .F.
|
|
::nError := 0
|
|
::qry := qry
|
|
|
|
/* Tables in query */
|
|
FOR i := 1 TO Len( ::aStruct )
|
|
IF hb_AScan( aTable, ::aStruct[ i ][ 5 ], , , .T. ) == 0
|
|
AAdd( aTable, ::aStruct[ i ][ 5 ] )
|
|
ENDIF
|
|
NEXT
|
|
|
|
::aTables := aTable
|
|
|
|
ELSE
|
|
::lError := .T.
|
|
::nError := qry
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Destroy() CLASS TFbQuery
|
|
|
|
LOCAL result := .T.
|
|
LOCAL n
|
|
|
|
IF ! ::lError .AND. ( n := FBFree( ::qry ) ) < 0
|
|
::lError := .T.
|
|
::nError := n
|
|
ENDIF
|
|
|
|
::closed := .T.
|
|
|
|
RETURN result
|
|
|
|
METHOD Fetch() CLASS TFbQuery
|
|
|
|
LOCAL result := .F.
|
|
LOCAL fetch_stat
|
|
|
|
IF ! ::lError .AND. ! ::lEof
|
|
|
|
IF ! ::Closed
|
|
fetch_stat := FBFetch( ::qry )
|
|
|
|
::nRecno++
|
|
|
|
IF fetch_stat == 0
|
|
::lBof := .F.
|
|
result := .T.
|
|
ELSE
|
|
::lEof := .T.
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Struct() CLASS TFbQuery
|
|
|
|
LOCAL result := {}
|
|
LOCAL i
|
|
|
|
IF ! ::lError
|
|
FOR i := 1 TO Len( ::aStruct )
|
|
AAdd( result, { ::aStruct[ i ][ 1 ], ::aStruct[ i ][ 2 ], ::aStruct[ i ][ 3 ], ::aStruct[ i ][ 4 ] } )
|
|
NEXT
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldPos( cField ) CLASS TFbQuery
|
|
|
|
LOCAL result := 0
|
|
|
|
IF ! ::lError
|
|
result := AScan( ::aStruct, {| x | x[ 1 ] == RTrim( Upper( cField ) ) } )
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldName( nField ) CLASS TFbQuery
|
|
|
|
LOCAL result
|
|
|
|
IF ! ::lError .AND. nField >= 1 .AND. nField <= Len( ::aStruct )
|
|
result := ::aStruct[ nField ][ 1 ]
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldType( nField ) CLASS TFbQuery
|
|
|
|
LOCAL result
|
|
|
|
IF ! ::lError .AND. nField >= 1 .AND. nField <= Len( ::aStruct )
|
|
result := ::aStruct[ nField ][ 2 ]
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldLen( nField ) CLASS TFbQuery
|
|
|
|
LOCAL result
|
|
|
|
IF ! ::lError .AND. nField >= 1 .AND. nField <= Len( ::aStruct )
|
|
result := ::aStruct[ nField ][ 3 ]
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldDec( nField ) CLASS TFbQuery
|
|
|
|
LOCAL result
|
|
|
|
IF ! ::lError .AND. nField >= 1 .AND. nField <= Len( ::aStruct )
|
|
result := ::aStruct[ nField ][ 4 ]
|
|
ENDIF
|
|
|
|
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 result != NIL
|
|
aBlob := FBGetBlob( ::db, result )
|
|
|
|
result := ""
|
|
FOR i := 1 TO Len( aBlob )
|
|
result += aBlob[ i ]
|
|
NEXT
|
|
|
|
// result := FBGetBlob( ::db, result )
|
|
ELSE
|
|
result := ""
|
|
ENDIF
|
|
|
|
ELSEIF cType == "N"
|
|
IF result != NIL
|
|
result := Val( result )
|
|
ELSE
|
|
result := 0
|
|
ENDIF
|
|
|
|
ELSEIF cType == "D"
|
|
IF result != NIL
|
|
result := hb_SToD( Left( result, 4 ) + SubStr( result, 5, 2 ) + SubStr( result, 7, 2 ) )
|
|
ELSE
|
|
result := hb_SToD()
|
|
ENDIF
|
|
|
|
ELSEIF cType == "L"
|
|
IF result != NIL
|
|
result := ( Val( result ) == 1 )
|
|
ELSE
|
|
result := .F.
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD Getrow() CLASS TFbQuery
|
|
|
|
LOCAL result
|
|
LOCAL aRow
|
|
LOCAL i
|
|
|
|
IF ! ::lError .AND. ! ::closed
|
|
|
|
aRow := Array( ::numcols )
|
|
|
|
FOR i := 1 TO ::numcols
|
|
aRow[ i ] := ::FieldGet( i )
|
|
NEXT
|
|
|
|
result := TFBRow():New( aRow, ::aStruct, ::db, ::dialect, ::aTables )
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD GetBlankRow() CLASS TFbQuery
|
|
|
|
LOCAL result
|
|
LOCAL aRow
|
|
LOCAL i
|
|
|
|
IF ! ::lError
|
|
aRow := Array( ::numcols )
|
|
|
|
FOR i := 1 TO ::numcols
|
|
|
|
SWITCH ::aStruct[ i ][ 2 ]
|
|
CASE "C"
|
|
CASE "M"
|
|
aRow[ i ] := ""
|
|
EXIT
|
|
CASE "N"
|
|
aRow[ i ] := 0
|
|
EXIT
|
|
CASE "L"
|
|
aRow[ i ] := .F.
|
|
EXIT
|
|
CASE "D"
|
|
aRow[ i ] := hb_SToD()
|
|
EXIT
|
|
ENDSWITCH
|
|
NEXT
|
|
|
|
result := TFBRow():New( aRow, ::aStruct, ::db, ::dialect, ::aTables )
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD GetKeyField() CLASS TFbQuery
|
|
|
|
IF ::aKeys == NIL
|
|
::aKeys := KeyField( ::aTables, ::db, ::dialect )
|
|
ENDIF
|
|
|
|
RETURN ::aKeys
|
|
|
|
CREATE CLASS TFbRow
|
|
|
|
VAR aRow
|
|
VAR aStruct
|
|
VAR aChanged
|
|
VAR aKeys
|
|
VAR db
|
|
VAR dialect
|
|
VAR aTables
|
|
|
|
METHOD New( row, struct, nDB, nDialect, aTable )
|
|
METHOD Changed( nField )
|
|
METHOD GetTables() INLINE ::aTables
|
|
METHOD FCount() INLINE Len( ::aRow )
|
|
METHOD FieldGet( nField )
|
|
METHOD FieldPut( nField, Value )
|
|
METHOD FieldName( nField )
|
|
METHOD FieldPos( cField )
|
|
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 := ( ::aChanged[ nField ] != NIL )
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldGet( nField ) CLASS TFbRow
|
|
|
|
LOCAL result
|
|
|
|
IF nField >= 1 .AND. nField <= Len( ::aRow )
|
|
result := ::aRow[ nField ]
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldPut( nField, Value ) CLASS TFbRow
|
|
|
|
LOCAL result
|
|
|
|
IF nField >= 1 .AND. nField <= Len( ::aRow )
|
|
::aChanged[ nField ] := .T.
|
|
result := ::aRow[ nField ] := Value
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldName( nField ) CLASS TFbRow
|
|
|
|
LOCAL result
|
|
|
|
IF nField >= 1 .AND. nField <= Len( ::aStruct )
|
|
result := ::aStruct[ nField ][ 1 ]
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldPos( cField ) CLASS TFbRow
|
|
RETURN AScan( ::aStruct, {| x | x[ 1 ] == RTrim( Upper( cField ) ) } )
|
|
|
|
METHOD FieldType( nField ) CLASS TFbRow
|
|
|
|
LOCAL result
|
|
|
|
IF nField >= 1 .AND. nField <= Len( ::aStruct )
|
|
result := ::aStruct[ nField ][ 2 ]
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldLen( nField ) CLASS TFbRow
|
|
|
|
LOCAL result
|
|
|
|
IF nField >= 1 .AND. nField <= Len( ::aStruct )
|
|
result := ::aStruct[ nField ][ 3 ]
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD FieldDec( nField ) CLASS TFbRow
|
|
|
|
LOCAL result
|
|
|
|
IF nField >= 1 .AND. nField <= Len( ::aStruct )
|
|
result := ::aStruct[ nField ][ 4 ]
|
|
ENDIF
|
|
|
|
RETURN result
|
|
|
|
METHOD GetKeyField() CLASS TFbRow
|
|
|
|
IF ::aKeys == NIL
|
|
::aKeys := KeyField( ::aTables, ::db, ::dialect )
|
|
ENDIF
|
|
|
|
RETURN ::aKeys
|
|
|
|
STATIC FUNCTION KeyField( aTables, db, dialect )
|
|
|
|
LOCAL cTable, cQuery
|
|
LOCAL qry
|
|
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 HB_ISARRAY( qry )
|
|
DO WHILE FBFetch( qry ) == 0
|
|
AAdd( aKeys, RTrim( FBGetData( qry, 1 ) ) )
|
|
ENDDO
|
|
|
|
FBFree( qry )
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN aKeys
|
|
|
|
STATIC FUNCTION DataToSql( xField )
|
|
|
|
SWITCH ValType( xField )
|
|
CASE "C"
|
|
RETURN '"' + StrTran( xField, '"', ' ' ) + '"'
|
|
CASE "D"
|
|
RETURN '"' + StrZero( Month( xField ), 2 ) + "/" + StrZero( Day( xField ), 2 ) + "/" + StrZero( Year( xField ), 4 ) + '"'
|
|
CASE "N"
|
|
RETURN Str( xField )
|
|
CASE "L"
|
|
RETURN iif( xField, "1", "0" )
|
|
ENDSWITCH
|
|
|
|
RETURN NIL
|
|
|
|
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 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 += ","
|
|
ENDIF
|
|
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 HB_ISARRAY( qry )
|
|
|
|
DO WHILE FBFetch( qry ) == 0
|
|
AAdd( aDomains, { ;
|
|
iif( FBGetData( qry, 1 ) == NIL, "", FBGetData( qry, 1 ) ), ;
|
|
iif( FBGetData( qry, 2 ) == NIL, "", FBGetData( qry, 2 ) ), ;
|
|
iif( FBGetData( qry, 3 ) == NIL, "", FBGetData( qry, 3 ) ) } )
|
|
ENDDO
|
|
|
|
FBFree( qry )
|
|
|
|
FOR i := 1 TO Len( aStru )
|
|
cField := RTrim( aStru[ i ][ 7 ] )
|
|
nType := aStru[ i ][ 2 ]
|
|
nSize := aStru[ i ][ 3 ]
|
|
nDec := aStru[ i ][ 4 ] * -1
|
|
cTable := RTrim( aStru[ i ][ 5 ] )
|
|
|
|
nVal := AScan( aDomains, {| x | RTrim( x[ 1 ] ) == cTable .AND. RTrim( x[ 2 ] ) == cField } )
|
|
|
|
IF nVal != 0
|
|
cDomain := aDomains[ nVal, 3 ]
|
|
ELSE
|
|
cDomain := ""
|
|
ENDIF
|
|
|
|
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
|
|
ENDIF
|
|
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 := "T"
|
|
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
|
|
ENDSWITCH
|
|
|
|
AAdd( aNew, { cField, cType, nSize, nDec, cTable, cDomain } )
|
|
NEXT
|
|
ENDIF
|
|
|
|
RETURN aNew
|
|
|
|
STATIC FUNCTION RemoveSpaces( cQuery )
|
|
|
|
DO WHILE At( " ", cQuery ) != 0
|
|
cQuery := StrTran( cQuery, " ", " " )
|
|
ENDDO
|
|
|
|
RETURN cQuery
|