Antonio, ¡estoy inquieto!

José Vicente Beltrán · Mon Jun 30, 2014 5:08 pm

Antonio,
Veo con cierta inquietud que nuestro barco se está decantando de manera muy clara por Harbour, y esto no sería malo si no fuera porque implicitamente está abandonando xHarbour. Espero estar equivocado, porque mi problema, y supongo que no soy el unico que lo tiene, es que algunos de mis programas mas veteranos y por tanto con un desarrollo mas complejo, con funciones muy especificas desarrolladas a lo largo de años (20 en algún caso) y que están funcionando muy bien bajo xHarbour 1.2.3 no es posible cambiarlos a Harbour, secillamente porque no compilan o lo hacen con muchos errores, lo que hace imposible el proceso de paso.
la diferencia ahora mismo entre Harbour y xHarbour es notable y en mi caso concreto insalvable porque no se puede reescribir una aplicación del tipo expuesto sin hacer pasar a los clientes por un nuevo proceso de pruebas superado ya hace mucho tiempo, y que para mas inri resulta que suelen ser los clientes mas importantes :cry:

Iniciar con Harbour 32/64 bits los nuevos programas está muy bien porque el mercado y las tendencias cambian, pero ¿que hacemos con los casos como el que acabo de exponer?, acaso ¿no habrá nuevas actualizaciones del compilador xHarbour?, ¿Como se le dice a determinados clientes que la aplicación que usan como centro de su sistema ya no va a cambiar al ritmo esperado?

Pues lo dicho, necesitaba exponer este pensamiento, asi que... ¡sigo inquieto!

Saludos

postinelli · Post by **postinelli** » Mon Jun 30, 2014 5:26 pm

José

Mi pequeña experiencia hizo que pasar de xHarbour a Harbour no sea nada. Literalmente nada o casi, sólo un par de lineas pero nada más. Me costó configurar el xEdit ( con el cual programo y compilo ) Una Vez hecho esto, fue sólo presionar un botón
Entiendo que mis programas no son complejos, pero tienen sus 10 años de desarrollo al menos y una vez compilado ningún error en funcionamiento. Tal vez si nos pasas tus errores entre todos salga la solución y tu paz para no estar tan inquieto.

Abrazo

Post by **Antonio Linares** » Mon Jun 30, 2014 5:31 pm

José Vicente,

No tienes por qué preocuparte, acabo de revisar el repositorio de xHarbour y sigue activo:

http://sourceforge.net/p/xharbour/code/HEAD/tree/trunk/xharbour/ChangeLog

Asi que si necesitas, por el motivo que sea, seguir trabajando con xHarbour puedes estar tranquilo. Y aqui, por supuesto, seguiremos dando soporte técnico siempre a xHarbour, porque nuestros usuarios son lo primero y jamás dejaríamos a nadie "tirado" :-)

Lo que si está claro es que Harbour ha superado ya con creces a xHarbour y de ahí que recomendemos a todos que migreis a Harbour.

Pero lo dicho, tienes todo nuestro soporte como siempre y a todos los usuarios que tengan que seguir con xHarbour :-)

Post by **karinha** » Mon Jun 30, 2014 5:46 pm

Maestro Antonio, una pregunta:

Se tengo FWH64 Bits, y recompilo las librerias de FiveWin 64 con el compilador de xHarbour 32 Bits, funciona normal ó no?

Gracias, saludos.

Post by **Antonio Linares** » Mon Jun 30, 2014 5:57 pm

João,

xHarbour no funciona en 64 bits que yo sepa, asi que lo que planteas no es posible :-(

Y además de eso, muchas funciones internas de xHarbour no tienen equivalencia en Harbour

José Vicente Beltrán · Mon Jun 30, 2014 5:58 pm

Está claro que el futuro, en estos momentos pasa por Harbour, pero os aseguro que el problema para mi es serio porque hablo de aplicaciones que interactuan con módulos escritos en delphi, Java, incluso VB en algún caso. (solo pensar en un traspaso a Harbour, se me baja la tensión), por cierto que gran parte de la integración con aplicaciones desarrolladas en delphi es gracias a los (tan denostados) indices NTX, solo quería dejar constancia de ello, y leer de Antonio lo que acabo de leer

, lo cual me apacigua la 'inquietud' de alguna forma

Gracias

Manuel Valdenebro · Post by **Manuel Valdenebro** » Mon Jun 30, 2014 7:31 pm

Jose Vicente,

Recientemente he pasado una aplicación importante desde xHarbour a Harbour. Logicamente, cualquier cambio trae complicaciones, en mi caso ha sido el tema de los Codepage. Pero una vez solucionado esto, el cambio de Harbour a xHarbour no ha sido demasiado complicado.

Yo sigo trabajando con xHarbour, pero he hecho pequeñas modificaciones en los módulos para hacerlos compatibles y compilo en xHarbour para los clientes y en Harbour para mi, para ir probando. Eso me va a permitir, por ejemplo, cuando los clientes exijan 64 bit, poder compatibilizar 32 bit y 64 bit sin mucho jaleo.

Soy receloso para los cambios, cuando la cosa funciona. Tarde tiempo en pasar de Clipper a FiveWin y de FW a FWH. Esta vez prefiero estar preparado.

José Vicente Beltrán · Mon Jun 30, 2014 7:41 pm

Hola Manuel,
Gracias por compartir tu experiencia, algo parecido he intentado yo, pero por el momento he sido derrotado en toda regla, de ahí "mi bajón", de todas formas tus palabras me animan a seguir intentando el "paso".

Saludos :shock:

Francisco Horta · Post by **Francisco Horta** » Wed Jul 02, 2014 4:44 pm

Foro,

Creo que algun dia llegare a migrar y ya lo he pensado, mi problema principal y que me preocupa, radica en que uso tmysql y veo que no esta en harbour.

Me diran que use tdolphin, se que no es mala la idea y si la usaria en nuevos desarrollos.

Pero, alguien ha podido adaptar tmysql de xHarbour para Harbour ?

Saludos

Post by **Antonio Linares** » Wed Jul 02, 2014 5:40 pm

Paco,

Tienes el código fuente de la Clase TMySQL ?

De ser asi, por favor publícalo aqui y te ayudamos a compilarlo con Harbour :-)

Francisco Horta · Post by **Francisco Horta** » Wed Jul 02, 2014 9:31 pm

Antonio,

Aqui la subo

Code: Select all | Expand


 /*
 * $Id: tmysql.prg 9279 2011-02-14 18:06:32Z druzus $
 */

 /*
 * Harbour Project source code:
 * MySQL DBMS classes.
 * These classes try to emulate clipper dbXXXX functions on a SQL query
 *
 * Copyright 2000 Maurilio Longo <maurilio.longo@libero.it>
 * www - http://www.harbour-project.org
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
 *
 * As a special exception, the Harbour Project gives permission for
 * additional uses of the text contained in its release of Harbour.
 *
 * The exception is that, if you link the Harbour libraries with other
 * files to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the Harbour library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the Harbour
 * Project under the name Harbour.  If you copy code from other
 * Harbour Project or Free Software Foundation releases into a copy of
 * Harbour, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for Harbour, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.
 *
 */

 /*
 2002-01-28 21:30 UTC+0100 Patrick Mast <email@patrickmast.com>
   * contrib/mysql/tmysql
     + Added DateTime field
     * Added more info on Alert message for Unknown type
     * Modified ClipValue2SQL() to process empty strings
 */

 /*
 2002-02-18 07:30 UTC+0100 Srdjan Dragojlovic <digikv@yahoo.com>
   * contrib/mysql/tmysql
     + Bug in GOTO Method
 */


