Lexical functions - F$FILE_ATTRIBUTES

Before we address the F$FILE_ATTRIBUTES function, we need to make note of the F$FID_TO_NAME function. The VMS file system works differently than the UOS file system and the DCL lexical function F$FID_TO_NAME is unique to that VMS file system. There is no analog in UOS to a file identifier, so this is one of those rare cases where this VMS feature simply is not present in UOS.

The F$FILE_ATTRIBUTES lexical function returns information about a file. This is UCL's interface to the SYS$DISPLAY system call. Here is the definition.

F$FILE_ATTRIBUTES returns attribute information for a specified file.

Format
F$FILE_ATTRIBUTES(filespec,item)

Return Value
Either an integer or a string, depending upon the item requested. The table below indicates the return values.

Arguments
filespec

Specifies the name of the file for which you are requesting information.

item

Specifies the type of information to return. The table below indicates the item values.

Item Information Returned

AI TRUE if after-image journaling is is enabled, FALSE otherwise.

ALQ RMS allocation quantity.

BDT Backup date/time.

BI TRUE if before-image jouranling is enabled, FALSE otherwise.

BKS RMS bucket size.

BLS RMS block size.

CBT TRUE if contiguous-best-try, FALSE otherwise.

CDT Creation date/time.

CTG TRUE if contiguous, FALSE otherwise.

DEQ RMS default extension quatity.

DID This doesn't have any meaning in UOS. It returns null.

DIRECTORY TRUE if file is a directory, FALSE otherwise.

DVI Name of the device the file resides on.

EDT Expiration date/time.

EOF Logical end of file - logical file length in bytes.

ERASE TRUE if file is erased when deleted, FALSE otherwise.

FFB RMS First Free Byte.

FID Always returns 0.

FILE_LENGTH_HINT RMS file length hint.

FSZ RMS fixed control area size.

GBC Global buffer count.

GBC32 Enhanced global buffer count.

GBCFLAGS Global buffer cache flags. Returns PERCENT, DEFAULT, or NONE.

GRP Group name for file.

JOURNAL_FILE TRUE if this is a journal file, FALSE otherwise.

KNOWN TRUE if this file was installed with the Install utility, FALSE otherwise.

LOCKED TRUE if the file is deaccessed-locked, FALSE otherwise.

LRL RMS logest record length.

MBM Always 0.

MOVE TRUE if movefile operations are enabled, FALSE otherwise.

MRN RMS maximum record number.

MRS Maximum record size (record size for fixed-format RMS and non-RMS files).

NOA RMS number of areas.

NOBACKUP FALSE if the file is marked for backup, TRUE otherwise.

NOK RMS number of keys.

ORG RMS file organization: SEQ, REL, IDX. Returns null if not an RMS file.

PRESHELVED TRUE if file is pre-shelved, FALSE otherwise.

PRO File protection string.

PVN RMS prolog version number.

RAT RMS record attributes. Returns null if not an RMS file.

RCK TRUE if file is marked Read-check, FALSE otherwise.

RDT Revision date/time.

RFM RMS record format string: VAR, FIX, VFC, UDF, STM, STMLF, or STMCR. Returns null if not an RMS file.

RU TRUE if recovery unit journaling is enabled, FALSE otherwise.

RVN Revision number.

SHELVABLE TRUE if file is shelvable, FALSE otherwise.

SHELVED TRUE if file is shelved, FALSE otherwise.

STORED_SEMANTICS RMS stored semantics.

UIC File owner UIC.

VERLIMIT Version limit number. 0 indicates no version limit.

WCK TRUE if file is write-checked, FALSE otherwise.

Example:
$ FILE_EOF = F$FILE_ATTRIBUTES("CALC.EXE","EOF")
This would assign the logical file size, in bytes, to the FILE_EOF symbol.

        Function_File_Attributes : begin
                                       if( Missing_Parentheses( '(' ) ) then
                                       begin
                                           exit ;
                                       end ;
                                       if( Parse_File_Attributes( Err, Context ) ) then
                                       begin
                                           exit ;
                                       end ;
                                       if( Missing_Parentheses( ')' ) ) then
                                       begin
                                           exit ;
                                       end ;
                                       S := Context ;
                                   end ;

This code is added to the Function_Reference function.

function Parse_File_Attributes( var Err : integer ; var Context : string ) : boolean ;

