************************************************************
* Program....: PRTSTRUC.PRG
* Version....: 1.0
* Author.....: IHS / IS Development Team / Gerry White
* Date.......: November 1996
* Notice.....: Copyright (c) 1996 Integrated Health Systems
* ...........: All rights reserved.
* Compiler...: FoxPro 2.6a
* Abstract...: obtain and print/store table structures
* Changes....:
************************************************************
CLOSE DATABASES
CLEAR ALL
SET TALK OFF
CLEAR

lcCurDef = FULLPATH(SET("DEFAULT"))

*!*	DO WHILE .T.
	@ 04,5 SAY "PrtStruc"
	@ 06,5 SAY "by Gerry White 11-96 / Maxim Group / IHS - Owings Mills,MD"
	@ 08,5 SAY "Today's date: " + DTOC(DATE())
	@ 10,5 SAY "This routine will gather and store (or print) the structures of all"
	@ 11,5 SAY "  tables in the directory you select."
	@ 13,5 SAY "Either DBFSTRUC.TXT will be stored in the selected table directory"
	@ 14,5 SAY "  or you can print structures immediately."
	WAIT CLEAR
	WAIT WINDOW "Select directory to gather table info for..." NOWAIT
	cDbfDir = GETDIR(CURDIR(),"DBF Source")	&& uses FoxPro GetDir dialog box
	IF EMPTY(cDbfDir)		&& user didn't select a DIR
		WAIT CLEAR
		WAIT WINDOW "No directory selected.  PrtStruc cancelled..." NOWAIT
		RETURN
	ELSE
		@ 14,00 CLEAR
	ENDIF
	@ 20,5 SAY "Directory selected: " + cDbfDir
	
	** Give user the choice to print structures or store info in file **
*!*		WAIT CLEAR
*!*		WAIT WINDOW "Press <P> to print structures now. Any other key to send to file..." TO m.Answer
*!*		lPrtStruc = IIF(UPPER(m.Answer)="P",.T.,.F.) && para que no me pregunta si quiero imprimirlo
	
	lPrtStruc =.f.
	** nDbfNum contains number of DBF files found		**
	** aDbfAry is the array created with DBF file data	**
	nDbfNum = ADIR(aDbfAry,cDbfDir+"*.DBF")		&& get a list of DBF's from selected dir
	
	IF nDbfNum = 0		&& no DBF's found?
		WAIT CLEAR
		WAIT WINDOW "No tables found in "+cDbfDir TIMEOUT 4
		LOOP
	ELSE					&& found one or more .DBF files
		WAIT CLEAR
		WAIT WINDOW "Processing "+ALLTRIM(STR(nDbfNum))+" table(s)." NOWAIT
	ENDIF
	
	@ 22,5 SAY "DBF's processed: "
	=ASORT(aDbfAry)		&& sort the array

	DbfStrFil = '"'+cDbfDir + "DbfStruc.TXT"+'"'

	** get rid of existing DbfStru.txt file, if it exists **
	IF FILE (DbfStrFil)
		ERASE (DbfStrFil)
	ENDIF	

	** get structure info for each table found **
	** each array section has five elements - hence the /5 divisor **
	FOR DbfCntr = 1 TO ALEN(aDbfAry)/5
		IF "FOXUSER" $ aDbfAry[DbfCntr,1]
			LOOP
		ENDIF
		USE cDbfDir + aDbfAry[DbfCntr,1] SHARED NOUPDATE
		?? aDbfAry[DbfCntr,1] + SPACE(3)		&& print DBF name on screen
		NumFlds = AFIELDS(aDbfStruc)			&& put table structure into array
		IF NOT lPrtStruc		&& send to file
			SET PRINTER TO &DbfStrFil ADDITIVE
		ENDIF
		LIST STRUCTURE TO PRINT NOCON
		IF NOT lPrtStruc		&& send to file
			SET PRINTER TO
		ENDIF
		USE
	ENDFOR && DbfCntr = 1 TO ALEN(aDbfAry)
	IF lPrtStruc
		cPrtStrg = " Table structures sent to printer."
	ELSE
		cPrtStrg = " Table structures stored in: &cDbfDir.DbfStruc.TXT"
	ENDIF
	=MESSAGEBOX("Finished running PrtStruc.prg for &cDBFDir" + CHR(13) + CHR(13) + cPrtStrg, ;
					0+48,"Click on OK to continue")
*!*	ENDDO
IF lPrtStruc
	@ 35,10 "Last operation's table structures stored in: &cDbfDir.DbfStruc.TXT"
ENDIF
CLOSE TABLES ALL
SET DEFAULT TO (lcCurDef)		&&  = FULLPATH(SET("DEFAULT"))
WAIT CLEAR
RETURN
** EOF: PrtStruc.prg **