>Dear!
>Sure, I really need that file and,
>Thankx a lot for your positive response
>
>Best Regards
>Aamir Mehmood Philips, Pakistan
>my e-mail "amehmood@ibm.net"


This is text of prg file, in wich I translate Russian comments to English

If you need some aditional information, feel free to write.

Sorry for a delay in answering.

Alexander Mitchenko, Kiev, Ukraine


*************************************************************
* DBF reapir program for error 'Not a database file' *
*************************************************************
*
* Structure of .DBF file:
*
* +--------------------------------------------------------+
* |Offset | Contents |
* +--------+-----------------------------------------------|
* |1 (0)|File type 3-standard file without memo |
* | | (83) 131-FoxBase+ with memo |
* | | (8B) 139-dBase IV with memo |
* | | (F5) 245-FoxPro with memo |
* | | |
* |2-4 (1)|YY MM DD |
* | | |
* |5-8 (4)|Existing number of records, LSB-MSB |
* | | |
* |9-10 (8)|Header length, LSB-MSB |
* | | |
* |11-12(10|Record length, LSB-MSB |
* | | |
* |13-32(12|Empty bytes 00H (20 bytes) |
* | | |
* |33-64(32|Filed description, 32 bytes |
* | (48| +15 - filed length (1 byte) |
* | | |
* | |End of header label - 13 (ODH) |
* | | |
* +--------------------------------------------------------+


set talk off
set safe off
set message to 24
set escape off
set confirm off
set cursor off


helpcolor=iif(iscolor(),[w+/rb,w+/rb,w+/rb],[w+/n,w+/n,w+/n])

define window OKAY from 18,23 to 21,65 shadow double
define window FIXHELP from 5, 3 to 23,75 shadow double;
color &helpcolor

scolor=iif(iscolor(),[b/b,b/b],[n/n,n/n])
set color to &scolor

dimension filelist(128)
public linecount,onscreen
on key label f1 do fixhelp

clear

@ 0,0,21,79 box replicate (chr(219),9)
scolor=iif(iscolor(),[gr+/b,w+/r],[w+/n,n/w])
set color to &scolor
@ 3,58 to 7,78 double
@ 4,60 say 'Pinter Consulting'
@ 5,60 say 'File Fix Utility'
@ 6,60 say ' F1 - Help'
@ 22,0 to 22,79
@ 23,0 say ' ** Building File List ** '
way=''
do LOADLIST


do while .t.
@ 23,0 clear
@ 23,0 prompt ' Wiew Directory ';
message 'Display current DBF files and status'
@ 23,col() prompt ' Fix a File';
message ' Fix a trashed .DBF file'
@ 23,col() prompt ' Exit ';
message ' Exit to DOS'

pick=1
menu to pick
@ 23,0 clear
choice=iif(pick=0,[],substr([VF ],pick,1))
do case
case choice=[ ]
exit
case choice=[V]
set cursor on
way=way+replicate(' ',30-len(way))
@ 1,3 get way
read
set cursor off
if mod(readkey(),256)=12
loop
endif
way=alltrim(way)
if len(way)#0
if right(way,1)#'\'
way=way+'\'
endif
endif
do LOADLIST

@ 23,0 say [ PgUp/PgDn to scroll list, ESC for menu]
@ 3,3 menu filelist, linecount, onscreen shadow
read menu to pick
loop
case choice=[F]
pick=3
do while .t.
@ 23,0 say [ PgUp/PgDn to scroll list, ENTER to select, ESC to cancel]
@ 3,3 menu filelist,linecount,onscreen shadow
read menu to pick
filename=iif(pick=0,' ',way+alltrim(left(filelist(pick),13)))
if len(trim(filename))=0
exit
endif
if pick<3 && if cursor was moved to the top 2 linnes,
pick=3 && place it back to the bottom
loop
endif

* Size of file
* -----------------------

readfile=fopen(filename)
filelen=fseek(readfile,0,2)

* Empty space on the hard drive
* ---------------------------------------------

if filelen>=diskspace()
=fclose(readfile)
wait window 'Insufficient disk space to rewrite file'
loop
endif
=fseek(readfile,0)

* File type
* -------------------
sentinel=asc(fread(readfile,1)) && ⨯ ä ©« : 3-standard type without memo
&& 131-FoxBase+ /memo
&& 139-dBase IV /memo
&& 245-FoxPro /memo
if .not.str(sentinel,3)$' 3-131-139-245'
=fclose(readfile)
wait window 'Invalid first byte - replace entire header'
loop
endif

fox_memo=(sentinel=245)

* status window
* ---------------------------
save screen
@ 9,19,16,60 box '+-+|+-+| '
@ 11,19 say '+----------------------------------------|'
@ 10,21 say 'File : ' + Filename
@ 12,26 say 'Number of Fields :'
@ 13,26 say 'Record Length :'
@ 14,26 say 'Number of Records :'
@ 15,20 say replicate(' ',40)
=fread(readfile,3) && date YY MM DD bytes (2-4)

* number of existing records,LSB-MSB bytes (5-8)
* -----------------------------------------------------------
oldrec= asc(fread(readfile,1))
oldrec=oldrec+asc(fread(readfile,1))*256
oldrec=oldrec+asc(fread(readfile,1))*65536
oldrec=oldrec+asc(fread(readfile,1))*16777216
@ 14,46 say alltrim(str(oldrec))

* header length,LSB-MSB bytes (9-10)
* -----------------------------------------------
hdrlen= asc(fread(readfile,1))
hdrlen=hdrlen+asc(fread(readfile,1))*256

* record length,LSB-MSB bytes (9-10)
* ----------------------------------------------
reclen= asc(fread(readfile,1))
reclen=reclen+asc(fread(readfile,1))*256
@ 13,46 say alltrim(str(reclen))
=fread(readfile,20)
sentinel=asc(fread(readfile,1))
new_reclen=1
numfields =0

* check for the end of file and for 257 fields
* if end of file marker does not exists.
* Extended Clipper file can contain 1022 fields
* ------------------------------------------------
do while sentinel#13.and.numfields<257.and..not.feof(readfile)
numfields=numfields+1

* counting the number of fileld
* ------------------
@ 12,46 say alltrim(str(numfields))
=fread (readfile,15)

* sum of fileds length to calculate actual record length
* -----------------------------------------------------
new_reclen=new_reclen+asc(fread(readfile,1))
=fread(readfile,15)
sentinel=asc(fread(readfile,1))
enddo

if numfields=257.or.sentinel#13
@ 12,46 say '???'

* check for dBase III/Clipper files with even header length
* --------------------------------------------------------------
if hdrlen/2=int(hdrlen/2)
wait window 'HEADER LENGTH INDICATES A DBASE III/CLIPPER FILE'
else
wait window 'UNABLE TO LOCATE THE END OF HEADER BYTE'
endif
=fclose(readfile)
restore screen
loop
endif

* calculating header length and number of records
* -------------------------------------------
new_hdrlen=(numfields+1)*32+1
numrecs=int((filelen-(32*numfields)-34) / new_reclen)

* if the is no need in rewriting header, display a message
* --------------------------------------------------------
if oldrec=numrecs.and.hdrlen=new_hdrlen.and.reclen=new_reclen
@ 15,31 say ' HEADER DATA IS OK '
= FCLOSE(readfile)
else

* otherwise build new file
* -------------------------------------------------
oldname=left(filename,at('.',filename)-1)+'.old'

* if no errors, rewrite file
* --------------------------------------------------------
if file(oldname)
if .not.OK2GO_ON()
=fclose(readfile)
restore screen
loop
endif
endif
=fseek(readfile,0)
writefile=fcreate(way+'fixed')
=fwrite(writefile,fread(readfile,1))

* change date in header to current
* --------------------------------------
fpt_name=dtoc(date())
=fwrite(writefile,chr(val(right(fpt_name,2))))
=fwrite(writefile,chr(val(left(fpt_name,2))))
=fwrite(writefile,chr(val(substr(fpt_name,4,2))))
=fread(readfile,3)
if oldrec=numrecs
=fwrite(writefile,fread(readfile,4))
else
* calc new record number, byte values and write
* ----------------------------------------------------------------
@ 14,46 say alltrim(str(numrecs))+space(6)
b4=chr(int(numrecs/16777216)) && 4 byte MSB
b1=mod(numrecs,16777216)
b3=chr(int(b1/65536)) && 3 byte NSB
b1=mod(b1,65536)
b2=chr(int(b1/256)) && 2 bye NSB
b1=chr(mod(b1,256))
=fread(readfile,4)
=fwrite(writefile,b1+b2+b3+b4)
endif

if hdrlen=new_hdrlen
=fwrite(writefile,fread(readfile,2))
else
=fread(readfile,2)
=fwrite(writefile,chr(mod(new_hdrlen,256))+chr(int(new_hdrlen/256)))
endif

if reclen=new_reclen
=fwrite(writefile,fread(readfile,2))
else
@ 13,46 say alltrim(str(new_reclen))+space(4)
=fread(readfile,2)
=fwrite(writefile,chr(mod(new_reclen,256))+chr(int(new_reclen/256)))
endif

=fwrite(writefile,fread(readfile,numfields*32+21))

* progress indicator
* --------------------------
for cntr=1 to numrecs
@ 15, 20 say replicate(' ',(cntr/numrecs)*40)
=fwrite(writefile,fread(readfile,new_reclen))
endfor
=fwrite(writefile,chr(26))
=fclose(writefile)
=fclose(readfile)
rename &filename to &oldname
fff=way+'fixed.'
rename &fff to &filename

endif

* file with memo
* ----------------------------------------
if fox_memo
fpt_name=way+left(filename,at('.',filename)-1) + '.fpt'

* check for .FPT file
* ---------------------------
if .not.file(fpt_name)
wait window 'UNABLE TO LOCATE THE ASSOCIATED MEMO FILE'
else
writefile=fopen(fpt_name,2)

* .FPT pointers in memo-file are located in reverse order
* MSB-LSB
* ----------------------------------------------------------
oldrec= asc(fread(writefile,1))*16777216
oldrec=oldrec+ asc(fread(writefile,1))*65536
oldrec=oldrec+ asc(fread(writefile,1))*256
oldrec=oldrec+ asc(fread(writefile,1))
=fread(writefile,2)

* calc block size MSB-LSB bytes (7-8)
* -------------------------------------------
reclen= asc(fread(writefile,1))*256
reclen=reclen+ asc(fread(writefile,1))
if reclen<1.or.reclen>16384
wait window 'INVALID BLOCKSIZE FOUND IN THE MEMO FILE'
else
=inkey(3)
if reclen<33
reclen=reclen*512
endif
filelen=fseek(writefile,0,2)
numrecs=int(filelen/reclen)
if numrecs<(filelen/reclen)
numrecs=numrecs+1
endif
if numrecs=oldrec
@ 15,31 say ' MEMO FILE IS GOOD '
else
@ 15,31 say ' FIXING MEMO FILE '
=fseek(writefile,0)
b4=chr(int(numrecs/16777216))
b1=mod(numrecs,16777216)
b3=chr(int(b1/65536))
b1=mod(b1,65536)
b2=chr(int(b1/256))
b1=chr(mod(b1,256))
=fwrite(writefile,b4+b3+b2+b1)
endif
endif
=fclose(writefile)
endif
endif

=inkey(3)
flush
on error wait window 'UNABLE TO CORRECTLY FIX THIS FILE'
use &filename
on error
use
***04.08.97 SIA
SET EXCLUSIVE ON
use &filename
USE
***
restore screen
do LOADLIST

enddo
endcase
enddo

erase foxdir.txt
set clear off
set cursor on
clear
@ 13,14 say ' ** Be sure to back up your data files regularly ** '
quit


*********************************************
* FILELIST *
*********************************************
procedure LOADLIST

* Build array with names of .DBF files, (DIR)
*-------------------------------------------------------------
set console off

* put chars in the keyboard buffer in order not to get
* 'Press any key' message in the case of a big file amount. One CHR(13) for
* each 22 files
*---------------------------------------------------------------
keyboard chr(13)+chr(13)+chr(13)+chr(13)+chr(13)+chr(13)

*-------------------------------------------------------
directory &way to file foxdir
clear typeahead
set console on
fh=fopen('foxdir.txt')

for i=1 to 128
filelist(i)=[]+left(fgets(fh),43)
if (len(alltrim(filelist(i)))=0.and.i>2).or.(i=127)
exit
endif
if 'NOT A FOX' $ upper(filelist(i))
filelist(i)=left(filelist(i),40)+space(3)
endif
endfor
=fclose(fh)
linecount=i-1

if i>2
on error filelist(i)=left(filelist(i),13)+[ - Error file]
for i=3 to linecount
fname=way+alltrim(left(filelist(i),13))
use &fname
endfor
use
endif

onscreen=iif(linecount<=17,linecount,17)
filelist(1)=filelist(2)
filelist(2)=replicate([-],44)
@ 3,3,3+onscreen+1,3+45 box [+-+|+-+| ]
for i=1 to onscreen
@ 3+i,4 say filelist(i)
endfor
return

procedure OK2GO_ON
privat ovr_wrt
activate window OKAY
clear
@ 0,1 say 'File '+oldname+' already exist.'
@ 1,5 prompt ' Cancel '
@ 1,col()+1 prompt ' Proceed '
ovr_wrt=1
menu to ovr_wrt
deactivate window okay

if ovr_wrt#2
return .f.
endif

delete file &oldname
return .t.

procedure FIXHELP
activate window FIXHELP
clear
text

This program allows to repair files, for wich error message
'Not a database file' was recieved. Program works similarly
to the Norton Utilities(tm) FileFix.

endtext
wait window
deactivate window FIXHELP
return