Marcia, thanks.
>
Is there an easy, elegant way to produce a structure report for all or some of the tables in a database?>
>The following program will create the report on either the table opened in the currently selected work area or the table name passed to it. So, you could write a little program to call this program with the names of all the tables for which you want the structure.
>
>
>***********************************************************************
>* Program....: LISTSTRU.PRG
>* Author.....: Andy Kramek
>* Date.......: 24 September 2001
>* Notice.....: Copyright (c) 2001 Tightline Computers Ltd, All Rights Reserved.
>* Compiler...: Visual FoxPro 07.00.0000.9262 for Windows
>* Purpose....: Replacement for the List Structure Command
>***********************************************************************
>LPARAMETERS tcTable, tlNoShow
>LOCAL lcTable, lnSelect, lnFields, lcFile, lnH, lnNextByte
>LOCAL lcCDX, lcMem, lcDBC, lWasOpen, lcStr, lcAlias, llIsDBC, lcDBCName
>
>*** Clean parameters and ensure a table is available
>lcTable = IIF(EMPTY(tcTable) OR VARTYPE(tcTable)#'C', ALIAS(), FORCEEXT( UPPER(ALLTRIM(tcTable)), 'dbf'))
>IF EMPTY(lcTable)
> lcTable = GETFILE( 'dbf', 'Structure For', 'Open' )
> IF EMPTY( lcTable )
> RETURN
> ENDIF
>ENDIF
>
>*** Open/Select Table if not the selected Alias
>lnSelect = SELECT()
>lcAlias = JUSTSTEM(lcTable)
>lWasOpen = .T.
>IF ! ALIAS() == lcAlias
> IF ! USED( lcAlias )
> IF FILE( lcTable )
> USE (lcTable) AGAIN IN 0
> lWasOpen = .F.
> ELSE
> MESSAGEBOX('Table Name ' + lcTable + ' Not Found', 16, 'Duff Name!' )
> RETURN
> ENDIF
> ENDIF
> SELECT (lcAlias)
>ENDIF
>
>*** Get field count and File Name
>lnFields = FCOUNT()
>lcFile = DBF()
>*** Open an output file
>lnH = FCREATE( lcAlias + '.TXT')
>
>IF UPPER(JUSTEXT(lcFile)) = 'TMP'
> *** Details for Cursor (or View)
> CursorLst( lcAlias, lnH )
>ELSE
> *** Details for Table
> lcDBCName = TableLst( lcFile, lnH)
>ENDIF
>
>IF ! EMPTY( lcDBCName )
> *** We have a DBC
> IF ! DBUSED( lcDBCName )
> *** But it's not open
> OPEN DATABASE (lcDBCName)
> ELSE
> *** Make it current
> SET DATABASE TO FORCEEXT( lcDBCName, "" )
> ENDIF
>ENDIF
>
>*** Index Details
>IndexLst( lnH )
>
>*** Field Details
>FieldLst( lnH, NOT EMPTY( lcDbcName ) )
>
>*** Close Output File and Table
>FCLOSE( lnH )
>IF ! lWasOpen
> USE IN (lcAlias)
>ENDIF
>
>IF tlNoShow
> *** Suppress display
>ELSE
> *** Show the file
> MODI FILE ( lcAlias + '.TXT') NOWAIT
>ENDIF
>
>*** Clean Up and Exit
>SELECT ( lnSelect )
>RETURN
>
>*****************************************
>* Get Info for Cursors
>*****************************************
>PROCEDURE CursorLst( tcFile, tnH )
>LOCAL ARRAY laFields[1]
>LOCAL lcFile, lnFCount, lnCnt, llHasMemo, lcMem
>lcFile = ALLTRIM( tcFile )
>*** Check for Memo Fields
>lnFCount = AFIELDS( laFields )
>FOR lnCnt = 1 TO lnFCount
> IF laFields[lnCnt,2] = "M"
> llHasMemo = .T.
> EXIT
> ENDIF
>NEXT
>*** Compose Output
>lcDBC = "Cursor cannot be associated with a DBC"
>lcMem = IIF( llHasMemo, lcFile + '.FPT', 'No Memo Fields')
>lcCDX = CDX(1)
>lcCDX = IIF( EMPTY( lcCDX), 'No Structural Index', lcCDX )
>*** Write out
>lcStr = 'Structure For: ' + lcFile
>FPUTS(tnH, lcStr )
>FPUTS(tnH, REPLICATE('=', LEN(lcStr)))
>FPUTS(tnH, 'DBC : ' + lcDBC )
>FPUTS(tnH, 'CDX : ' + lcCDX )
>FPUTS(tnH, 'Memo : ' + lcMem )
>FPUTS(tnH, '')
>RETURN
>
>*****************************************
>* Get DBC-Related Info for Tables/DBCs
>*****************************************
>PROCEDURE TableLst( tcFile, tnH )
>LOCAL lcFile, lnDBCH, lnNextByte, lcCDX, lcMem, lcDBC, lnFields, lcAlias, llInDBC
>lnFields = FCOUNT()
>lcFile = ALLTRIM( tcFile )
>lcAlias = JUSTSTEM(tcFile)
>*** Close the table
>USE
>*** Re-Open DBF at low level
>lnDBCH = FOPEN( lcFile )
>*** Associated files
>FSEEK(lnDBCH,28)
>lnNextByte = ASC( FREAD(lnDBCH, 1))
>IF lnNextByte = 7
> *** The specified file is actually a DBC, not a Table
> llInDBC = .F.
> lcCDX = lcAlias + '.DCX'
> lcMem = lcAlias + '.DCT'
> lcDBC = lcAlias + '.DBC is a Database Container'
>ELSE
> *** It's a table after all!
> lcCDX = IIF( lnNextByte%2 = 0, 'No Structural CDX', lcAlias + '.CDX')
> lcMem = IIF( lnNextByte%4 < 2, 'No Memo File', lcAlias + '.FPT')
> *** So now Read DBC Backlink
> FSEEK(lnDBCH,(33+(lnFields*32)))
> lcDBC = UPPER(ALLTRIM(STRTRAN(FGETS( lnDBCH, 263), CHR(0))))
> IF EMPTY( lcDBC )
> llInDBC = .F.
> lcDBC = "Not Part of a DBC"
> ELSE
> llInDBC = .T.
> ENDIF
> *** Check to see if table allows nulls
> IF 'NULLFLAGS' $ lcDBC
> *** Need to read a different location
> FSEEK(lnDBCH,(65+(lnFields*32)))
> lcDBC = UPPER(ALLTRIM(STRTRAN(FREAD( lnDBCH, 263), CHR(0))))
> ENDIF
>ENDIF
>*** Close File and re-open as a table
>FCLOSE( lnDBCH )
>*** Write the header info for Tables/DBC
>lcStr = 'Structure For: ' + lcFile
>FPUTS(tnH, lcStr )
>FPUTS(tnH, REPLICATE('=', LEN(lcStr)))
>FPUTS(tnH, 'DBC : ' + lcDBC )
>FPUTS(tnH, 'CDX : ' + lcCDX )
>FPUTS(tnH, 'Memo : ' + lcMem )
>FPUTS(tnH, '')
>USE (lcFile)
>*** Return DBC name
>RETURN IIF( llInDBC, lcDBC, "" )
>
>*****************************************
>* List Index Details
>*****************************************
>PROCEDURE IndexLst( tnFileHandle )
>LOCAL lnH, lnCnt, lcStr
>lnH = tnFileHandle
>*** Get Index Details
>FPUTS( lnH, '' )
>IF TAGCOUNT() > 0
> FPUTS(lnH, 'Associated Indexes' )
> FPUTS(lnH, '==================' )
> *** We have indexes
> *** NB Maybe we should save these to an array and sort it too!
> *** Primary first, then Candidate, then others?
> FOR lnCnt = 1 TO TAGCOUNT()
> lcStr = ""
> *** Check for PK
> IF PRIMARY( lnCnt )
> lcStr = "*** PRIMARY KEY: "
> ELSE
> *** Check for Candidate
> IF Candidate( lnCnt )
> lcStr = "(Candidate): "
> ENDIF
> ENDIF
> lcStr = CHR(9) + lcStr + TAG(lnCnt) + ": " + KEY(lnCnt)
> FPUTS(lnH, lcStr )
> NEXT
>ELSE
> *** No Associated indexes
> FPUTS( lnH, 'No Associated Indexes' )
> FPUTS( lnH, '=====================' )
>ENDIF
>RETURN
>
>*****************************************
>* List Field Details
>*****************************************
>PROCEDURE FieldLst( tnFileHandle, tlIsDBC )
>LOCAL ARRAY laFields[1]
>LOCAL lnH, lcStr, lnFields, lnCnt, lnMax, lcFldList, lcT
>
>lnH = tnFileHandle
>
>*** No DBC so just use AFIELDS()
>*** Get the structure into an array
>lnFields = AFIELDS( laFields )
>*** Table Details
>FPUTS(lnH, CHR(13) + "Table Information" )
>FPUTS(lnH, "=================" )
>IF !EMPTY(laFields[1,12])
> *** DBC Table Name
> lcStr = "Long Name: " + laFields[1,12]
> FPUTS(lnH, lcStr )
>ENDIF
>IF !EMPTY(laFields[1,16])
> *** Table Comment
> lcStr = "Comment: " + laFields[1,16]
> FPUTS(lnH, lcStr )
>ELSE
> lcStr = "No Comment Supplied"
> FPUTS(lnH, lcStr )
>ENDIF
>IF ! EMPTY(laFields[1,10])
> lcStr = CHR(9) + 'Table Rule: ' + laFields[1,10] ;
> + ' (Error Message: ' ;
> + IIF( EMPTY(laFields[1,11]), 'VFP Default', laFields[1,11] ) ;
> + ')'
> FPUTS(lnH, lcStr )
>ELSE
> lcStr = "No Table Rule"
> FPUTS(lnH, lcStr )
>ENDIF
>IF !EMPTY(laFields[1,13])
> *** Insert Trigger
> lcStr = CHR(9) + "On Insert: " + laFields[1,13]
> FPUTS(lnH, lcStr )
>ELSE
> lcStr = "No Insert Trigger"
> FPUTS(lnH, lcStr )
>ENDIF
>IF !EMPTY(laFields[1,14])
> *** Update Trigger
> lcStr = CHR(9) + "On Update: " + laFields[1,14]
> FPUTS(lnH, lcStr )
>ELSE
> lcStr = "No Update Trigger"
> FPUTS(lnH, lcStr )
>ENDIF
>IF !EMPTY(laFields[1,15])
> *** Delete Trigger
> lcStr = CHR(9) + "On Delete: " + laFields[1,15]
> FPUTS(lnH, lcStr )
>ELSE
> lcStr = "No Delete Trigger"
> FPUTS(lnH, lcStr )
>ENDIF
>
>FPUTS(lnH, '' )
>FPUTS(lnH, 'Field Details' )
>FPUTS(lnH, '=============' )
>lnMax = 0
>*** Find longest Field Name
>FOR lnCnt = 1 TO lnFields
> lnMax = MAX( lnMax, LEN(ALLTRIM(laFields[lnCnt,1])))
>NEXT
>
>*** Output field Data
>lcFldList = ""
>FOR lnCnt = 1 TO lnFields
> *** Field Definition
> lcStr = CHR(9) + PADR(LOWER(laFields[lnCnt,1]),lnMax) + CHR(9) ;
> + laFields[lnCnt,2] + " (" ;
> + PADL( laFields[lnCnt,3], 3 ) + ',' ;
> + ALLTRIM( STR( laFields[lnCnt,4] )) + ' )' + CHR(9) ;
> + IIF( laFields[lnCnt,5], 'NULL', 'NOT NULL' )
> FPUTS(lnH, lcStr )
>
> *** Add Field Name to Field List
> lcFldList = lcFldList + IIF( !EMPTY( lcFldList ), ", ", "" ) + LOWER( ALLTRIM( laFields[lnCnt,1]))
>
> *** Default Value
> IF ! EMPTY( laFields[lnCnt,9] )
> lcStr = CHR(9) + CHR(9) + 'Default: ' + laFields[lnCnt,9] ;
> + ' (Error Message: ' ;
> + IIF( EMPTY(laFields[lnCnt,7]), 'VFP Default', laFields[lnCnt,8] ) ;
> + ')'
> ELSE
> lcStr = ""
> ENDIF
> IF ! EMPTY( lcStr )
> FPUTS(lnH, lcStr )
> ENDIF
>
> *** Field Level Validation
> IF ! EMPTY( laFields[lnCnt,7] )
> lcStr = CHR(9) + CHR(9) + 'Valid: ' + laFields[lnCnt,7] ;
> + ' (Error Message: ' ;
> + IIF( EMPTY(laFields[lnCnt,8]), 'VFP Default', laFields[lnCnt,8] ) ;
> + ')'
> ELSE
> lcStr = ""
> ENDIF
> IF ! EMPTY( lcStr )
> FPUTS(lnH, lcStr )
> ENDIF
>
> *** Comment
> IF tlIsDBC
> STORE "" TO lcStr, lcT
> *** We have a DBC - get some properties
> lcT = DBGETPROP( ALLTRIM(ALIAS()) + "." + laFields[ lnCnt,1], "FIELD", "COMMENT" )
> lcStr = IIF( ! EMPTY( lcT ), CHR(9) + CHR(9) + 'Comment: ' + lcT, "" )
> lcT = DBGETPROP( ALLTRIM(ALIAS()) + "." + laFields[ lnCnt,1], "FIELD", "CAPTION" )
> lcStr = lcStr + IIF( EMPTY( lcStr ), "", CHR(13) )
> lcStr = lcStr + IIF( ! EMPTY( lcT ), CHR(9) + CHR(9) + 'Caption: ' + lcT, "" )
> ELSE
> lcStr = ""
> ENDIF
> IF ! EMPTY( lcStr )
> FPUTS(lnH, lcStr )
> ENDIF
>NEXT
>
>*** Output Field List
>FPUTS(lnH, CHR(13) + "Field List" )
>FPUTS(lnH, "==========" )
>FPUTS(lnH, lcFldList )
>
>RETURN
>
