Código de FoxPro/Visual FoxPro - Reparar encabezado archivos DBF

Reparar encabezado archivos DBFgráfica de visualizaciones


FoxPro/Visual FoxPro

estrellaestrellaestrellaestrellaestrella(3)
Publicado el 22 de Septiembre del 2012 por Richard Alejandro
7.064 visualizaciones desde el 22 de Septiembre del 2012. Una media de 35 por semana
Código desarrollado en FoxPro 2.5 que recorre un directorio buscando todos los archivos .dbf y intenta reparar el encabezado de los mismos si no puede abrirlos.

Versión 1
estrellaestrellaestrellaestrellaestrella(3)

Publicado el 22 de Septiembre del 2012gráfica de visualizaciones de la versión: Versión 1
7.065 visualizaciones desde el 22 de Septiembre del 2012. Una media de 35 por semana
estrellaestrellaestrellaestrellaestrella
estrellaestrellaestrellaestrella
estrellaestrellaestrella
estrellaestrella
estrella

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
*-------------------------------------------------------------------------------------------- *
*    PROGRAMA : DBREPARA.PRG
*    OBJETIVO : RECORRE TODOS LOS DBF DE UN DIRECTORIO Y CHEQUEA QUE SE PUEDA
*               ABRIR SI NO ES ASI, INTENTA REPARAR EL ENCABEZADO
*    AUTOR    : RICHARD SANCHEZ
*    FECHA    : 11/OCT/2004
*-------------------------------------------------------------------------------------------- *
 
CLOSE ALL
ON ERROR DO NOABRE
SET EXCLU ON
 
do db_titulo
 
SELE 1
 
MRUTA = DB_DRIVE+DB_ARCHIVO+DB_SLASH
SET DEFA TO &MRUTA
 
DECLARE ARD(200,5)
XTA=0
KA=ADIR(ARD,"*.DBF")
T=ASORT(ARD)
TKA=0
 
FOR N=1 TO KA
    WAIT WINDOWS "REPARANDO TABLAS" NOWAIT
      DBF=ALLTRIM(ARD(N,1))
      AP=.T.
      DO WHILE .T.
          OK=.T.
        USE &DBF
        IF OK
            EXIT
        ENDIF
      ENDDO
      IF .NOT. AP
          SELE 1
        TKA=TKA+1
      ENDIF
NEXT
 
CLOSE ALL
ON ERROR
CLOSE ALL
SET DEFA TO &DB_OBJETOS
IF TKA<>0
    DO DB_ERRMSG WITH "Proceso finalizado ! Se repararon "+ALLTRIM(TRANS(TKA,"999999"))+" archivo(s)"
ELSE
    DO DB_ERRMSG WITH "Proceso finalizado ! No se encontraron archivos da¤ados"
ENDIF
QUIT
 
PROCEDURE NOABRE
  H=FOPEN(DBF,2)
  IF H<0
    DO DB_ERRMSG WITH "NO ES POSIBLE ABRIR EL ARCHIVO "+DBF
    RETURN
  ENDIF
  M=FSEEK(H,4)
  C1=FREAD(H,1)
  M=FSEEK(H,5)
  C2=FREAD(H,1)
  M=FSEEK(H,6)
  C3=FREAD(H,1)
  TAM=(ASC(C3)*65536)+(ASC(C2)*256)+(ASC(C1))
  OTM=TAM
  TAM=TAM-1
  STORE 0 TO B1,B2,B3
  IF TAM>=65536
      B3=INT(TAM/65536)
  ENDIF
  TAM=TAM-(65536*B3)
  IF TAM>=256
      B2=INT(TAM/256)
  ENDIF
  TAM=TAM-(256*B2)
  B1=TAM
  M=FSEEK(H,4)
  T=FWRITE(H,CHR(B1))
  M=FSEEK(H,5)
  T=FWRITE(H,CHR(B2))
  M=FSEEK(H,6)
  T=FWRITE(H,CHR(B3))
  XTA=(B3*65536)+(B2*256)+B1
  IF AP
      SELE 1
    AP=.F.
  ENDIF
  DO DB_CLRLIN WITH 23
  @ 23,15 SAY "TABLA "+DBF+TRANS(OTM,"999999")+" REGISTROS REPARANDOSE"
  T=FCLOSE(H)
OK=.F.



Comentarios sobre la versión: Versión 1 (3)

Jorge
12 de Diciembre del 2013
estrellaestrellaestrellaestrellaestrella
Muy buena su web, con bastante tiempo ayudando mucha gente pero deben cuidar la calidad de los artìculos que aùn soportan, necesitè reparar unas dbf viejas acudì a esta rutina que aùn tienen publicada y lo ùnico que contiene son errores, esto significa pèrdida de tiempo y por consiguiente de puntos por parte de su foro. Saludos...
Responder
Hector
04 de Abril del 2014
estrellaestrellaestrellaestrellaestrella
Es verdad, al modulo le faltan rutinas como el db_titulo que no se que es lo que hace. Uno tiene que adivinar que es lo que hace. Seria bueno que se entreguen soluciones completas
Responder
Imágen de perfil
Francisco
09 de Febrero del 2015
estrellaestrellaestrellaestrellaestrella
Cuando deseen compartir los programas si es con el fin de ayudar bienvenido sea, es de gran ayuda, pero como un buen programador debe y siempre lo debe hacer es documentar todo lo codificado y para las versiones a las cuales funciona, pero es muy interesante ver como hay muchos que desean ayudar a los demas programadores
Responder

Comentar la versión: Versión 1

Nombre
Correo (no se visualiza en la web)
Valoración
Comentarios

http://lwp-l.com/s2218