//TH-Header
//*****************************************************************************************
// Copyright (c)  2001 Udo Haemel
// All rights reserved.
// If you want to use this source in your applications conatct: <Udo.Haemel@gmx.de>
//
// $FileName    : cIndex.pkg
// $ProjectName : The Hammer Project
// $Author      : Udo Haemel
// $Created     : 22.06.2001  20:07
//
// Contents:
//  Getting indexinformation of a file.
//*****************************************************************************************
//TH-RevisionStart
// 22.06.2001 20:09  Added a function "fsIndexString"      Mk     SERVER
//                   which delivers a string of the format
//                   "Index.X Field1,Field2,....
// 26.06.2001 20:30  Cild-Classes of "cFileOperations"     Uh
//                   now react with new default behaviour.
//                   When the data could not be retrieved,
//                   they reset to zero (empty props and
//                   empty data-structures.
// 26.06.2001 20:30  Creation of empty objects without     Uh
//                   any paramaters is now possible.
//                   Objects likes this will act with
//                   default behaviour (see above)
//TH-RevisionEnd

Use cFileOperations

Class cIndex Is A cFileOperations

        // Uh 26.06.2001 Allow creation of objects without parameters
    Procedure Construct_Object  Integer iFile ;
                                Integer iIndex

        Forward Send Construct_Object

        Integer iFileSend
        Integer iIndexSend

        Property Integer    pFile       Public 0    // defines file for index
        Property Integer    pIndex      Public 0    // defines indexnumber
        Property Integer    pSegments   Public 0    // fieldcount of index
        Property String     pFields     Public ''   // fieldnumbers of indexsegments

        If (Num_Arguments > 0) ;
            Move iFile To iFileSend

        If (Num_Arguments > 1) ;
            Move iIndex To iIndexSend


        Send mInitObject iFileSend iIndexSend

    End_Procedure   //  Construct_Object


        // Uh 26.06.2001 Implemented default behaviour
    Procedure mInitObject   Integer iFile ;
                            Integer iIndex

        Integer bOpen
        Integer iSegmentsCount
        Integer iCrntSegment
        Integer iField
        String  sField
        String  sFields

        Get pOpen iFile To bOpen    // check or try to open file

        If (bOpen) Begin

            Send Delete_Data
            Get_Attribute DF_INDEX_NUMBER_SEGMENTS Of iFile iIndex To iSegmentsCount
            For iCrntSegment From 1 To iSegmentsCount
                Get_Attribute DF_INDEX_SEGMENT_FIELD Of iFile iIndex iCrntSegment To iField
                Get_Attribute DF_FIELD_NAME Of iFile iField To sField
                Set Array_Value Item iCrntSegment To sField
                Move (sFields + Character(iField)) To sFields
            Loop

            Set pFile       To iFile
            Set pIndex      To iIndex
            Set pSegments   To iSegmentsCount
            Set pFields     To sFields

            Send pClose iFile bOpen // close file, if needed
        End
        Else Begin
            Send Delete_Data
            Set pFile       To 0
            Set pIndex      To 0
            Set pSegments   To 0
            Set pFields     To ""
        End

    End_Procedure


        // Delivers a string of the Format:
        // Index.X  Field1,Field2,Field3...
    Function fsIndexString Integer iNoPrefix Returns String
        Integer iC
        String  sRet sFields
        If (pIndex(Self)>0) Begin
            If (iNoPrefix)  Move (String(pIndex(Self))+" /"+"/ ") To sRet
            Else            Move ("Index."+String(pIndex(Self))+" /"+"/ ") To sRet
        End
        Else Begin
            If (iNoPrefix)  Function_Return ("0 /"+"/ RECNUM")
            Else            Function_Return "Recnum"
        End
        For iC From 1 To (Item_Count(Self)-1)
            If sFields Ne "" Append sFields ","
            Append sFields (Trim(Value(Self,iC)))
        End
        Append sRet sFields
        Function_Return sRet
    End_Function

End_Class   // cIndex