From 91db201e901e7625fe17cdbee978c5eb6bedf841 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 3 Feb 2010 13:24:28 +0000 Subject: [PATCH] 2010-02-03 14:24 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbfbird/tfirebrd.prg + Formatted. ! Indented. % Optimized to use SWITCH/CASE. % Optimized to avoid ASize() and AAdd() in a few places. --- harbour/ChangeLog | 7 + harbour/contrib/hbfbird/tfirebrd.prg | 1432 +++++++++++++------------- 2 files changed, 728 insertions(+), 711 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 9138adf5be..cc1135e4aa 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,13 @@ past entries belonging to author(s): Viktor Szakats. */ +2010-02-03 14:24 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * contrib/hbfbird/tfirebrd.prg + + Formatted. + ! Indented. + % Optimized to use SWITCH/CASE. + % Optimized to avoid ASize() and AAdd() in a few places. + 2010-02-03 12:47 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * contrib/hbpgsql/tpostgre.prg + Formatted. diff --git a/harbour/contrib/hbfbird/tfirebrd.prg b/harbour/contrib/hbfbird/tfirebrd.prg index b1aed5615f..45d343cece 100644 --- a/harbour/contrib/hbfbird/tfirebrd.prg +++ b/harbour/contrib/hbfbird/tfirebrd.prg @@ -55,705 +55,725 @@ #include "common.ch" #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_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 + 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 New( cServer, cUser, cPassword, nDialect ) + METHOD Destroy() INLINE FBClose( ::db ) + METHOD Close() INLINE FBClose( ::db ) - METHOD TableExists( cTable ) - METHOD ListTables() - METHOD TableStruct( cTable ) + METHOD TableExists( cTable ) + METHOD ListTables() + METHOD TableStruct( cTable ) - METHOD StartTransaction() - METHOD Commit() - METHOD Rollback() + METHOD StartTransaction() + METHOD Commit() + METHOD Rollback() - METHOD Execute( cQuery ) - METHOD Query( cQuery ) + METHOD Execute( cQuery ) + METHOD Query( cQuery ) - METHOD Update( oRow, cWhere ) - METHOD Delete( oRow, cWhere ) - METHOD Append( oRow ) + METHOD Update( oRow, cWhere ) + METHOD Delete( oRow, cWhere ) + METHOD Append( oRow ) + + METHOD NetErr() INLINE ::lError + METHOD Error() INLINE FBError( ::nError ) + METHOD ErrorNo() INLINE ::nError - 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 + Default nDialect TO 1 - ::lError := .F. - ::nError := 0 - ::StartedTrans := .F. - ::Dialect := nDialect + ::lError := .F. + ::nError := 0 + ::StartedTrans := .F. + ::Dialect := nDialect - ::db := FBConnect(cServer, cUser, cPassword) + ::db := FBConnect( cServer, cUser, cPassword ) - if ISNUMBER(::db) - ::lError := .T. - ::nError := ::db - endif -RETURN self + IF ISNUMBER( ::db ) + ::lError := .T. + ::nError := ::db + ENDIF + RETURN self METHOD StartTransaction() CLASS TFbServer - Local result := .F. - ::trans := FBStartTransaction(::db) + LOCAL result := .F. - if ISNUMBER(::trans) - ::lError := .T. - ::nError := ::trans - else - result := .T. - ::lError := .F. - ::lnError := 0 - ::StartedTrans := .T. - endif -RETURN result + ::trans := FBStartTransaction( ::db ) + IF ISNUMBER( ::trans ) + ::lError := .T. + ::nError := ::trans + ELSE + result := .T. + ::lError := .F. + ::lnError := 0 + ::StartedTrans := .T. + ENDIF + + 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. - endif - endif -RETURN result + 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., 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 + 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, n - cQuery := RemoveSpaces(cQuery) + LOCAL result + LOCAL n - if ::StartedTrans - n := FBExecute( ::db, cQuery, ::dialect, ::trans ) - else - n := FBExecute( ::db, cQuery, ::dialect ) - endif + cQuery := RemoveSpaces( cQuery ) - if n < 0 - ::lError := .T. - ::nError := n - result := .F. - else - ::lError := .F. - ::nError := 0 - result := .T. - endif -RETURN result + 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 - Local oQuery - - oQuery := TFbQuery():New(::db, cQuery, ::dialect) -RETURN oQuery - + RETURN TFbQuery():New( ::db, cQuery, ::dialect ) METHOD TableExists( cTable ) CLASS TFbServer - Local cQuery, result := .F., qry - cQuery := 'select rdb$relation_name from rdb$relations where rdb$relation_name = "' + Upper(cTable) + '"' + LOCAL cQuery + LOCAL result := .F. + LOCAL qry - qry := FBQuery(::db, cQuery, ::dialect) + cQuery := 'select rdb$relation_name from rdb$relations where rdb$relation_name = "' + Upper( cTable ) + '"' - if ISARRAY(qry) - result := (FBFetch(qry) == 0) + qry := FBQuery( ::db, cQuery, ::dialect ) - FBFree(qry) - endif + IF ISARRAY( qry ) + result := ( FBFetch( qry ) == 0 ) -RETURN result + FBFree( qry ) + ENDIF + RETURN result METHOD ListTables() CLASS TFbServer - Local result := {}, cQuery, 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 ' + LOCAL result := {} + LOCAL cQuery + LOCAL qry - qry := FBQuery(::db, RemoveSpaces(cQuery), ::dialect) + 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 ' - if ISARRAY(qry) - do while (FBFetch(qry)) == 0 - aadd( result, FBGetdata(qry, 1) ) - enddo + qry := FBQuery( ::db, RemoveSpaces( cQuery ), ::dialect ) - FBFree(qry) - endif -RETURN result + IF 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 := {}, cQuery, cType, nSize, cDomain, cField, nType, nDec - Local qry + 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 ' + 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) + qry := FBQuery( ::db, RemoveSpaces( cQuery ), ::dialect ) - if 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) + IF 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 + SWITCH nType + CASE 7 // SMALLINT + IF "BOOL" $ cDomain + cType := "L" + nSize := 1 + nDec := 0 + ELSE + cType := "N" + nSize := 5 + ENDIF - exit + EXIT - case 8 // INTEGER - case 9 - cType := 'N' - nSize := 9 - exit + CASE 8 // INTEGER + CASE 9 + cType := "N" + nSize := 9 + EXIT - case 10 // FLOAT - case 11 - cType := 'N' - nSize := 15 - exit + CASE 10 // FLOAT + CASE 11 + cType := "N" + nSize := 15 + EXIT - case 12 // DATE - cType := 'D' - nSize := 8 - exit + CASE 12 // DATE + cType := "D" + nSize := 8 + EXIT - case 13 // TIME - cType := 'C' - nSize := 10 - exit + CASE 13 // TIME + cType := "C" + nSize := 10 + EXIT - case 14 // CHAR - cType := 'C' - exit + CASE 14 // CHAR + cType := "C" + EXIT - case 16 // INT64 - cType := 'N' - nSize := 9 - exit + CASE 16 // INT64 + cType := "N" + nSize := 9 + EXIT - case 27 // DOUBLE - cType := 'N' - nSize := 15 - exit + CASE 27 // DOUBLE + cType := "N" + nSize := 15 + EXIT - case 35 // TIMESTAMP - cType := 'D' - nSize := 8 - exit + CASE 35 // TIMESTAMP + cType := "D" + nSize := 8 + EXIT - case 37 // VARCHAR - case 40 - cType := 'C' - exit + CASE 37 // VARCHAR + CASE 40 + cType := "C" + EXIT - case 261 // BLOB - cType := 'M' - nSize := 10 - exit + CASE 261 // BLOB + cType := "M" + nSize := 10 + EXIT - otherwise - cType := 'C' - nDec := 0 - endswitch + OTHERWISE + cType := "C" + nDec := 0 + ENDSWITCH - aadd( result, { cField, cType, nSize, nDec } ) + AAdd( result, { cField, cType, nSize, nDec } ) - enddo + ENDDO - FBFree(qry) - endif -RETURN result + FBFree( qry ) + ENDIF + RETURN result METHOD Delete( oRow, cWhere ) CLASS TFbServer - Local result := .F., aKeys, i, nField, xField, cQuery, aTables - aTables := oRow:GetTables() + LOCAL result := .F. + LOCAL aKeys, i, nField, xField, cQuery, aTables - if ! ISNUMBER(::db) .and. len(aTables) == 1 - // Cannot delete joined tables + aTables := oRow:GetTables() - if cWhere == NIL - aKeys := oRow:GetKeyField() + IF ! ISNUMBER( ::db ) .AND. Len( aTables ) == 1 + // Cannot delete joined tables - cWhere := '' - For i := 1 to len(aKeys) - nField := oRow:Fieldpos(aKeys[i]) - xField := oRow:Fieldget(nField) + IF cWhere == NIL + aKeys := oRow:GetKeyField() - cWhere += aKeys[i] + '=' + DataToSql(xField) + cWhere := "" + FOR i := 1 TO Len( aKeys ) + nField := oRow:Fieldpos( aKeys[ i ] ) + xField := oRow:Fieldget( nField ) - if i != len(aKeys) - cWhere += ',' - endif - Next - endif + cWhere += aKeys[ i ] + "=" + DataToSql( xField ) - if ! (cWhere == '') - cQuery := 'DELETE FROM ' + aTables[1] + ' WHERE ' + cWhere + IF i != Len( aKeys ) + cWhere += "," + ENDIF + NEXT + ENDIF - result := ::Execute(cQuery) - endif - endif -RETURN result + IF !( cWhere == "" ) + cQuery := 'DELETE FROM ' + aTables[ 1 ] + ' WHERE ' + cWhere + result := ::Execute( cQuery ) + ENDIF + ENDIF + + RETURN result METHOD Append( oRow ) CLASS TFbServer - Local result := .F., cQuery, i, aTables - aTables := oRow:GetTables() + LOCAL result := .F. + LOCAL cQuery, i, aTables - if ! ISNUMBER(::db) .and. len(aTables) == 1 - // Can insert only one table, not in joined tables + aTables := oRow:GetTables() - 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 + IF ! ISNUMBER( ::db ) .AND. Len( aTables ) == 1 + // Can insert only one table, not in joined tables - cQuery := Left( cQuery, len(cQuery) - 1 ) + ') VALUES (' + 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 - For i := 1 to oRow:FCount() - if oRow:Changed(i) - cQuery += DataToSql(oRow:FieldGet(i)) + ',' - endif - Next + cQuery := Left( cQuery, Len( cQuery ) - 1 ) + ") VALUES (" - cQuery := Left( cQuery, len(cQuery) - 1 ) + ')' + FOR i := 1 TO oRow:FCount() + IF oRow:Changed( i ) + cQuery += DataToSql( oRow:FieldGet( i ) ) + "," + ENDIF + NEXT - result := ::Execute(cQuery) - endif -RETURN result + cQuery := Left( cQuery, Len( cQuery ) - 1 ) + ")" + result := ::Execute( cQuery ) + ENDIF + + RETURN result METHOD Update( oRow, cWhere ) CLASS TFbServer - Local result := .F., aKeys, cQuery, i, nField, xField, aTables - aTables := oRow:GetTables() + LOCAL result := .F. + LOCAL aKeys, cQuery, i, nField, xField, aTables - if ! ISNUMBER(::db) .and. len(aTables) == 1 - // Can't insert joined tables + aTables := oRow:GetTables() - if cWhere == NIL - aKeys := oRow:GetKeyField() + IF ! ISNUMBER( ::db ) .AND. Len( aTables ) == 1 + // Can't insert joined tables - cWhere := '' - For i := 1 to len(aKeys) - nField := oRow:Fieldpos(aKeys[i]) - xField := oRow:Fieldget(nField) + IF cWhere == NIL + aKeys := oRow:GetKeyField() - cWhere += aKeys[i] + '=' + DataToSql(xField) + cWhere := "" + FOR i := 1 TO Len( aKeys ) + nField := oRow:Fieldpos( aKeys[ i ] ) + xField := oRow:Fieldget( nField ) - if i != len(aKeys) - cWhere += ', ' - endif - Next - endif + cWhere += aKeys[ i ] + "=" + DataToSql( xField ) - 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 i != Len( aKeys ) + cWhere += ", " + ENDIF + NEXT + ENDIF - if ! (cWhere == '') - cQuery := Left( cQuery, len(cQuery) - 1 ) + ' WHERE ' + cWhere + 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 - result := ::Execute(cQuery) - endif - endif -RETURN result + 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 + 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 New( nDB, cQuery, nDialect ) + METHOD Destroy() + METHOD Close() INLINE ::Destroy() - METHOD Refresh() - METHOD Fetch() - METHOD Skip() INLINE ::Fetch() + METHOD Refresh() + METHOD Fetch() + METHOD Skip() INLINE ::Fetch() - METHOD Bof() INLINE ::lBof - METHOD Eof() INLINE ::lEof - METHOD RecNo() INLINE ::nRecno + 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 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 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() + 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() + ::db := nDb + ::query := RemoveSpaces( cQuery ) + ::dialect := nDialect + ::closed := .T. + ::aKeys := NIL -RETURN self + ::Refresh() + RETURN self METHOD Refresh() CLASS TFbQuery - Local qry, result, i, aTable := {} - if ! ::closed - ::Destroy() - endif + LOCAL qry, result, i, aTable := {} - ::lBof := .T. - ::lEof := .F. - ::nRecno := 0 - ::closed := .F. - ::numcols := 0 - ::aStruct := {} - ::nError := 0 - ::lError := .F. + IF ! ::closed + ::Destroy() + ENDIF - result := .T. + ::lBof := .T. + ::lEof := .F. + ::nRecno := 0 + ::closed := .F. + ::numcols := 0 + ::aStruct := {} + ::nError := 0 + ::lError := .F. - qry := FBQuery( ::db, ::query, ::dialect ) + result := .T. - if ISARRAY(qry) - ::numcols := qry[4] + qry := FBQuery( ::db, ::query, ::dialect ) - ::aStruct := StructConvert(qry[6], ::db, ::dialect) + IF ISARRAY( qry ) + ::numcols := qry[ 4 ] - ::lError := .F. - ::nError := 0 - ::qry := qry + ::aStruct := StructConvert( qry[ 6 ], ::db, ::dialect ) - /* Tables in query */ - For i := 1 To len(::aStruct) - if (ASCAN(aTable, ::aStruct[i,5]) == 0) - aadd( aTable, ::aStruct[i,5]) - endif - Next + ::lError := .F. + ::nError := 0 + ::qry := qry - ::aTables := aTable + /* Tables in query */ + FOR i := 1 TO Len( ::aStruct ) + IF AScan( aTable, ::aStruct[ i ][ 5 ] ) == 0 + AAdd( aTable, ::aStruct[ i ][ 5 ] ) + ENDIF + NEXT - else - ::lError := .T. - ::nError := qry - endif + ::aTables := aTable -RETURN result + ELSE + ::lError := .T. + ::nError := qry + ENDIF + RETURN result METHOD Destroy() CLASS TFbQuery - Local result := .T., n + LOCAL result := .T. + LOCAL n - if (! ::lError) .and. ((n := FBFree(::qry)) < 0) - ::lError := .T. - ::nError := n - endif + IF ! ::lError .AND. ( n := FBFree( ::qry ) ) < 0 + ::lError := .T. + ::nError := n + ENDIF - ::closed := .T. - -RETURN result + ::closed := .T. + RETURN result METHOD Fetch() CLASS TFbQuery - Local result := .F., fetch_stat + LOCAL result := .F. + LOCAL fetch_stat - if ! ::lError .and. ! ::lEof + IF ! ::lError .AND. ! ::lEof - if ! ::Closed - fetch_stat := FBFetch(::qry) + IF ! ::Closed + fetch_stat := FBFetch( ::qry ) - ::nRecno++ + ::nRecno++ - if fetch_stat == 0 - ::lBof := .F. - result := .T. - - else - ::lEof := .T. - - endif - endif - endif -RETURN result + IF fetch_stat == 0 + ::lBof := .F. + result := .T. + ELSE + ::lEof := .T. + ENDIF + ENDIF + ENDIF + RETURN result METHOD Struct() CLASS TFbQuery - Local result := {}, i + 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 + 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 + LOCAL result := 0 - if ! ::lError - result := AScan( ::aStruct, {|x| x[1] == trim(Upper(cField)) }) - endif - -RETURN result + IF ! ::lError + result := AScan( ::aStruct, {| x | x[ 1 ] == RTrim( Upper( cField ) ) } ) + ENDIF + RETURN result METHOD FieldName( nField ) CLASS TFbQuery - Local result + LOCAL result - if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 1] - endif - -RETURN result + IF ! ::lError .AND. nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ 1 ] + ENDIF + RETURN result METHOD FieldType( nField ) CLASS TFbQuery - Local result + LOCAL result - if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 2] - endif - -RETURN result + IF ! ::lError .AND. nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ 2 ] + ENDIF + RETURN result METHOD FieldLen( nField ) CLASS TFbQuery - Local result + LOCAL result - if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 3] - endif -RETURN result + IF ! ::lError .AND. nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ 3 ] + ENDIF + RETURN result METHOD FieldDec( nField ) CLASS TFbQuery - Local result + LOCAL result - if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 4] - endif -RETURN 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 + LOCAL result, aBlob, i, cType - if ! ::lError .and. nField >= 1 .and. nField <= len(::aStruct) .and. ! ::closed + IF ! ::lError .AND. nField >= 1 .AND. nField <= Len( ::aStruct ) .AND. ! ::closed - /* TODO: Convert to right data type */ + /* TODO: Convert to right data type */ - result := FBGetData(::qry, nField) - cType := ::aStruct[ nField, 2 ] + result := FBGetData( ::qry, nField ) + cType := ::aStruct[ nField ][ 2 ] - if cType == "M" - /* Blob */ + IF cType == "M" + /* Blob */ - if result != NIL - aBlob := FBGetBlob( ::db, result) + IF result != NIL + aBlob := FBGetBlob( ::db, result ) - result := '' - For i := 1 to Len(aBlob) - result += aBlob[i] - Next + result := "" + FOR i := 1 TO Len( aBlob ) + result += aBlob[ i ] + NEXT - //result := FBGetBlob( ::db, result) - else - result := '' - endif + //result := FBGetBlob( ::db, result ) + ELSE + result := "" + ENDIF - elseif cType == "N" - if result != NIL - result := val(result) - else - result := 0 - endif + ELSEIF cType == "N" + IF result != NIL + result := Val( result ) + ELSE + result := 0 + ENDIF - elseif cType == "D" - if result != NIL - result := StoD(left(result,4) + substr(result, 5, 2) + substr(result, 7, 2)) - else - result := CtoD('') - 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 + ELSEIF cType == "L" + IF result != NIL + result := ( Val( result ) == 1 ) + ELSE + result := .F. + ENDIF + ENDIF + ENDIF + RETURN result METHOD Getrow() CLASS TFbQuery - Local result, aRow := {}, i - if ! ::lError .and. ! ::closed - ASize(aRow, ::numcols) + LOCAL result + LOCAL aRow + LOCAL i - For i := 1 to ::numcols - aRow[i] := ::Fieldget(i) - Next + IF ! ::lError .AND. ! ::closed - result := TFbRow():New( aRow, ::aStruct, ::db, ::dialect, ::aTables ) - endif -RETURN result + 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, aRow := {}, i - if ! ::lError - ASize(aRow, ::numcols) + LOCAL result + LOCAL aRow + LOCAL i - 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] := '' - endif - Next + IF ! ::lError + aRow := Array( ::numcols ) - result := TFbRow():New( aRow, ::aStruct, ::db, ::dialect, ::aTables ) - endif -RETURN result + 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 + IF ::aKeys == NIL + ::aKeys := KeyField( ::aTables, ::db, ::dialect ) + ENDIF + RETURN ::aKeys CREATE CLASS TFbRow VAR aRow @@ -765,9 +785,9 @@ CREATE CLASS TFbRow VAR aTables METHOD New( row, struct, nDB, nDialect, aTable ) - METHOD Changed(nField) + METHOD Changed( nField ) METHOD GetTables() INLINE ::aTables - METHOD FCount() INLINE Len(::aRow) + METHOD FCount() INLINE Len( ::aRow ) METHOD FieldGet( nField ) METHOD FieldPut( nField, Value ) METHOD FieldName( nField ) @@ -776,287 +796,277 @@ CREATE CLASS TFbRow 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 + ::aRow := row + ::aStruct := struct + ::db := nDB + ::dialect := nDialect + ::aTables := aTable + ::aChanged := Array( Len( row ) ) + + RETURN self METHOD Changed( nField ) CLASS TFbRow - Local result + LOCAL result - if nField >= 1 .and. nField <= len(::aRow) - result := ::aChanged[nField] != NIL - endif - -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aRow ) + result := ( ::aChanged[ nField ] != NIL ) + ENDIF + RETURN result METHOD FieldGet( nField ) CLASS TFbRow - Local result + LOCAL result - if nField >= 1 .and. nField <= len(::aRow) - result := ::aRow[nField] - endif - -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aRow ) + result := ::aRow[ nField ] + ENDIF + RETURN result METHOD FieldPut( nField, Value ) CLASS TFbRow - Local result + LOCAL result - if nField >= 1 .and. nField <= len(::aRow) - ::aChanged[nField] := .T. - result := ::aRow[nField] := Value - endif - -RETURN 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 + LOCAL result - if nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 1] - endif - -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ 1 ] + ENDIF + RETURN result METHOD FieldPos( cField ) CLASS TFbRow - Local result - - result := AScan( ::aStruct, {|x| x[1] == trim(Upper(cField)) }) - -RETURN result - + RETURN AScan( ::aStruct, {| x | x[ 1 ] == RTrim( Upper( cField ) ) } ) METHOD FieldType( nField ) CLASS TFbRow - Local result + LOCAL result - if nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 2] - endif - -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ 2 ] + ENDIF + RETURN result METHOD FieldLen( nField ) CLASS TFbRow - Local result + LOCAL result - if nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 3] - endif -RETURN result + IF nField >= 1 .AND. nField <= Len( ::aStruct ) + result := ::aStruct[ nField ][ 3 ] + ENDIF + RETURN result METHOD FieldDec( nField ) CLASS TFbRow - Local result + LOCAL result - if nField >= 1 .and. nField <= len(::aStruct) - result := ::aStruct[nField, 4] - endif -RETURN 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 + IF ::aKeys == NIL + ::aKeys := KeyField( ::aTables, ::db, ::dialect ) + ENDIF + RETURN ::aKeys +STATIC FUNCTION KeyField( aTables, db, dialect ) -Static Function KeyField( aTables, db, dialect ) - Local cTable, cQuery - Local qry - Local aKeys := {} + LOCAL cTable, cQuery + LOCAL qry + LOCAL aKeys := {} - /* Check row, many tables exists in current query, so we must have only one table */ + /* Check row, many tables exists in current query, so we must have only one table */ - if Len(aTables) = 1 - cTable := aTables[1] + 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 ' + 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) + qry := FBQuery(db, RemoveSpaces(cQuery), dialect) - if ISARRAY(qry) - do while (FBFetch(qry)) == 0 - aadd(aKeys, trim(FBGetdata(qry, 1))) - enddo + IF ISARRAY( qry ) + DO WHILE FBFetch( qry ) == 0 + AAdd( aKeys, RTrim( FBGetdata( qry, 1 ) ) ) + ENDDO - FBFree(qry) - endif - endif + FBFree( qry ) + ENDIF + ENDIF -RETURN aKeys + RETURN aKeys +STATIC FUNCTION DataToSql( xField ) -Static Function DataToSql(xField) - Local cType, result + 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 - cType := ValType(xField) + RETURN NIL - 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' ) - endif +STATIC FUNCTION StructConvert( aStru, db, dialect) -return result + 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 := "" -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 + /* create table list and field list */ - Local xTables := '' - Local xFields := '' + FOR i := 1 TO Len( aStru ) + xtables += DataToSql( aStru[ i ][ 5 ] ) + xfields += DataToSql( aStru[ i ][ 1 ] ) - /* create table list and field list */ + IF i != Len( aStru ) + xtables += "," + xfields += "," + ENDIF + NEXT - For i := 1 to Len(aStru) - xtables += DataToSql(aStru[i, 5]) - xfields += DataToSql(aStru[i, 1]) + /* 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 + ')' - if i != len(aStru) - xtables += ',' - xfields += ',' - endif - Next + qry := FBQuery( db, RemoveSpaces( cQuery ), dialect ) - /* 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 + ')' + IF ISARRAY( qry ) - qry := FBQuery(db, RemoveSpaces(cQuery), dialect) + DO WHILE FBFetch( qry ) == 0 + AAdd( aDomains, { FBGetdata( qry, 1 ), FBGetdata( qry, 2 ), FBGetdata( qry, 3 ) } ) + ENDDO - if ISARRAY(qry) + FBFree( qry ) - do while (FBFetch(qry)) == 0 - aadd( aDomains, { FBGetdata(qry, 1), FBGetdata(qry,2), FBGetdata(qry,3) } ) - end + FOR i := 1 TO Len( aStru ) + cField := RTrim( aStru[ i ][ 1 ] ) + nType := aStru[ i ][ 2 ] + nSize := aStru[ i ][ 3 ] + nDec := aStru[ i ][ 4 ] * -1 + cTable := RTrim( aStru[ i ][ 5 ] ) - FBFree(qry) + nVal := AScan( aDomains, {| x | RTrim( x[ 1 ] ) == cTable .AND. RTrim( x[ 2 ] ) == cField } ) - 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]) + IF nVal != 0 + cDomain := aDomains[ nVal, 3 ] + ELSE + cDomain := "" + ENDIF - nVal := AScan(aDomains, {|x| trim(x[1]) == cTable .and. trim(x[2]) == cField}) + 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 nVal != 0 - cDomain := aDomains[ nVal, 3 ] - else - cDomain := '' - endif + 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 := "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 + ENDSWITCH - 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)) */ + AAdd( aNew, { cField, cType, nSize, nDec, cTable, cDomain } ) + NEXT + ENDIF - 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 - endswitch + RETURN aNew - aadd( aNew, { cField, cType, nSize, nDec, cTable, cDomain } ) - next - endif +STATIC FUNCTION RemoveSpaces( cQuery ) -return aNew + DO WHILE At( " ", cQuery ) != 0 + cQuery := StrTran( cQuery, " ", " " ) + ENDDO -Static Function RemoveSpaces( cQuery ) - Do While AT(" ", cQuery) != 0 - cQuery := Strtran(cQuery, " ", " ") - enddo -Return cQuery + RETURN cQuery