FiveTech Software tech support forums

Posted: **Thu Nov 01, 2007 1:13 pm**

Vean este sencillo trozo de código....

Es necesario en la base 3 eliminar todos los registros que esten repetidos
es decir si se repiten registros con un mismo campo5, todos se eliminan (no queda ninguno con ese numero) donde base3->campo5 es un campo de texto de 40 caracteres que contiene un numero.

Se corre el proceso sobre la base (que tiene repeticiones) y no hace nada.

Code: Select all

FUNCTION Main()
	LOCAL wdotant:=""
	SET AUTOPEN OFF
	SET DELETED OFF
	USE BASE3 EXCLUSIVE
	IF File("TMP.CDX")
		ERASE "TMP.CDX"
	ENDIF
	INDEX ON Campo5 TO TMP
	GO TOP
	wdotant = BASE3->Campo5
	SKIP
	WHILE ! Eof()
		IF BASE3->Campo5 = wdotant
			SKIP -1
			DO WHILE BASE3->Campo5 = wdotant
				DELETE
				SKIP 1
			ENDDO
		ENDIF
		wdotn = BASE3->Campo5
		SKIP
	ENDDO
	PACK
RETURN NIL

Aqui les dejo el prg y la base:

http://www.mediafire.com/?3mml0o1mntd

Posted: **Thu Nov 01, 2007 1:34 pm**

Cada vez más comienzo a pensar que debo dormir más.

Reemplacé algunos comandos por sus funciones y sigo igual.....

Code: Select all

FUNCTION Main()
	LOCAL wdotant:=""
	SET AUTOPEN OFF
	SET DELETED OFF
	USE BASE3 EXCLUSIVE
	IF File("TMP.CDX")
		ERASE "TMP.CDX"
	ENDIF
	INDEX ON Campo5 TO TMP
	GO TOP
	wdotant = BASE3->Campo5
	DbSkip()
	WHILE ! Eof()
		IF BASE3->Campo5 = wdotant
			DbSkip(-1)
			WHILE BASE3->Campo5 = wdotant
				DbDelete()
				DbSkip()
			ENDDO
		ENDIF
		wdotn = BASE3->Campo5
		DbSkip()
	ENDDO
	PACK
RETURN NIL

Posted: **Thu Nov 01, 2007 2:46 pm**

Proba asi

Code: Select all

FUNCTION Main() 
   LOCAL wdotant:="" 
   SET AUTOPEN OFF 
   SET DELETED OFF 
   USE BASE3 EXCLUSIVE 
   IF File("TMP.CDX") 
      ERASE "TMP.CDX" 
   ENDIF 
   INDEX ON Campo5 TO TMP 
   SET INDEX TO TMP  // Agrega esta linea
   GO TOP 
   wdotant = BASE3->Campo5 
   DbSkip() 
   WHILE ! Eof() 
      IF BASE3->Campo5 = wdotant 
         DbSkip(-1) 
         WHILE BASE3->Campo5 = wdotant 
            DbDelete() 
            DbSkip() 
         ENDDO 
      ENDIF 
      wdotn = BASE3->Campo5 
      DbSkip() 
   ENDDO 
   PACK 
RETURN NIL

Posted: **Thu Nov 01, 2007 2:49 pm**

Hola Jose

Definitivamente debes descansar un poco mas

Prueba asi :

Code: Select all

	IF File("TMP.CDX")
		ERASE "TMP.CDX"
	ENDIF
	INDEX ON BASE3->Campo5 TO TMP
	GO TOP
	wdotant := AllTrim( BASE3->Campo5 )
	SKIP
	WHILE ! Eof()
		DO WHILE AllTrim( BASE3->Campo5 ) == wdotant
			DELETE
			SKIP 1
		ENDDO
		wdotant := AllTrim( BASE3->Campo5 )
		SKIP
	ENDDO
	PACK

Estas usando "otra" variable al momente de reasignar el valor del campo, ahi es donde se pierde la validacion.

Saludos

Posted: **Thu Nov 01, 2007 2:49 pm**

cmsoft wrote:Proba asi

Code: Select all

FUNCTION Main() 
   LOCAL wdotant:="" 
   SET AUTOPEN OFF 
   SET DELETED OFF 
   USE BASE3 EXCLUSIVE 
   IF File("TMP.CDX") 
      ERASE "TMP.CDX" 
   ENDIF 
   INDEX ON Campo5 TO TMP 
   SET INDEX TO TMP  // Agrega esta linea
   GO TOP 
   wdotant = BASE3->Campo5 
   DbSkip() 
   WHILE ! Eof() 
      IF BASE3->Campo5 = wdotant 
         DbSkip(-1) 
         WHILE BASE3->Campo5 = wdotant 
            DbDelete() 
            DbSkip() 
         ENDDO 
      ENDIF 
      wdotn = BASE3->Campo5 
      DbSkip() 
   ENDDO 
   PACK 
RETURN NIL

Gracias por tu ayuda amigo, pero es obvio que necesito dormir más, el problema es que la variable wdotant no cambia porque actualizo wdotn por error.

Me voy a dormir una siesta, la necesito.

Posted: **Thu Nov 01, 2007 2:53 pm**

Raymundo Islas M. wrote:Hola Jose