var E : int64 ;
    Filespec, Item, Dev, Dir, Ext, Node, Ver : string ;
    P : integer ;
    X : int64 ;
    FAB : TFAB ;
    NAM : TNAML ;
    XABALL : TXABALL ;
    XABDAT : TXABDAT ;
    XABFHC : TXABFHC ;
    XABKEY : TXABKEY ;
    XABPRO : TXABPRO ;
    XABRDT : TXABRDT ;
    XABSUM : TXABSUM ;

begin
    Result := False ; // Assume success

    // Get Filespec value...
    Filespec := Get_Parameter( Err, Context ) ;
    if( Err <> 0 ) then
    begin
        Result := True ; // Assume error
        exit ;
    end ;
    if( Missing_Comma( Err ) ) then
    begin
        exit ;
    end ;

    // Get item value...
    Item := lowercase( Get_Parameter( Err, Context ) ) ;
    if( Err <> 0 ) then
    begin
        Result := True ; // Assume error
        exit ;
    end ;

First, this function gets the two function parameters and exit if there's an error.

    // Parse the file name...
    P := pos( '::', Filespec ) ;
    Node := copy( Filespec, 1, P - 1 ) ;
    if( P > 0 ) then
    begin
        Filespec := copy( Filespec, P + 2, length( Filespec ) ) ;
    end ;
    P := pos( ':', Filespec ) ;
    Dev := copy( Filespec, 1, P - 1 ) ;
    Filespec := copy( Filespec, P + 1, length( Filespec ) ) ;
    P := RInstr( length( Filespec ), Filespec, '\' ) ;
    Dir := copy( Filespec, 1, P ) ;
    Filespec := copy( Filespec, P + 1, length( Filespec ) ) ;
    P := RInstr( length( Filespec ), Filespec, '.' ) ;
    Ext := copy( Filespec, P, length( Filespec ) ) ;
    Filespec := copy( Filespec, 1, P - 1 ) ;
    Ver := '' ;
    P := pos( ';', Ext ) ;
    if( P > 0 ) then
    begin
        if( trystrtoint64( copy( Ext, P + 1, length( Ext ) ), X ) ) then
        begin
            Ver := copy( Ext, P + 1, length( Ext ) ) ;
            setlength( Ext, P - 1 ) ;
        end ;
    end ;

This code parses a filename into its constituent pieces.

    // Set up structures...
    fillchar( FAB, sizeof( FAB ), 0 ) ;
    fillchar( NAM, sizeof( NAM ), 0 ) ;
    fillchar( XABALL, sizeof( XABALL ), 0 ) ;
    fillchar( XABDAT, sizeof( XABDAT ), 0 ) ;
    fillchar( XABFHC, sizeof( XABFHC ), 0 ) ;
    fillchar( XABKEY, sizeof( XABKEY ), 0 ) ;
    fillchar( XABPRO, sizeof( XABPRO ), 0 ) ;
    fillchar( XABRDT, sizeof( XABRDT ), 0 ) ;
    fillchar( XABSUM, sizeof( XABSUM ), 0 ) ;

    FAB.FAB_B_BLN := sizeof( FAB ) ;
    FAB.FAB_L_NAM := int64( @NAM ) ;
    FAB.FAB_L_XAB := int64( @XABALL ) ;

    NAM.NAML_B_BID := NAML_C_BID ;
    NAM.NAML_B_BLN := sizeof( NAM ) ;
    NAM.NAML_L_LONG_DEV := int64( PChar( Dev ) ) ;
    NAM.NAML_B_LONG_DEV_SIZE := length( Dev ) ;
    NAM.NAML_L_LONG_DIR := int64( PChar( Dir ) ) ;
    NAM.NAML_L_LONG_DIR_SIZE := length( Dir ) ;
    NAM.NAML_L_LONG_NAME := int64( PChar( Filespec ) ) ;
    NAM.NAML_L_LONG_NAME_SIZE := length( Filespec ) ;
    NAM.NAML_L_LONG_NODE := int64( PChar( Node ) ) ;
    NAM.NAML_L_LONG_NODE_SIZE := length( Node ) ;
    NAM.NAML_L_LONG_TYPE := int64( PChar( Ext ) ) ;
    NAM.NAML_L_LONG_TYPE_SIZE := length( Ext ) ;
    NAM.NAML_L_LONG_VER := int64( PChar( Ver ) ) ;
    NAM.NAML_L_LONG_VER_SIZE := length( Ver ) ;

    XABALL.XAB_B_COD := XAB_C_ALL ;
    XABALL.XAB_B_BLN := sizeof( XABALL ) ;
    XABALL.XAB_L_NXT := int64( @XABDAT ) ;

    XABDAT.XAB_B_COD := XAB_C_DAT ;
    XABDAT.XAB_B_BLN := sizeof( XABDAT ) ;
    XABDAT.XAB_L_NXT := int64( @XABFHC ) ;

    XABFHC.XAB_B_COD := XAB_C_FHC ;
    XABFHC.XAB_B_BLN := sizeof( XABFHC ) ;
    XABFHC.XAB_L_NXT := int64( @XABKEY ) ;

    XABKEY.XAB_B_COD := XAB_C_KEY ;
    XABKEY.XAB_B_BLN := sizeof( XABKEY ) ;
    XABKEY.XAB_L_NXT := int64( @XABPRO ) ;

    XABPRO.XAB_B_COD := XAB_C_PRO ;
    XABPRO.XAB_B_BLN := sizeof( XABPRO ) ;
    XABPRO.XAB_L_NXT := int64( @XABRDT ) ;

    XABRDT.XAB_B_COD := XAB_C_RDT ;
    XABRDT.XAB_B_BLN := sizeof( XABRDT ) ;
    XABRDT.XAB_L_NXT := int64( @XABSUM ) ;

    XABSUM.XAB_B_COD := XAB_C_SUM ;
    XABSUM.XAB_B_BLN := sizeof( XABSUM ) ;

Next we create our FAB, NAML, and XAB structures. We described these structures in the previous article. First, we zero-out all of the structures. Then we fill the FAB fields with the FAB size and pointers to the NAML and XAB blocks. Then we put pointers into the NAML block to the strings we parsed the filename into. Finally we construct the XAB chain by setting the pointers and sizes of the various XAB structures.

    if( SYS_DISPLAY( int64( @FAB ), 0, 0 ) <> 0 ) then
    begin
        E := LIB_Get_Exception( 0 ) ; // Get handle
        Set_Exception( LIB_Get_Exception_Text( 0, E ) ) ;
        exit ;
    end ;

Now we call the SYS_DISPLAY routine to fill our structures. If there was an error, we set our exception state and exit.

    // Provide requested data...
    if( Item = 'ai' ) then
    begin
        Context := 'FALSE' ;
    end else
    if( Item = 'alq' ) then
    begin
        Context := inttostr( XABALL.XAB_L_ALQ ) ;
    end else
    if( Item = 'bdt' ) then
    begin
        Context := ASCTIM( XABDAT.XAB_Q_BDT ) ;
    end else
    if( Item = 'bi' ) then
    begin
        Context := 'FALSE' ;
    end else
    if( Item = 'bks' ) then
    begin
        Context := inttostr( XABFHC.XAB_B_BKS ) ;
    end else
    if( Item = 'bls' ) then
    begin
        Context := inttostr( FAB.FAB_W_BLS ) ;
    end else
    if( Item = 'cbt' ) then  // Same as 'ctg'
    begin
        if( ( XABFHC.XAB_W_FLG and FAF_CONTIGUOUS ) = 0 ) then
        begin
            Context := 'FALSE' ;
        end else
        begin
            Context := 'TRUE' ;
        end ;
    end else
    if( Item = 'cdt' ) then
    begin
        Context := ASCTIM( XABDAT.XAB_Q_CDT ) ;
    end else
    if( Item = 'ctg' ) then
    begin
        if( ( XABFHC.XAB_W_FLG and FAF_CONTIGUOUS ) = 0 ) then
        begin
            Context := 'FALSE' ;
        end else
        begin
            Context := 'TRUE' ;
        end ;
    end else
    if( Item = 'deq' ) then
    begin
        Context := inttostr( XABALL.XAB_W_DEQ ) ;
    end else
    if( Item = 'did' ) then
    begin
        Context := '' ; // No meaning in UOS
    end else
    if( Item = 'directory' ) then
    begin
        if( ( XABFHC.XAB_W_FLG and FAF_DIRECTORY ) = 0 ) then
        begin
            Context := 'FALSE' ;
        end else
        begin
            Context := 'TRUE' ;
        end ;
    end else
    if( Item = 'dvi' ) then
    begin
        Context := Dev ;
    end else
    if( Item = 'edt' ) then
    begin
        Context := ASCTIM( XABDAT.XAB_Q_EDT ) ;
    end else
    if( Item = 'eof' ) then
    begin
        Context := inttostr( XABFHC.XAB_Q_EOF ) ;
    end else
    if( Item = 'erase' ) then
    begin
        if( ( XABFHC.XAB_W_FLG and FAF_DSM_MASK ) < 2 ) then
        begin
            Context := 'FALSE' ;
        end else
        begin
            Context := 'TRUE' ;
        end ;
    end else
    if( Item = 'ffb' ) then
    begin
        Context := inttostr( XABFHC.XAB_Q_EOF ) ; // Same as 'eof' for now
    end else
    if( Item = 'fid' ) then
    begin
        Context := '0' ;
    end else
    if( Item = 'file_length_hint' ) then
    begin
        Context := '' ; // RMS-specific
    end else
    if( Item = 'fsz' ) then
    begin
        Context := inttostr( XABFHC.XAB_B_HSZ ) ;
    end else
    if( ( Item = 'gbc' ) or ( Item = 'gbc32' ) ) then
    begin
        Context := inttostr( XABFHC.XAB_W_GBC ) ;
    end else
    if( Item = 'gbcflags' ) then
    begin
        Context := 'NONE' ; //TODO
    end else
    if( Item = 'grp' ) then
    begin
        Context := '0' ; //TODO
    end else
    if( Item = 'journal_file' ) then
    begin
        Context := 'FALSE' ;
    end else
    if( Item = 'known' ) then
    begin
        Context := 'FALSE' ; // TODO
    end else
    if( Item = 'locked' ) then
    begin
        Context := 'FALSE' ; // TODO
    end else
    if( Item = 'lrl' ) then
    begin
        Context := inttostr( XABFHC.XAB_W_LRL ) ;
    end else
    if( Item = 'mbm' ) then
    begin
        Context := '' ; // Not supported on UOS
    end else
    if( Item = 'move' ) then
    begin
        Context := 'FALSE' ; //TODO
    end else
    if( Item = 'mrn' ) then
    begin
        Context := inttostr( FAB.FAB_L_MRN ) ;
    end else
    if( Item = 'mrs' ) then
    begin
        Context := inttostr( XABFHC.XAB_W_MRS ) ;
    end else
    if( Item = 'noa' ) then
    begin
        Context := inttostr( XABSUM.XAB_B_NOA ) ;
    end else
    if( Item = 'nobackup' ) then
    begin
        if( ( XABFHC.XAB_W_FLG and FAF_DSM_MASK ) = 0 ) then
        begin
            Context := 'TRUE' ;
        end else
        begin
            Context := 'FALSE' ;
        end ;
    end else
    if( Item = 'nok' ) then
    begin
        Context := inttostr( XABSUM.XAB_B_NOK ) ;
    end else
    if( Item = 'org' ) then
    begin
        Context := '' ; // TODO
    end else
    if( Item = 'preshelved' ) then
    begin
        Context := 'FALSE' ; //TODO
    end else
    if( Item = 'pro' ) then
    begin
        Context := Protection_To_Text( XABPRO.XAB_W_PRO shl 16 ) ;
    end else
    if( Item = 'pvn' ) then
    begin
        Context := inttostr( XABSUM.XAB_W_PVN ) ;
    end else
    if( Item = 'rat' ) then
    begin
        Context := '' ; //TODO
    end else
    if( Item = 'rck' ) then
    begin
        Context := 'FALSE' ; //TODO
    end else
    if( Item = 'rdt' ) then
    begin
        Context := ASCTIM( XABDAT.XAB_Q_RDT ) ;
    end else
    if( Item = 'rfm' ) then
    begin
        Context := '' ; //TODO
    end else
    if( Item = 'ru' ) then
    begin
        Context := '' ; //TODO
    end else
    if( Item = 'rvn' ) then
    begin
        Context := '' ; //TODO
    end else
    if( Item = 'shelvable' ) then
    begin
        Context := 'FALSE' ; //TODO
    end else
    if( Item = 'shelved' ) then
    begin
        Context := 'FALSE' ; //TODO
    end else
    if( Item = 'stored_semanticcs' ) then
    begin
        Context := '' ; //TODO
    end else
    if( Item = 'uic' ) then
    begin
        Context := inttostr( XABPRO.XAB_L_UIC ) ;
    end else
    if( Item = 'verlimit' ) then
    begin
        Context := inttostr( XABFHC.XAB_W_VERLIMIT ) ;
    end else
    if( Item = 'wck' ) then
    begin
        Context := 'FALSE' ; //TODO
    end else
    begin
        Context := Item ;
        Err := UCL_IVKEYW ;
    end ;
end ; // Parse_File_Attributes

Finally, we set the result based on the item. If the item is not recognized, we set the error.
You may note the //TODO comments on some lines. These items are related to features that we haven't covered yet. We will revisit them in the future.

In the next article, we'll cover the code for the system call.