PC Toledo

Código: Selecionar todos

FUNCTION ROOTNAME(cFilePath)
  LOCAL cPath, cFileName, cExtension
  HB_FNameSplit( cFilePath, @cPath, @cFileName, @cExtension )
RETURN cFileName

Código: Selecionar todos

#include "FiveWin.ch"

FUNCTION Main()

  //parameters cFileName
  LOCAL cFileName := "SERVIDOR.DBF"

  ? isdbf(cFilename)

  aDBInfo:=isdbf(cFileName,1)

  ? aDBInfo[1] 
  ? aDBInfo[2] 
  ? aDBInfo[3]

  aDBStruct:=isdbf(cFileName,2)

  ? aDBInfo[1] 
  ? aDBInfo[2] 
  ? aDBInfo[3]

  quit

RETURN NIL

* -------------------------------------------------------- 
function   isdbf(cFileName,nMode) 
  /* ------------------------------------------------------ 
    ISDBF() 
      Pr ft ob DBF in Ordnung ist 
    Syntax: 
      isdbf(<cDATEINAME>,[<nMODUS>])->lOK|aDBINFO 
    Parameter: 
      <cDateiname> ein g ltiger DOS Dateiname 
      <nModus> 0 oder NULL gibt logischen Wert zur ck ob Datei in Ordnung 
ist 
               1 gibt ein Array mit Dateiinformationen zur ck 
               2 gibt ein Array mit Dateiinformationen zur ck 
    R ckgabe: 
      Modus 0: .t. Datei ok, .f. Datei fehlerhaft 
      Modus 1: Ein Array mit folgendem Aufbau: 
               nError       : Fehlernummer; 0=ok 
               cDErrorText  : Fehlerbeschreibung deutsch 
               cGBErrorText : Fehlerbeschreibung englisch 
        zus?tzlich, wenn kein Fehler: 
               nDBType      : Versionsnummer der Datenbank 
               cLastUpdate  : Datum des letzten Schreibzugriffs 
               nRecNo       : Anzahl der Datens?tze laut Header 
               nHeadLen     : Headerl?nge 
               nRecLen      : Satzl?nge 
               nFieldCount  : Anzahl der Felder 
      Modus 2: Ein Array mit folgendem Aufbau: 
               nError       : Fehlernummer; 0=ok 
               cDErrorText  : Fehlerbeschreibung deutsch 
               cGBErrorText : Fehlerbeschreibung englisch 
        zus?tzlich, wenn kein Fehler: 
               aFieldName   : Array mit den Feldnamen 
               aFieldType   : Array mit den Feldtypen 
               aFieldLen    : Array mit den Feldl?ngen 
               aFieldDec    : Array mit den Dezimalstellen 
  -------------------------------------------------------- */ 
  * ---------------- Puffervariablen initialisieren ------ 
  cDBType:=space(1)      /* DBase Version 03=DB3 / 83=DB3-Memo */ 
  cLastUpdate:=space(3)  /* Datum letzter Schreibzugriff */ 
  cRecNo:=space(4)       /* Anzahl Datens?tze */ 
  cHeadLen:=space(2)     /* Headerl?nge */ 
  cRecLen:=space(2)      /* Datensatzl?nge */ 
  cFieldInfo:=space(32)  /* Feldbeschreibung */ 
  nFieldCount:=0         /* Anzahl der Felder */ 
  cHeadEnd:=space(1)     /* Header Ende (0D) */ 
  nDBType:=0 
  nRecNo:=0 
  nHeadLen:=0 
  nRecLen:=0 
  nFieldCount:=0 
  nCount:=0 
  * ------------------------------------------------------ 
  if valtype(nMode)="U" 
    nMode:=0 
  endif 
  nHandle:=fopen(cFileName,64)  /* read-only deny-none */ 
  nError:=ferror() 
  begin sequence 
    if nError!=0 
      break /* low level file error */ 
    endif 
    nFileLen:=fseek(nHandle,0,2)  /* EOF */ 
    fseek(nHandle,0,0) /* BOF */ 
    /* Datenbankversion */ 

    nDBType:=asc(cDBType) 
    if nDBType!=3 .and. nDBType!=131 
      nError:=200 
      break  /* Keine DB3 Datei */ 
    endif 
    /* Datum letzte ?nderung ins dtos Format */ 

    cLastUpdate:="19"+strzero(asc(substr(cLastupdate,1,1)),2)+; 
                 strzero(asc(substr(cLastupdate,2,1)),2)+; 
                 strzero(asc(substr(cLastupdate,3,1)),2) 
    /* Anzahl Records LSB=1, MSB=4 (interner Z?hler) */ 

    nRecNo:=asc(substr(cRecNo,1,1))+; 
            asc(substr(cRecNo,2,1))*256+; 
            asc(substr(cRecNo,3,1))*65536+; 
            asc(substr(cRecNo,4,1))*4294967296 
    /* Headerl?nge LSB=1, MSB=2 */ 

    nHeadLen:=asc(substr(cHeadLen,1,1))+; 
              asc(substr(cHeadLen,2,1))*256 
    /* Recordl?nge LSB=1, MSB=2 */ 

    nRecLen:=asc(substr(cRecLen,1,1))+; 
             asc(substr(cRecLen,2,1))*256 
    /* reservierter Bereich 20 Zeichen  berspringen */ 
    fseek(nHandle,20,1) 
    /* Feldinfos auslesen (Bis hier ist der Header immer 32 Byte lang) */ 
    do while fseek(nHandle,0,1)<nHeadLen-32 

      if nByteCount!=32 
        nError:=210 
        nCount:=nFieldCount 
        break  /* Something terrible has happened */ 
      endif 
      nFieldCount++ 
    enddo 
    /* Feldinfo analysieren */ 
    fseek(nHandle,32,0) 
    declare aFieldName[nFieldCount],aFieldType[nFieldCount],; 
            aFieldLen[nFieldCount],aFieldDec[nFieldCount] 
    for nCount=1 to nFieldCount 

      aFieldName[nCount]:=substr(cFieldInfo,1,at(chr(0),cFieldInfo)-1) 
      aFieldType[nCount]:=substr(cFieldInfo,12,1) 
      if !aFieldType[nCount]$"CNLDM" 
        nError:=220 
        break  /* unbekannter Feldtyp */ 
      endif 
      aFieldLen[nCount]:=asc(substr(cFieldInfo,17,1)) 
      aFieldDec[nCount]:=asc(substr(cFieldInfo,18,1)) 
      if aFieldDec[nCount]>0 .and. aFieldType[nCount]!="N" 
        nError:=230 
        break /* Dezimalstellen nur bei numerischen Feldern */ 
      endif 
      if aFieldDec[nCount]>aFieldLen[nCount]-2 .and.; 
         aFieldDec[nCount]!=0 .and. aFieldType[nCount]=="N" 
        nError:=240 
        break /* zu viele Dezimalstellen angegeben */ 
      endif 
    next 
    /* Header Ende lesen */ 

    if cHeadEnd!=chr(13) 
      nError:=250 
      break  /* Hier mu das Header Ende sein */ 
    endif 
  end sequence 
  fclose(nHandle) 
  aTmp=ErrTxt(nError,nCount) 
  cDErrorText:=aTmp[1] 
  cGBErrorText:=aTmp[2] 
  do case 
    case nMode==1 .and. nError==0 
      return({nError,cDErrorText,cGBErrorText,nDBType,cLastUpdate,; 
              nRecNo,nHeadLen,nRecLen,nFieldCount}) 
    case nMode==1 .and. nError!=0 
      return({nError,cDErrorText,cGBErrorText}) 
    case nMode==2 .and. nError==0 
      return({nError,cDErrorText,cGBErrorText,aFieldName,; 
              aFieldType,aFieldLen,aFieldDec}) 
    case nMode==2 .and. nError!=0 
      return({nError,cDErrorText,cGBErrorText}) 
    otherwise 
      return(iif(nError==0,.t.,.f.)) 
  endcase 
* -------------------------------------------------------- 
function   ErrTxt(nError,nFieldNo) 
  do case 
    case nError==0 
      cDErrorText:="Keine Fehler gefunden" 
      cGBErrorText:="No errors found" 
    case nError==2 
      cDErrorText:="Datei nicht gefunden" 
      cGBErrorText:="File not found" 
    case nError==3 
      cDErrorText:="Pfad nicht gefunden" 
      cGBErrorText:="Path not found" 
    case nError==4 
      cDErrorText:="Zu viele Dateien geffnet" 
      cGBErrorText:="Too many open files" 
    case nError==5 
      cDErrorText:="Zugriff verweigert" 
      cGBErrorText:="Access denied" 
    case nError==6 
      cDErrorText:="Ung ltiges Datei-Handle" 
      cGBErrorText:="Invalid handle" 
    case nError==8 
      cDErrorText:="Nicht gen gend Speicher vorhanden" 
      cGBErrorText:="Insufficient memory" 
    case nError==15 
      cDErrorText:="Ung ltige Laufwerksangabe" 
      cGBErrorText:="Invalid drive specified" 
    case nError==19 
      cDErrorText:="Schreibversuch auf schreibgesch tzter Diskette" 
      cGBErrorText:="Attempt to write on a write protected diskette" 
    case nError==21 
      cDErrorText:="Laufwerk nicht bereit" 
      cGBErrorText:="Drive not ready" 
    case nError==23 
      cDErrorText:="CRC-Datenfehler (Pr fsummenfehler)" 
      cGBErrorText:="CRC error" 
    case nError==29 
      cDErrorText:="Schreibfehler" 
      cGBErrorText:="Write fault" 
    case nError==30 
      cDErrorText:="Lesefehler" 
      cGBErrorText:="Read fault" 
    case nError==32 
      cDErrorText:="Fehlerhafter Mehrfachzugriff" 
      cGBErrorText:="Sharing violation" 
    case nError==33 
      cDErrorText:="Mehrfachzugriff gesperrt" 
      cGBErrorText:="Lock violation" 
    case nError==200 
      cDErrorText:="Datei ist keine DB3 Datei" 
      cGBErrorText:="File is no DB3 database" 
    case nError==210
      cDErrorText:="Lesefehler in der Datenfeldbeschreibung Feld:"+strzero(nFieldNo,3)
      cGBErrorText:="Read fault in field definition field:"+strzero(nFieldNo,3)
    case nError==220 
      cDErrorText:="Feldtyp unbekannt; Feld:"+strzero(nFieldNo,3) 
      cGBErrorText:="Unknown field type; field:"+strzero(nFieldNo,3) 
    case nError==230 
      cDErrorText:="Felddezimalenfehler; Feld:"+strzero(nFieldNo,3) 
      cGBErrorText:="Error in field decimals; field:"+strzero(nFieldNo,3) 
    case nError==240 
      cDErrorText:="Feldl?ngenfehler; Feld:"+strzero(nFieldNo,3) 
      cGBErrorText:="Error in field length; field:"+strzero(nFieldNo,3) 
    case nError==250 
      cDErrorText:="Dateiheader Ende nicht gefunden" 
      cGBErrorText:="File header end not found" 
    otherwise 
      cDErrorText:="Unbekannter Fehler: "+str(nError,3) 
      cGBErrorText:="Unknown error: "+str(nError,3) 
  endcase 
 return({ cDErrorText,cGBErrorText })

