Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
DSalvage
Message
 
To
06/05/2008 09:03:41
Jay Johengen
Altamahaw-Ossipee, North Carolina, United States
General information
Forum:
Visual FoxPro
Category:
Other
Title:
Environment versions
Visual FoxPro:
VFP 9 SP2
Miscellaneous
Thread ID:
01315302
Message ID:
01315356
Views:
19
Here is a routine I got somewhere that helps to fix some minor goofs in DBF files ...
set talk off
private LGotError, cdbffile, l1str, nHdrRecCount, nBeginData, nRecSize, nRecsFound, ;
   l1replace, l1tmp, nFileNum, l1loop, hnddbffile, nOffset
store .f. to LGotError, cdbffile, l1str, nHdrRecCount, nBeginData, nRecSize, nRecsFound, ;
   l1replace, l1tmp, nFileNum, l1loop, hnddbffile, nOffset
dimension aDbfs(1)
=adir(aDbfs,'.\*.dbf')
LGotError=.f.
clear
? 'Checking Database Files'
?
if alen(aDbfs)<>1
   for nFileNum=1 to alen(aDbfs,1)

      if aDbfs[nFileNum,2] = 0
         LGotError=.t.
         ? cDbfFile
         ?? ' 0 bytes' 
         loop
      endif

      cDbfFile=aDbfs(nFileNum,1)
      store fopen(cDbfFile,2) to hndDbfFile
      store fseek(hndDbfFile, 0, 2) to nOffset
      =fseek(hndDbfFile,0)
      l1str=fread(hndDbfFile,4)  && skip over file type byte and 3 bytes for modified date
      nHdrRecCount=readx(4)
      nBeginData=readx(2)
      nRecSize=readx(2)
      nRecsFound=(nOffset-(nBeginData+1))/nRecSize
      nRecsFound=iif(nOffset=nBeginData,0,nRecsFound)
      if nRecsFound # nHdrRecCount
         LGotError=.t.
         ? cDbfFile
         ?? ' ' 
         ?? nRecsFound 
         ?? ' ' 
         ?? nHdrRecCount
         =fseek(hndDbfFile,0)
         l1str=fread(hndDbfFile,4)
         l1replace=right('00000000'+hex(nRecsFound),8)
         l1tmp=''
         for l1loop=1 to 4
            l1tmp=chr(dec(substr(l1replace,l1loop*2-1,2)))+l1tmp
         endfor
         =fwrite(hndDbfFile,l1tmp)
      endif
      = fclose(hndDbfFile)
   endfor
endif
?
? iif(LGotError,'Errors Found!','All Databases appear okay')
return

Function Readx
   parameter l1len
   private l1str, l1tmp, l1value, l1loop
   store .f. to l1str, l1tmp, l1value, l1loop
   l1str=fread(hndDbfFile,l1len)
   l1tmp=''
   for l1loop=1 to l1len
     l1tmp=right('00'+hex(asc(substr(l1str,l1loop,1))),2)+l1tmp
   endfor
   l1value=dec(l1tmp)
   return l1value

Function Hex
   parameters l1int
   private l1part, l1loop, l1hex, l1str
   store .f. to l1part, l1loop,l1hex,l1str
   l1str='0123456789ABCDEF'
   l1hex=''
   for l1loop=7 to 0 step -1
      l1part=int(l1int/(16^l1loop))
      l1hex=l1hex+substr(l1str,l1part+1,1)
      l1int=l1int-l1part*(16^l1loop)
   endfor
   do while left(l1hex,1)='0'.and.len(l1hex)>1
      l1hex=substr(l1hex,2)
   enddo
   return l1hex

Function Dec
   parameters l1hex
   private l1loop, l1int, l1str, l1ctr
   l1str='0123456789ABCDEF'
   l1int=0
   for l1loop=len(l1hex)-1 to 0 step -1
      l1int=l1int+(16^l1loop)*(at(substr(l1hex,len(l1hex)-l1loop,1),l1str)-1)
   endfor
   return l1int


Previous
Reply
Map
View

Click here to load this message in the networking platform