Leer la CABECERA de un .DBF
Por sotero (#866) a las 23:11 del 06-04-2002  
 

************************************************************
*   Utilidad para leer la cabecera de los ficheros .DBF    *
************************************************************
*   SOTERO ALONSO NAVAS
*   Primera versión:09/1994
*   Basado en el LIBRO: Curso de Programacion en CLIPPER 5
*                       Editorial RAMA ISBN: 84-7897-110-6
*
************************************************************
************************************************************
*   Reescrito en 06/2000, para actualizarse a los cambios  *
*   que se han ido haciendo en la cabecera de los .DBF     *
*   También basado en información publicada en FOXPRESS    *
************************************************************
LPARAMETERS pcFicheroDbf

PUBLIC glErrorApertura


CLEAR

if pcount() # 1
	LOCAL pcFicheroDbf
	pcFicheroDbf = ""
else
	pcFicheroDbf = alltrim(pcFicheroDbf)
endif


if empty ( pcFicheroDbf )
	pcFicheroDbf = alltrim(getfile("Tablas:DBF,DBC,SCX,LBL,MNX,PJX,FRX,VCX"))
endif

if !file (pcFicheroDbf )
	Messagebox("Fichero: " + pcFicheroDbf + " NO EXISTE")
	return
endif

*//Manejo de errores, si hay error fuera.
ON ERROR errhand( ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM( ), LINENO( ) )

*//Ver si es una tabla
use ( pcFicheroDbf )
ON ERROR  && Restaura el controlador de errores del sistema.

if glErrorApertura
	clear all
	clear
	release all extend
	return
else
	use
endif

*//Si llegó hasta aquí empezar el baile
# define nDB_VERSION   1
# define nDB_ULTACT    2
# define nDB_NUMREG    3
# define nDB_TAMCAB    4
# define nDB_TAMREG    5
# definE nDB_NUMCAMPOS1 6
# definE nDB_NUMCAMPOS2 7
# definE nDB_MEMOCDXDBC 8
# define nDB_ALEN      8



LOCAL lnManejador ,  lcCabecera  , lacDb , lacMensaje , lnX , lnUno ,
lnVeintiocho
*//BYTES a leer del fichero que nos pasen en el parametro pcFicheroDbf
lcCabecera = space ( 32 )

*//Matrices para los mensajes generales y los particulares de cada byte
Dimension lacDb(nDB_ALEN)
Dimension lacMensaje(nDB_ALEN)

*//Rellenar matriz de mensajes generales
STORE  'Versión' 							TO lacMensaje(nDB_VERSION)
STORE  'Fecha Ultima Actualizacion' 		TO lacMensaje(nDB_ULTACT)
STORE  'Numero de Registros' 				TO lacMensaje(nDB_NUMREG)
STORE  'Posición Primer Registro de datos' 	TO lacMensaje(nDB_TAMCAB)
STORE  'Tamaño del Registro Datos' 			TO lacMensaje(nDB_TAMREG )
STORE  'Numero Campos DBF(bajo nivel)' 		TO lacMensaje(nDB_NUMCAMPOS1)
STORE  'Numero Campos DBF (Fcount)' 		TO lacMensaje(nDB_NUMCAMPOS2)
STORE  '.CDX asociado, tiene MEMO, es .DBC' TO lacMensaje(nDB_MEMOCDXDBC)

SET DATE BRIT

*//Apertua del fichero pasado como parametro, a bajo nivel
*//Para solo lectura y con buffer:segundo parametro = 0
lnManejador = FOpen ( pcFicheroDbf , 0 )
if  lnManejador = -1
	Messagebox("Problemas con la APERTURA de " + pcFicheroDbf )
	return
endif

*//Leemos la cabecera los 32 bytes primeros
lcCabecera = FRead ( lnManejador , 32 )

*//Cerramos el fichero, ya tenemos lo que buscabamos.
if !Fclose ( lnManejador )
    Messagebox ( 'Error al cerrar '+pcFicheroDbf+' en I/O bajo nivel' )
	return
endif


*//Versión BYTE 0, 1er dato de la cadena leida de 32 caracteres
*//En el mensaje o contenido se indica el caracter contenido en HEXADECIMAL y
DECIMAL
lnUno = asc ( Left ( lcCabecera , 1 ) )
do case
	case lnUno = 2
		lacDb [ nDB_VERSION ] = '[O2h][02d]-FoxBase'
	case lnUno = 3
		lacDb [ nDB_VERSION ] = '[O3h][03d]-FoxBase+/Dbase III Plus, sin memo (y
Clipper)'
	case lnUno = 48
		lacDb [ nDB_VERSION ] = '[30h][48d]-Visual FoxPro'
	case lnUno = 67
		lacDb [ nDB_VERSION ] = '[43h][67d]-Dbase IV SQL archivos de tabla, sin memo'
	case lnUno = 99
		lacDb [ nDB_VERSION ] = '[63h][99d]-Dbase IV SQL archivos de sistema, sin
memo'
	case lnUno = 131
		lacDb [ nDB_VERSION ] = '[83h][131d]-FoxBase+/Dbase III Plus, con memo (y
