added LSL2 stored procedures
This commit is contained in:
Infineon\StieberD
190
LSL2/STPROC/DICTTOACAD.txt
Normal file
190
LSL2/STPROC/DICTTOACAD.txt
Normal file
@ -0,0 +1,190 @@
|
||||
COMPILE SUBROUTINE DictToAcad(TableNames)
|
||||
|
||||
/*
|
||||
Routine to export dictionary information to text file for use in Acad
|
||||
|
||||
August 18, 2000 - John C. Henry - J.C. Henry, Inc. - Copyright 2000
|
||||
|
||||
*/
|
||||
|
||||
DECLARE SUBROUTINE Utility
|
||||
DECLARE FUNCTION Utility
|
||||
|
||||
$INSERT DICT_EQUATES
|
||||
equ CRLF$ to char(13):char(10)
|
||||
equ TAB$ TO CHAR(9)
|
||||
|
||||
TableCnt = COUNT(TableNames,@VM) + (TableNames NE '')
|
||||
|
||||
CurrPath = DRIVE() ;* Returns OI directory so backup one level
|
||||
CurrPath = FIELD(CurrPath,'\',1,COUNT(CurrPath,'\')):'\ACADTEXT'
|
||||
|
||||
|
||||
DirPath = UTILITY('CHOOSEDIR',@WINDOW,'Directory for Acad Text':@FM:CurrPath)
|
||||
|
||||
|
||||
|
||||
FOR N = 1 TO TableCnt
|
||||
|
||||
TableName = TableNames<1,N>
|
||||
|
||||
FieldData = XLATE('DICT.':TableName,'%FIELDS%','','X') ;* Get the %FIELD% record from the dictionary
|
||||
|
||||
MaxFields = COUNT(FieldData<FIELDS_NAME$>,@VM) + (FieldData<FIELDS_NAME$> NE '')
|
||||
PrintLines = ''
|
||||
TextLines = ''
|
||||
|
||||
Symbolics = ''
|
||||
SymTextLines = ''
|
||||
SymSort = ''
|
||||
FieldSort = ''
|
||||
|
||||
LineCnt = 0
|
||||
FOR I = 1 TO MaxFields
|
||||
|
||||
FieldName = FieldData<FIELDS_NAME$,I>
|
||||
IF FieldName[1,1] NE '%' THEN
|
||||
DictRec = XLATE('DICT.':TableName,FieldName,'','X')
|
||||
|
||||
FMC = DictRec<DICT_COLUMN_NO$>
|
||||
Part = DictRec<DICT_PART$>
|
||||
Type = DictRec<DICT_TYPE$>
|
||||
Master = DictRec<DICT_MASTER_FLAG$>
|
||||
S_M = DictRec<DICT_SM$>
|
||||
DataType = DictRec<DICT_GENERIC_TYPE$>
|
||||
Desc = DictRec<DICT_DESC$>
|
||||
Conv = DictRec<DICT_CONV$>
|
||||
Length = DictRec<DICT_LENGTH$>
|
||||
Justification = DictRec<DICT_JUST$>
|
||||
|
||||
Formula = DictRec<DICT_FORMULA$>
|
||||
SWAP @VM WITH CRLF$ IN Formula
|
||||
|
||||
Btree = DictRec<DICT_INDEX_FLAG$>
|
||||
XrefField = DictRec<DICT_XREF$>
|
||||
RelatedTo = DictRec<DICT_RELATIONAL$>
|
||||
RelatedFrom = DictRec<DICT_RELATED$>
|
||||
Protected = DictRec<DICT_PROTECT$>
|
||||
CaseSensitive = DictRec<DICT_LOWERCASE$>
|
||||
|
||||
IndexData = ''
|
||||
|
||||
IF Btree = 1 THEN IndexData := 'Btree':CRLF$
|
||||
IF XrefField = 1 THEN IndexData := 'Xref':CRLF$
|
||||
IF CaseSensitive = 1 THEN IndexData := 'Case Sensitive':CRLF$
|
||||
|
||||
IF RelatedTo NE '' THEN IndexData := 'Related To: ':RelatedTo:CRLF$
|
||||
IF RelatedFrom NE '' THEN IndexData := 'Related From: ':RelatedFrom:CRLF$
|
||||
*IF Protected = 1 THEN IndexData := 'Protected'
|
||||
|
||||
IF IndexData[-2,2] = CRLF$ THEN IndexData[-2,2] = ''
|
||||
|
||||
TextLine = ''
|
||||
SymLine = ''
|
||||
SymTextLine = ''
|
||||
|
||||
IF FieldName[-1,'B4'] NE '_ORG' THEN
|
||||
|
||||
IF Type = 'S' THEN
|
||||
|
||||
SymLine = ''
|
||||
SymLine<1,1> = FieldName
|
||||
SymLine<1,2> = DataType
|
||||
SymLine<1,3> = S_M
|
||||
SymLine<1,4> = Justification
|
||||
SymLine<1,5> = Length
|
||||
SymLine<1,6> = Conv
|
||||
SymLine<1,7> = Formula:CRLF$
|
||||
SymLine<1,8> = IndexData
|
||||
|
||||
SymTextLine = ' ':@VM:FieldName
|
||||
IF S_M[1,1] = 'M' THEN SymTextLine := '(s)'
|
||||
|
||||
IF IndexData NE '' THEN SymTextLine := ' --> ':IndexData
|
||||
|
||||
END ELSE
|
||||
PrintLine = ''
|
||||
PrintLine<1,1> = FMC
|
||||
PrintLine<1,2> = Part
|
||||
PrintLine<1,3> = FieldName
|
||||
PrintLine<1,4> = DataType
|
||||
PrintLine<1,5> = S_M
|
||||
PrintLine<1,6> = Justification
|
||||
PrintLine<1,7> = Length
|
||||
PrintLine<1,8> = Conv
|
||||
PrintLine<1,9> = Desc:CRLF$
|
||||
PrintLine<1,10> = IndexData
|
||||
|
||||
TextLine = '':@VM:FieldName
|
||||
IF S_M[1,1] = 'M' THEN TextLine := '(s)'
|
||||
IF IndexData NE '' THEN TextLine := ' --> ':IndexData
|
||||
|
||||
END
|
||||
|
||||
|
||||
IF FMC NE '' THEN
|
||||
IF NOT(INDEX(PrintLine,'_ORG',1)) AND NOT(INDEX(PrintLine,'TW_',1)) THEN
|
||||
IF FMC = 0 AND Part NE '' THEN FMC := '.':Part
|
||||
LOCATE FMC IN FieldSort BY 'AR' USING @FM SETTING POS THEN
|
||||
FieldSort = INSERT(FieldSort,POS,0,0,FMC)
|
||||
END ELSE
|
||||
FieldSort = INSERT(FieldSort,POS,0,0,FMC)
|
||||
END
|
||||
TextLine<1,1> = FMT(FMC,'R#3')
|
||||
TextLines = INSERT(TextLines,POS,0,0,TextLine)
|
||||
PrintLines = INSERT(PrintLines,POS,0,0,PrintLine)
|
||||
END
|
||||
|
||||
END ELSE
|
||||
*IF INDEX(SymTextLine,'-->',1) THEN
|
||||
LOCATE FieldName IN SymSort USING @FM SETTING POS ELSE
|
||||
SymSort = INSERT(SymSort,POS,0,0,FieldName)
|
||||
END
|
||||
Symbolics = INSERT(Symbolics,POS,0,0,SymLine)
|
||||
|
||||
SymTextLines = INSERT(SymTextLines,POS,0,0,SymTextLine)
|
||||
*END
|
||||
END ;* End of sorting routine
|
||||
END ;* End of check for "_ORG"
|
||||
|
||||
END ; *
|
||||
|
||||
NEXT I
|
||||
|
||||
TextLineCnt = COUNT(TextLines,@FM) + (TextLines NE '')
|
||||
/*
|
||||
IF TextLineCnt > 60 THEN
|
||||
TextLines = TableName:@FM:@FM:TextLines
|
||||
CONVERT @VM TO ' ' IN TextLines
|
||||
SWAP @FM WITH CRLF$ IN TextLines
|
||||
FileName = TableName:'.TXT'
|
||||
OSWRITE TextLines ON DirPath:'\':FileName
|
||||
|
||||
Segment = 1
|
||||
LOOP
|
||||
TextLines = TableName:@FM:'Symbolics-':Segment:@FM:@FM:FIELD(SymTextLines,@FM,1,TextLineCnt)
|
||||
SymTextLines[1,COL2()+1] = ''
|
||||
|
||||
CONVERT @VM TO ' ' IN TextLines
|
||||
SWAP @FM WITH CRLF$ IN TextLines
|
||||
FileName = TableName:Segment:'.TXT'
|
||||
|
||||
OSWRITE TextLines ON DirPath:'\':FileName
|
||||
UNTIL SymTextLines = ''
|
||||
Segment += 1
|
||||
REPEAT
|
||||
END ELSE
|
||||
*/
|
||||
TextLines = TableName:@FM:@FM:TextLines:@FM:SymTextLines
|
||||
CONVERT @VM TO ',' IN TextLines ;* Excel export
|
||||
SWAP @FM WITH CRLF$ IN TextLines
|
||||
FileName = TableName:'.TXT'
|
||||
OSWRITE TextLines ON DirPath:'\':FileName
|
||||
*END
|
||||
|
||||
NEXT N
|
||||
|
||||
|
||||
|
||||
|
||||
RETURN
|
||||
Reference in New Issue
Block a user