#include "hbclass.ch"
#include "common.ch"
#include "dbstruct.ch"
#include "mysql.ch"



// Every single row of an answer
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

   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


METHOD New( aRow, aFStruct, cTableName ) CLASS TMySQLRow

   default cTableName to ""
   default aFStruct to {}

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

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

   AFill( ::aDirty, .F. )

return Self


METHOD FieldGet( cnField ) CLASS TMySQLRow

   local nNum

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

   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


METHOD FieldPut( cnField, Value ) CLASS TMySQLRow

   local nNum

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

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

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

         // 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


// Given a field name returns it's position
METHOD FieldPos( cFieldName ) CLASS TMySQLRow

   local cUpperName, nPos

   cUpperName := Upper( cFieldName )

   nPos := AScan( ::aFieldStruct, {| aItem | Upper( aItem[ MYSQL_FS_NAME ] ) == cUpperName } )

return nPos


// Returns name of field N
METHOD FieldName( nNum ) CLASS TMySQLRow

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

return ""


METHOD FieldLen(nNum) CLASS TMySQLRow

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

return 0


METHOD FieldDec( nNum ) CLASS TMySQLRow

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

return 0


METHOD FieldType( nNum ) CLASS TMySQLRow

   if nNum >= 1 .AND. nNum <= Len( ::aFieldStruct )
      Return SQL2ClipType( ::aFieldStruct[ nNum ][ MYSQL_FS_TYPE ] )
   endif

return "U"


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

   local cWhere := " WHERE ", aField

   for each aField in ::aFieldStruct

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

         cWhere += aField[ MYSQL_FS_NAME ] + "="

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

         cWhere += " AND "
      endif

   next

   // remove last " AND "
      if ( cWhere != " WHERE " )
      // remove last " AND "
      cWhere := Left( cWhere, Len( cWhere ) - 5 )
   else
      // sk
      cWhere = ""
   endif


return cWhere

/* ----------------------------------------------------------------------------------------*/

// Every single query submitted to MySQL server
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

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

   DATA  lError            // .T. if last operation failed

   DATA  loRow             // If return oRow in GetRow(),

   METHOD   New( nSocket, cQuery, loRow )  // New query object

   METHOD   Destroy()  INLINE sqlFreeR( ::nResultHandle ), Self
                                           // Free result handle and associated resources
   METHOD   End()      INLINE ::Destroy()

   METHOD   Refresh()                      // ReExecutes the query (cQuery) so that changes to table are visible

   METHOD   GetRow( nRow, loRow, lSkip )   // return Row n of answer

   METHOD   Skip( nRows )                  // Same as clipper ones

   METHOD   Bof()        INLINE ::lBof  // ::nCurRow == 1
   METHOD   Eof()        INLINE ::lEof  // ::nCurRow == ::nNumRows
   METHOD   RecNo()      INLINE ::nCurRow
   METHOD   LastRec()    INLINE ::nNumRows
   METHOD   GoTop()      INLINE ::GetRow( 1 )
   METHOD   GoBottom()   INLINE ::GetRow( ::nNumRows ) //-1 )
   METHOD   GoTo( nRow ) INLINE ::GetRow( nRow )

   METHOD   FCount()     INLINE ::nNumFields

   METHOD   NetErr()     INLINE ::lError      // Returns .T. if something went wrong

   METHOD   Error()      INLINE ::lError := .F., sqlGetErr(::nSocket)
                                              // Returns textual description of last error and clears ::lError

   METHOD   ErrorNo()    INLINE ::lError := .F., sqlGetErrNo(::nSocket)
                                              // Returns number 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

   METHOD   Locate( cFieldName, Value, bPartialKey, bSoftSeek )

   METHOD   RecCount()   INLINE ::nNumRows

   PROTECTED:

   DATA lEof
   DATA lBof

ENDCLASS


METHOD New( nSocket, cQuery, loRow ) CLASS TMySQLQuery

   local  aField, rc, bBlock

   Default loRow to .t.

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

   ::lError        := .F.
   ::aFieldStruct  := {}
   ::nCurRow       := 1
   ::nResultHandle := nil
   ::nNumFields    := 0
   ::nNumRows      := 0
   ::loRow         := loRow


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

      // save result set
      if ( ::nResultHandle := sqlStoreR( nSocket ) ) > 0

         ::nNumRows     := sqlNRows( ::nResultHandle )
         ::nNumFields   := sqlNumFi( ::nResultHandle )

         ::aFieldStruct := Array( ::nNumFields )
         ::aRow         := Array( ::nNumFields )

         if ::nNumRows > 0
            ::lEof      := .f.
            ::lBof      := .f.
         else
            ::lEof      := .t.
            ::lBof      := .t.
         endif

         for each aField in ::aFieldStruct

            aField := sqlFetchF( ::nResultHandle )

            bBlock := ArrayBlock( HB_EnumIndex() )

            __objAddInline( Self,     aField[ MYSQL_FS_NAME ], bBlock )
            __objAddInline( Self, "_"+aField[ MYSQL_FS_NAME ], bBlock )

         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
            ::lEof   := .t.
            ::lBof   := .t.
         else
            ::lError := .T.

         endif
      endif

   else
      ::lError := .T.

   endif

return Self


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
      ::lError := .T.

   endif

return !::lError


METHOD Skip( nRows ) CLASS TMySQLQuery
Local nOldrow := ::nCurRow
   // NOTE: MySQL row count starts from 0
   default nRows to 1

   if ::nNumRows > 0
      ::lBof := .f.
      ::lEof := .f.
   else
      ::lBof := .t.
      ::lEof := .t.
   endif

   if nRows == 0
      // No move

   elseif nRows < 0
      // Negative movement
      if (::nCurRow += nRows) < 1
         ::nCurRow := 0
         ::lBof    := .t.
      endif

   else
      // positive movement
      if (::nCurRow += nRows) > ::nNumRows
         ::nCurRow := ::nNumRows + 1
         ::lEof    := .t.
      endif

   endif

   ::getRow( ::nCurRow )

return ::nCurRow - nOldRow


// Get row n of a query and return it as a TMySQLRow object
METHOD GetRow( nRow, loRow, lSkip ) CLASS TMySQLQuery

   local cType, xField
//   local cDateFormat := Lower( Set( 4 ) )

   default loRow to ::loRow
   default nRow  to ::nCurRow
   default lSkip to .f.

   if ::nResultHandle <> NIL
      if lSkip
         nRow := ::nCurRow + 1
      endif

      do case
      case ::nNumRows == 0
         ::lBof    := .t.
         ::lEof    := .t.
         ::nCurRow := 1
      case nRow < 1
         ::lBof    := .t.
         ::lEof    := .t.
         ::nCurRow := ::nNumRows + 1
      case nRow > 0 .and. nRow <= ::nNumRows //- 1
         ::lBof    := .f.
         ::lEof    := .f.
         ::nCurRow := nRow
      case nRow > ::nNumRows
         ::lBof    := .f.
         ::lEof    := .t.
         ::nCurRow := ::nNumRows + 1
      endcase
      nRow := ::nCurRow

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

         // NOTE: row count starts from 0
         sqlDataS( ::nResultHandle, nRow - 1 )
         ::nCurRow := nRow
         ::aRow := sqlFetchR( ::nResultHandle )

      elseif nRow == ::nNumRows + 1
         ::aRow := Array( Len( ::aFieldStruct ) )
         Afill( ::aRow, "" )

      else
         ::aRow := NIL
      endif


      if ::aRow <> NIL

         // Convert answer from text field to correct clipper types
         for each xField in ::aRow

            cType := SQL2ClipType( ::aFieldStruct[ HB_EnumIndex() ][ MYSQL_FS_TYPE ] )

            switch cType
               case "L"
                  xField := !( Val( xField ) == 0 )
                  exit

               case "N"
               case "I"
               case "T"
                  xField := Val( xField )
                  exit

               case "D"
                  if Empty(xField)
                     xField := CToD( "" )
