Here is an example program that demonstrates the extraction of a file definition, using a variety of FILE properties.
PROGRAM
MAP
PrintFile PROCEDURE(*FILE F)
DumpGroupDetails PROCEDURE(USHORT start, USHORT total)
DumpFieldDetails PROCEDURE(USHORT indent, USHORT FieldNo)
DumpToFile PROCEDURE
SetAttribute PROCEDURE(SIGNED Prop,STRING Value)
StartLine PROCEDURE(USHORT indent,STRING label, STRING type)
Concat PROCEDURE(STRING s)
END
LineSize EQUATE(255)
FileIndent EQUATE(20)
DestName STRING(FILE:MaxFilePath)
DestFile FILE,DRIVER('ASCII'),CREATE,NAME(DestName)
Record RECORD
Line STRING(LineSize)
END
END
Employee FILE,DRIVER('TOPSPEED'),NAME('Employee.tps'),PRE(EMP),BINDABLE,CREATE,THREAD
EmpID_Key KEY(EMP:EmpID),PRIMARY
EmpName_Key KEY(EMP:Lname,EMP:Fname,EMP:MInit),DUP
JobID_Key KEY(EMP:JobID),DUP
PubID_Key KEY(EMP:PubID),DUP
DateKey KEY(-EMP:Hire_date),DUP,NOCASE,OPT
MyMemo MEMO(2000)
MyBlob BLOB,BINARY
Record RECORD,PRE()
EmpID CSTRING(10)
Fname CSTRING(21)
MInit CSTRING(2)
Lname CSTRING(31)
JobID SHORT
Job_lvl BYTE
PubID CSTRING(5)
Hire_date DATE
PictureFile STRING(65)
END
END
TheFile &FILE
AKey &KEY
Line STRING(LineSize)
Blobs LONG
CODE
PrintFile(Employee)
PrintFile PROCEDURE(*FILE F)
CODE
IF NOT FILEDIALOG('Choose Output File',DestName,'Text|*.TXT|Source|*.CLW',0100b)
RETURN
END
OPEN(DestFile)
IF ERRORCODE()
CREATE(DestFile)
OPEN(DestFile)
END
ASSERT(ERRORCODE()=0)
TheFile &= F
DO DumpFileDetails
DO DumpKeys
DO DumpMemosBlobs
DumpGroupDetails(0, F{PROP:Fields})
StartLine(FileIndent,,'END')
DumpToFile
DumpFileDetails ROUTINE
StartLine(FileIndent, 'aFile', 'FILE')
Concat(',DRIVER(
' & CLIP(TheFile{PROP:Driver}))
IF TheFile{PROP:DriverString}
Concat(',' & CLIP(TheFile{PROP:DriverString}))
END
Concat(')')
SetAttribute(TheFile{PROP:Create},'CREATE')
SetAttribute(TheFile{PROP:Reclaim},'RECLAIM')
IF TheFile{PROP:Owner}
Concat(',OWNER(
' & CLIP(TheFile{PROP:Owner}) & ')')
END
SetAttribute(TheFile{PROP:Encrypt},'ENCRYPT')
Concat(',NAME(
' & CLIP(TheFile{PROP:Name}) & ')')
SetAttribute(TheFile{PROP:Thread},'THREAD')
SetAttribute(TheFile{PROP:OEM},'OEM')
DumpToFile
DumpMemosBlobs ROUTINE
DATA
x UNSIGNED,AUTO
CODE
LOOP X = 1 TO (TheFile{PROP:Memos} + TheFile{PROP:Blobs})
IF UPPER (TheFile{PROP:type, -X}) = 'MEMO'
StartLine(FileIndent+2, TheFile{PROP:label, -X}, 'MEMO(')
Concat(CLIP(TheFile{PROP:Size, -X})&')')
ELSE
StartLine(FileIndent+2, TheFile{PROP:label, -X}, 'BLOB')
END
SetAttribute(TheFile{PROP:Binary,-X}, 'BINARY')
IF TheFile{PROP:Name, -X}
Concat(',NAME(
' & CLIP(TheFile{PROP:Name, -X}) & ')')
END
DumpToFile
END
DumpKeys ROUTINE
DATA
x UNSIGNED,AUTO
y UNSIGNED,AUTO
CODE
LOOP x = 1 TO TheFile{PROP:Keys}
AKey &= TheFile{PROP:Key, x}
StartLine(FileIndent+2, AKey{PROP:label}, AKey{PROP:Type})
Concat('(')
LOOP y = 1 TO AKey{PROP:Components}
IF y > 1 THEN Concat(',').
IF AKey{PROP:Ascending, y}
Concat('+')
ELSE
Concat('-')
END
Concat(TheFile{PROP:Label, akey{PROP:Field, y}})
END
Concat(')')
SetAttribute(AKey{PROP:Dup},'DUP')
SetAttribute(AKey{PROP:NoCase},'NOCASE')
SetAttribute(AKey{PROP:Opt},'OPT')
SetAttribute(AKey{PROP:Primary},'PRIMARY')
IF AKey{PROP:Name}
Concat(',NAME(
' & CLIP(AKey{PROP:Name}) & ')')
END
DumpToFile
END
DumpGroupDetails PROCEDURE(USHORT start, USHORT total)
fld USHORT
fieldsInGroup USHORT
GroupIndent USHORT,STATIC,AUTO
CODE
IF start = 0 THEN
GroupIndent = FileIndent+2
StartLine(GroupIndent,'RECORD','RECORD')
DumpToFile
END
GroupIndent += 2
LOOP fld = start+1 TO start+total
DumpFieldDetails(GroupIndent,fld)
IF TheFile{PROP:Type,fld} = 'GROUP'
fieldsInGroup = TheFile{PROP:Fields,fld}
DumpGroupDetails (fld, fieldsInGroup)
fld += fieldsInGroup
END
END
GroupIndent -= 2
StartLine(GroupIndent,
,'END')
DumpToFile
DumpFieldDetails PROCEDURE(USHORT indent, USHORT FieldNo)
FldType STRING(20)
CODE
FldType = TheFile{PROP:Type,FieldNo}
StartLine(indent,TheFile{PROP:Label,FieldNo},FldType)
IF INSTRING('STRING', FldType, 1, 1)
Concat('(')
IF TheFile{PROP:Picture, FieldNo}
Concat(TheFile{PROP:Picture, FieldNo})
ELSE
Concat(TheFile{PROP:Size, FieldNo})
END
Concat(')')
ELSIF INSTRING('DECIMAL', FldType, 1, 1)
Concat('(' & TheFile{PROP:Size, FieldNo} & ',' & |
TheFile{PROP:Places, FieldNo} & ')')
END
IF TheFile{PROP:Dim,FieldNo} <;> 0
Concat(',DIM(' & CLIP(TheFile{PROP:Dim,FieldNo}) & ')')
END
IF TheFile{PROP:Over, FieldNo} <;> 0
Concat(',OVER(')
IF TheFile{PROP:Label, TheFile{PROP:Over, FieldNo}}
Concat(CLIP(TheFile{PROP:Label, TheFile{PROP:Over, FieldNo}}))
ELSE
Concat('field ' & TheFile{PROP:Over, FieldNo})
END
Concat(')')
END
IF TheFile{PROP:Name,FieldNo}
Concat(',NAME(' & CLIP(TheFile{PROP:Name,FieldNo}) &
')')
END
DumpToFile
SetAttribute PROCEDURE (Prop,Value)
CODE
IF Prop THEN Line = CLIP(Line) & ',' & CLIP(Value).
StartLine PROCEDURE (USHORT indent,STRING label, STRING type)
spaces USHORT,AUTO
clen LONG,AUTO
CODE
line = label
clen = LEN(CLIP(line))
IF clen <; Indent
spaces = Indent - clen
ELSE
spaces = 4
END
line = CLIP(line) & ALL(' ', spaces) & type
Concat PROCEDURE (STRING s)
CODE
Line = CLIP(Line) & s
DumpToFile PROCEDURE
CODE
DestFile.Line = Line
ADD(DestFile)
ASSERT(ERRORCODE()=0)
See Also: