#include "fileio.ch"
#include "dbstruct.ch"

// crea el 5to parametro a la estructura de uan DBF para validar si se va a usar o no
#define DBS_INCLUYE     5
#define DBS_IND_AFIELD  6

Function MyDbExport( cFile, acSalida, aField, bCond, bBlock, aExtraField, bBlock2 )
/*
     Funcion que hace un dbExport() básico -> creada el 31/01/2011


USO  :       MyDbExport( <dbf a consultar>, <dbf resultante>, [<selección de campos>],;
                         [<condición de selección>], [<block auxiliar>] )
     cFile        es la DBF a leer
     acSalida     es la DBF que genera la salida si se especifica un string
                  si se espcifica un array se genera una array multidimencional
                  si se especifica NIL, se genera un array de 1 dimensión, sumando las salidas
     aField       son los campos para llevar a la salida
     bCond        es la condición de de evaluación
     bBlock       es una alternativa para hacer algo
     aExtraField  es una arreglo que contiene campos para agregar a la estructura de salida

EJEMPLO        ( Alias() )->( MyDbExport( 'MYBASE.DBF', 'SALIDA.DBF', { 'CAMPO1', 'CAMPO2' } ) )
                  genera SALIDA.DBF a partir de MYBASE.DBD con solo 2 campos
               ( Alias() )->( MyDbExport( 'MYBASE.DBF', 'SALIDA.DBF',, { || FIELD->NOMBRE > 10000 } )

CUIDADOS no usar FIELD-> para referenciar los campos, usar solamente el alias (por ejem. ART-> si Alias() = 'ART')
         siempre usar el Alias en las condiciones por ejemplo : ART->CODIGO < 10,000
*/
*Begin
   Local nHan, aSt, i, j, k, f, nLen, aIni, nLST, nRec, nRegDBF
   Local cAl, nHead, nRecS, nSize, nOff, cBuf, nPos, nRead, cReg
   Local nSec, xAux, x, lField, nSel, l2Array, xInit, nAccion
   Local nRet, nCount, aDatos, aRecord, nNewSel
   nRet    := 0                            // valir de salida
   l2Array := ( ValType( acSalida ) != 'C' )
   nSel    := Select()
   bBlock  := If( (ValType( bBlock ) = 'B'), bBlock, { || .T. } )
   bBlock2 := If( (ValType( bBlock2 ) = 'B'), bBlock2, { || .T. } )
   cAl     := Upper( Alias() ) + '->'
   nHan    := FOpen( cFile, FO_READ + FO_SHARED )
   lField  := ( aField != NIL )
   aField  := If( (aField = NIL), dbStruct(), aField )
   bCond   := If( (bCond = NIL), { || .T. }, bCond )
   bCond   := Upper( Var2Char( bCond ) )
   bCond   := StrTran( bCond, 'FIELD', Upper( Alias() ) )
   nRegDBF := RecNo()
   aDatos  := {}
   If ( Eof() )
      dbGoTOP()                            // me salgo del Eof() para que no me interfiera en la selección y
   EndIF                                   // ...y no tenga que estar reemplazando por un .T.
   If ( nHan != F_ERROR )
      nHead := Header()
      nRecS := RecSize()
      aSt   := dbStruct()
      nLST  := Len( aST )
      aIni  := Array( 2, nLST )
      Afill( aIni[1], 0 )                  // tiene los punteros que utilzo para recorrer la cadena y manejar los offset
      Afill( aIni[2], 0 )                  // tengo los punteros originales
      For i := 1 To nLST
         AAdd( aST[i], .T. )               // agrego el 5to parámetro al array de la estructura para uatorizar al aField[]
         AAdd( aST[i],  i  )               // agrefo el 6to parámetro que tiene la posicion de aField
         If ( lField )                     // si tengo qie evaluar que campos considero
            k := aScan( aField, aST[i,DBS_NAME] )
            If ( k > 0 )
               // copio de esta manera para que cuando aplique cambio a aST[n,1] no afecte a aField[n,1]
               aField[k]             := { aST[i,1], aST[i,2], aST[i,3], aST[i,4] }
               aST[i,DBS_IND_AFIELD] := k  //
             Else
               aST[i,DBS_INCLUYE]    := .F.// desautorizo el uso del campo
            EndIF
         EndIF
         aSt[i,DBS_NAME] := cAl + aSt[i,DBS_NAME]
         For k := nLST To i + 1 STEP -1
            aIni[2,k] := aIni[2,k] + aST[i,DBS_LEN]
         Next k
         aIni[1,i] := aIni[2,i]
         j := At( aSt[i,DBS_NAME], bCond )
         If ( j > 0 )
            cBuf    := 'SubStr(x,y[' + LTrim( Str( i, 4 ) ) + '],' + LTrim( Str( aSt[i,DBS_LEN], 4 ) ) + ' )'
            If ( aSt[i,DBS_TYPE] = 'N' )
               cBuf := 'Val_(' + cBuf + ')'
            EndIF
            AAdd( aDatos, cBuf )
            While ( j > 0 )
               bCond := Stuff( bCond, j, Len( aSt[i,DBS_NAME] ), cBuf )
               j     := At( aSt[i,DBS_NAME], bCond )
            EndDO                          //
         EndIF                             //
      Next i                               //
      If ( ValType( aExtraField ) = 'A' )
         For i := 1 To Len( aExtraField )
            AAdd( aField, aExtraField[i] )
         Next i
      EndIF                                //
      If ( ValType( acSalida ) = 'C' )
         dbCreate( acSalida, aField, 'DBFCDX' )
         dbUseArea( .T., 'DBFCDX', acSalida, 'QWERT01', .F. )
         nNewSel := Select()
         dbSelectArea( nSel )
         nAccion := 2
       Else
         If ( acSalida = NIL )
            xInit   := ''
            nAccion := 0
          Else
            xInit   := {}
            nAccion := 1
         EndIF
         acSalida := {}
      EndIF                                // del If ValType( acSalida ) = 'C'
      j              := At( '{ ||', bCond )
      If ( j > 0 )
         bCond       := Stuff( bCond, j, 3, '{ | x, y, z ' )
       Else
         j           := At( '{||', bCond )
         If ( j > 0 )
            bCond    := Stuff( bCond, j, 2, '{ | x, y, z ' )
          Else
            j        := At( '{ |', bCond )
            If ( j = 0 )
               bCond := '{ | x, y, z | ' + bCond + ' }'
            EndIF                          //
         EndIF                             //
      EndIF                                //
      bCond  := &( bCond )
      nLen   := 1000                       // cantidad de registros a procesar
      nSize  := FSeek( nHan, 0, FS_END )   // calculo el tamaño del archivo
      nOff   := nRecS * nLen               // tamaño del buffer a leer
      cBuf   := Space( nOff )              // salto al area de datos
      nPos   := FSeek( nHan, nHead, FS_SET )
      nRec   := 0
      nSec   := Seconds()
      nCount := 0                          // cuenta los posibles elementos de acSalida en caso que salga a array
      While ( nPos < nSize )
         // levanto de a (n) registros
         nRead :=FRead( nHan, @cBuf, Len( cBuf ) )
         If ( nRead != nOff )
            nLen :=( nRead / nRecS )       // recalculo la nueva cantidad de registros
            nOff := nRecS * nLen
         EndIF
         // tomo el nuevo puntero
         nPos  := FSeek( nHan, 0, FS_RELATIVE )
         k     := 1
         For i := 1 To nLST
            // inicializo los punteros a los campos, sumo 2 porque así salto la marca de delete
            // y porque todas las inicializaciones estan consideradas desde 0
            aIni[1,i] := aIni[2,i] + 2
         Next i
         For j      := 1 To nLen           // recorro todos los registros
            nRec    := nRec + 1
            cReg    := SubStr( cBuf, k, nRecS )
            k       := k + nRecS
            aRecord := {}
            If ( cReg[1] = ' ' )           // si el registro no esta deleteado
               If ( Eval( bCond, cBuf, aIni[1], aDatos ) )
                  If ( l2Array )
                     AAdd( acSalida, xInit )
                     nCount := nCount + 1
                   Else
                     QWERT01->( dbAppend() )
                  EndIF
                  For x := 1 To nLST
                     // si incluyo este campo, lo proceso
                     If ( aST[x,DBS_INCLUYE] )
                        xAux := SubStr( cBuf, aIni[1,x], aST[x,DBS_LEN] )
                        If ( nAccion = 0 )
                           acSalida[nCount] := acSalida[nCount] + xAux + '  '
                         Else
                           If ( aST[x,DBS_TYPE] = 'N' )
                              xAux := Val_( xAux )
                           ElseIf ( aST[x,DBS_TYPE] = 'L' )
                              xAux := ( xAux = 'T' )
                           ElseIf ( aST[x,DBS_TYPE] = 'D' )
                              xAux := SToD( xAux )
                           EndIF
                           If ( nAccion = 1 )
                              AAdd( acSalida[nCount], xAux )
                            Else
                              QWERT01->( FieldPut( aST[x,DBS_IND_AFIELD], xAux ) )
                           EndIF
                        EndIF              // del If nAccion = 0
                        AAdd( aRecord, xAux )
                        Eval( bBlock2, aRecord, nNewSel, nRec )
                     EndIF                 // del If aST[x,DBS_INCLUYE]
                  Next x                   // For x := 1 To nLST
               EndIF                       // del If Eval( bCond, cBuf, aIni[1] )
            EndIF                          // del If cReg[1] = ' '  -> si no esta deleteado
            Eval( bBlock, aRecord, nNewSel, nRec )
            For i := 1 To nLST
               aIni[1,i] := aIni[1,i] + nRecS // salto al siguiente registro
            Next i
         Next j                            // del For j := 1 To nLen
      EndDO                                // del While nPos < nSize .And. G != K_ESC
      nSec := Seconds() - nSec
      FClose( nHan )
      If ( ValType( acSalida ) = 'C' )
         nRet := QWERT01->( LastRec() )
         QWERT01->( dbCloseArea() )
       Else
         nRet := nCount
      EndIF
   EndIF                                   // del If nHan != F_ERROR
   If ( nRegDBF != RecNo() )
      dbGoTo( nRegDBF )                    // restauro puntero
   EndIF
   Return ( nRet )
*End;
*