/*
                  elseif cDateFormat = 'mm-dd-yyyy' // USA
                     xField := ctod(substr(xField,6,2)+"-"+right(xField,2,0)+ "-" + Left(xField, 4))

                  elseif  cDateFormat = 'dd/mm/yyyy' .or. cDateFormat = 'dd/mm/yy' // BRITISH ou FRENCH
                     xField :=  ctod(right(xField,2,0)+ "/"+ substr(xField,6,2)+"/"+ Left(xField, 4))

                  elseif cDateFormat = 'yyyy.mm.dd' // ANSI
                     xField := ctod(Left(xField, 4)+ "."+substr(xField,6,2)+"."+right(xField,2,0))

                  elseif cDateFormat = 'dd.mm.yyyy' //GERMAN
                     xField :=ctod(right(xField,2,0)+ "."+ substr(xField,6,2)+"."+ Left(xField, 4 ))

                  elseif cDateFormat = 'dd-mm-yyyy'  //ITALIAN
                     xField :=ctod(right(xField,2,0)+ "-"+ substr(xField,6,2)+"-"+ Left(xField, 4))

                  elseif cDateFormat = 'yyyy/mm/dd' //JAPAN
                     xField :=  ctod(Left(xField, 4)+ "/"+substr(xField,6,2)+"/"+right(xField,2,0))

                  elseif cDateFormat = 'mm/dd/yyyy' // AMERICAN
                     xField :=  ctod(substr(xField,6,2)+"/"+right(xField,2,0)+ "/" + Left(xField, 4))
                  else
                     xField := "''"
*/
                  else
                     // MySQL Date format YYYY-MM-DD
                     xField := SToD( Left( xField, 4 ) + substr( xField, 6, 2 ) + right( xField, 2 ) )
                  endif
                  exit

               case "C"
                  xField := PadR( xField , ::aFieldStruct[ HB_EnumIndex() ][ MYSQL_FS_LENGTH ] )
               case "M"
               case "B"
                  // Character or Memo field
                  exit

               default

//                  Alert("Unknown type from SQL Server Field: " + LTrim(Str(i))+" is type "+LTrim(Str(nType)))

            end

//            __objsetValuelist(Self,{{::aFieldStruct[i][MYSQL_FS_NAME],xField}})

         next

         if loRow
            Return TMySQLRow():New( ::aRow, ::aFieldStruct )
         endif

      endif

   endif

return nil


// Given a field name returns it's position
METHOD FieldPos( cFieldName ) CLASS TMySQLQuery

   local cUpperName, nPos := 0

   cUpperName := Upper( cFieldName )

   nPos := AScan( ::aFieldStruct, {| aItem | Upper( aItem[ MYSQL_FS_NAME ] ) == cUpperName } )

return nPos


// Returns name of field N
METHOD FieldName( nNum ) CLASS TMySQLQuery

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

return ""

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
//       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


METHOD FieldLen(nNum) CLASS TMySQLQuery

   if nNum > 0 .AND. nNum <= ::nNumFields
      return ::aFieldStruct[ nNum ][ MYSQL_FS_LENGTH ]
   endif

return 0


METHOD FieldDec( nNum ) CLASS TMySQLQuery

   if nNum > 0 .AND. nNum <= ::nNumFields
      return ::aFieldStruct[ nNum ][ MYSQL_FS_DECIMALS ]
   endif

return 0


METHOD FieldType( nNum ) CLASS TMySQLQuery

   local cType := "U"

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

      cType := SQL2ClipType( ::aFieldStruct[ nNum ][ MYSQL_FS_TYPE ] )

   endif

return cType


METHOD Locate( cFieldName, Value, bPartialKey, bSoftSeek ) CLASS TMySQLQuery
local nRecPrec := ::recno(), bFound := .F.

   //bSoftSeek cause the record pointer to be moved to the next record

   if bSoftSeek   == NIL ; bSoftSeek := .F. ; endif
   if bPartialKey == NIL ; bPartialKey := .T. ; endif

   ::gotop()
   while ! ::eof()
     bFound := (::FieldGet(::FieldPos(cFieldName)) == Value) .or. ((::FieldGet(::FieldPos(cFieldName)) = Value) .and. bPartialKey)

     if !bFound .and. ((::FieldGet(::FieldPos(cFieldName)) > Value) .and. bSoftSeek)
       bFound := .T.
     endif

     if bFound
       exit
     endif

     ::skip()
   enddo

   if !bFound
     ::goto(nRecPrec)
   endif

return bFound



/* ----------------------------------------------------------------------------------------*/

// A Table is a query without joins; this way I can Insert() e Delete() rows.
// NOTE: it's always a SELECT result, so it will contain a full table only if
//       SELECT * FROM ... was issued
CLASS TMySQLTable FROM TMySQLQuery

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

   METHOD   New( nSocket, cQuery, cTableName, loRow )
   METHOD   GetRow( nRow, loRow, lSkip )
   METHOD   Skip( nRow )

   METHOD   Update( oRow )                // Gets an oRow and updates changed fields
   METHOD   Save( oRow )   INLINE ::Update( oRow )
   METHOD   Delete( oRow )                // Deletes passed row from table
   METHOD   Append( oRow )                // Inserts passed row into table

   METHOD   GetBlankRow( loRow )          // Returns an empty row with all available fields empty
   METHOD   Blank( loRow ) INLINE ::GetBlankRow( loRow )

   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


METHOD New(nSocket, cQuery, cTableName, loRow) CLASS TMySQLTable

Local xValue

   super:New(nSocket, AllTrim(cQuery), loRow)

   ::cTable    := Lower(cTableName)
   ::aOldValue := Array( ::nNumFields )

   for each xValue in ::aOldValue
      xValue := ::fieldget( HB_EnumIndex() )
   next

return Self


METHOD GetRow( nRow, loRow, lSkip ) CLASS TMySQLTable

   local oRow := super:GetRow( nRow, loRow, lSkip ), xValue

   if oRow <> NIL
      oRow:cTable := ::cTable
   endif

   ::aOldvalue := Array( ::nNumFields )

   for each xValue in ::aOldValue
      xValue := ::fieldget( HB_EnumIndex() )
   next

return oRow


METHOD Skip(nRow) CLASS TMySQLTable
   Local xValue, nSkipRows

     nSkipRows := super:skip(nRow)

     for each xValue in ::aOldValue
        xValue := ::fieldget( HB_EnumIndex() )
     next

return nSkipRows


