Clipper On Line • Ver Tópico - Função para teste de integridade de .DBF( Uso Geral )
Mudar para estilo Clássico
Aqui você poderá oferecer suas Contribuições, Dicas e Tutoriais (Texto ou Vídeo) que sejam de interesse de todos.
Postar uma resposta

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

27 Nov 2004 01:52

Amiguinhos

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

Código:
#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 :?)
Editado pela última vez por rochinha em 30 Nov 2005 11:48, no total de 2 vez

29 Nov 2004 09:37

Vou deixar como fixo por um tempo pro pessoal poder ver, testar e responder se funfou legal.

Valeu rochinha. :D (Y)
Editado pela última vez por evolver em 01 Dez 2004 10:33, num total de 1 vezes

01 Dez 2004 09:25

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 :?)
Postar uma resposta