Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : FIELDS.ZIP
Filename : FIELDS.PRG

* FIELDS.PRG - Program to measure field length and usage
* Rick Shaddock - Computer Applications Company 202-829-4444
* Ever wonder if you have too many blank spaces in your files
* by having too wide a length?
* Steps:
* 1. Bring a database in to use in area 1
* 2. Type DO FIELDS
* 3. After processing, a database FIELDS.DBF in work area 2 will show the results
*
* You will be able to see which fields could be trimmed down
* and how many times each field has been actually used.

set echo off
set format to
set talk off
clear
vDATABASE=dbf()+space(100-len(trim(dbf())))
@ row(),0 say 'Which database to use?:' get vDATABASE func '!S56'
read
vDATABASE=trim(vDATABASE)

select 1
if len(vDATABASE) > 0
use &vDATABASE
endif
vDATABASE=upper(dbf())
set safety off
copy structure extended to TEMP

select 2
use FIELDS excl
zap
append from TEMP
erase TEMP.DBF
set safety on
CMD="@8,2 say str(recno())+'/'+RECCOUNT+str(K)+str(LENGTH)+'/'+ltrim(str(MAX))"
go top
BAR_FIELD =1/reccount()
BAR_RECORD=0

do while .not. eof()
clear
@1,0 to 10,50
FIELD = FIELD_NAME
FTYPE = FIELD_TYPE
MAX=0
K=0
@ 2,2 say vDATABASE
@ 3,2 say ' Field Type'
@ 4,2 say str(recno())+'/'+ltrim(str(reccount())) +' '+FIELD+' '+FTYPE
@ 7,2 say ' Record UseCount Length/Maximum'


@13,2 say replicate(chr(219),BAR_FIELD * recno(2) * 76)

select 1
* The DBF being tested
go top
RECCOUNT = ltrim(str(reccount())) +" "
BAR_RECORD = 1/reccount()
BAR="@12,2 say replicate(chr(219),BAR_RECORD * recno(1) * 76)"
@11,0 to 14,78

do case
case FTYPE = 'C'
do while .not. eof()
LENGTH = len(trim(&FIELD))
if LENGTH > MAX
MAX = LENGTH
endif
if LENGTH > 0
K=K+1
endif
&CMD
&BAR
skip
enddo

case FTYPE = 'N'
do while .not. eof()
LENGTH = &FIELD
if LENGTH > MAX
MAX = LENGTH
endif
if &FIELD > 0
K=K+1
endif
&CMD
&BAR
skip
enddo
do case
case MAX >= 1000000000
MAX =10
case MAX >= 100000000
MAX =9
case MAX >= 10000000
MAX =8
case MAX >= 1000000
MAX =7
case MAX >= 100000
MAX =6
case MAX >= 10000
MAX =5
case MAX >= 1000
MAX =4
case MAX >= 100
MAX =3
case MAX >= 10
MAX =2
otherwise
MAX =1
endcase

case FTYPE = 'L'
MAX = 1
LENGTH = 1
do while .not. eof()
if &FIELD
K=K+1
endif
&CMD
&BAR
skip
enddo

case FTYPE = 'D'
MAX = 8
LENGTH = 8
do while .not. eof()
if dtoc(&FIELD)<>' / / '
K=K+1
endif
&CMD
&BAR
skip
enddo

case FTYPE = 'M'
MAX = 10
LENGTH = 10
@ 8,2 say 'Memo field - NA'
&BAR

endcase

select 2
* FIELDS.DBF
replace LENGTH with MAX
replace FIELDCOUNT with K
skip
enddo
? chr(7)
? chr(7)
? chr(7)
? 'Done!'
set talk on
**