Clipper)'
	case lnUno = 139
		lacDb [ nDB_VERSION ] = '[8Bh][139d]-Dbase IV con memo'
	case lnUno = 203
		lacDb [ nDB_VERSION ] = '[CBh][203d]-Dbase IV SQL archivos de tabla, con memo'
	case lnUno = 245
		lacDb [ nDB_VERSION ] = '[F5h][245d]-FoxPro 2.x (o anterior) con memo'
	case lnUno = 251
		lacDb [ nDB_VERSION ] = '[FBh][251d]-FoxBase, "supongo que con memo"'		
endcase



*//Fecha en formato DD-MM-AA, BYTE 1 a 3
lacDb [ nDB_ULTACT ] =  dtoc ( ctod (str ( Asc ( Substr ( lcCabecera , 4 , 1 ) )
, 2 ) +'/'+;
                             str ( Asc ( Substr ( lcCabecera , 3 , 1 ) ) , 2 )
+'/'+;
                             str ( Asc ( Substr ( lcCabecera , 2 , 1 ) ) , 2 )
))

*//Numero de Registros del fichero .DBF BYTES 4 a 7
lacDb [ nDB_NUMREG ] = ALLTRIM( STR (;
 					  VAL( str(ASC ( Substr ( lcCabecera , 8 , 1 ) )*(256^3))) +;
			          VAL(str(ASC  ( Substr ( lcCabecera , 7 , 1 ) )*(256^2))) +;
			          VAL(str(ASC  ( Substr ( lcCabecera , 6 , 1 ) )* 256)) +;
			          VAL(str(ASC  ( Substr ( lcCabecera , 5 , 1 ) )) ) ;
			          ))

*//Posicion del primer registro de datos BYTES 8 y 9
lacDb [ nDB_TAMCAB ] = ALLTRIM ( STR (;
 					 val(str ( ASC ( Substr ( lcCabecera , 10 , 1 ) )*256 )) +;
					 val(str( ASC ( Substr ( lcCabecera , 9 , 1 ) ) ) ) ;
					 ))
*//Tama¤o de cada registro  ( 1 mas por el controlado de borrados "*" )
*//Que es igual a recsize() BYTES 10 y 11
lacDb [ nDB_TAMREG ] = alltrim ( str (;
 					 val( str (asc ( Substr ( lcCabecera , 12 , 1 ))*256 )) +;
			         val (str(asc ( Substr ( lcCabecera , 11 , 1 )))) ;
			         ))
*//Numero de campos de la .dbf, bajo nivel solo Visual FoxPro
if lnUno = 48  &&Solo Visual FoxPro
    lacDb [ nDB_NUMCAMPOS1 ] =  alltrim ( str( ( val(lacDb [ nDB_TAMCAB ]) -296
) / 32 ) )
else
   lacDb [ nDB_NUMCAMPOS1 ] = 'Solo en Versión Visual FoxPro'
endif

*//Numero de campos de la .dbf, que es igual a Fcount()
use  ( pcFicheroDbf ) alias TONTO  in 0
lacDb [ nDB_NUMCAMPOS2 ] =  alltrim(str(fcount()))
use in TONTO


*//definE nDB_MEMOCDXDBC 8, tiene .cdx, memo o es .DBC, BYTE 28
lnVeintiocho = asc ( substr ( lcCabecera , 29 ,1 ) )

do case
	case lnVeintiocho = 1
		lacDb [ nDB_MEMOCDXDBC ] = '[O1h][01d]-Tiene un .CDX asociado'
	case lnVeintiocho = 2
		lacDb [ nDB_MEMOCDXDBC ] = '[O2h][02d]-Tiene un campo MEMO'
	case lnVeintiocho = 3
		lacDb [ nDB_MEMOCDXDBC ] = '[O3h][03d]-Tiene un .CDX y campo MEMO'
	case lnVeintiocho = 4
		lacDb [ nDB_MEMOCDXDBC ] = '[O4h][04d]-Es una Base de Datos (.DBC)'						
	otherwise
		lacDb [ nDB_MEMOCDXDBC ] = 'Nada ASOCIADO'
endcase




*//Mostrar la informacion de la cabecera extraida
create cursor borrame ( concepto c(40) , contenido c(60) )
for lnX = 1 to nDB_ALEN
	append blank
	replace concepto  with lacMensaje[lnX]
	replace contenido with lacDb[lnX]
next

brow title "Información del fichero: " + pcFicheroDbf
use

release all extend
RETURN
*eof()

***************************************************
PROCEDURE errhand ( nError, mess, mess1, mprog, mlineno )

	Messagebox ( 'Número de error: ' + LTRIM(STR(nError)) + chr(13)+;
				 'Mensaje de error: ' + mess + chr(13)+;
				 'Línea de código con error: ' + mess1 +chr(13)+;
				 'Número de línea del error: ' + LTRIM(STR(mlineno))+chr(13)+;
				 'Programa con error: ' + mprog	)
	glErrorApertura = .t.

ENDPROC
***************************************************
*//INFORMACIÓN DE LA CABECERA DEL .DBF:
*//En la ayuda de VFP, en Indice teclear CAPACIDADES DEL SISTEMA
*//En esa entrada picar en Vea Tambíen y luego ya en:
*//Estructura de archivo de tabla (.dbc, .dbf, .frx, .lbx, .mnx, .pjx, .scx,
.vcx)
*
*//Ahí se definen los 32 bytes primeros de la cabecera, además de otras muchas
cosas.