hbmysql

  Previous topic Next topic JavaScript is required for the print function Mail us feedback on this topic! Mail us feedback on this topic!  
c:\harbour\contrib\hbmysql
mysql.c
TypeFunctionSourceLine
HB_FUNCSQLVERSION(void)
HB_FUNC( SQLVERSION ) /* long mysql_get_server_version( MYSQL * ) */
{
#if MYSQL_VERSION_ID > 32399
   hb_retnl( ( long ) mysql_get_server_version( ( MYSQL * ) HB_PARPTR( 1 ) ) );
#else
   const char * szVer = mysql_get_server_info( ( MYSQL * ) HB_PARPTR( 1 ) );
   long lVer = 0;

   while( *szVer )
   {
      if( *szVer >= '0' && *szVer <= '9' )
         lVer = lVer * 10 + *szVer;
      szVer++;
   }
   hb_retnl( lVer );
#endif
}
mysql.c81
HB_FUNCSQLCONNECT(void)
HB_FUNC( SQLCONNECT ) /* MYSQL *mysql_real_connect(MYSQL*, char * host, char * user, char * password, char * db, uint port, char *, uint flags) */
{
   const char * szHost = hb_parc( 1 );
   const char * szUser = hb_parc( 2 );
   const char * szPass = hb_parc( 3 );

#if MYSQL_VERSION_ID > 32200
   MYSQL * mysql;
   unsigned int port  = ISNUM( 4 ) ? ( unsigned int ) hb_parni( 4 ) : MYSQL_PORT;
   unsigned int flags = ISNUM( 5 ) ? ( unsigned int ) hb_parni( 5 ) : 0;

   if( ( mysql = mysql_init( ( MYSQL * ) NULL ) ) != NULL )
   {
      /* from 3.22.x of MySQL there is a new parameter in mysql_real_connect() call, that is char * db
         which is not used here */
      if( mysql_real_connect( mysql, szHost, szUser, szPass, 0, port, NULL, flags ) )
         HB_RETPTR( ( void * ) mysql );
      else
      {
         mysql_close( mysql );
         HB_RETPTR( NULL );
      }
   }
   else
      HB_RETPTR( NULL );
#else
   HB_RETPTR( ( void * ) mysql_real_connect( NULL, szHost, szUser, szPass, 0, NULL, 0 ) );
#endif
}
mysql.c99
HB_FUNCSQLCLOSE(void)
HB_FUNC( SQLCLOSE ) /* void mysql_close(MYSQL *mysql) */
{
   mysql_close( ( MYSQL * ) HB_PARPTR( 1 ) );
}
mysql.c129
HB_FUNCSQLCOMMIT(void)
HB_FUNC( SQLCOMMIT ) /* bool mysql_commit(MYSQL *mysql) */
{
#if MYSQL_VERSION_ID >= 40100
   hb_retnl( ( long ) mysql_commit( ( MYSQL * ) HB_PARPTR( 1 ) ) );
#else
   hb_retnl( ( long ) mysql_query( ( MYSQL * ) HB_PARPTR( 1 ), "COMMIT" ) );
#endif
}
mysql.c134
HB_FUNCSQLROLLBACK(void)
HB_FUNC( SQLROLLBACK ) /* bool mysql_rollback(MYSQL *mysql) */
{
#if MYSQL_VERSION_ID >= 40100
   hb_retnl( ( long ) mysql_rollback( ( MYSQL * ) HB_PARPTR( 1 ) ) );
#else
   hb_retnl( ( long ) mysql_query( ( MYSQL * ) HB_PARPTR( 1 ), "ROLLBACK" ) );
#endif
}
mysql.c143
HB_FUNCSQLSELECTD(void)
HB_FUNC( SQLSELECTD ) /* int mysql_select_db(MYSQL *, char *) */
{
   hb_retnl( ( long ) mysql_select_db( ( MYSQL * ) HB_PARPTR( 1 ), ( const char * ) hb_parc( 2 ) ) );
}
mysql.c152
HB_FUNCSQLQUERY(void)
HB_FUNC( SQLQUERY ) /* int mysql_query(MYSQL *, char *) */
{
   hb_retnl( ( long ) mysql_query( ( MYSQL * ) HB_PARPTR( 1 ), hb_parc( 2 ) ) );
}
mysql.c157
HB_FUNCSQLSTORER(void)
HB_FUNC( SQLSTORER ) /* MYSQL_RES *mysql_store_result( MYSQL * ) */
{
   HB_RETPTR( ( void * ) mysql_store_result( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
mysql.c162
HB_FUNCSQLUSERES(void)
HB_FUNC( SQLUSERES ) /* MYSQL_RES *mysql_use_result( MYSQL * ) */
{
   HB_RETPTR( ( void * ) mysql_use_result( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
mysql.c167
HB_FUNCSQLFREER(void)
HB_FUNC( SQLFREER ) /* void mysql_free_result(MYSQL_RES *) */
{
   mysql_free_result( ( MYSQL_RES * ) HB_PARPTR( 1 ) );
}
mysql.c172
HB_FUNCSQLFETCHR(void)
HB_FUNC( SQLFETCHR ) /* MYSQL_ROW *mysql_fetch_row(MYSQL_RES *) */
{
   MYSQL_RES * mresult = ( MYSQL_RES * ) HB_PARPTR( 1 );
   int num_fields = mysql_num_fields( mresult );
   PHB_ITEM aRow = hb_itemArrayNew( num_fields );
   MYSQL_ROW mrow = mysql_fetch_row( mresult );

   if( mrow )
   {
      unsigned long * lengths = mysql_fetch_lengths( mresult );
      int i;
      for( i = 0; i < num_fields; i++ )
         hb_arraySetCL( aRow, i + 1, mrow[ i ], lengths[ i ] );
   }

   hb_itemReturnRelease( aRow );
}
mysql.c177
HB_FUNCSQLDATAS(void)
HB_FUNC( SQLDATAS ) /* void mysql_data_seek(MYSQL_RES *, unsigned int) */
{
   mysql_data_seek( ( MYSQL_RES * ) HB_PARPTR( 1 ), ( unsigned int ) hb_parni( 2 ) );
}
mysql.c195
HB_FUNCSQLNROWS(void)
HB_FUNC( SQLNROWS ) /* my_ulongulong  mysql_num_rows(MYSQL_RES *) */
{
   hb_retnint( mysql_num_rows( ( ( MYSQL_RES * ) HB_PARPTR( 1 ) ) ) );
}
mysql.c200
HB_FUNCSQLFETCHF(void)
HB_FUNC( SQLFETCHF ) /* MYSQL_FIELD *mysql_fetch_field(MYSQL_RES *) */
{
   /* NOTE: field structure of MySQL has 8 members as of MySQL 3.22.x */
   PHB_ITEM aField = hb_itemArrayNew( 8 );
   MYSQL_FIELD * mfield = mysql_fetch_field( ( MYSQL_RES * ) HB_PARPTR( 1 ) );

   if( mfield )
   {
      hb_arraySetC(  aField, 1, mfield->name );
      hb_arraySetC(  aField, 2, mfield->table );
      hb_arraySetC(  aField, 3, mfield->def );
      hb_arraySetNL( aField, 4, ( long ) mfield->type );
      hb_arraySetNL( aField, 5, mfield->length );
      hb_arraySetNL( aField, 6, mfield->max_length );
      hb_arraySetNL( aField, 7, mfield->flags );
      hb_arraySetNL( aField, 8, mfield->decimals );
   }

   hb_itemReturnRelease( aField );
}
mysql.c205
HB_FUNCSQLFSEEK(void)
HB_FUNC( SQLFSEEK ) /* MYSQL_FIELD_OFFSET mysql_field_seek(MYSQL_RES *, MYSQL_FIELD_OFFSET) */
{
   mysql_field_seek( ( MYSQL_RES * ) HB_PARPTR( 1 ), ( MYSQL_FIELD_OFFSET ) hb_parni( 2 ) );
}
mysql.c226
HB_FUNCSQLNUMFI(void)
HB_FUNC( SQLNUMFI ) /* unsigned int mysql_num_fields(MYSQL_RES *) */
{
   hb_retnl( mysql_num_fields( ( ( MYSQL_RES * ) HB_PARPTR( 1 ) ) ) );
}
mysql.c231
HB_FUNCSQLFICOU(void)
HB_FUNC( SQLFICOU ) /* unsigned int mysql_field_count( MYSQL * ) */
{
   hb_retnl( mysql_field_count( ( ( MYSQL * ) HB_PARPTR( 1 ) ) ) );
}
mysql.c238
HB_FUNCSQLLISTF(void)
HB_FUNC( SQLLISTF ) /* MYSQL_RES *mysql_list_fields(MYSQL *, char *); */
{
   hb_retptr( mysql_list_fields( ( MYSQL * ) HB_PARPTR( 1 ), hb_parc( 2 ), NULL ) );
}
mysql.c245
HB_FUNCSQLGETERR(void)
HB_FUNC( SQLGETERR ) /* char *mysql_error( MYSQL * ); */
{
   hb_retc( mysql_error( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
mysql.c250
HB_FUNCSQLLISTDB(void)
HB_FUNC( SQLLISTDB ) /* MYSQL_RES * mysql_list_dbs(MYSQL *, char * wild); */
{
   MYSQL * mysql = ( MYSQL * ) HB_PARPTR( 1 );
   MYSQL_RES * mresult = mysql_list_dbs( mysql, NULL );
   long nr = ( long ) mysql_num_rows( mresult );
   PHB_ITEM aDBs = hb_itemArrayNew( nr );
   long i;

   for( i = 0; i < nr; i++ )
   {
      MYSQL_ROW mrow = mysql_fetch_row( mresult );
      hb_arraySetC( aDBs, i + 1, mrow[ 0 ] );
   }

   mysql_free_result( mresult );

   hb_itemReturnRelease( aDBs );
}
mysql.c255
HB_FUNCSQLLISTTBL(void)
HB_FUNC( SQLLISTTBL ) /* MYSQL_RES * mysql_list_tables(MYSQL *, char * wild); */
{
   MYSQL * mysql = ( MYSQL * ) HB_PARPTR( 1 );
   char  * cWild = hb_parc( 2 );
   MYSQL_RES * mresult = mysql_list_tables( mysql, cWild );
   long nr = ( long ) mysql_num_rows( mresult );
   PHB_ITEM aTables = hb_itemArrayNew( nr );
   long i;

   for( i = 0; i < nr; i++ )
   {
      MYSQL_ROW mrow = mysql_fetch_row( mresult );
      hb_arraySetC( aTables, i + 1, mrow[ 0 ] );
   }

   mysql_free_result( mresult );
   hb_itemReturnRelease( aTables );
}
mysql.c274
HB_FUNCSQLAND(void)
HB_FUNC( SQLAND )
{
   hb_retnl( hb_parnl( 1 ) & hb_parnl( 2 ) );
}
mysql.c293
HB_FUNCSQLAFFROWS(void)
HB_FUNC( SQLAFFROWS )
{
   hb_retnl( ( long ) mysql_affected_rows( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
mysql.c299
HB_FUNCSQLHOSTINFO(void)
HB_FUNC( SQLHOSTINFO )
{
   hb_retc( mysql_get_host_info( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
mysql.c304
HB_FUNCSQLSRVINFO(void)
HB_FUNC( SQLSRVINFO )
{
   hb_retc( mysql_get_server_info( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
mysql.c309
HB_FUNCDATATOSQL(void)
HB_FUNC( DATATOSQL )
{
   const char * from = hb_parc( 1 );
   int iSize = hb_parclen( 1 );
   char * buffer = ( char * ) hb_xgrab( iSize * 2 + 1 );
   iSize = mysql_escape_string( buffer, from, iSize );
   hb_retclen_buffer( ( char * ) buffer, iSize );
}
mysql.c314
STATIC CHAR *filetoBuff( char * fname, int * size )
static char * filetoBuff( char * fname, int * size )
{
   char * buffer = NULL;
   int handle = hb_fsOpen( ( BYTE * ) fname, FO_READWRITE );

   if( handle != FS_ERROR )
   {
      *size = ( int ) hb_fsSeek( handle, 0, FS_END );
      *size -= ( int ) hb_fsSeek( handle, 0, FS_SET );
      buffer = ( char * ) hb_xgrab( * size + 1 );
      *size = hb_fsReadLarge( handle, ( BYTE * ) buffer, *size );
      buffer[ *size ] = '\0';
      hb_fsClose( handle );
   }
   else
      *size = 0;

   return buffer;
}
mysql.c323
HB_FUNCFILETOSQLBINARY(void)
HB_FUNC( FILETOSQLBINARY )
{
   int iSize;
   char * from = filetoBuff( hb_parc( 1 ), &iSize );

   if( from )
   {
      char *buffer = ( char * ) hb_xgrab( iSize * 2 + 1 );
      iSize = mysql_escape_string( buffer, from, iSize );
      hb_retclen_buffer( buffer, iSize );
      hb_xfree( from );
   }
}
mysql.c343
tmysql.prg
TypeFunctionSourceLine
CLASSTMySQLRow
CLASS TMySQLRow

   DATA  aRow              // a single row of answer
   DATA  aDirty            // array of booleans set to .T. if corresponding field of aRow has been changed
   DATA  aOldValue         // If aDirty[n] is .T. aOldValue[n] keeps a copy of changed value if aRow[n] is part of a primary key
   //DAVID:
   DATA  aOriValue         // Original values ( same as TMySQLtable:aOldValue )

   DATA  aFieldStruct      // type of each field
   DATA  cTable            // Name of table containing this row, empty if TMySQLQuery returned this row

   METHOD   New(aRow, aFStruct, cTableName)     // Create a new Row object

   METHOD   FieldGet(cnField)          // Same as clipper ones, but FieldGet() and FieldPut() accept a string as
   METHOD   FieldPut(cnField, Value)   // field identifier, not only a number
   METHOD   FieldName(nNum)
   METHOD   FieldPos(cFieldName)

   METHOD   FieldLen(nNum)             // Length of field N
   METHOD   FieldDec(nNum)             // How many decimals in field N
   METHOD   FieldType(nNum)            // Clipper type of field N

   METHOD   MakePrimaryKeyWhere()    // returns a WHERE x=y statement which uses primary key (if available)

ENDCLASS
tmysql.prg70
TMYSQLROW:METHODNew(aRow, aFStruct, cTableName) CLASS TMySQLRow
METHOD New(aRow, aFStruct, cTableName) CLASS TMySQLRow

   default cTableName to ""
   default aFStruct to {}

   ::aRow := aRow
   //DAVID:
   ::aOriValue := ACLONE( aRow )    // Original values ( same as TMySQLtable:aOldValue )

   ::aFieldStruct := aFStruct
   ::cTable := cTableName

   ::aDirty := Array(Len(::aRow))
   ::aOldValue := Array(Len(::aRow))

   AFill(::aDirty, .F.)

return Self
tmysql.prg97
TMYSQLROW:METHODFieldGet(cnField) CLASS TMySQLRow
METHOD FieldGet(cnField) CLASS TMySQLRow

   local nNum := iif( ISCHARACTER( cnField ), ::FieldPos(cnField), cnField )

   if nNum > 0 .AND. nNum <= Len(::aRow)

      // Char fields are padded with spaces since a real .dbf field would be
      if ::FieldType(nNum) == "C"
         return PadR(::aRow[nNum], ::aFieldStruct[nNum][MYSQL_FS_LENGTH])
      else
         return ::aRow[nNum]
      endif

   endif

return nil
tmysql.prg117
TMYSQLROW:METHODFieldPut(cnField, Value) CLASS TMySQLRow
METHOD FieldPut(cnField, Value) CLASS TMySQLRow

   local nNum := iif( ISCHARACTER( cnField ), ::FieldPos(cnField), cnField )

   if nNum > 0 .AND. nNum <= Len(::aRow)

      if Valtype(Value) == Valtype(::aRow[nNum]) .OR. ::aRow[nNum]==NIL

         // if it is a char field remove trailing spaces
         if ValType(Value) == "C"
            Value := RTrim(Value)
         endif

         // Save starting value for this field
         if !::aDirty[nNum]
            ::aOldValue[nNum] := ::aRow[nNum]
            ::aDirty[nNum] := .T.
         endif

         ::aRow[nNum] := Value

         return Value
      endif
   endif

return nil
tmysql.prg135
TMYSQLROW:METHODFieldPos(cFieldName) CLASS TMySQLRow
METHOD FieldPos(cFieldName) CLASS TMySQLRow

   local cUpperName := Upper(cFieldName)

return AScan(::aFieldStruct, {|aItem| (Upper(aItem[MYSQL_FS_NAME]) == cUpperName)})
tmysql.prg164
TMYSQLROW:METHODFieldName(nNum) CLASS TMySQLRow
METHOD FieldName(nNum) CLASS TMySQLRow

return iif( nNum >=1 .AND. nNum <= Len(::aFieldStruct), ::aFieldStruct[nNum][MYSQL_FS_NAME], "" )
tmysql.prg172
TMYSQLROW:METHODFieldLen(nNum) CLASS TMySQLRow
METHOD FieldLen(nNum) CLASS TMySQLRow

return iif( nNum >=1 .AND. nNum <= Len(::aFieldStruct), ::aFieldStruct[nNum][MYSQL_FS_LENGTH], 0 )
tmysql.prg177
TMYSQLROW:METHODFieldDec(nNum) CLASS TMySQLRow
METHOD FieldDec(nNum) CLASS TMySQLRow

   if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
      if ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE .or. ;
         ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE 
       return set(_SET_DECIMALS)
      else
       return ::aFieldStruct[nNum][MYSQL_FS_DECIMALS]
      endif
   endif

return 0
tmysql.prg181
TMYSQLROW:METHODFieldType(nNum) CLASS TMySQLRow
METHOD FieldType(nNum) CLASS TMySQLRow

   local cType := "U"

   if nNum >=1 .AND. nNum <= Len(::aFieldStruct)

      do case
         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_TINY_TYPE
            cType := "L"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_SHORT_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_LONG_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_LONGLONG_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DECIMAL_TYPE
            cType := "N"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DATE_TYPE
            cType := "D"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_BLOB_TYPE
            cType := "M"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_VAR_STRING_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_STRING_TYPE     .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DATETIME_TYPE
            cType := "C"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_INT24_TYPE
            cType := "N"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_MEDIUM_BLOB_TYPE
            cType := "M"

         otherwise
            cType := "U"

      endcase
   endif

return cType
tmysql.prg195
TMYSQLROW:METHODMakePrimaryKeyWhere() CLASS TMySQLRow
METHOD MakePrimaryKeyWhere() CLASS TMySQLRow

   local ni, cWhere := " WHERE "

   for nI := 1 to Len(::aFieldStruct)

      // search for fields part of a primary key
      if (sqlAND(::aFieldStruct[nI][MYSQL_FS_FLAGS], PRI_KEY_FLAG) == PRI_KEY_FLAG) .OR.;
         (sqlAND(::aFieldStruct[nI][MYSQL_FS_FLAGS], MULTIPLE_KEY_FLAG) == MULTIPLE_KEY_FLAG)

         cWhere += ::aFieldStruct[nI][MYSQL_FS_NAME] + "="

         // if a part of a primary key has been changed, use original value
         if ::aDirty[nI]
            cWhere += ClipValue2SQL(::aOldValue[nI])
         else
            cWhere += ClipValue2SQL(::aRow[nI])
         endif

         cWhere += " AND "
      endif

   next

   // remove last " AND "
   cWhere := Left(cWhere, Len(cWhere) - 5)

return cWhere
tmysql.prg240
CLASSTMySQLQuery
CLASS TMySQLQuery

   DATA  nSocket           // connection handle to MySQL server
   DATA  nResultHandle     // result handle received from MySQL

   DATA  cQuery            // copy of query that generated this object

   DATA  nNumRows          // number of rows available on answer NOTE MySQL is 0 based
   DATA  nCurRow           // I'm currently over row number

   //DAVID:
   DATA  lBof
   DATA  lEof

   //DAVID:
   DATA  lFieldAsData      //Use fields as object DATA. For compatibility
                           //Names of fields can match name of TMySQLQuery/Table DATAs,
                           //and it is dangerous. ::lFieldAsData:=.F. can fix it
   DATA  aRow              //Values of fields of current row

   DATA  nNumFields        // how many fields per row
   DATA  aFieldStruct      // type of each field, a copy is here a copy inside each row

   DATA  lError            // .T. if last operation failed

   METHOD   New(nSocket, cQuery)       // New query object
   METHOD   Destroy()
tmysql.prg272
TMYSQLQUERY:METHODEnd()
   METHOD   End() INLINE ::Destroy()
   METHOD   Refresh()                  // ReExecutes the query (cQuery) so that changes to table are visible

   METHOD   GetRow(nRow)               // return Row n of answer

   METHOD   Skip(nRows)                // Same as clipper ones
tmysql.prg299
TMYSQLQUERY:METHODBof()
   METHOD   Bof() INLINE ::lBof    //DAVID:  ::nCurRow == 1
tmysql.prg306
TMYSQLQUERY:METHODEof()
   METHOD   Eof() INLINE ::lEof    //DAVID:  ::nCurRow == ::nNumRows
tmysql.prg307
TMYSQLQUERY:METHODRecNo()
   METHOD   RecNo() INLINE ::nCurRow
tmysql.prg308
TMYSQLQUERY:METHODLastRec()
   METHOD   LastRec() INLINE ::nNumRows
tmysql.prg309
TMYSQLQUERY:METHODGoTop()
   METHOD   GoTop() INLINE ::GetRow(1)
tmysql.prg310
TMYSQLQUERY:METHODGoBottom()
   METHOD   GoBottom() INLINE ::GetRow(::nNumRows)
tmysql.prg311
TMYSQLQUERY:METHODGoTO(nRow)
   METHOD   GoTO(nRow) INLINE ::GetRow(nRow)

   METHOD   FCount()
tmysql.prg312
TMYSQLQUERY:METHODNetErr()
   METHOD   NetErr() INLINE ::lError         // Returns .T. if something went wrong
   METHOD   Error()                           // Returns textual description of last error and clears ::lError

   METHOD   FieldName(nNum)
   METHOD   FieldPos(cFieldName)
   METHOD   FieldGet(cnField)

   METHOD   FieldLen(nNum)             // Length of field N
   METHOD   FieldDec(nNum)             // How many decimals in field N
   METHOD   FieldType(nNum)            // Clipper type of field N

ENDCLASS
tmysql.prg316
TMYSQLQUERY:METHODNew(nSocket, cQuery) CLASS TMySQLQuery
METHOD New(nSocket, cQuery) CLASS TMySQLQuery

   local nI, aField, rc

   ::nSocket := nSocket
   ::cQuery := cQuery

   ::lError := .F.
   ::aFieldStruct := {}
   ::nCurRow := 1
   ::nResultHandle := nil
   ::nNumFields := 0
   ::nNumRows := 0
   //DAVID:
   ::lBof := .T.
   ::lEof := .T.

   ::lFieldAsData := .T.     //Use fields as object DATA. For compatibility
   ::aRow := {}              //Values of fields of current row

   if (rc := sqlQuery(nSocket, cQuery)) == 0

      // save result set
      if !Empty(::nResultHandle := sqlStoreR(nSocket))

         ::nNumRows := sqlNRows(::nResultHandle)
         ::nNumFields := sqlNumFi(::nResultHandle)
         //DAVID:
         ::aRow       := Array( ::nNumFields )

         for nI := 1 to ::nNumFields

            aField := sqlFetchF(::nResultHandle)
            AAdd(::aFieldStruct, aField)
            //DAVID:
            if ::lFieldAsData
               __ObjAddData(Self,::aFieldStruct[nI][MYSQL_FS_NAME])
            endif

         next

         ::getRow(::nCurRow)

      else
         // Should query have returned rows? (Was it a SELECT like query?)

         if (::nNumFields := sqlNumFi(nSocket)) == 0

            // Was not a SELECT so reset ResultHandle changed by previous sqlStoreR()
            ::nResultHandle := nil

         else
            ::lError := .T.

         endif
      endif

   else
      ::lError := .T.
   endif

return Self
tmysql.prg330
TMYSQLQUERY:METHODRefresh() CLASS TMySQLQuery
METHOD Refresh() CLASS TMySQLQuery

   local rc

   // free present result handle
   sqlFreeR(::nResultHandle)

   ::lError := .F.

   if (rc := sqlQuery(::nSocket, ::cQuery)) == 0

      // save result set
      ::nResultHandle := sqlStoreR(::nSocket)
      ::nNumRows := sqlNRows(::nResultHandle)

      // NOTE: I presume that number of fields doesn't change (that is nobody alters this table) between
      // successive refreshes of the same

      // But row number could very well change
      if ::nCurRow > ::nNumRows
         ::nCurRow := ::nNumRows
      endif

      ::getRow(::nCurRow)

   else
    /*  ::aFieldStruct := {}
      ::nResultHandle := nil
      ::nNumFields := 0
      ::nNumRows := 0
      */
      ::lError := .T.

   endif

return !::lError
tmysql.prg394
TMYSQLQUERY:METHODSkip(nRows) CLASS TMySQLQuery
METHOD Skip(nRows) CLASS TMySQLQuery
//DAVID:
   local lbof

   // NOTE: MySQL row count starts from 0
   default nRows to 1

   //DAVID:
   ::lBof := ( EMPTY( ::LastRec() ) )

   if nRows == 0
      // No move

   elseif nRows < 0
      // Negative movement
      //DAVID: ::nCurRow := Max(::nCurRow + nRows, 1)
      if ( ( ::recno() + nRows ) + 0 ) < 1
         nRows := - ::recno() + 1
         //Clipper: only SKIP movement can set BOF() to .T.
         ::lBof := .T.  //Try to skip before first record
      endif

   else
      // positive movement
      //DAVID: ::nCurRow := Min(::nCurRow + nRows, ::nNumRows)
      if ( ( ::recno() + nRows ) + 0 ) > ::lastrec()
         nRows := ::lastrec() - ::recno() + 1
      endif

   endif

   //DAVID:
   ::nCurRow := ::nCurRow + nRows

   //DAVID: maintain ::bof() true until next movement
   //Clipper: only SKIP movement can set BOF() to .T.
   lbof := ::bof()

//   sqlDataS(::nResultHandle, ::nCurRow - 1)
   ::getRow(::nCurrow)

   if lbof
      ::lBof := .T.
   endif

//DAVID: DBSKIP() return NIL  return ::nCurRow
return nil
tmysql.prg432
STATIC FUNCTIONNMonth(cMonthValue)
static function NMonth(cMonthValue)

   static cMonths := {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Ago", "Sep", "Oct", "Nov", "Dec" }
   local nMonth

   nMonth := AScan(cMonths, cMonthValue)

return PadL(nMonth, 2, "0")
tmysql.prg482
TMYSQLQUERY:METHODGetRow(nRow) CLASS TMySQLQuery
METHOD GetRow(nRow) CLASS TMySQLQuery

   //DAVID: replaced by ::aRow   local aRow := NIL
   local oRow := NIL
   local i

   //DAVID: use current row  default nRow to 0
   default nRow to ::nCurRow

   if ::nResultHandle != NIL

      //DAVID:
      ::lBof := ( EMPTY( ::LastRec() ) )

      if nRow < 1 .or. nRow > ::lastrec()  //Out of range
         // Equal to Clipper behaviour
         nRow := ::lastrec() + 1  //LASTREC()+1
         ::nCurRow := ::lastrec() + 1
         // ::lEof := .t.
      endif

      if nRow >= 1 .AND. nRow <= ::nNumRows

         // NOTE: row count starts from 0
         sqlDataS(::nResultHandle, nRow - 1)
         ::nCurRow := nRow
//DAVID:      else
         //DAVID: use current row  ::nCurRow++
      endif

      //DAVID:
      ::lEof := ( ::Recno() > ::LastRec() )
      ::aRow := NIL

      if ::eof()
         // Phantom record with empty fields
         ::aRow := Array( Len( ::aFieldStruct ) )
         Afill( ::aRow, "" )

      else
         ::aRow := sqlFetchR(::nResultHandle)
      endif

      if ::aRow != NIL

         // Convert answer from text field to correct clipper types
         for i := 1 to ::nNumFields
            do case
               case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_TINY_TYPE
                  //DAVID:
                  if ::aRow[i]==NIL
                     ::aRow[i] := "0"
                  endif
                  ::aRow[i] := iif(Val(::aRow[i]) == 0, .F., .T.)

               case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_SHORT_TYPE .OR.;
                    ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_LONG_TYPE .OR.;
                    ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_LONGLONG_TYPE .OR.;
                    ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_INT24_TYPE .OR. ;
                    ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DECIMAL_TYPE
                  //DAVID:
                  if ::aRow[i]==NIL
                     ::aRow[i] := "0"
                  endif
                  ::aRow[i] := Val(::aRow[i])

               case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE .OR.;
                    ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE
                  //DAVID:
                  if ::aRow[i]==NIL
                     ::aRow[i] := "0"
                  endif
                  ::aRow[i] := Val(::aRow[i])

               case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DATE_TYPE
                  if Empty(::aRow[i])
                     ::aRow[i] := hb_SToD("")
                  else
                     // Date format YYYY-MM-DD
                     ::aRow[i] := hb_SToD(Left(::aRow[i], 4) + SubStr(::aRow[i], 6, 2) + Right(::aRow[i], 2))
                  endif

               case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_BLOB_TYPE
                  // Memo field

               case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_STRING_TYPE .OR.;
                    ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_VAR_STRING_TYPE
                  // char field

               case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DATETIME_TYPE
                  // DateTime field

               otherwise

                  //DAVID: Alert("Unknown type from SQL Server Field: " + LTrim(Str(i))+" is type "+LTrim(Str(::aFieldStruct[i][MYSQL_FS_TYPE])))
                  // QOUT("Unknown type from SQL Server Field: " + LTrim(Str(i))+" is type "+LTrim(Str(::aFieldStruct[i][MYSQL_FS_TYPE])))

            endcase

            //DAVID:
            if ::lFieldAsData
               __objsetValuelist(Self,{{::aFieldStruct[i][MYSQL_FS_NAME],::aRow[i]}})
            endif

         next

         oRow := TMySQLRow():New(::aRow, ::aFieldStruct)

      endif

   endif
  //DAVID: if ::arow==nil; msginfo("::arow nil"); end

return iif(::aRow == NIL, NIL, oRow)
tmysql.prg493
TMYSQLQUERY:METHODDestroy() CLASS TMySQLQuery
METHOD Destroy() CLASS TMySQLQuery

   sqlFreeR(::nResultHandle)

return Self
tmysql.prg610
TMYSQLQUERY:METHODFCount() CLASS TMySQLQuery
METHOD FCount() CLASS TMySQLQuery

return ::nNumFields
tmysql.prg617
TMYSQLQUERY:METHODError() CLASS TMySQLQuery
METHOD Error() CLASS TMySQLQuery

   ::lError := .F.

return sqlGetErr(::nSocket)
tmysql.prg622
TMYSQLQUERY:METHODFieldPos(cFieldName) CLASS TMySQLQuery
METHOD FieldPos(cFieldName) CLASS TMySQLQuery

   local cUpperName, nPos := 0

   cUpperName := Upper(cFieldName)

   //DAVID: nPos := AScan(::aFieldStruct, {|aItem| iif(Upper(aItem[MYSQL_FS_NAME]) == cUpperName, .T., .F.)})
   nPos := AScan(::aFieldStruct, {|aItem| (Upper(aItem[MYSQL_FS_NAME]) == cUpperName)})

   /*while ++nPos <= Len(::aFieldStruct)
      if Upper(::aFieldStruct[nPos][MYSQL_FS_NAME]) == cUpperName
         exit
      endif
   enddo

   // I haven't found field name
   if nPos > Len(::aFieldStruct)
      nPos := 0
   endif*/

return nPos
tmysql.prg629
TMYSQLQUERY:METHODFieldName(nNum) CLASS TMySQLQuery
METHOD FieldName(nNum) CLASS TMySQLQuery

   if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
      return ::aFieldStruct[nNum][MYSQL_FS_NAME]
   endif

return ""
tmysql.prg653
TMYSQLQUERY:METHODFieldGet(cnField) CLASS TMySQLQuery
METHOD FieldGet(cnField) CLASS TMySQLQuery

   local nNum,Value

   if ValType(cnField) == "C"
      nNum := ::FieldPos(cnField)
   else
      nNum := cnField
   endif

   if nNum > 0 .AND. nNum <= ::nNumfields
      //DAVID: Value :=  __objsendmsg(Self,::aFieldStruct[nNum][MYSQL_FS_NAME])
      Value := ::aRow[ nNum ]

      // Char fields are padded with spaces since a real .dbf field would be
      if ::FieldType(nNum) == "C"
         return PadR(Value,::aFieldStruct[nNum][MYSQL_FS_LENGTH])
      else
         return  Value
      endif

   endif

return nil
tmysql.prg661
TMYSQLQUERY:METHODFieldLen(nNum) CLASS TMySQLQuery
METHOD FieldLen(nNum) CLASS TMySQLQuery

   if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
      return ::aFieldStruct[nNum][MYSQL_FS_LENGTH]
   endif

return 0
tmysql.prg687
TMYSQLQUERY:METHODFieldDec(nNum) CLASS TMySQLQuery
METHOD FieldDec(nNum) CLASS TMySQLQuery

   if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
      if ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE .or. ;
         ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE 
       return set(_SET_DECIMALS)
      else
       return ::aFieldStruct[nNum][MYSQL_FS_DECIMALS]
      endif
   endif

return 0
tmysql.prg695
TMYSQLQUERY:METHODFieldType(nNum) CLASS TMySQLQuery
METHOD FieldType(nNum) CLASS TMySQLQuery

   local cType := "U"

   if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
      do case
         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_TINY_TYPE
            cType := "L"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_SHORT_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_LONG_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_LONGLONG_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE.OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DECIMAL_TYPE
            cType := "N"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DATE_TYPE
            cType := "D"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_BLOB_TYPE
            cType := "M"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_VAR_STRING_TYPE .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_STRING_TYPE     .OR.;
              ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DATETIME_TYPE
            cType := "C"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_INT24_TYPE
            cType := "N"

         case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_MEDIUM_BLOB_TYPE
            cType := "M"

         otherwise
            cType := "U"

      endcase
   endif

return cType
tmysql.prg709
CLASSTMySQLTable FROM TMySQLQuery
CLASS TMySQLTable FROM TMySQLQuery

   DATA  cTable               // name of table
   DATA  aOldValue         //  keeps a copy of old value

   METHOD   New(nSocket, cQuery, cTableName)
   METHOD   GetRow(nRow)
   METHOD   Skip(nRow)
tmysql.prg759
TMYSQLTABLE:METHODGoTop()
   METHOD   GoTop() INLINE ::GetRow(1)
tmysql.prg767
TMYSQLTABLE:METHODGoBottom()
   METHOD   GoBottom() INLINE ::GetRow(::nNumRows)
tmysql.prg768
TMYSQLTABLE:METHODGoTo(nRow)
   METHOD   GoTo(nRow) INLINE ::GetRow(nRow)

   //DAVID: lOldRecord, lrefresh added
   METHOD   Update(oRow, lOldRecord, lRefresh)      // Gets an oRow and updates changed fields
tmysql.prg769
TMYSQLTABLE:METHODSave()
   METHOD   Save() INLINE ::Update()

   //DAVID: lOldRecord, lRefresh added
   METHOD   Delete(oRow, lOldRecord, lRefresh)      // Deletes passed row from table
   //DAVID: lRefresh added
   METHOD   Append(oRow, lRefresh)      // Inserts passed row into table
   //DAVID: lSetValues added
   METHOD   GetBlankRow( lSetValues )     // Returns an empty row with all available fields empty
tmysql.prg774
TMYSQLTABLE:METHODSetBlankRow()
   METHOD   SetBlankRow() INLINE ::GetBlankRow( .T. )    //Compatibility
tmysql.prg783
TMYSQLTABLE:METHODBlank()
   METHOD   Blank() INLINE ::GetBlankRow()
   METHOD   FieldPut(cnField, Value)   // field identifier, not only a number
   METHOD   Refresh()
   METHOD   MakePrimaryKeyWhere()    // returns a WHERE x=y statement which uses primary key (if available)

ENDCLASS
tmysql.prg785
TMYSQLTABLE:METHODNew(nSocket, cQuery, cTableName) CLASS TMySQLTable
METHOD New(nSocket, cQuery, cTableName) CLASS TMySQLTable

Local i := 0
   super:New(nSocket, AllTrim(cQuery))

   ::cTable := Lower(cTableName)
   ::aOldValue:={}

   for i := 1 to ::nNumFields
      aadd(::aOldValue, ::fieldget(i))
   next


return Self
tmysql.prg793
TMYSQLTABLE:METHODGetRow(nRow) CLASS TMySQLTable
METHOD GetRow(nRow) CLASS TMySQLTable

   local oRow := super:GetRow(nRow),i := 0

   if oRow != NIL
      oRow:cTable := ::cTable
   endif

   ::aOldvalue:={}
   for i := 1 to ::nNumFields

       // ::aOldValue[i] := ::FieldGet(i)
       aadd(::aOldvalue,::fieldget(i))
   next

return oRow
tmysql.prg809
TMYSQLTABLE:METHODSkip(nRow) CLASS TMySQLTable
METHOD Skip(nRow) CLASS TMySQLTable
   Local i
     super:skip(nRow)

     for i := 1 to ::nNumFields
         ::aOldValue[i] := ::FieldGet(i)
     next

//DAVID: DBSKIP() return NIL  return Self
return nil
tmysql.prg827
TMYSQLTABLE:METHODUpdate(oRow, lOldRecord, lRefresh ) CLASS TMySQLTable
METHOD Update(oRow, lOldRecord, lRefresh ) CLASS TMySQLTable

   local cUpdateQuery := "UPDATE " + ::cTable + " SET "
   local i
   //DAVID:
   local ni, cWhere := " WHERE "
   default lOldRecord to .F.
   //DAVID: too many ::refresh() can slow some processes, so we can desactivate it by parameter
   default lRefresh to .T.

   ::lError := .F.

   Do case

          // default Current row
       case oRow==nil

         for i := 1 to  ::nNumFields

            if !( ::aOldValue[i] == ::FieldGet(i) )
               cUpdateQuery += ::aFieldStruct[i][MYSQL_FS_NAME] + "=" + ClipValue2SQL(::FieldGet(i)) + ","
            endif
         next

         // no Change
         if right(cUpdateQuery,4)=="SET "; return !::lError; end

         // remove last comma
         cUpdateQuery := Left(cUpdateQuery, Len(cUpdateQuery) -1)

         //DAVID:
         if lOldRecord
            // based in matching of ALL fields of old record
            // WARNING: if there are more than one record of ALL fields matching, all of those records will be changed

            for nI := 1 to Len(::aFieldStruct)
                  cWhere += ::aFieldStruct[nI][MYSQL_FS_NAME] + "="
                  // use original value
                  cWhere += ClipValue2SQL(::aOldValue[nI])
                  cWhere += " AND "
            next
            // remove last " AND "
            cWhere := Left(cWhere, Len(cWhere) - 5)
            cUpdateQuery += cWhere

         else
            //MakePrimaryKeyWhere is based in fields part of a primary key
            cUpdateQuery += ::MakePrimaryKeyWhere()
         endif

         if sqlQuery(::nSocket, cUpdateQuery) == 0
            //DAVID: Clipper maintain same record pointer

            //DAVID: after refresh(), position of current record is often unpredictable
            if lRefresh
               ::refresh()
            else
               //DAVID: just reset values (?)
               for i := 1 to ::nNumFields
                   ::aOldValue[i] := ::FieldGet(i)
               next
            endif

         else
            ::lError := .T.

         endif

      Case oRow!=nil

         if oRow:cTable == ::cTable

            for i := 1 to Len(oRow:aRow)
               if oRow:aDirty[i]
                  cUpdateQuery += oRow:aFieldStruct[i][MYSQL_FS_NAME] + "=" + ClipValue2SQL(oRow:aRow[i]) + ","
               endif
            next

            // remove last comma
            cUpdateQuery := Left(cUpdateQuery, Len(cUpdateQuery) -1)

            //DAVID:
            if lOldRecord
               // based in matching of ALL fields of old record
               // WARNING: if there are more than one record of ALL fields matching, all of those records will be changed

               for nI := 1 to Len(oRow:aFieldStruct)
                     cWhere += oRow:aFieldStruct[nI][MYSQL_FS_NAME] + "="
                     // use original value
                     cWhere += ClipValue2SQL(oRow:aOriValue[nI])
                     cWhere += " AND "
               next
               // remove last " AND "
               cWhere := Left(cWhere, Len(cWhere) - 5)
               cUpdateQuery += cWhere

            else
               //MakePrimaryKeyWhere is based in fields part of a primary key
               cUpdateQuery += oRow:MakePrimaryKeyWhere()
            endif

            if sqlQuery(::nSocket, cUpdateQuery) == 0

               // All values are commited
               Afill(oRow:aDirty, .F.)
               Afill(oRow:aOldValue, nil)

               //DAVID:
               oRow:aOriValue := ACLONE( oRow:aRow )

               //DAVID: Clipper maintain same record pointer

               //DAVID: after refresh(), position of current record is often unpredictable
               if lRefresh
                  ::refresh()
               endif

            else
               ::lError := .T.

            endif

         endif
   endCase

return !::lError
tmysql.prg841
TMYSQLTABLE:METHODDelete(oRow, lOldRecord, lRefresh) CLASS TMySQLTable
METHOD Delete(oRow, lOldRecord, lRefresh) CLASS TMySQLTable

   local cDeleteQuery := "DELETE FROM " + ::cTable , i

   //DAVID:
   local ni, cWhere := " WHERE "
   default lOldRecord to .F.
   //DAVID: too many ::refresh() can slow some processes, so we can desactivate it by parameter
   default lRefresh to .T.

   // is this a row of this table ?
   Do Case
      Case orow==nil

         //DAVID:
         if lOldRecord
            // based in matching of ALL fields of old record
            // WARNING: if there are more than one record of ALL fields matching, all of those records will be changed

            for nI := 1 to Len(::aFieldStruct)
                  cWhere += ::aFieldStruct[nI][MYSQL_FS_NAME] + "="
                  // use original value
                  cWhere += ClipValue2SQL(::aOldValue[nI])
                  cWhere += " AND "
            next
            // remove last " AND "
            cWhere := Left(cWhere, Len(cWhere) - 5)
            cDeleteQuery += cWhere

         else
            //MakePrimaryKeyWhere is based in fields part of a primary key
            cDeleteQuery += ::MakePrimaryKeyWhere()
         endif

         if sqlQuery(::nSocket, cDeleteQuery) == 0
            ::lError := .F.
            //DAVID: Clipper maintain same record pointer
            //DAVID: ::nCurRow--

            //DAVID: after refresh(), position of current record is often unpredictable
            if lRefresh
               ::refresh()
            else
               //DAVID: just reset values (?)
               for i := 1 to ::nNumFields
                   ::aOldValue[i] := ::FieldGet(i)
               next
            endif

         else
            ::lError := .T.

         endif

      Case oRow!=nil
         if oRow:cTable == ::cTable

            //DAVID:
            if lOldRecord
               // based in matching of ALL fields of old record
               // WARNING: if there are more than one record of ALL fields matching, all of those records will be changed

               for nI := 1 to Len(oRow:aFieldStruct)
                     cWhere += oRow:aFieldStruct[nI][MYSQL_FS_NAME] + "="
                     // use original value
                     cWhere += ClipValue2SQL(oRow:aOriValue[nI])
                     cWhere += " AND "
               next
               // remove last " AND "
               cWhere := Left(cWhere, Len(cWhere) - 5)
               cDeleteQuery += cWhere

            else
               //MakePrimaryKeyWhere is based in fields part of a primary key
               cDeleteQuery += oRow:MakePrimaryKeyWhere()
            endif

            if sqlQuery(::nSocket, cDeleteQuery) == 0
               ::lError := .F.

               //DAVID: after refresh(), position of current record is often unpredictable
               if lRefresh
                  ::refresh()
               endif

            else
               ::lError := .T.

            endif

          endif
  EndCase

return !::lError
tmysql.prg970
TMYSQLTABLE:METHODAppend(oRow, lRefresh) CLASS TMySQLTable
METHOD Append(oRow, lRefresh) CLASS TMySQLTable

   local cInsertQuery := "INSERT INTO " + ::cTable + " ("
   local i
   //DAVID: too many ::refresh() can slow some processes, so we can desactivate it by parameter
   default lRefresh to .T.

   Do Case
           // default Current row
      Case oRow==nil

            // field names
            for i := 1 to ::nNumFields
               if ::aFieldStruct[i][MYSQL_FS_FLAGS]!=AUTO_INCREMENT_FLAG
                  cInsertQuery += ::aFieldStruct[i][MYSQL_FS_NAME] + ","
               endif
            next
            // remove last comma from list
            cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ") VALUES ("

            // field values
            for i := 1 to ::nNumFields
               if ::aFieldStruct[i][MYSQL_FS_FLAGS]!=AUTO_INCREMENT_FLAG
                  cInsertQuery += ClipValue2SQL(::FieldGet(i)) + ","
               endif
            next

            // remove last comma from list of values and add closing parenthesis
            cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ")"

            if sqlQuery(::nSocket, cInsertQuery) == 0
               ::lError := .F.
               //DAVID: Clipper add record at end
               ::nCurRow := ::lastrec() + 1

               //DAVID: after refresh(), position of current record is often unpredictable
               if lRefresh
                  ::refresh()
               else
                  //DAVID: just reset values in memory (?)
                  /* was same values from fieldget(i) !
                  for i := 1 to ::nNumFields
                      ::aOldValue[i] := ::FieldGet(i)
                  next
                  */
               endif

               return .T.
            else
               ::lError := .T.
            endif

    Case oRow!=nil

         if oRow:cTable == ::cTable

            // field names
            for i := 1 to Len(oRow:aRow)
               if oRow:aFieldStruct[i][MYSQL_FS_FLAGS]!=AUTO_INCREMENT_FLAG
                  cInsertQuery += oRow:aFieldStruct[i][MYSQL_FS_NAME] + ","
               endif
            next
            // remove last comma from list
            cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ") VALUES ("

            // field values
            for i := 1 to Len(oRow:aRow)
               if oRow:aFieldStruct[i][MYSQL_FS_FLAGS]!=AUTO_INCREMENT_FLAG
                  cInsertQuery += ClipValue2SQL(oRow:aRow[i]) + ","
               endif
            next

            // remove last comma from list of values and add closing parenthesis
            cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ")"

            if sqlQuery(::nSocket, cInsertQuery) == 0
               //DAVID:
               ::lError := .F.

               //DAVID:
               // All values are commited
               Afill(oRow:aDirty, .F.)
               Afill(oRow:aOldValue, nil)

               //DAVID:
               oRow:aOriValue := ACLONE( oRow:aRow )

               //DAVID: Clipper add record at end
               ::nCurRow := ::lastrec() + 1

               //DAVID: after refresh(), position of current record is often unpredictable
               if lRefresh
                  ::refresh()
               endif

               return .T.
            else
               ::lError := .T.
            endif

         endif

    Endcase
return .F.
tmysql.prg1068
TMYSQLTABLE:METHODGetBlankRow( lSetValues ) CLASS TMySQLTable
METHOD GetBlankRow( lSetValues ) CLASS TMySQLTable

   local i
   local aRow := Array(::nNumFields)

   //DAVID: It is not current row, so do not change it
   default lSetValues to .F.

   // crate an array of empty fields
   for i := 1 to ::nNumFields

      do case
      case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_STRING_TYPE     .OR.;
           ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_VAR_STRING_TYPE .OR.;
           ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_BLOB_TYPE       .OR.;
           ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DATETIME_TYPE
         aRow[i] := ""

      case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_SHORT_TYPE      .OR.;
           ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_LONG_TYPE .OR.;
           ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_LONGLONG_TYPE .OR.;
           ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_INT24_TYPE .OR. ;
           ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DECIMAL_TYPE
         aRow[i] := 0

      case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_TINY_TYPE
         aRow[i] := .F.

      case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE     .OR.;
           ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE
         aRow[i] := 0.0

      case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DATE_TYPE
         aRow[i] := hb_SToD("")

      otherwise
         aRow[i] := nil

      endcase
   next

   //DAVID:
   if lSetValues   //Assign values as current row values
      for i := 1 to ::nNumFields
            ::FieldPut(i, aRow[i])
            ::aOldValue[i] := aRow[i]
      next
   endif

return TMySQLRow():New(aRow, ::aFieldStruct, ::cTable, .F.)
tmysql.prg1175
TMYSQLTABLE:METHODFieldPut(cnField, Value) CLASS TMySQLTable
METHOD FieldPut(cnField, Value) CLASS TMySQLTable

   local nNum

   if ValType(cnField) == "C"
      nNum := ::FieldPos(cnField)
   else
      nNum := cnField
   endif

   if nNum > 0 .AND. nNum <= ::nNumFields

//DAVID:      if Valtype(Value) == Valtype(::FieldGet(nNum)) .OR. Empty(::Fieldget(nNum))
      if Valtype(Value) == Valtype(::aRow[nNum]) .OR. ::aRow[nNum]==NIL

         // if it is a char field remove trailing spaces
         if ValType(Value) == "C"
            Value := RTrim(Value)
         endif

         //DAVID:
         ::aRow[ nNum ] := Value
         if ::lFieldAsData
            __objsetValueList(Self,{{::aFieldStruct[nNum][MYSQL_FS_NAME],Value}})
         endif

         return Value
      endif
   endif

return nil
tmysql.prg1227
TMYSQLTABLE:METHODRefresh() CLASS TMySQLTABLE
METHOD Refresh() CLASS TMySQLTABLE

   local rc

   // free present result handle
   sqlFreeR(::nResultHandle)

   ::lError := .F.

   if (rc := sqlQuery(::nSocket, ::cQuery)) == 0

      // save result set
      ::nResultHandle := sqlStoreR(::nSocket)
      ::nNumRows := sqlNRows(::nResultHandle)

      // NOTE: I presume that number of fields doesn't change (that is nobody alters this table) between
      // successive refreshes of the same

      // But row number could very well change
      if ::nCurRow > ::nNumRows
         ::nCurRow := ::nNumRows
      endif

      ::getRow(::nCurRow)

   else
/*      ::aFieldStruct := {}
      ::nResultHandle := nil
      ::nNumFields := 0
      ::nNumRows := 0

      ::aOldValue:={}
      */
      ::lError := .T.
   endif

return !::lError
tmysql.prg1260
TMYSQLTABLE:METHODMakePrimaryKeyWhere() CLASS TMySQLTable
METHOD MakePrimaryKeyWhere() CLASS TMySQLTable

   local ni, cWhere := " WHERE "

   for nI := 1 to Len(::aFieldStruct)

      // search for fields part of a primary key
      if (sqlAND(::aFieldStruct[nI][MYSQL_FS_FLAGS], PRI_KEY_FLAG) == PRI_KEY_FLAG) .OR.;
         (sqlAND(::aFieldStruct[nI][MYSQL_FS_FLAGS], MULTIPLE_KEY_FLAG) == MULTIPLE_KEY_FLAG)

         cWhere += ::aFieldStruct[nI][MYSQL_FS_NAME] + "="

         // if a part of a primary key has been changed, use original value

            cWhere += ClipValue2SQL(::aOldValue[nI])


         cWhere += " AND "
      endif

   next

   // remove last " AND "
   cWhere := Left(cWhere, Len(cWhere) - 5)

return cWhere
tmysql.prg1300
CLASSTMySQLServer
CLASS TMySQLServer

   DATA  nSocket                 // connection handle to server (currently pointer to a MYSQL structure)
   DATA  cServer                 // server name
   DATA  cDBName                 // Selected DB
   DATA  cUser                   // user accessing db
   DATA  cPassword               // his/her password
   DATA  lError                  // .T. if occurred an error
   DATA  cCreateQuery

   METHOD   New(cServer, cUser, cPassword)   // Opens connection to a server, returns a server object
   METHOD   Destroy()                        // Closes connection to server

   METHOD   SelectDB(cDBName)    // Which data base I will use for subsequent queries

   METHOD   CreateTable(cTable, aStruct,cPrimaryKey,cUniqueKey,cAuto)  // Create new table using the same syntax of dbCreate()
   METHOD   DeleteTable(cTable)           // delete table
   METHOD   TableStruct(cTable)           // returns a structure array compatible with clipper's dbStruct() ones
   METHOD   CreateIndex(cName, cTable, aFNames, lUnique) // Create an index (unique) on field name(s) passed as an array of strings aFNames
   METHOD   DeleteIndex(cName, cTable)                   // Delete index cName from cTable

   METHOD   ListDBs()            // returns an array with list of data bases available
   METHOD   ListTables()         // returns an array with list of available tables in current database

   METHOD   Query(cQuery)        // Gets a textual query and returns a TMySQLQuery or TMySQLTable object
tmysql.prg1332
TMYSQLSERVER:METHODNetErr()
   METHOD   NetErr() INLINE ::lError         // Returns .T. if something went wrong
   METHOD   Error()                          // Returns textual description of last error
   METHOD   CreateDatabase( cDataBase )      // Create an New Mysql Database
//Mitja
   METHOD   sql_Commit()      // Commits transaction
   METHOD   sql_Rollback()    // Rollbacks transaction
   METHOD   sql_Version()     // server version as numeric
ENDCLASS
tmysql.prg1358
TMYSQLSERVER:METHODNew(cServer, cUser, cPassword) CLASS TMySQLServer
METHOD New(cServer, cUser, cPassword) CLASS TMySQLServer

   ::cServer := cServer
   ::cUser := cUser
   ::cPassword := cPassword
   ::nSocket := sqlConnect(cServer, cUser, cPassword)
   ::lError := .F.

   if Empty( ::nSocket )
      ::lError := .T.
   endif

return Self
tmysql.prg1368
TMYSQLSERVER:METHODDestroy() CLASS TMySQLServer
METHOD Destroy() CLASS TMySQLServer
   sqlClose(::nSocket)
return Self
tmysql.prg1384
TMYSQLSERVER:METHODsql_commit() CLASS TMySQLServer
METHOD sql_commit() CLASS TMySQLServer
  if sqlCommit(::nSocket) == 0
    Return .T.
  endif
return .F.
tmysql.prg1390
TMYSQLSERVER:METHODsql_rollback() CLASS TMySQLServer
METHOD sql_rollback() CLASS TMySQLServer
  if sqlRollback(::nSocket) == 0
    Return .T.
  endif
return .F.
tmysql.prg1398
TMYSQLSERVER:METHODsql_version() CLASS TMySQLServer
METHOD sql_version() CLASS TMySQLServer
local nVer
  nVer:=sqlversion(::nSocket)
return nVer



*METHOD SelectDB(cDBName) CLASS TMySQLServer
*
*   if sqlSelectD(::nSocket, cDBName) == 0
*      ::cDBName := cDBName
*      return .T.
*   else
*      ::cDBName := ""
*   endif
*
*return .F.


*****************alterado
tmysql.prg1405
TMYSQLSERVER:METHODSelectDB(cDBName) CLASS TMySQLServer
METHOD SelectDB(cDBName) CLASS TMySQLServer

   ::lError := .F.

   if sqlSelectD(::nSocket, cDBName) != 0     && tabela nao existe
      ::cDBName :=""
      ::lError := .T.
   else                                       && tabela existe
      ::cDBName :=cDBName
      ::lError := .F.
      return .T.
   endif

return .F.
tmysql.prg1425
TMYSQLSERVER:METHODCreateDatabase ( cDataBase ) CLASS TMySQLServer
METHOD CreateDatabase ( cDataBase ) CLASS TMySQLServer
   local cCreateQuery := "CREATE DATABASE "+ lower(cDatabase)

   if sqlQuery(::nSocket, cCreateQuery) == 0
      return .T.
   endif

return .F.
tmysql.prg1441
TMYSQLSERVER:METHODCreateTable(cTable, aStruct,cPrimaryKey,cUniqueKey,cAuto) CLASS TMySQLServer
METHOD CreateTable(cTable, aStruct,cPrimaryKey,cUniqueKey,cAuto) CLASS TMySQLServer

   /* NOTE: all table names are created with lower case */

   local i

   // returns NOT NULL if extended structure has DBS_NOTNULL field to true
   local cNN := {|aArr| iif(Len(aArr) > DBS_DEC, iif(aArr[DBS_NOTNULL], " NOT NULL ", ""), "")}
   ::cCreateQuery := "CREATE TABLE " + Lower(cTable) + " ("
   for i := 1 to Len(aStruct)
      do case
      case aStruct[i][DBS_TYPE] == "C"
         ::cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")" + Eval(cNN, aStruct[i])+ iif(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ ","

      case aStruct[i][DBS_TYPE] == "M"
         ::cCreateQuery += aStruct[i][DBS_NAME] + " text" + Eval(cNN, aStruct[i]) + ","

      case aStruct[i][DBS_TYPE] == "N"
         /*
         if aStruct[i][DBS_DEC] == 0
            ::cCreateQuery += aStruct[i][DBS_NAME] + " int(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")" + Eval(cNN, aStruct[i]) + iif(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ iif(aStruct[i][DBS_NAME]==cAuto," auto_increment ",'' ) + ","
         else
            ::cCreateQuery += aStruct[i][DBS_NAME] + " real(" + AllTrim(Str(aStruct[i][DBS_LEN])) + "," + AllTrim(Str(aStruct[i][DBS_DEC])) + ")" + Eval(cNN, aStruct[i]) + ","
         endif
         */
         if (aStruct[i][DBS_DEC] == 0) .and. (aStruct[i][DBS_LEN] <= 18)
            do case
               case (aStruct[i][DBS_LEN] <= 4)
                  ::cCreateQuery += aStruct[i][DBS_NAME] + " smallint(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
               case (aStruct[i][DBS_LEN] <= 6)
                  ::cCreateQuery += aStruct[i][DBS_NAME] + " mediumint(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
               case (aStruct[i][DBS_LEN] <= 9)
                  ::cCreateQuery += aStruct[i][DBS_NAME] + " int(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
               otherwise
                  ::cCreateQuery += aStruct[i][DBS_NAME] + " bigint(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
            endcase
            ::cCreateQuery += Eval(cNN, aStruct[i]) + iif(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ iif(aStruct[i][DBS_NAME]==cAuto," auto_increment ",'' ) + ","
         else
            ::cCreateQuery += aStruct[i][DBS_NAME] + " real(" + AllTrim(Str(aStruct[i][DBS_LEN])) + "," + AllTrim(Str(aStruct[i][DBS_DEC])) + ")" + Eval(cNN, aStruct[i]) + ","
         endif
      case aStruct[i][DBS_TYPE] == "D"
         ::cCreateQuery += aStruct[i][DBS_NAME] + " date " + Eval(cNN, aStruct[i]) + ","

      case aStruct[i][DBS_TYPE] == "L"
         ::cCreateQuery += aStruct[i][DBS_NAME] + " tinyint "  + Eval(cNN, aStruct[i]) + ","

      case aStruct[i][DBS_TYPE] == "B"
         ::cCreateQuery += aStruct[i][DBS_NAME] + " mediumblob "  + Eval(cNN, aStruct[i]) + ","

      case aStruct[i][DBS_TYPE] == "I"
         ::cCreateQuery += aStruct[i][DBS_NAME] + " mediumint " + Eval(cNN, aStruct[i]) + ","

      otherwise
         ::cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")" + Eval(cNN, aStruct[i]) + ","

      endcase

   next
   if cPrimarykey != NIL
        ::cCreateQuery += ' PRIMARY KEY ('+cPrimaryKey+'),'
   endif
   if cUniquekey != NIL
        ::cCreateQuery += ' UNIQUE '+cUniquekey +' ('+cUniqueKey+'),'
   endif

   // remove last comma from list
   ::cCreateQuery := Left(::cCreateQuery, Len(::cCreateQuery) -1) + ");"
   if sqlQuery(::nSocket, ::cCreateQuery) == 0
      return .T.
   else
      ::lError := .T.
   endif

return .F.
tmysql.prg1454
TMYSQLSERVER:METHODCreateIndex(cName, cTable, aFNames, lUnique) CLASS TMySQLServer
METHOD CreateIndex(cName, cTable, aFNames, lUnique) CLASS TMySQLServer

   local cCreateQuery := "CREATE "
   local i

   default lUnique to .F.

   if lUnique
      cCreateQuery += "UNIQUE INDEX "
   else
      cCreateQuery += "INDEX "
   endif

   cCreateQuery += cName + " ON " + Lower(cTable) + " ("

   for i := 1 to Len(aFNames)
      cCreateQuery += aFNames[i] + ","
   next

   // remove last comma from list
   cCreateQuery := Left(cCreateQuery, Len(cCreateQuery) -1) + ")"

   if sqlQuery(::nSocket, cCreateQuery) == 0
      return .T.

   endif

return .F.
tmysql.prg1530
TMYSQLSERVER:METHODDeleteIndex(cName, cTable) CLASS TMySQLServer
METHOD DeleteIndex(cName, cTable) CLASS TMySQLServer

   local cDropQuery := "DROP INDEX " + cName + " FROM " + Lower(cTable)

   if sqlQuery(::nSocket, cDropQuery) == 0
      return .T.
   endif

return .F.
tmysql.prg1560
TMYSQLSERVER:METHODDeleteTable(cTable) CLASS TMySQLServer
METHOD DeleteTable(cTable) CLASS TMySQLServer

   local cDropQuery := "DROP TABLE " + Lower(cTable)

   if sqlQuery(::nSocket, cDropQuery) == 0
      return .T.

   endif

return .F.
tmysql.prg1571
TMYSQLSERVER:METHODQuery(cQuery) CLASS TMySQLServer
METHOD Query(cQuery) CLASS TMySQLServer

   local oQuery, cTableName, i, cUpperQuery, nNumTables, cToken

   default cQuery to ""


   cUpperQuery := Upper(AllTrim(cQuery))
   i := 1
   nNumTables := 1

   while !( (cToken := __StrToken(cUpperQuery, i++, " ")) == "FROM" ) .AND. !Empty(cToken)
   enddo

   // first token after "FROM" is a table name
   // NOTE: SubSelects ?
   cTableName := __StrToken(cUpperQuery, i++, " ")

   while !( (cToken := __StrToken(cUpperQuery, i++, " ")) == "WHERE" ) .AND. !Empty(cToken)
      // do we have more than one table referenced ?
      if cToken == "," .OR. cToken == "JOIN"
         nNumTables++
      endif
   enddo

   if nNumTables == 1
      oQuery := TMySQLTable():New(::nSocket, cQuery, cTableName)
   else
      oQuery := TMySQLQuery():New(::nSocket, cQuery)
   endif

   if oQuery:NetErr()
      ::lError := .T.
   endif

return oQuery
tmysql.prg1583
TMYSQLSERVER:METHODError() CLASS TMySQLServer
METHOD Error() CLASS TMySQLServer

   ::lError := .F.

return iif(Empty( ::nSocket ), "No connection to server", sqlGetErr(::nSocket))
tmysql.prg1621
TMYSQLSERVER:METHODListDBs() CLASS TMySQLServer
METHOD ListDBs() CLASS TMySQLServer

   local aList

   aList := sqlListDB(::nSocket)

return aList
tmysql.prg1628
TMYSQLSERVER:METHODListTables() CLASS TMySQLServer
METHOD ListTables() CLASS TMySQLServer

   local aList

   aList := sqlListTbl(::nSocket)

return aList
tmysql.prg1637
TMYSQLSERVER:METHODTableStruct(cTable) CLASS TMySQLServer
METHOD TableStruct(cTable) CLASS TMySQLServer

   local aStruct := {}

   HB_SYMBOL_UNUSED( cTable )

   /* TODO: rewrite for MySQL
   local nRes, aField, aStruct, aSField, i

   aStruct := {}
   nRes := sqlListF(::nSocket, cTable)

   if !Empty( nRes )
      for i := 1 to sqlNumFi(nRes)

         aField := sqlFetchF(nRes)
         aSField := Array(DBS_DEC)

         // don't count indexes as real fields
         if aField[MSQL_FS_TYPE] <= MSQL_LAST_REAL_TYPE

            aSField[DBS_NAME] := Left(aField[MSQL_FS_NAME], 10)
            aSField[DBS_DEC] := 0

            do case
            case aField[MSQL_FS_TYPE] == MSQL_INT_TYPE
               aSField[DBS_TYPE] := "N"
               aSField[DBS_LEN] := 11

            case aField[MSQL_FS_TYPE] == MSQL_UINT_TYPE
               aSField[DBS_TYPE] := "L"
               aSField[DBS_LEN] := 1

            case aField[MSQL_FS_TYPE] == MSQL_CHAR_TYPE
               aSField[DBS_TYPE] := "C"
               aSField[DBS_LEN] := aField[MSQL_FS_LENGTH]

            case aField[MSQL_FS_TYPE] == MSQL_DATE_TYPE
               aSField[DBS_TYPE] := "D"
               aSField[DBS_LEN] := aField[MSQL_FS_LENGTH]

            case aField[MSQL_FS_TYPE] == MSQL_REAL_TYPE
               aSField[DBS_TYPE] := "N"
               aSField[DBS_LEN] := 12
               aSFIeld[DBS_DEC] := 8

            case aField[MSQL_FS_TYPE] == MYSQL_MEDIUM_BLOB_TYPE
               aSField[DBS_TYPE] := "B"
               aSField[DBS_LEN] := aField[MSQL_FS_LENGTH]

            case aField[MSQL_FS_TYPE] == FIELD_TYPE_INT24
               aSField[DBS_TYPE] := "I"
               aSField[DBS_LEN] := aField[MSQL_FS_LENGTH]
               aSFIeld[DBS_DEC] := aField[MYSQL_FS_DECIMALS]
            otherwise

            endcase

            AAdd(aStruct, aSField)
         endif
      next

      sqlFreeR(nRes)

   endif*/

return aStruct
tmysql.prg1647
STATIC FUNCTIONClipValue2SQL(Value)
static function ClipValue2SQL(Value)

   local cValue

   do case
      case Valtype(Value) == "N"
         cValue := AllTrim(Str(Value))

      case Valtype(Value) == "D"
         if !Empty(Value)
            // MySQL dates are like YYYY-MM-DD
            cValue := "'"+StrZero(Year(Value), 4) + "-" + StrZero(Month(Value), 2) + "-" + StrZero(Day(Value), 2) + "'"
         else
            cValue := "''"
         endif

      case Valtype(Value) $ "CM"
         IF Empty( Value)
            cValue="''"
         ELSE
            cValue := "'"
            Value:=DATATOSQL(value)
            cValue+= value+ "'"
         ENDIF

      case Valtype(Value) == "L"
         cValue := AllTrim(Str(iif(Value == .F., 0, 1)))

      otherwise
         cValue := "''"       // NOTE: Here we lose values we cannot convert

   endcase

return cValue
tmysql.prg1717
tsqlbrw.prg
TypeFunctionSourceLine
CLASSTBColumnSQL from TBColumn
CLASS TBColumnSQL from TBColumn

   DATA  oBrw                 // pointer to Browser containing this column, needed to be able to
                              // retreive field values from Browse instance variable oCurRow
   //DATA  Picture              // From clipper 5.3
   DATA  nFieldNum            // This column maps field num from query

   MESSAGE  Block METHOD Block()          // When evaluating code block to get data from source this method
                                          // gets called. I need this since inside TBColumn Block I cannot
                                          // reference Column or Browser instance variables

   METHOD   New(cHeading, bBlock, oBrw)   // Saves inside column a copy of container browser

ENDCLASS
tsqlbrw.prg77
TBCOLUMNSQL:METHODNew(cHeading, bBlock, oBrw) CLASS TBColumnSQL
METHOD New(cHeading, bBlock, oBrw) CLASS TBColumnSQL

   super:New(cHeading, bBlock)
   ::oBrw := oBrw

return Self
tsqlbrw.prg93
TBCOLUMNSQL:METHODBlock() CLASS TBColumnSQL
METHOD Block() CLASS TBColumnSQL

   local xValue := ::oBrw:oCurRow:FieldGet(::nFieldNum)
   local xType := ::oBrw:oCurRow:FieldType(::nFieldNum)

   do case
      case xType == "N"
         xValue := "'"+Str(xValue, ::oBrw:oCurRow:FieldLen(::nFieldNum), ::oBrw:oCurRow:FieldDec(::nFieldNum))+"'"

      case xType == "D"
         xValue :=  "'" + DToC(xValue) + "'"

      case xType == "L"
         xValue := iif(xValue, ".T.", ".F.")

      case xType == "C"
         // Chr(34) is a double quote
         // That is: if there is a double quote inside text substitute it with a string
         // which gets converted back to a double quote by macro operator. If not it would
         // give an error because of unbalanced double quotes.
         xValue := Chr(34) + StrTran(xValue, Chr(34), Chr(34) + "+Chr(34)+" + Chr(34)) + Chr(34)

      case xType == "M"
         xValue := "'  '"

      otherwise
        xValue := "'"+xValue+"'"
   endcase

return &("{||" + xValue + "}")


tsqlbrw.prg101
CLASSTBrowseSQL from TBrowse
CLASS TBrowseSQL from TBrowse

   DATA     oCurRow                       // Active row inside table / sql query
   DATA     oQuery                        // Query / table object which we are browsing

   METHOD   New(nTop, nLeft, nBottom, nRight, oServer, oQuery, cTable)

   METHOD   EditField()                   // Editing of hilighted field, after editing does an update of
                                          // corresponding row inside table

   METHOD   BrowseTable(lCanEdit, aExitKeys) // Handles standard moving inside table and if lCanEdit == .T.
                                             // allows editing of field. It is the stock ApplyKey() moved inside a table
                                             // if lCanEdit K_DEL deletes current row
                                             // When a key is pressed which is present inside aExitKeys it leaves editing loop

   METHOD   KeyboardHook(nKey)            // Where do all unknown keys go?

ENDCLASS
tsqlbrw.prg140
TBROWSESQL:METHODNew(nTop, nLeft, nBottom, nRight, oServer, oQuery, cTable) CLASS TBrowseSQL
METHOD New(nTop, nLeft, nBottom, nRight, oServer, oQuery, cTable) CLASS TBrowseSQL

   local i, oCol

   HB_SYMBOL_UNUSED( oServer )
   HB_SYMBOL_UNUSED( cTable )

   super:New(nTop, nLeft, nBottom, nRight)

   ::oQuery := oQuery

   // Let's get a row to build needed columns
   ::oCurRow := ::oQuery:GetRow(1)

   // positioning blocks
   ::SkipBlock := {|n| ::oCurRow := Skipper(@n, ::oQuery), n }
   ::GoBottomBlock := {|| ::oCurRow := ::oQuery:GetRow(::oQuery:LastRec()), 1 }
   ::GoTopBlock := {|| ::oCurRow := ::oQuery:GetRow(1), 1 }

   // Add a column for each field
   for i := 1 to ::oQuery:FCount()

      // No bBlock now since New() would use it to find column length, but column is not ready yet at this point
      oCol := TBColumnSQL():New(::oCurRow:FieldName(i),, Self)

      if !( ::oCurRow:FieldType(i) == "M" )
         oCol:Width := Max(::oCurRow:FieldLen(i), Len(oCol:Heading))
      else
         oCol:Width := 10
      endif

      // which field does this column display
      oCol:nFieldNum := i

      // Add a picture
      do case
         case ::oCurRow:FieldType(i) == "N"
            oCol:picture := replicate("9", oCol:Width)

         case ::oCurRow:FieldType(i) $ "CM"
            oCol:picture := replicate("!", oCol:Width)
      endcase

      ::AddColumn(oCol)
   next

return Self
tsqlbrw.prg160
STATIC FUNCTIONSkipper(nSkip, oQuery)
static function Skipper(nSkip, oQuery)

   local    i := 0

   do case
   case (nSkip == 0 .OR. oQuery:LastRec() == 0)
      oQuery:Skip(0)

   case (nSkip > 0)
      while ( i < nSkip )           // Skip Foward

         //DAVID: change in TMySQLquery:eof() definition  if oQuery:eof()
         if oQuery:recno() == oQuery:lastrec()
            exit
         endif
         oQuery:Skip(1)
         i++

      enddo

   case ( nSkip < 0 )
      while ( i > nSkip )           // Skip backward

         //DAVID: change in TMySQLquery:bof() definition  if oQuery:bof()
         if oQuery:recno() == 1
            exit
         endif

         oQuery:Skip(-1)
         i--

      enddo
   endcase

   nSkip := i

return oQuery:GetRow(oQuery:RecNo())
tsqlbrw.prg209
TBROWSESQL:METHODEditField() CLASS TBrowseSQL
METHOD EditField() CLASS TBrowseSQL

   local oCol
   local aGetList
   local nKey
   local cMemoBuff, cMemo

   // Get the current column object from the browse
   oCol := ::getColumn(::colPos)

   // Editing of a memo field requires a MemoEdit() window
   if ::oCurRow:FieldType(oCol:nFieldNum) == "M"

      /* save, clear, and frame window for memoedit */
      cMemoBuff := SaveScreen(10, 10, 22, 69)

      Scroll(10, 10, 22, 69, 0)
      DispBox(10, 10, 22, 69)

      /* use fieldspec for title */
      //@ 10,((76 - Len(::oCurRow:FieldName(oCol:nFieldNum)) / 2) SAY "  " + (::oCurRow:FieldName(oCol:nFieldNum)) + "  "

      /* edit the memo field */
      cMemo := MemoEdit(::oCurRow:FieldGet(oCol:nFieldNum), 11, 11, 21, 68, .T.)

      if Lastkey() == K_CTRL_END
         ::oCurRow:FieldPut(oCol:nFieldNum, cMemo)

         /* NOTE: To do in a better way */
         if !::oQuery:Update(::oCurRow)
            Alert(Left(::oQuery:Error(), 60))
         endif
      endif

      RestScreen(10, 10, 22, 69, cMemoBuff)

   else
      // Create a corresponding GET
      // NOTE: I need to use ::oCurRow:FieldPut(...) when changing values since message redirection doesn't work at present
      //       time for write access to instance variables but only for reading them
      aGetList := { getnew( row(), col(),    ;
                           {|xValue| iif(xValue == nil, Eval(oCol:Block), ::oCurRow:FieldPut(oCol:nFieldNum, xValue))} ,;
                           oCol:heading,     ;
                           oCol:picture,     ;
                           ::colorSpec ) }

      // Set initial cursor shape
      //setcursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) )
      ReadModal(aGetList)
      //setcursor( SC_NONE )

      /* NOTE: To do in a better way */
      if !::oQuery:Update(::oCurRow)
         Alert(Left(::oQuery:Error(), 60))
      endif

   endif

   if !::oQuery:Refresh()
      Alert(::oQuery:Error())
   endif

   ::RefreshAll()

   // Check exit key from get
   nKey := LastKey()
   if nKey == K_UP   .or. nKey == K_DOWN .or. ;
      nKey == K_PGUP .or. nKey == K_PGDN

      // Ugh
      keyboard( chr( nKey ) )

   endif

RETURN Self
tsqlbrw.prg248
TBROWSESQL:METHODBrowseTable(lCanEdit, aExitKeys) CLASS TBrowseSQL
METHOD BrowseTable(lCanEdit, aExitKeys) CLASS TBrowseSQL

   local nKey
   local lKeepGoing := .T.

   default nKey      to nil
   default lCanEdit  to .F.
   default aExitKeys to {K_ESC}


   while lKeepGoing

      while !::Stabilize() .and. NextKey() == 0
      enddo

      nKey := Inkey(0)

      if AScan(aExitKeys, nKey) > 0
         lKeepGoing := .F.
         LOOP
      endif

      do case
         case nKey == K_DOWN
            ::down()

         case nKey == K_PGDN
            ::pageDown()

         case nKey == K_CTRL_PGDN
            ::goBottom()

         case nKey == K_UP
            ::up()

         case nKey == K_PGUP
            ::pageUp()

         case nKey == K_CTRL_PGUP
            ::goTop()

         case nKey == K_RIGHT
            ::right()

         case nKey == K_LEFT
            ::left()

         case nKey == K_HOME
            ::home()

         case nKey == K_END
            ::end()

         case nKey == K_CTRL_LEFT
            ::panLeft()

         case nKey == K_CTRL_RIGHT
            ::panRight()

         case nKey == K_CTRL_HOME
            ::panHome()

         case nKey == K_CTRL_END
            ::panEnd()

         case nKey == K_RETURN .AND. lCanEdit
            ::EditField()

         /*case nKey == K_DEL
            if lCanEdit
               if ! ::oQuery:Delete(::oCurRow)
                  Alert("not deleted " + ::oQuery:Error())
               endif
               if !::oQuery:Refresh()
                  Alert(::oQuery:Error())
               endif

               ::inValidate()
               ::refreshAll():forceStable()
            endif*/

         otherwise
            ::KeyboardHook(nKey)

      endcase
   enddo

return Self
tsqlbrw.prg325
TBROWSESQL:METHODKeyboardHook(nKey) CLASS TBrowseSQL
METHOD KeyboardHook(nKey) CLASS TBrowseSQL

   HB_SYMBOL_UNUSED( nKey )

return Self
tsqlbrw.prg416

Page url: http://www.yourdomain.com/help/index.html?hbmysql.htm