Definitivamente debes descansar un poco mas

Prueba asi :
Code: Select all
	IF File("TMP.CDX")
		ERASE "TMP.CDX"
	ENDIF
	INDEX ON BASE3->Campo5 TO TMP
	GO TOP
	wdotant := AllTrim( BASE3->Campo5 )
	SKIP
	WHILE ! Eof()
		DO WHILE AllTrim( BASE3->Campo5 ) == wdotant
			DELETE
			SKIP 1
		ENDDO
		wdotant := AllTrim( BASE3->Campo5 )
		SKIP
	ENDDO
	PACK
Estas usando "otra" variable al momente de reasignar el valor del campo, ahi es donde se pierde la validacion.

Saludos

Gracias amigo, increíblemente acababa de darme cuenta y posteamos al mismo momento.

Es bueno contar con nuestros amigos....
(especialmente cuando dormimos poco

)

Posted: **Thu Nov 01, 2007 2:59 pm**

#Include "Fivewin.Ch"

Code: Select all

FUNCTION MAIN()

    FIELD CAMPO5

    LOCAL WDOTANT := ""

    SET AUTOPEN OFF
    SET DELETED OFF

    USE BASE3 ALIAS BASE3 EXCLUSIVE NEW

    IF FILE("TMP.CDX")
        ERASE "TMP.CDX"
    ENDIF

    INDEX ON CAMPO5 TO TMP

    GO TOP

    WDOTANT = BASE3->CAMPO5

    SKIP

    //->  10011171 solo debes borrar uno registro -> Este: 10011171 del CAMPO5
    ? WDOTANT

    DBSEEK( WDOTANT )

    BROWSE()

    WHILE ! EOF()

        SYSREFRESH()

        IF EOF()
            EXIT
        ENDIF

        IF BASE3->CAMPO5 = WDOTANT

            SKIP -1

            WHILE BASE3->CAMPO5 = WDOTANT

                SYSREFRESH()

                DELETE

                SKIP

            ENDDO

        ENDIF

        WDOTANT := BASE3->CAMPO5

        SKIP

    ENDDO

    //PACK

    RELEASE ALL
    DBCLOSEALL()

RETURN NIL

//-> FIN

Regards, saludos.

Posted: **Thu Nov 01, 2007 9:45 pm**

jose,
yo lo haria asi

local aCampo := {}, nPos

use base3 new exclusive
base3->(dbgotop())
do while !base3->(Eof())
nPos := 0
if ( nPos := Ascan( aCampo , base3->campo5 ) ) <> 0
base3->(dbdelete())
else
AADD(aCampo, base3->campo5)
endif
base3->(dbskip())
enddo
base3->(dbpack())
use

salu2
paco

Posted: **Fri Nov 02, 2007 2:46 am**

Gracias Francisco, Gracias Joao

Probaré y me quedo con la que me guste, la verdad que con sus aportes aprendo mucho.

Un abrazo para todos los amigos que han aportado a este tema.

Posted: **Fri Nov 02, 2007 9:48 am**

Otra alternativa:

Aunque la opción "unique" de los índices no es muy usada, porque en la mayoría de las veces no es práctica, creo que en este caso si lo es.

Code: Select all

FUNCTION Main()
   SET AUTOPEN OFF
   SET DELETED OFF
   USE BASE3 EXCLUSIVE
   IF File("TMP.CDX")
      ERASE "TMP.CDX"
   ENDIF
   INDEX ON Campo5 TO TMP UNIQUE
   COPY TO TEMPO
   OrdListClear()
   ZAP
   APPEND FROM TEMPO

RETURN NIL

Faltaría algo de higiene, es decir borrar los temporales y demás, pero la idea está.

Otra alternativa sería usar un indice normal y hacer un OrdSkipUnique() para el copy, pero creo que la solucion está.

Un saludo,

Carlos.

Posted: **Fri Nov 02, 2007 3:28 pm**

Es interesante ver como programadores expertos, usando todos el mismo lenguaje de programacion, escriben la misma funcion desde 11 lineas la mas corta hasta 32 lineas la mas larga.

George

Posted: **Sat Nov 03, 2007 1:47 pm**

Un metodo adicional para TDataBase

Code: Select all

//eliminando duplicado para indices UNIQUE... 
//puede tener varias ordenes por esos no se puede hacer zap

...
USE BASE3 EXCLUSIVE
DATABASE oDbf
oDbf:SetOrder( "TuOrdenUnique" )
oDbf:CheckUnique()

...........

METHOD CheckUnique() CLASS TDataBase
   Local cTmpFile := cTempFile()

   ( ::nArea )->( __dbCopy( cTmpFile ) )

  // Elimando haste que no kede ninguno
   Do While ( ::cAlias )->( DbOrderInfo( DBOI_KEYCOUNT ) ) > 0

      ::GoTop()

      ::Eval( { || dbDelete() } )
      ( ::nArea )->( __dbPack() )
      SysRefresh()

   EndDo

   ( ::nArea )->( __dbApp( cTmpFile ) )

   FErase( cTmpFile + '.Dbf' )
   Return Nil

Saludos
.........

FiveTech Software tech support forums

Necesito dormir más?

Necesito dormir más?