/* Creates an update query for changed fields and submits it to server */
METHOD Update( oRow,cWhere ) CLASS TMySQLTable

   local cUpdateQuery := "UPDATE " + ::cTable + " SET "
   local xValue

   ::lError := .F.


          // default Current row
   if oRow == nil

         for each xValue in ::aOldValue
            if xValue == NIL .or. xValue <> ::FieldGet( HB_EnumIndex() )
               cUpdateQuery += ::aFieldStruct[ HB_EnumIndex() ][MYSQL_FS_NAME] + "=" + ClipValue2SQL(::FieldGet( HB_EnumIndex() ),::FieldType( HB_EnumIndex() )) + ","
            endif
         next

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

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


         if ( cWhere != nil )
             cUpdateQuery += " WHERE " + cWhere
         else
             cUpdateQuery += ::MakePrimaryKeyWhere()
         endif


// alert( cUpdateQuery )

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

            ::refresh()
            for each xValue in ::aOldValue
               xValue := ::fieldget( HB_EnumIndex() )
            next

         else
            ::lError := .T.

         endif

   else

      WITH OBJECT oRow

         if :cTable == ::cTable

            for each xValue in :aRow
               if :aDirty[ HB_EnumIndex() ]
                  cUpdateQuery += :aFieldStruct[ HB_EnumIndex() ][ MYSQL_FS_NAME ] + "=" + ClipValue2SQL( :aRow[ HB_EnumIndex() ], :FieldType( HB_EnumIndex() ) ) + ","
               endif
            next

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

            cUpdateQuery += :MakePrimaryKeyWhere()

// alert( cUpdateQuery )

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

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

            else
               ::lError := .T.

            endif

         endif
      END  // WITH
   endif

return !::lError


METHOD Delete( oRow ) CLASS TMySQLTable

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

   // is this a row of this table ?

   if oRow == nil

         cDeleteQuery += ::MakePrimaryKeyWhere()

         if sqlQuery( ::nSocket, cDeleteQuery ) == 0
            ::lError := .F.
            // ::nCurRow--
            ::refresh()

            for each xValue in ::aOldValue
               xValue := ::fieldget( HB_EnumIndex() )
            next

         else
            ::lError := .T.

         endif

   else

      WITH OBJECT oRow
         if :cTable == ::cTable

            cDeleteQuery += :MakePrimaryKeyWhere()

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

            else
               ::lError := .T.

            endif

          endif
      END  // WITH
  Endif

return !::lError


// Adds a row with values passed into oRow
METHOD Append( oRow ) CLASS TMySQLTable

   local cInsertQuery := "INSERT INTO " + ::cTable + " ("
   local xValue, lResult:= .F.

           // default Current row
   if oRow == nil

            // field names
            for each xValue in ::aFieldStruct
               if xValue[ MYSQL_FS_FLAGS ] <> AUTO_INCREMENT_FLAG
                  cInsertQuery += xValue[ MYSQL_FS_NAME ] + ","
               endif
            next

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

            // field values
            for each xValue in ::aFieldStruct
               if xValue[ MYSQL_FS_FLAGS ] <> AUTO_INCREMENT_FLAG
                  cInsertQuery += ClipValue2SQL( ::FieldGet(HB_EnumIndex() ), ::FieldType(HB_EnumIndex()) ) + ","
               endif
            next

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

// alert( cInsertQuery )

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

               ::refresh()
               for each xValue in ::aOldValue
                  xValue := ::fieldget( HB_EnumIndex() )
               next
               lResult:= .T.
            else
               ::lError := .T.
            endif


   else

      WITH OBJECT oRow
         if :cTable == ::cTable

            // field names
            for each xValue in :aFieldStruct
               if xValue[ MYSQL_FS_FLAGS ] <> AUTO_INCREMENT_FLAG
                  cInsertQuery += xValue[ MYSQL_FS_NAME ] + ","
               endif
            next
            // remove last comma from list
            cInsertQuery := Left( cInsertQuery, Len( cInsertQuery ) - 1 ) + ") VALUES ("

            // field values
            for each xValue in :aRow
               if :aFieldStruct[ HB_EnumIndex() ][ MYSQL_FS_FLAGS ] <> AUTO_INCREMENT_FLAG
                  cInsertQuery += ClipValue2SQL( xValue, :FieldType(HB_EnumIndex()) ) + ","
               endif
            next

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

// alert( cInsertQuery )

            if sqlQuery( ::nSocket, cInsertQuery ) == 0
               lResult:= .T.
            else
               ::lError := .T.
            endif

         endif
      END  // WITH
   Endif
return lResult


METHOD GetBlankRow( loRow ) CLASS TMySQLTable

   local cType
   local xValue

   Default loRow to ::loRow

   for each xValue in ::aRow

      cType := SQL2ClipType( ::aFieldStruct[ HB_EnumIndex() ][ MYSQL_FS_TYPE ] )

      switch cType
      case "C"
         ::aOldValue[ HB_EnumIndex() ] := xValue := SPACE(::aFieldStruct[ HB_EnumIndex() ][ MYSQL_FS_LENGTH ])
         exit
      case "M"
      case "B"
         ::aOldValue[ HB_EnumIndex() ] := xValue := ""
         exit

      case "N"
      case "I"
         ::aOldValue[ HB_EnumIndex() ] := xValue := 0
         exit

      case "L"
         ::aOldValue[ HB_EnumIndex() ] := xValue := .F.
         exit

      case "D"
         ::aOldValue[ HB_EnumIndex() ] := xValue := CToD("")
         exit

      default
         ::aOldValue[ HB_EnumIndex() ] := xValue := nil

      end
   next


   if loRow
      return TMySQLRow():New( ::aRow, ::aFieldStruct, ::cTable )
   endif

return nil


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

//      if Valtype( Value ) == Valtype( ::FieldGet( nNum ) ) .OR. ::Fieldget( nNum ) == NIL )
      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

         ::aRow[ nNum ] := Value

         return Value
      endif
   endif

return nil

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
      ::lError := .T.

   endif

return !::lError


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

   local  cWhere := " WHERE ", aField

   for each aField in ::aFieldStruct

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

         cWhere += aField[ MYSQL_FS_NAME ] + "="

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

            cWhere += ClipValue2SQL( ::aOldValue[ HB_EnumIndex() ], ::FieldType(HB_EnumIndex()) )

         cWhere += " AND "
      endif

   next

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

return cWhere



/* ----------------------------------------------------------------------------------------*/

// Every available MySQL server
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  nPort
   DATA  nFlags
   DATA  cCreateQuery

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

   METHOD   Destroy()    INLINE sqlClose( ::nSocket ), Self
                                             // Closes connection to server

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

   METHOD   CreateDatabase( cDataBase )      // Create an New Mysql Database

   METHOD   ListDBs()            INLINE sqlListDB(::nSocket)
                                             // returns an array with list of data bases available

   METHOD   DBExist( cDB )       INLINE ( cDB IN ::ListDBs() )
                                             // return .T. if cTable exist in the database

   METHOD   CreateTable( cTable, aStruct, cPrimaryKey, cUniqueKey, cAuto)
                                             // Create new table using the same syntax of dbCreate()

   METHOD   DeleteTable( cTable )            // delete table

   METHOD   TableExist( cTable ) INLINE ( cTable IN ::ListTables() )
                                             // return .T. if cTable exist in the database

   METHOD   ListTables()         INLINE sqlListTbl(::nSocket)
                                             // returns an array with list of available tables in current database

   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   Query( cQuery, loRow )           // Gets a textual query and returns a TMySQLQuery or TMySQLTable object

   METHOD   NetErr()             INLINE ::lError
                                             // Returns .T. if something went wrong

   METHOD   Error()                          // Returns textual description of last error
   METHOD   RenameTable( old_cTable, new_cTable )  // rename table
ENDCLASS


