*/***************************************************************************
*/Program : SYS_DICT.PRG
*/System :
*/Purpose : Create a generic data dictionary program
*/Syntax : =SYS_DICT() or =SYS_DICT("c:\xxx\xxx"

*/Returns : nothing
*/Parameter : DIR - string - Directory to build the data dictionary in
*/Defaults : dir = sys(5)+sys(2003)
*/Requires : nothing
*/Changes : SYS_DICT.DBF
*/Version : 1.0
*/Dated : 23 May 1995
*/Written By: David W. Grewe
*/***************************************************************************
*& Utility - Programing
*/***************************************************************************
*/ Record Of Change
*/
*/***************************************************************************
*/ Program standards:
*/ FoxPro Command Words - lower case
*/ Memory Variables & UDFs - UPPER CASE
*/ Memory variable naming method:
*/ F_ (Global - File) Holds Info About The User.
*/ C_ (Global - Constant) once defined they are never changed.
*/ G_ (Global - Public ) may be accessed/changed by any file or procedure.
*/ P_ (Private - used to pass values as parameters to and from procedures.
*/ L_ (Private - used only inside a file or procedure.
*/***************************************************************************
parameter pcSearchPath
if parameters() < 1 or type("pcSearchPath"

# "C"
pcSearchPath = sys(5)+sys(2003)
endif
*
set default to (pcSearchPath) && Shift default to work area
set step on
if sys(5)+sys(2003) != pcSearchPath
wait window proper(pcSearchPath) + chr(13) + "is not a valid path !!"
on error
set defa to &lcStartDir
return
endif
*
if right(pcSearchPath,1) != "\"
pcSearchPath = pcSearchPath + "\"
endif
*
if upper(pcSearchPath) = sys(2004)
set defa to &lcStartDir
wait window "FoxPro launch directory " + chr(13) + ;
proper(sys(2004)) + " is not available !!"
on error
return
endif
*
* set enviroment
*
close all
clear
set sysmenu on
set sysmenu to default
set exclu off
set exact on
set talk off
set exclusive off
set safety off
on error **
*
* declare memvars
*
lnDbfs=0
lnFields=0
lcStartDir = sys(5)+sys(2003)
lcDataDbf=pcSearchPath + "SYS_DICT.DBF"
lcDataCdx=pcSearchPath + "SYS_DICT.CDX"
lcDataFpt=pcSearchPath + "SYS_DICT.FPT"
*
* Open/Create Databases
*
if file(lcDataDbf)
use (lcDataDbf) order table alias SYS_DICT exclu
copy stru to C:\TEMP
select 0
use C:\TEMP exclu
else
return
endif
set order to table
*
* Test for dbf files in specified path
*
lnDbfs=adir(laDbfs,"*.DBF"

if lnDbfs < 1
wait window proper(pcSearchPath) + chr(13) + "does not contain databases !!"
else
*
* ran out of reasons not to do it so here goes
*
=asort(laDbfs)
@ 1,1 say "Databases To Place In Dictionary"
@ 2,12 say lnDbfs
@ 3,1 say "Completed"
for I = 1 to lnDbfs
@ 3,12 say I
@ 4,12 say padr(laDbfs(I,1),15)
do case
case upper(laDbfs(I,1))="SYS_DICT.DBF"
loop
case upper(laDbfs(I,1))="FOXUSER.DBF"
loop
case substr(upper(laDbfs(I,1)),1,4)="TEMP"
loop
case substr(upper(laDbfs(I,1)),1,3)="DWG"
loop
endcase
*
* put field structure into to an array
*
lnError=0
on error lnError=ERRORTRAP()
select 0
use laDbfs(I,1) alias IMPORT shared
if lnError < 0
on error
loop
endif
on error
copy stru extended to c:\stru
use
select temp
zap
append from c:\stru
replace all TABLE with strtran(laDbfs(I,1),".DBF",""

goto top
*
* populate the data database
*
scan all
scatter memvar memo
if !seek(M.TABLE+M.FIELD_NAME,"SYS_DICT"

insert into SYS_DICT from memvar
endif
endscan
*
select TEMP
zap
endfor
*
endif
close databases
delete file ("C:\TEMP.DBF"

delete file ("C:\TEMP.CDX"

delete file ("C:\TEMP.FPT"

delete file ("C:\STRU.DBF"

delete file ("C:\STRU.CDX"

delete file ("C:\STRU.FPT"

set defa to &lcStartDir && Restore user default
release array laFields,laDbfs
release all
set sysmenu to default
on error
clear
return
*!*****************************************************************************
*!
*! Procedure: ERRORTRAP
*!
*! Called by: DICTDATA.PRG
*!
*!*****************************************************************************
procedure ERRORTRAP
*******************
return -1
*: EOF: DICTDATA.PRG
David W. Grewe
Dave@internationalbid.com