Código: Selecionar todos

function main()

    cls
    ? verificaDBF("a.dbf")
    ? verificaDBF("facil.dbf")

return NIL

// ============================================================
function verificaDBF(nomeArquivo)
    local ret := .T.

    BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
        use &nomearquivo
        close
    RECOVER
        ret:= .F.
    END SEQUENCE

return ret
// ============================================================

Código: Selecionar todos

#include "FiveWin.ch"  // retire isto

STATIC lOk := .F.

FUNCTION Main()

   IF ISDBF( "SERVIDOR.dbf" )

      IF lOk

         ? "Valid .DBF File"

      ELSE

         ? "Not a valid .DBF file."

      ENDIF

   ENDIF

RETURN NIL

function IsDBF(cFile)

   local hFile,buffer,cText:=""

   hFile:=fopen(cFile)

   buffer:=SPACE(512)

   fread(hFile,@buffer ,512)

   cText:=str2hex(substr(buffer,1,1))

   fclose(cFile)

   if alltrim(cText)="03"

      lOk:=.t.

   else

      lOk:=.f.

   end if

return lOk

Código: Selecionar todos

function main()
  LOCAL nHandle := FOpen( "teste.dbf" )
  LOCAL cDbfMod := SPACE(1)
  
  IF FError() == 0
    FRead( nHandle, @cDbfMod, 1 )
    FClose( nHandle )
    
    IF cDbfMod == 0x03 .OR. cDbfMod == 0x83
      ? "EH UM DBF EM!!!"
    ENDIF 
  ENDIF  

return nil