FiveTech Software tech support forums

Code: Select all

function checkBaseDato()
local cPath, aDir, cDbf, aStruc1, aStruc2, i, j, cInfo, nHandle, lPaso, aBase := {}, lIndex := .f.

if DirMake( ViewUsu():cPathTmp + "\chkDbf" ) <> 0
	MsgInfo( "imposible crear directorio" + CRLF + ViewUsu():cPathTmp + "\chkDbf"+ CRLF + CRLF + "Borrelo manualmente", "Usuario" )
	return( nil )
endif

cPath := ViewUsu():cPathDbf //guardamos la ubicacion original
ViewUsu():cPathDbf := ViewUsu():cPathTmp + "\chkDbf"

AdsSetSearchPath( ViewUsu():cPathDbf )

CreaDbf() //creamos los dbf en el directorio creado

aDir := Directory( ViewUsu():cPathDbf + "\*.DBF" )

IF (nHandle := FCREATE( 'Informe.log', 0 )) == -1
	msginfo( "Hubo un Error;;al crear Archivo" )
	return( nil )
endif

cInfo := "Informe de structura" + CRLF
cInfo += repli("=",80) + CRLF

for i := 1 to len( aDir )

	cDbf := strtran( upper(aDir[i,1]),".DBF", "" )

	cInfo += "Archivo:"+PADR(cDbf,10)

	aStruc1 := {}
	aStruc2 := {}

	use (ViewUsu():cPathDbf + "\" + cDbf )exclusive VIA "DBFCDX"
	if !NetErr()
		aStruc1 := dbStruct()
		if file( cPath + "\" + cDbf + ".dbf" )
			USE (cPath + "\" + cDbf) EXCLUSIVE VIA "DBFCDX"
			if !NetErr()
				aStruc2 := dbStruct()
			else
				cInfo += CRLF + "Imposible abrir de la ruta "+cPath
			endif
		else
			aStruc2 := {{ "NO EXISTE FILE", "C", 0, 0 }}
		endif
	else
		cInfo := "Error abrir archivo:"+ViewUsu():cPathDbf + "\"+cDbf
	endif
	lPaso := .f.
	if !empty(aStruc1) .and. !empty(aStruc2)
		if len( aStruc1 ) = len( aStruc2 )
			for j := 1 to len( aStruc1 )
				if aStruc1[j,1] <> aStruc2[j,1] .or. ;
					aStruc1[j,2] <> aStruc2[j,2] .or. ;
					aStruc1[j,3] <> aStruc2[j,3] .or. ;
					aStruc1[j,4] <> aStruc2[j,4]
					cInfo += CRLF + ;
								aStruc1[j,1] + aStruc1[j,2] + str(aStruc1[j,3],3) + str(aStruc1[j,4],2)+ "  " +;
								aStruc2[j,1] + aStruc2[j,2] + str(aStruc2[j,3],3) + str(aStruc2[j,4],2)
					lPaso:=.t.
				endif
			next j

			if !lPaso
				cInfo += chr(9)+ chr(9) + "OK" + CRLF
			endif
		else
			lPaso := .t.
		endif
	endif

	if lpaso
		if len(aStruc1) <= len( aStruc2 )
			cInfo += CRLF + chr(9) + "Estructuras de " + padr(cPath,50)+ chr(9)+ViewUsu():cPathDbf+CRLF
			for j := 1 to len( aStruc1 )
				cInfo += chr(9) + ;
								PadR(aStruc1[j,1],10)+chr(9) + aStruc1[j,2] + chr(9) + str(aStruc1[j,3],3) + chr(9)+str(aStruc1[j,4],2) + chr(9)+chr(9)

				cInfo += chr(9) + ;
							PadR(aStruc2[j,1],10) + chr(9) + aStruc2[j,2] + chr(9) + str(aStruc2[j,3],3) + chr(9)+str(aStruc2[j,4],2) + CRLF
			next j

			while j <= len( aStruc2 )
				cInfo += chr(9) + ;
							PadR(aStruc2[j,1],10) + chr(9)+aStruc2[j,2] + chr(9)+str(aStruc2[j,3],3) + chr(9)+str(aStruc2[j,4],2) + CRLF
				j++
			enddo

		else
		   cInfo += CRLF + chr(9) + "Estructuras de " + PadR(ViewUsu():cPathDbf,50)+ chr(9)+cPath+CRLF+CRLF
			for j := 1 to len( aStruc2 )
				cInfo += chr(9) + ;
								PadR(aStruc2[j,1],10)+chr(9) + aStruc2[j,2] + chr(9) + str(aStruc2[j,3],3) + chr(9)+str(aStruc2[j,4],2) + chr(9)+chr(9)

				cInfo += chr(9) + ;
							PadR(aStruc1[j,1],10) + chr(9) + aStruc1[j,2] + chr(9) + str(aStruc1[j,3],3) + chr(9)+str(aStruc1[j,4],2) + CRLF
			next j

			while j <= len( aStruc1 )
				cInfo += chr(9) + ;
							PadR(aStruc1[j,1],10) + chr(9)+aStruc1[j,2] + chr(9)+str(aStruc1[j,3],3) + chr(9)+str(aStruc1[j,4],2) + CRLF
				j++
			enddo
		endif
		aadd( aBase, cDbf )
	endif
	USE
	FWRITE( nHandle, cInfo+CRLF )
	cInfo:=""
next i

FCLOSE( nHandle )
dbCloseAll()
WAITRUN("NOTEPAD informe.LOG")

if len( aBase ) > 0 .AND. MsgNoYes( "Desea reparar las bases!!" + CRLF + "antes de prodeder hacer una copia de respaldo", "usuario" )
	lIndex := .t.
	for i := 1 to len( aBase )

		cDbf := aBase[i]

		use (ViewUsu():cPathDbf + "\" + cDbf )exclusive VIA "DBFCDX"

		if !NetErr()

			if file( cPath + "\" + cDbf + ".dbf" )
				MsgRun( "Espere, importando " +cDbf+"["+str(i,2)+"/"+str(len(abase),2)+"]", "Usuario",;
							 { || __dbApp( cPath + "\"+cDbf,{ },,,,,.F.,"DBFCDX") } )

				USE
				if fErase( cPath + "\" + cDbf + ".DBF" ) = 0
					if file( cPath + "\" + cDbf + ".fpt" )
						fErase( cPath + "\" + cDbf + ".fpt" )
						FileCopy( ViewUsu():cPathDbf + "\" + cDbf + ".fpt", cPath + "\" + cDbf + ".fpt" )
					endif
					FileCopy( ViewUsu():cPathDbf + "\" + cDbf + ".DBF", cPath + "\" + cDbf + ".DBF" )
				else
					MsgInfo( "Error al borrar "+ cPath + "\" + cDbf + ".DBF" )
				endif
			else
				USE
				FileCopy( ViewUsu():cPathDbf + "\" + cDbf + ".DBF", cPath + "\" + cDbf + ".DBF" )
				if file( ViewUsu():cPathDbf + "\" + cDbf + ".FPT" )
					FileCopy( ViewUsu():cPathDbf + "\" + cDbf + ".fpt", cPath + "\" + cDbf + ".fpt" )
				endif
			endif
		else
			msginfo( "imposible abrir base" + cDbf )
		endif
		USE
	next i
endif

aDir := Directory( ViewUsu():cPathTmp + "\chkDbf\*.*" )
aEval( aDir, { |x| cDbf := X[1], fErase( ViewUsu():cPathTmp + "\chkDbf\"+ cDbf ) } )

ViewUsu():cPathDbf := cPath  //restauramos el original
AdsSetSearchPath( ViewUsu():cPathDbf )
DirRemove( ViewUsu():cPathTmp + "\chkDbf" )

if lIndex
	Indexar( .f. )
	dbCloseAll()
endif
return( nil )
//---------------------------------------------------------------------------------------------------------------