Página 1 de 1

Função para teste de integridade de .DBF( Uso Geral )

Enviado: 27 Nov 2004 02:52
por rochinha
Amiguinhos

Coloquei este post desta forma para que o mesmo possa ser visto de forma mais geral.

Código: Selecionar todos

#INCLUDE "FILEIO.CH" 

FUNCTION lOkDbf( cNameExt, cPath ) 
LOCAL lReturn := .T. 
LOCAL nHnd, cBytes, nNumRecs, nHdrSize, nRecSize, nFileSize, nRecs 
LOCAL cError, cErrorLog 

// Abrimos en exclusiva. Si no es posible, alguien lo esta usando (NO dañado) 
IF (nHnd := FOpen(cPath + '\' + cNameExt, FO_READWRITE + FO_EXCLUSIVE)) > 0 
   FSeek(nHnd,4,FS_SET) 
   // Numero registros segun tabla 
   cBytes := '0000' 
   FRead(nHnd,@cBytes,4) 
   nNumRecs := Bin2L(cBytes) 
   // Tamaño Header 
   cBytes := '00' 
   FRead(nHnd,@cBytes,2) 
   nHdrSize := Bin2I(cBytes) 
   // Tamaño Registro 
   cBytes := '00' 
   FRead(nHnd,@cBytes,2) 
   nRecSize := Bin2I(cBytes) 
   // Tamaño Tabla 
   nFileSize := FSeek(nHnd,0,FS_END) 
   // Numero de registros real 
   nRecs := (nFileSize - nHdrSize) / nRecSize 
   // Si el archivo se manipulo con dBase, Fox ... tiene 1 byte mas 
   IF nRecs != Round(nRecs,0) 
      nRecs := (nFileSize - nHdrSize - 1) / nRecSize 
   ENDIF 
   // Si los registros segun la tabla y los calculados no coinciden 
   IF nRecs != nNumRecs 
      cError := "Número de registros incorrecto en fichero " + cNameExt 
      cErrorLog := cError + " en" + CRLF + Trim(cPath) + ' :' + CRLF + CRLF +; 
      " Registros iniciales " + sTr(nNumRecs,7) + CRLF +; 
      " Registros detectados " + sTr(nRecs,7) + CRLF + CRLF +; 
      "Asegúrese de guardar la última copia de seguridad y" + CRLF +; 
      "realice una copia suplementaria ANTES DE corregir el" + CRLF +; 
      "problema." 
      IF MsgNoYes( cErrorLog + CRLF + CRLF +; 
         "¿ Desea corregir el problema ?", "Error de apertura") 
         FSeek(nHnd,4,FS_SET) 
         FWrite(nHnd,L2Bin(Round(nRecs,0)),4) 
         MsgInfo('El problema ha sido corregido.' + CRLF + CRLF +; 
                 'Antes de continuar el uso normal del programa' + CRLF +; 
                 'debe realizarse una "Indexación de ficheros".','Aviso Importante') 
      ENDIF 
   ENDIF 
   FClose(nHnd) 
ENDIF 
RETURN lReturn

function MsgNoYes( mensagem )
    if Alert( mensagem, { "Sim", "Nao" } ) == 1
       return .t.
    endif
    return .f.
    
function MsgInfo( mensagem )
    Alert( mensagem )
    return .t.
@braços :?)

Enviado: 29 Nov 2004 10:37
por evolver
Vou deixar como fixo por um tempo pro pessoal poder ver, testar e responder se funfou legal.

Valeu rochinha. :D (Y)

Enviado: 01 Dez 2004 10:25
por rochinha
Valeu amiguinho

Desculpe a demora de resposta, mas as vezes não consigo entrar no forum pois o site simplesmente não é encontrado.

@braços :?)