FiveTech Support Forums

//-------------------------------------------------------------------------//
// Poner este control antes de empezar los procesos.
FUNCTION lCompruebaIndiceTabla(cAlias)
Local a:= SEntorno({cAlias})
Local nI
Local lOk:= .t.
Local cOrdKey, cIndexKey, lClave, bIndexKey
Local nJ, nFCount
Local oRet        
*
IF Empty(cAlias)
   MERROR_("Necesario el alias !!", cAlias)
   RETURN .F.
ENDIF
*
*

   SELECT (cAlias)
   nFCount:= FCount()
   bIndexKey:= bCOMPILA( IndexKey(0) )
   *
   // Comprueba 2 registros: uno nuevo y uno existente.
   Add_Rec(0)
   FOR nI:= 1 TO 2

      *
      *
      *
      *
      *
      *
      // PRIMERO. Comprueba que las operaciones de a¤adir y replace funcionen
      Rec_Lock(0)
         FOR nJ:= 1 TO Min(6, nFCount) 
            FieldPut(nJ, FieldGet(nJ))
         NEXT
         COMMIT
         IF nI == 1
            DELETE
         ENDIF
      UNLOCK
      *
      *
      *
      // SEGUNDO. Comprueba que la clave se corresponda
      cOrdKey:= OrdKeyVal()
      cIndexKey:= ""
      lClave:= cOrdKey != NIL
      IF lClave
         cIndexKey:= Eval(bIndexKey)
         *
         // El left para por las claves
         // super grandes y el maximo es 250.
         IF ValType(cOrdKey) == "C"
            IF Len(cIndexKey) >= 250
               lClave:= Left(cIndexKey, Len(cOrdKey)) == cOrdKey
            ELSE
               lClave:= cIndexKey == cOrdKey
            ENDIF
         ELSE
            lClave:= cIndexKey == cOrdKey
         ENDIF
      ENDIF
      IF !lClave
         lOk:= .f.
         EXIT
      ENDIF
      *
      *
      *
      *
      *
      *
      // Compruebo un registro con datos de los ultimos
      SKIP -5
      IF Bof()
         EXIT
      ENDIF
   NEXT
   *
   // Comprueba con SEEK todos los indices del alias actual
   oRet:= oCompruebaIndicesYClaves()
   IF !oRet:lOk
      lOk:= .f.
   ENDIF
   *

*
*
REntorno(a)
RETURN lOk
*
*
//-------------------------------------------------------------------------//
// Esto puede dar positivo (error) en un entorno compartido donde
// otros usuarios estan añadiendo registros en el momento de comprobar,
// especialmente si otro usuario esta añadiendo registros masivamente
STATIC FUNCTION oCompruebaIndicesYClaves()
Local cAlias:= Alias()
Local a:= SEntorno({cAlias})
Local nItem, nJ
Local xClave
Local lOk:= .t.
Local nSitio
Local oRet
*
SELECT (cAlias)
*
FOR nItem:= 1 TO 40        // H-V
   SET ORDER TO (nItem)
   IF IndexOrd() != nItem
      EXIT                 // No hay mas indices
   ENDIF
   *
   GO BOTTOM
   SKIP -20     // Comprueba los ultimos 20 registros
   DO WHILE !Eof()
      nSitio:= Recno()
      xClave:= & ( IndexKey(0) )
      SEEK xClave  // Debe encontrar la clave actual o una anterior igual
      IF Eof()
         lOk:= .f.
         EXIT
      ENDIF
      GO nSitio
      SKIP
   ENDDO
   *
   IF !lOk
      FLOGMSG_("Error !! Indice incorrecto !!", Alias(), dbInfo(10), IndexKey(0), IndexOrd(), OrdBagName(nItem), OrdName(), xClave)
      EXIT
   ENDIF
NEXT
*
oRet:= ClassVarRapida({"lOk", "cAlias", "cFullFile", "cIndexKey", "xClave"})
oRet:lOk:= lOk
oRet:cAlias:= Alias()
oRet:cFullFile:= dbInfo(10)
IF !lOk
   oRet:cIndexKey:= IndexKey(0)
   oRet:xClave:= xClave
ENDIF
*
REntorno(a)
RETURN oRet
*
*

   if( ! fLeaf )
   {
      hb_cdxPageGetChild( pPage );
#ifdef HB_CDX_DBGCODE
      if( memcmp( hb_cdxPageGetKeyVal( pPage, pPage->iCurKey ),
                  hb_cdxPageGetKeyVal( pPage->Child, pPage->Child->iKeys - 1 ),
                  pPage->TagParent->uiLen ) != 0 ||
          hb_cdxPageGetKeyRec( pPage, pPage->iCurKey ) !=
          hb_cdxPageGetKeyRec( pPage->Child, pPage->Child->iKeys - 1 ) )
      {
         fprintf( stderr, "\r\nkeyLen=%u", pPage->TagParent->uiLen );
         fprintf( stderr, "\r\nparent=%lx, iKey=%d, rec=%lu", pPage->Page, pPage->iCurKey, hb_cdxPageGetKeyRec( pPage, pPage->iCurKey ) );
         fprintf( stderr, "\r\n child=%lx, iKey=%d, rec=%lu", pPage->Child->Page, pPage->Child->iKeys - 1, hb_cdxPageGetKeyRec( pPage->Child, pPage->Child->iKeys - 1 ) );
         fprintf( stderr, "\r\nparent val=[%s]", hb_cdxPageGetKeyVal( pPage, pPage->iCurKey ) );
         fprintf( stderr, "\r\n child val=[%s]", hb_cdxPageGetKeyVal( pPage->Child, pPage->Child->iKeys - 1 ) );
         fflush( stderr );
         hb_cdxErrInternal( "hb_cdxPageSeekKey: wrong parent key." );
      }
#endif
      k = hb_cdxPageSeekKey( pPage->Child, pKey, ulKeyRec );
   }

static void hb_cdxErrInternal( const char * szMsg )
{
   hb_errInternal( 9201, szMsg ? szMsg : "hb_cdxErrInternal: data integrity error.", NULL, NULL );
}