METHOD New( cServer, cUser, cPassword, nPort, nFlags ) CLASS TMySQLServer

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

   if ::nSocket == 0
      ::lError := .T.
   endif

return Self


METHOD SelectDB( cDBName ) CLASS TMySQLServer

   ::lError := .F.

   if sqlSelectD( ::nSocket, cDBName ) != 0   // table not exist
      ::cDBName :=""
      ::lError  := .T.
   else                                       // table exist
      ::cDBName := cDBName
      ::lError  := .F.
      return .T.
   endif

return .F.



METHOD CreateDatabase ( cDataBase ) CLASS TMySQLServer
   local cCreateQuery := "CREATE DATABASE "+ lower( cDatabase )

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

return .F.


// NOTE: OS/2 port of MySQL is picky about table names, that is if you create a table with
// an upper case name you cannot alter it (for example) using a lower case name, this violates
// OS/2 case insensibility about names
METHOD CreateTable( cTable, aStruct, cPrimaryKey, cUniqueKey, cAuto ) CLASS TMySQLServer

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

   local aField

   // 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 each aField in aStruct

      switch aField[ DBS_TYPE ]
      case "C"
         ::cCreateQuery += aField[ DBS_NAME ] + " char(" + AllTrim(Str(aField[DBS_LEN])) + ")" + Eval(cNN, aField)+ if(aField[DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ ","
         exit

      case "M"
         ::cCreateQuery += aField[ DBS_NAME ] + " text" + Eval(cNN, aField) + ","
         exit

      case "N"

         if aField[ DBS_DEC ] == 0 .and. aField[ DBS_LEN ] <= 18

            do case
               case aField[ DBS_LEN ] <= 4
                  ::cCreateQuery += aField[ DBS_NAME ] + " smallint("  + AllTrim( Str( aField[ DBS_LEN ] ) ) + ")"

               case aField[ DBS_LEN ] <= 6
                  ::cCreateQuery += aField[ DBS_NAME ] + " mediumint(" + AllTrim( Str( aField[ DBS_LEN ] ) ) + ")"

               case aField[ DBS_LEN ] <= 9
                  ::cCreateQuery += aField[ DBS_NAME ] + " int("       + AllTrim( Str( aField[ DBS_LEN ] ) ) + ")"

               otherwise
                  ::cCreateQuery += aField[ DBS_NAME ] + " bigint("    + AllTrim( Str( aField[ DBS_LEN ] ) ) + ")"

            endcase

            ::cCreateQuery += Eval( cNN, aField ) + if( aField[ DBS_NAME ] == cPrimaryKey, " NOT NULL ", "" ) + if( aField[ DBS_NAME ] == cAuto, " auto_increment ", "" ) + ","

         else
            ::cCreateQuery += aField[ DBS_NAME ] + " real(" + AllTrim( Str( aField[ DBS_LEN ] ) ) + "," + AllTrim( Str( aField[ DBS_DEC ] ) ) + ")" + Eval( cNN, aField ) + ","

         endif
         exit

      case "D"
         ::cCreateQuery += aField[ DBS_NAME ] + " date " + Eval( cNN, aField ) + ","
         exit

      case "L"
         ::cCreateQuery += aField[ DBS_NAME ] + " tinyint " + Eval( cNN, aField ) + ","
         exit

      case "B"
         ::cCreateQuery += aField[ DBS_NAME ] + " mediumblob " + Eval( cNN, aField ) + ","
         exit

      case "I"
         ::cCreateQuery += aField[ DBS_NAME ] + " mediumint " + Eval( cNN, aField ) + ","
         exit

      case "T"
         ::cCreateQuery += aField[ DBS_NAME ] + " timestamp(" + AllTrim( Str( aField[ DBS_LEN ] ) ) + ")" + Eval( cNN, aField ) + ","
         exit

      default
         ::cCreateQuery += aField[ DBS_NAME ] + " char(" + AllTrim(Str(aField[DBS_LEN])) + ")" + Eval( cNN, aField ) + ","

      end

   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.


METHOD CreateIndex( cName, cTable, aFNames, lUnique ) CLASS TMySQLServer

   local cCreateQuery := "CREATE "
   local cField

   default lUnique to .F.

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

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

   for each cField in aFNames
      cCreateQuery += cField + ","
   next

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

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

return .F.


METHOD DeleteIndex( cName, cTable ) CLASS TMySQLServer

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

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

return .F.


METHOD DeleteTable( cTable ) CLASS TMySQLServer

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

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

   endif

return .F.


METHOD Query( cQuery, loRow ) 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, loRow )
   else
      oQuery := TMySQLQuery():New(::nSocket, cQuery, loRow )
   endif

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

return oQuery


METHOD Error() CLASS TMySQLServer

   ::lError := .F.

return iif(::nSocket > 0, sqlGetErr(::nSocket), "No connection to server")

METHOD RenameTable( old_cTable, new_cTable ) CLASS TMySQLServer
   local cDropQuery := "ALTER TABLE " + Lower( old_cTable)+" RENAME "+ Lower( new_cTable)
   if sqlQuery( ::nSocket, cDropQuery ) == 0
     return .T.
   endif
return .F.

/* TOFIX: Conversion creates a .dbf with fields of wrong dimension (often) */
METHOD TableStruct( cTable ) CLASS TMySQLServer

   local nRes, aField, aStruct, aSField, i


   aStruct := {}

   /* TODO: rewrite for MySQL */
   nRes := sqlListF( ::nSocket, cTable )

   if nRes > 0
      for i := 1 to sqlNumFi( nRes )

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

         // don't count indexes as real fields
//         if aField[ MYSQL_FS_TYPE ] <= MYSQL_LAST_REAL_TYPE

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

            asField[ DBS_TYPE ] :=  SQL2ClipType( aField[ MYSQL_FS_TYPE ] )

            switch aField[ MYSQL_FS_TYPE ]
            case MYSQL_TINY_TYPE
               aSField[ DBS_TYPE ] := "L"
               aSField[ DBS_LEN ]  := 1
               exit

            case MYSQL_SHORT_TYPE
               aSField[ DBS_TYPE ] := "N"
               aSField[ DBS_LEN ]  := Min( 6, aField[ MYSQL_FS_LENGTH ] )
               exit

            case MYSQL_INT24_TYPE
               aSField[ DBS_TYPE ] := "N"
               aSField[ DBS_LEN ]  := Min( 8, aField[ MYSQL_FS_LENGTH ] )
               exit

            case MYSQL_LONG_TYPE
               aSField[ DBS_TYPE ] := "N"
               aSField[ DBS_LEN ]  := Min( 11, aField[ MYSQL_FS_LENGTH ] )
               exit

            case MYSQL_LONGLONG_TYPE
               aSField[ DBS_TYPE ] := "N"
               aSField[ DBS_LEN ]  := Min( 20, aField[ MYSQL_FS_LENGTH ] )
               exit

            case MYSQL_FLOAT_TYPE
            case MYSQL_DOUBLE_TYPE
            case MYSQL_DECIMAL_TYPE
            case MYSQL_TYPE_NEWDECIMAL
               aSField[ DBS_TYPE ] := "N"
               aSField[ DBS_LEN ] := aField[ MYSQL_FS_LENGTH ]
               aSFIeld[ DBS_DEC ] := aField[ MYSQL_FS_DECIMALS ]
               exit

/*            case FIELD_TYPE_INT24
               aSField[ DBS_TYPE ] := "I"
               aSField[ DBS_LEN ] := aField[ MYSQL_FS_LENGTH ]
               aSFIeld[ DBS_DEC ] := aField[ MYSQL_FS_DECIMALS ]
               exit  */

            case MYSQL_STRING_TYPE
            case MYSQL_VAR_STRING_TYPE
            case MYSQL_DATETIME_TYPE
            case MYSQL_TIME_TYPE
               aSField[ DBS_TYPE ] := "C"
               aSField[ DBS_LEN ] := aField[ MYSQL_FS_LENGTH ]
               exit

            case MYSQL_DATE_TYPE
               aSField[ DBS_TYPE ] := "D"
               aSField[ DBS_LEN ] := 8
               exit

            case MYSQL_MEDIUM_BLOB_TYPE
               aSField[ DBS_TYPE ] := "B"
               aSField[ DBS_LEN ] := aField[ MYSQL_FS_LENGTH ]
               exit

            case MYSQL_BLOB_TYPE
               aSField[ DBS_TYPE ] := "M"
               aSField[ DBS_LEN ] := 10
               exit

            case MYSQL_TIMESTAMP_TYPE
               aSField[ DBS_TYPE ] := "N"
               aSField[ DBS_LEN ]  := aField[ MYSQL_FS_LENGTH ]
               exit

            default
               aSField[ DBS_TYPE ] := "C"
               aSField[ DBS_LEN ] := aField[ MYSQL_FS_LENGTH ]

            end

            AAdd( aStruct, aSField )
//         endif
      next

      sqlFreeR( nRes )

   endif

return aStruct


// Returns an SQL string with clipper value converted ie. Date() -> "'YYYY-MM-DD'"
static function ClipValue2SQL(Value, cType)

   local cValue := ""
//   local cDateFormat := Lower( Set( 4 ) )

   Default cType to ValType( Value )

   switch cType
      case "N"
      case "I"
         cValue := AllTrim( Str( Value ) )
         exit

      case "D"
         if !Empty( Value )
            // MySQL dates are like YYYY-MM-DD or YYYYMMDD
            cValue := "'" + Transform( Dtos( Value ), "@R 9999-99-99" ) + "'"
/*
            if cDateFormat == 'mm-dd-yyyy' // USA
               cValue := "'"+PadL(Month(Value), 2, "0") + '-'+ PadL(Day(Value), 2, "0") + "-" + Str(Year(Value), 4) + "'"
            elseif  cDateFormat == 'dd/mm/yyyy' // BRITISH ou FRENCH
               //cValue := "'"+PadL(Day(Value), 2, "0") + "/" + PadL(Month(Value), 2, "0") + "/" + Str(Year(Value), 4) + "'"
               cValue := "'"+Str(Year(Value), 4) + "-" + PadL(Month(Value), 2, "0") + "-" + PadL(Day(Value), 2, "0") + "'"
            elseif cDateFormat == 'yyyy.mm.dd' // ANSI
               cValue := "'"+Str(Year(Value), 4)  + "." + PadL(Month(Value), 2, "0") + "." + PadL(Day(Value), 2, "0") + "'"
            elseif cDateFormat == 'dd.mm.yyyy' //GERMAN
               cValue := "'"+PadL(Day(Value), 2, "0") + "." + PadL(Month(Value), 2, "0") + "." + Str(Year(Value), 4) +  "'"
            elseif cDateFormat == 'dd-mm-yyyy'  //ITALIAN
               cValue := "'"+PadL(Day(Value), 2, "0") + "-" + PadL(Month(Value), 2, "0") + "-" + Str(Year(Value), 4)  + "'"
            elseif cDateFormat == 'yyyy/mm/dd' //JAPAN
               cValue := "'"+Str(Year(Value), 4)  + "/" + PadL(Month(Value), 2, "0") + "/" + PadL(Day(Value), 2, "0") + "'"
            elseif cDateFormat == 'mm/dd/yyyy' // AMERICAN
               cValue := "'"+Str(Year(Value), 4)     + "/" + PadL(Month(Value), 2, "0") + "/" + PadL(Day(Value), 2, "0") + "'"
            endif
*/
         else
            cValue := "NULL"
         endif
         exit

      case "C"
      case "M"
      case "B"
         IF Empty( Value)
            cValue := "''"
         ELSE
            cValue := "'" + DATATOSQL( value ) + "'"
         ENDIF
         exit

      case "L"
         cValue := AllTrim( Str( iif(Value, 1, 0 ) ) )
         exit

      case "T"
         cValue := iif( Value < 0, "NULL", Alltrim( str( Value ) ) )
         exit

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

   end

return cValue


static function SQL2ClipType( nType )

   switch nType
      case MYSQL_TINY_TYPE
         Return "L"

      case MYSQL_SHORT_TYPE
      case MYSQL_LONG_TYPE
      case MYSQL_LONGLONG_TYPE
      case MYSQL_FLOAT_TYPE
      case MYSQL_DOUBLE_TYPE
      case MYSQL_DECIMAL_TYPE
      case MYSQL_TYPE_NEWDECIMAL
         Return "N"

      case MYSQL_DATE_TYPE
         Return "D"

      case MYSQL_BLOB_TYPE
         Return "M"

      case MYSQL_VAR_STRING_TYPE
      case MYSQL_STRING_TYPE
      case MYSQL_DATETIME_TYPE
      case MYSQL_TIME_TYPE
         Return "C"

      case MYSQL_INT24_TYPE
         Return "I"

      case MYSQL_MEDIUM_BLOB_TYPE
         Return "B"

      case MYSQL_TIMESTAMP_TYPE
         Return "T"

   end

Return "U"


/* Given a three letter month name gives back month number as two char string (ie. Apr -> 04) */
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")


static function ARRAYBLOCK( nIndex )
   Local bBlock

   bBlock := {|Self, x | iif( PCount() == 1, ::aRow[ nIndex ], ::aRow[ nIndex ] := x ) }

return bBlock

Gracias
Saludos

Post by **Antonio Linares** » Thu Jul 03, 2014 3:21 am

Paco,

Has intentado compilarlo con Harbour ? Añade ese PRG como uno más de tu aplicación

Francisco Horta · Post by **Francisco Horta** » Fri Jul 04, 2014 2:57 pm

Antonio

Voy a probarlo y comento

Saludos

Francisco Horta · Post by **Francisco Horta** » Thu Feb 19, 2015 11:06 pm

Pues retomando el tema despues de un rato, estoy tratando de crear la lib de la clase tmysql que uso en xharbour para usarla con harbour,

pero me tira estos errores, y pues la verdad no entiendo de .c y veo que es los wrappers de mysql.c

alguien que me pueda ayudar?

adjunto los errores y el codigo de mysql.c

Error E2451 mysql.c 160: Undefined symbol 'HB_ITEM' in function HB_FUN_SQLFETCHR
Error E2379 mysql.c 160: Statement missing ; in function HB_FUN_SQLFETCHR
Error E2451 mysql.c 161: Undefined symbol 'itRow' in function HB_FUN_SQLFETCHR
Error E2451 mysql.c 162: Undefined symbol 'itTemp' in function HB_FUN_SQLFETCHR
Error E2451 mysql.c 205: Undefined symbol 'HB_ITEM' in function HB_FUN_SQLFETCHF
Error E2379 mysql.c 205: Statement missing ; in function HB_FUN_SQLFETCHF
Error E2451 mysql.c 207: Undefined symbol 'itField' in function HB_FUN_SQLFETCHF
Error E2451 mysql.c 208: Undefined symbol 'itTemp' in function HB_FUN_SQLFETCHF
Error E2451 mysql.c 269: Undefined symbol 'HB_ITEM' in function HB_FUN_SQLLISTDB
Error E2379 mysql.c 269: Statement missing ; in function HB_FUN_SQLLISTDB
Error E2451 mysql.c 275: Undefined symbol 'itDBs' in function HB_FUN_SQLLISTDB
Error E2451 mysql.c 280: Undefined symbol 'itTemp' in function HB_FUN_SQLLISTDB
Error E2451 mysql.c 294: Undefined symbol 'HB_ITEM' in function HB_FUN_SQLLISTTBL
Error E2379 mysql.c 294: Statement missing ; in function HB_FUN_SQLLISTTBL
Error E2451 mysql.c 299: Undefined symbol 'itTables' in function HB_FUN_SQLLISTTBL
Error E2451 mysql.c 304: Undefined symbol 'itTemp' in function HB_FUN_SQLLISTTBL
Warning W8065 mysql.c 362: Call to function 'hb_retclenAdopt' with no prototype in function HB_FUN_DATATOSQL
Warning W8065 mysql.c 406: Call to function 'hb_retclenAdopt' with no prototype in function HB_FUN_FILETOSQLBINARY

Code: Select all | Expand


/*
 * $Id: mysql.c 9328 2011-02-27 17:07:05Z lculik $
 */

/*
 * Harbour Project source code:
 * MySQL DBMS low level (client api) interface code.
 *
 * Copyright 2000 Maurilio Longo <maurilio.longo@libero.it>
 * www - http://www.harbour-project.org
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
 *
 * As a special exception, the Harbour Project gives permission for
 * additional uses of the text contained in its release of Harbour.
 *
 * The exception is that, if you link the Harbour libraries with other
 * files to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the Harbour library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the Harbour
 * Project under the name Harbour.  If you copy code from other
 * Harbour Project or Free Software Foundation releases into a copy of
 * Harbour, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for Harbour, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.
 *
 */

/*
 * The following parts are Copyright of the individual authors.
 * www - http://www.harbour-project.org
 *
 * Copyright 2001 Luiz Rafael Culik <culik@sl.conex.net>
 *    DATATOSQL(),FILETOSQLBINARY()
 *
 * See doc/license.txt for licensing terms.
 *
 */


/* NOTE: we need this to prevent base types redefinition */
#define _CLIPDEFS_H
#if defined(HB_OS_WIN_USED) || defined(HB_OS_WIN_32_USED)
   #include <windows.h>
#endif

#include "hbapifs.h"
#include "extend.api"
#include "item.api"
#include "mysql.h"
#include <stdio.h>
#include <hb_io.h>
#include <fcntl.h>


/* NOTE: OS/2 EMX port of MySQL needs libmysqlclient.a from 3.21.33b build which has st and mt
   versions of client library. I'm using ST version since harbour is single threaded. You need
   also .h files from same distribution
*/

HB_FUNC(SQLCONNECT) // MYSQL *mysql_real_connect(MYSQL*, char * host, char * user, char * password, char * db, uint port, char *, uint flags)
{
   MYSQL * mysql;
   const char *szHost=hb_parcx( 1 );
   const char *szUser=hb_parcx( 2 );
   const char *szPass=hb_parcx( 3 );
   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_VERSION_ID > 32200
   /* 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 */
   mysql = mysql_init((MYSQL*) 0)       ;

   if ( ( mysql != NULL) )
   {
     if( mysql_real_connect( mysql, szHost, szUser, szPass, 0, port, NULL, flags) )
     {
        hb_retnl((long) mysql);
     }
     else
     {
       mysql_close( mysql );
       hb_retnl( 0 );
     }
   }
   else
   {
     hb_retnl( 0 );
   }
#else
   mysql = mysql_real_connect(NULL, _parc(1), _parc(2), _parc(3), 0, NULL, 0);
   hb_retnl((long) mysql);
#endif
}


HB_FUNC(SQLCLOSE) // void mysql_close(MYSQL *mysql)
{
   mysql_close((MYSQL *)_parnl(1));
   hb_ret();
}


HB_FUNC(SQLSELECTD) // int mysql_select_db(MYSQL *, char *)
{
   const   char *db=hb_parcx(2);
   hb_retnl((long) mysql_select_db((MYSQL *)_parnl(1), db));
}


HB_FUNC(SQLQUERY) // int mysql_query(MYSQL *, char *)
{
   hb_retnl((long) mysql_query((MYSQL *)_parnl(1), _parc(2)));
}


HB_FUNC(SQLSTORER) // MYSQL_RES *mysql_store_result(MYSQL *)
{
   hb_retnl((long) mysql_store_result((MYSQL *)_parnl(1)));
}


HB_FUNC(SQLFREER) // void mysql_free_result(MYSQL_RES *)
{
   mysql_free_result((MYSQL_RES *)_parnl(1));
   hb_ret();
}


HB_FUNC(SQLFETCHR) // MYSQL_ROW *mysql_fetch_row(MYSQL_RES *)
{
   MYSQL_RES *mresult = (MYSQL_RES *)_parnl(1);
   UINT ui, uiNumFields = mysql_num_fields(mresult);
   ULONG *pulFieldLengths ;
   MYSQL_ROW mrow;
   HB_ITEM itRow, itTemp;
   itRow.type = HB_IT_NIL ;
   itTemp.type = HB_IT_NIL ;

   hb_arrayNew( &itRow, uiNumFields );
   mrow = mysql_fetch_row(mresult);
   pulFieldLengths = mysql_fetch_lengths( mresult ) ;
   if ( mrow  )
   {
     for (ui = 0; ui < uiNumFields; ui++)
     {
       if ( mrow[ ui ] == NULL )
       {
         hb_itemPutC( &itTemp , "" );  // if field is NULL
       }
       else  // Put the actual data in
       {
         hb_itemPutCL( &itTemp, mrow[ ui ], pulFieldLengths[ ui ] );
       }
       hb_arraySetForward( &itRow, ui+1, &itTemp );
     }
   }
   hb_itemReturn(&itRow);

}


HB_FUNC(SQLDATAS) // void mysql_data_seek(MYSQL_RES *, unsigned int)
{
   mysql_data_seek((MYSQL_RES *)_parnl(1), (unsigned int)_parni(2));
   hb_ret();
}


HB_FUNC(SQLNROWS) // my_ulongulong  mysql_num_rows(MYSQL_RES *)
{
   /* NOTE: I receive a my_ulongulong which I convert to a long, so I could lose precision */
   hb_retnl((long)mysql_num_rows(((MYSQL_RES *)_parnl(1))));
}


HB_FUNC(SQLFETCHF) // MYSQL_FIELD *mysql_fetch_field(MYSQL_RES *)
{
   /* NOTE: field structure of MySQL has 8 members as of MySQL 3.22.x */
   MYSQL_FIELD *mfield;
   HB_ITEM itField, itTemp;

   itField.type = HB_IT_NIL ;
   itTemp.type = HB_IT_NIL ;

   mfield = mysql_fetch_field((MYSQL_RES *)_parnl(1));
   hb_arrayNew( &itField, 8 );
   if (!(mfield == NULL))
   {
      hb_arraySetForward(&itField, 1, hb_itemPutC(&itTemp, mfield->name));
      hb_arraySetForward(&itField, 2, hb_itemPutC(&itTemp, mfield->table));
      hb_arraySetForward(&itField, 3, hb_itemPutC(&itTemp, mfield->def));
      hb_arraySetForward(&itField, 4, hb_itemPutNL(&itTemp, (long)mfield->type));
      hb_arraySetForward(&itField, 5, hb_itemPutNL(&itTemp, mfield->length));
      hb_arraySetForward(&itField, 6, hb_itemPutNL(&itTemp, mfield->max_length));
      hb_arraySetForward(&itField, 7, hb_itemPutNL(&itTemp, mfield->flags));
      hb_arraySetForward(&itField, 8, hb_itemPutNL(&itTemp, mfield->decimals));
   }
   hb_itemReturn(&itField);

}


HB_FUNC(SQLFSEEK) // MYSQL_FIELD_OFFSET mysql_field_seek(MYSQL_RES *, MYSQL_FIELD_OFFSET)
{
   mysql_field_seek((MYSQL_RES *)_parnl(1), (MYSQL_FIELD_OFFSET)_parni(2));
   hb_ret();
}


HB_FUNC(SQLNUMFI) // unsigned int mysql_num_fields(MYSQL_RES *)
{
   hb_retnl(mysql_num_fields(((MYSQL_RES *)_parnl(1))));
}

#if MYSQL_VERSION_ID > 32200
HB_FUNC(SQLFICOU) // unsigned int mysql_num_fields(MYSQL_RES *)
{
   hb_retnl(mysql_field_count(((MYSQL *)_parnl(1))));
}
#endif

HB_FUNC(SQLLISTF) // MYSQL_RES *mysql_list_fields(MYSQL *, char *);
{
   hb_retnl((long) mysql_list_fields((MYSQL *)_parnl(1), _parc(2), NULL));
}


HB_FUNC(SQLGETERR) // char *mysql_error(MYSQL *);
{
   hb_retc((char *)mysql_error((MYSQL *)_parnl(1)));
}

HB_FUNC(SQLGETERRNO)
{
   hb_retnl(mysql_errno((MYSQL *)_parnl(1)));
}

HB_FUNC(SQLLISTDB) // MYSQL_RES * mysql_list_dbs(MYSQL *, char * wild);
{
   MYSQL * mysql = (MYSQL *)hb_parnl(1);
   MYSQL_RES * mresult;
   MYSQL_ROW mrow;
   long nr, i;
   HB_ITEM itDBs = HB_ITEM_NIL, itTemp= HB_ITEM_NIL ;

   mresult = mysql_list_dbs(mysql, NULL);

   nr = (LONG) mysql_num_rows(mresult);

   hb_arrayNew( &itDBs, nr) ;

   for (i = 0; i < nr; i++)
   {
      mrow = mysql_fetch_row(mresult);
      hb_itemPutC(&itTemp, mrow[0]) ;
      hb_arraySetForward( &itDBs, i+1, &itTemp );
   }

   mysql_free_result(mresult);
   hb_itemReturn(&itDBs);
}

HB_FUNC(SQLLISTTBL) // MYSQL_RES * mysql_list_tables(MYSQL *, char * wild);
{
   MYSQL * mysql = (MYSQL *)hb_parnl(1);
   MYSQL_RES * mresult;
   MYSQL_ROW mrow;
   long nr, i;
   HB_ITEM itTables= HB_ITEM_NIL, itTemp= HB_ITEM_NIL;

   mresult = mysql_list_tables(mysql, NULL);
   nr = (LONG) mysql_num_rows(mresult);

   hb_arrayNew(&itTables,0);

   for (i = 0; i < nr; i++)
   {
      mrow = mysql_fetch_row(mresult);
      hb_arrayAddForward((PHB_ITEM) &itTables , hb_itemPutC(&itTemp, mrow[0]) );
   }
   mysql_free_result(mresult);
   hb_itemReturn(&itTables);
}

// returns bitwise and of first parameter with second
HB_FUNC(SQLAND)
{
   hb_retnl(_parnl(1) & _parnl(2));
}

HB_FUNC(SQLAFFROWS)
{
   hb_retnl( (LONG) mysql_affected_rows( (MYSQL *)_parnl(1) ) );
}

HB_FUNC(SQLHOSTINFO)
{
   hb_retc((char *) mysql_get_host_info( (MYSQL *)_parnl(1) ) );
}

HB_FUNC(SQLSRVINFO)
{
   hb_retc((char *) mysql_get_server_info( (MYSQL *)_parnl(1) ) );
}

ULONG getfilelength( int handle )
{
    ULONG nEnd = hb_fsSeek( handle, 0 , 2 );
    ULONG nStart = hb_fsSeek( handle , 0 , 0 );
    return ( nEnd - nStart ) ;
}


HB_FUNC(DATATOSQL)
{
   char *FromBuffer ;
   ULONG iSize, iFromSize ;
   char *ToBuffer;
   BOOL bResult = FALSE ;
   iSize= hb_parclen(1) ;
   iFromSize = iSize ;

   FromBuffer = (char*) hb_parc( 1 ) ;   /// aqui modifico wmormar
   if ( iSize )
   {
     ToBuffer = ( char *) hb_xgrab( ( iSize*2 ) + 1 );
     if ( ToBuffer )
     {
       if ISNUM(2)
       {
         iSize = mysql_real_escape_string( (MYSQL *) hb_parnl(2), ToBuffer, FromBuffer, iSize);
       }
       else
       {
         iSize = mysql_escape_string( ToBuffer, FromBuffer, iSize );
       }
       hb_retclenAdopt( ( char *) ToBuffer, iSize ) ;
       bResult = TRUE ;
     }
   }
   if ( !bResult )
   {
     // Should we raise a runtime error here????? or just return the original string
     hb_retclen( (char *) FromBuffer, iFromSize ) ;
   }
}

HB_FUNC(FILETOSQLBINARY)
{
   BOOL bResult = FALSE ;
   char *szFile= (char*) hb_parcx(1);   // aqui modifoco wmormar
   int fHandle;
   ULONG iSize;
   char *ToBuffer;
   char *FromBuffer;
   if ( szFile && hb_parclen(1) )
   {
     fHandle    = hb_fsOpen(( BYTE *) szFile,2);
     if ( fHandle > 0 )
     {
       iSize      = getfilelength( fHandle );
       if ( iSize > 0 )
       {
         FromBuffer = ( char *) hb_xgrab( iSize );
         if ( FromBuffer )
         {
           iSize      = hb_fsReadLarge( fHandle , ( BYTE * ) FromBuffer , iSize );
           if ( iSize > 0 )
           {
             ToBuffer   = ( char *) hb_xgrab( ( iSize*2 ) + 1 );
             if ( ToBuffer )
             {
               if ISNUM(2)
               {
                 iSize = mysql_real_escape_string( (MYSQL *) hb_parnl(2), ToBuffer, FromBuffer, iSize);
               }
               else
               {
                 iSize = mysql_escape_string( ToBuffer, FromBuffer, iSize);
               }
               hb_retclenAdopt( ( char *) ToBuffer, iSize);
               bResult = TRUE ;
             }
           }
           hb_xfree( FromBuffer );
         }
       }
       hb_fsClose( fHandle );
     }
   }
   if ( !bResult )
   {
     hb_retc( "" ) ;
   }
}

Gracias
Saludos

Post by **Antonio Linares** » Fri Feb 20, 2015 4:34 am

Paco,

Añádele al principio #include <hbapi.h>

FiveTech Software tech support forums

Antonio, ¡estoy inquieto!

Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!

Re: Antonio, ¡estoy inquieto!