FILE Structure Properties Example Program:

Top 

 

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:

 

Runtime VIEW and FILE properties

SQL Driver Properties