Close Databases All
SET EXACT OFF
Local aRelation[1]
Local m.lnRelationRows, m.lcTableName
Local m.lnCtr, m.lnSub, m.lnFieldNumber
Local m.lcTagName, m.lcTagExpr, m.lcTagType, m.lcTagFor, m.lcTagAD
Local m.lcRelParTbl, m.lcRelParTag, m.lcRelRefUDI
Local fcDBCName
fcDBCName=Getfile("dbc")
If Empty(fcDBCName)
Messagebox("You have not selected a Database")
Else
Open Database (fcDBCName) Exclusive
Set Database To (fcDBCName)
Set Default To Justpath(fcDBCName)
Set Safety Off
m.lnRelationRows = Adbobjects(aRelation, 'Relation')
Dimension laFieldType[11]
laFieldType[01] = 'C Character'
laFieldType[02] = 'D Date '
laFieldType[03] = 'L Logical '
laFieldType[04] = 'M Memo '
laFieldType[05] = 'N Numeric '
laFieldType[06] = 'F Float '
laFieldType[07] = 'I Integer '
laFieldType[08] = 'B Double '
laFieldType[09] = 'Y Currency '
laFieldType[10] = 'T Date-Time'
laFieldType[11] = 'G General '
Dimension laStructure[1, 1]
Create Cursor curRight (TableName C(128))
Select curRight
Index On Left(TableName, 32) To fcCurRightIDX
Create Cursor curTableStructure ( ;
FieldName C(150), ;
FieldType C(009), ;
FieldLength N(003), ;
FieldDecimal N(002), ;
NullAllowed L, ;
CodePageBarred L, ;
FieldValidationRule C(250), ;
FieldValidationText C(250), ;
FieldDefaultValue C(250), ;
TableValidationRule C(250), ;
TableValidationText C(250), ;
LongTableName C(128), ;
InsertTrigger C(250), ;
UpdateTrigger C(250), ;
DeleteTrigger C(250), ;
TableComment C(250), ;
DBFName C(128), ;
FieldNumber N(004), ;
RecordType C(001), ;
TagExpression C(250), ;
TagType C(009), ;
TagFor C(250), ;
TagAscDesc C(001), ;
RelParentTbl C(128), ;
RelParentTag C(010), ;
RelRefIntegUDI C(006) ;
)
MAKELIST(fcDBCName)
Select curRight
Scan
m.lcTableName = Rtrim(curRight.TableName)
Use (m.lcTableName) In 0 Shared Alias SourceTable
Select SourceTable
m.lnCtr = Afields(laStructure)
Select curTableStructure
m.lnSub = Reccount()
Append From Array laStructure
Goto m.lnSub + 1
m.lnFieldNumber = 1
Do While Not Eof()
Replace LongTableName With curRight.TableName
Replace DBFName With Dbf('SourceTable')
Replace FieldNumber With m.lnFieldNumber
Replace RecordType With 'F'
m.lnSub = Ascan(laFieldType, Left(FieldType, 1))
Replace FieldType With Iif(m.lnSub > 0, ;
RIGHT(laFieldType[m.lnSub], 9), '***')
m.lnFieldNumber = m.lnFieldNumber + 1
Skip 1
Enddo
If Not Empty(Cdx(1, 'SourceTable'))
m.lcTagName = '???'
m.lnSub = 1
Select SourceTable
Do While Not Empty(m.lcTagName)
m.lcTagName = Tag(m.lnSub)
m.lcTagExpr = Key(m.lnSub)
m.lcTagType = 'Regular'
m.lcTagType = Iif(Primary(m.lnSub), 'Primary', m.lcTagType)
m.lcTagType = Iif(Candidate(m.lnSub), 'Candidate', m.lcTagType)
m.lcTagType = Iif(Unique(m.lnSub), 'Unique', m.lcTagType)
m.lcTagFor = For(m.lnSub)
m.lcTagAD = Iif(Descending(m.lnSub), 'D', 'A')
m.lcRelParTbl = '
m.lcRelParTag = '
m.lcRelRefUDI = '
If m.lcTagType = 'Regular'
For m.lnSub2 = 1 To m.lnRelationRows
If (Upper(aRelation[m.lnSub2, 1]) = Upper(Alltrim(m.lcTableName)) ;
AND Upper(aRelation[m.lnSub2, 3]) = Upper(Alltrim(m.lcTagName)))
m.lcRelParTbl = aRelation[m.lnSub2, 2]
m.lcRelParTag = aRelation[m.lnSub2, 4]
m.lcRelRefUDI = aRelation[m.lnSub2, 5]
m.lcTagType = 'Foreign'
Endif
Endfor
Endif
If Not Empty(m.lcTagName)
Select curTableStructure
Append Blank
Replace FieldName With m.lcTagName
Replace TagExpression With m.lcTagExpr
Replace TagType With m.lcTagType
Replace TagFor With m.lcTagFor
Replace LongTableName With curRight.TableName
Replace FieldNumber With m.lnSub
Replace RecordType With 'I'
Replace TagAscDesc With m.lcTagAD
Replace RelParentTbl With m.lcRelParTbl
Replace RelParentTag With m.lcRelParTag
Replace RelRefIntegUDI With m.lcRelRefUDI
Select SourceTable
Endif
m.lnSub = m.lnSub + 1
Enddo
Endif
Select SourceTable
Use
Select curRight
Endscan
generatereport()
Select curTableStructure
Endif
Function MAKELIST
Lparameters lcDBCName
Local m.lnSub1, m.lnSub2, m.lcDatabaseName
m.lnSub1 = Rat('\', lcDBCName) + 1
m.lnSub2 = Rat('.', lcDBCName) - m.lnSub1
m.lcDatabaseName = Substr(lcDBCName, m.lnSub1, m.lnSub2)
Select ObjectName As TableName ;
FROM (lcDBCName) ;
WHERE ObjectType = 'Table' ;
ORDER By ObjectName ;
INTO Array faTableName
Select curRight
Zap
Append From Array faTableName
If Used(m.lcDatabaseName)
Use In (m.lcDatabaseName)
Endif
Endfunc
Function generatereport
Select curTableStructure
Create Report C:\Structure From curTableStructure Fields FieldName,FieldType,FieldLength,LongTableName,TagType
REPORT FORM c:\structure.frx preview
Endfunc
