Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/INDX18EU.ZIP/INDEXEDF.PAS

Pascal/Delphi Source File | 1991-03-20 | 21.5 KB | 917 lines

UNIT IndexedFiles ;

                             INTERFACE



{

    ***********************************************************************

    AUTHOR    :  Thomas E. Jenkins, Jr.

    VERSION   :  1.5           10 JAN 1991

    CONTACT   :  BITNET   :  C0361 @ UNIVSCVM
                 INTERNET :  C0361 @ UNIVSCVM.CSD.SCAROLINA.EDU
                 S-MAIL   :  Tom Jenkins
                             9732 Windsor Lake Blvd.
                             Columbia, SC 29223
                 Voice    :  [phone]  ( Ask for Tom Jenkins )

    ***********************************************************************

      THIS MODULE:

            UNIT :  IndexedFiles          PC :  INDEXEDF.PAS

      USES :

            UNIT :  Files                 PC :  FILES   .PAS


    ***********************************************************************

    This unit will index any record you design.  The only draw back is that
    the very first element of your record MUST be a string [ 10 ] .  This is
    the index.  You must supply a unique index here to insert a new record,
    or simply enter an existing index to replace the record in the indexed
    file.

    There are replacements to the standard turbo file procedures and functions
    to deal with the index files.  There is a new file type exported by this
    unit as well.

    Here is an example of how to create a index file:

    Define record with index.
    Declare variable of type IFile.
    Call AssignIndexed with IFile variable and file name.
    Call ReWriteIndexed with IFile

    And now you have an indexed file!  See READ.ME file for more information.

    ReadIndexed and WriteIndexed will place data in your file.  The indexing
    is up to you, but the index file is automatic and requires no ( read DO
    NOT ) tampering!  See READ.ME file for more information.

    There is an exporteded variable:

       The type is WORD, fileError, set to 0.  This variable is updated
       with one of the constants with this unit.  The variable IS NOT reset by
       the unit until a new unit routine is called.

    There are also several constants exported by the unit.  See the READ.ME
    file for more information.


}





CONST
       NO_ERROR                                  = 0 ;

CONST
       NOT_ENOUGH_MEMORY                         = 1 ;

CONST
       READ_LESS_BYTES_THAN_EXPECTED             = 2 ;

CONST
       INDEX_NOT_FOUND                           = 3 ;

CONST
       LESS_BYTES_WRITTEN_THAN_EXPECTED          = 4 ;

CONST
       INVALID_FILE_NAME                         = 5 ;





TYPE
       IndexStr                                  = STRING [ 010 ] ;

       IFile                                     = RECORD

         baseFile                                : FILE ;
         indexFile                               : FILE ;

         fileName                                : STRING ;

       END ;  {  IFile  }


TYPE
       IndexType                                 = RECORD

         index                                   : IndexStr ;
         position                                : LONGINT ;

       END ;  {  IndexType  }





VAR
       fileError                                 : WORD ;





 PROCEDURE   ReadIndexed ( VAR f                 : IFile ;
                           VAR buffer                   ;
                               size              : WORD ) ;

 PROCEDURE   WriteIndexed ( VAR f                : IFile ;
                            VAR buffer                  ;
                                size             : WORD ) ;

 PROCEDURE   DeleteIndexed ( VAR f               : IFile ;
                             VAR buffer          ;
                                 size            : WORD ) ;

 PROCEDURE   ResetIndexed ( VAR f                : IFile ) ;

 PROCEDURE   ReWriteIndexed ( VAR f              : IFile ) ;

 PROCEDURE   CloseIndexed ( VAR f                : IFile ) ;

 FUNCTION    FilePosIndexed ( VAR f              : IFile ;
                                  size           : WORD )
                                                 : LONGINT ;

 PROCEDURE   AssignIndexed ( VAR f               : IFile ;
                                 indexFile       : STRING ) ;

 FUNCTION    FileSizeIndexed ( VAR f             : IFile ;
                                   size          : WORD )
                                                 : LONGINT ;

 FUNCTION    IndexFileSize ( VAR f               : FILE )
                                                 : LONGINT ;

 PROCEDURE   IndexSeek ( VAR f                   : FILE ;
                             position            : LONGINT ) ;

 PROCEDURE   IndexRead ( VAR f                   : FILE ;
                         VAR tempIndex           : IndexType ) ;

 FUNCTION    IndexedError (     errorNum         : WORD )
                                                 : STRING ;






                           IMPLEMENTATION






USES
       DOS ,
       CRT ,
       Files ;





 FUNCTION    IndexFileSize ( VAR f               : FILE )
                                                 : LONGINT ;

   BEGIN  {  IndexFileSize  }

     IndexFileSize := FileSize ( f ) DIV SizeOf ( IndexType ) ;

   END ;  {  IndexFileSize  }





 PROCEDURE   IndexReset ( VAR i                  : FILE ) ;

   BEGIN  {  IndexReset  }

     Reset ( i , 1 ) ;

   END ;  {  IndexReset  }





 PROCEDURE   IndexSeek ( VAR f                   : FILE ;
                             position            : LONGINT ) ;

   BEGIN  {  IndexSeek  }

     Seek ( f , ( position * SizeOf ( IndexType ) ) ) ;

   END ;  {  IndexSeek  }





 PROCEDURE   IndexRead ( VAR f                   : FILE ;
                         VAR tempIndex           : IndexType ) ;

  VAR
       numRead                                   : WORD ;

   BEGIN  {  IndexRead  }

     BlockRead ( f , tempIndex , SizeOf ( IndexType ) , numRead ) ;

     IF ( numRead < SizeOf ( IndexType ) )
      THEN
         fileError := READ_LESS_BYTES_THAN_EXPECTED ;

   END ;  {  IndexRead  }





 PROCEDURE   IndexWrite ( VAR f                  : FILE ;
                              index              : IndexType ) ;
  VAR
       numWritten                                : WORD ;

   BEGIN  {  IndexWrite  }

     BlockWrite ( f , index , SizeOf ( IndexType ) , numWritten ) ;

     IF ( numWritten < SizeOf ( IndexType ) )
      THEN
         fileError := LESS_BYTES_WRITTEN_THAN_EXPECTED ;

   END ;  {  IndexWrite  }





 FUNCTION    SearchIndex ( VAR f                 : IFile ;
                               index             : IndexStr ;
                           VAR indexPosition     : LONGINT )
                                                 : LONGINT ;
  VAR
       highRecord                                : LONGINT ;
       lowRecord                                 : LONGINT ;
       tempSearch                                : LONGINT ;
       indexNotFound                             : BOOLEAN ;
       tempIndex                                 : IndexType ;

   BEGIN  {  SearchIndex  }

     highRecord := IndexFileSize ( f.indexFile ) ;

     IF ( highRecord < 1 )
      THEN
       BEGIN

         SearchIndex := -1 ;

         Exit ;

       END ;  {  IF  }

     IF ( highRecord = 1 )
      THEN
       BEGIN

         indexPosition := 0 ;

         IndexSeek ( f.indexFile , indexPosition ) ;

         IndexRead ( f.indexFile , tempIndex ) ;

         IF ( tempIndex.index = index )
          THEN
             SearchIndex := tempIndex.position

          ELSE
             SearchIndex := -1 ;

         Exit ;

       END ;  {  IF  }

     indexNotFound := TRUE ;

     lowRecord := 0 ;

     Dec ( highRecord ) ;                {  record position filesize - 1  }

     indexPosition := Trunc ( ( highRecord - lowRecord  ) / 2 ) ;

     WHILE (
                  ( indexNotFound )
             AND
                  ( lowRecord <> highRecord )
           )
      DO
       BEGIN

         IndexSeek ( f.indexFile , indexPosition ) ;

         IndexRead ( f.indexFile , tempIndex ) ;

         IF ( tempIndex.index = index )
          THEN
             indexNotFound := FALSE

          ELSE
             IF ( tempIndex.index > index )
              THEN
               BEGIN

                 IF ( highRecord = indexPosition )
                  THEN
                     lowRecord := highRecord

                  ELSE
                   BEGIN

                     highRecord := indexPosition ;

                     indexPosition :=
                        lowRecord +
                        Trunc ( ( highRecord - lowRecord ) / 2 ) ;

                   END ;  {  ELSE  }

               END    {  IF  }

              ELSE
               BEGIN

                 IF ( lowRecord = indexPosition )
                  THEN
                     highRecord := lowRecord

                  ELSE
                   BEGIN

                     lowRecord  := indexPosition ;

                     indexPosition :=
                        lowRecord +
                        Round ( ( highRecord - lowRecord ) / 2 ) ;

                   END ;  {  ELSE  }

               END ;  {  ELSE  }

       END ;  {  WHILE  }

     IF ( indexNotFound )
      THEN
         SearchIndex := -1

      ELSE
         SearchIndex := tempIndex.position ;

   END ;  {  SearchIndex  }





 FUNCTION    FileSizeIndexed ( VAR f             : IFile ;
                                   size          : WORD )
                                                 : LONGINT ;
   BEGIN  {  FileSizeIndexed  }

     fileError := NO_ERROR ;

     FileSizeIndexed := ( FileSize ( f.baseFile ) DIV size ) ;

   END ;  {  FileSizeIndexed  }





 PROCEDURE   InsertIndex ( VAR f                 : IFile ;
                               index             : IndexStr ;
                               position          : LONGINT ) ;

  VAR
       newIndex                                  : IndexType ;
       numWritten                                : WORD ;

       highRecord                                : LONGINT ;
       lowRecord                                 : LONGINT ;
       searchRecord                              : LONGINT ;
       tempSearch                                : LONGINT ;
       tempIndex                                 : IndexType ;

   BEGIN  {  InsertIndex  }

     newIndex.index         := index ;
     newIndex.position      := position ;

     highRecord := IndexFileSize ( f.indexFile ) ;

     IF ( highRecord < 1 )
      THEN
       BEGIN

         IndexSeek ( f.indexFile , highRecord ) ;

         IndexWrite ( f.indexFile , newIndex ) ;

         Exit ;

       END ;  {  IF  }

     IF ( highRecord <= 1 )
      THEN
       BEGIN

         IndexSeek ( f.indexFile , 0 ) ;

         IndexRead ( f.indexFile , tempIndex ) ;

         IF ( tempIndex.index < newIndex.index )
          THEN
             IndexWrite ( f.indexFile , newIndex )

          ELSE
             InsertRecord ( f.indexFile ,
                            newIndex , 0 , SizeOf ( newIndex ) ) ;

         Exit ;

       END ;  {  IF  }

     IF ( highRecord <= 2 )
      THEN
       BEGIN

         IndexSeek ( f.indexFile , 0 ) ;

         IndexRead ( f.indexFile , tempIndex ) ;

         IF ( tempIndex.index > newIndex.index )
          THEN
           BEGIN

             InsertRecord ( f.indexFile ,
                            newIndex , 0 , SizeOf ( newIndex ) ) ;

             Exit ;

           END ;  {  THEN  }

         IndexSeek ( f.indexFile , 1 ) ;

         IndexRead ( f.indexFile , tempIndex ) ;

         IF ( tempIndex.index > newIndex.index )
          THEN
           BEGIN

             InsertRecord ( f.indexFile ,
                            newIndex , 1 , SizeOf ( newIndex ) ) ;

             Exit ;

           END ;  {  THEN  }

         IndexSeek ( f.indexFile , 2 ) ;

         IndexWrite ( f.indexFile , newIndex ) ;

         Exit ;

       END ;  {  IF  }

     lowRecord := 0 ;

     Dec ( highRecord ) ;                {  record position filesize - 1  }

     searchRecord := Trunc ( ( highRecord - lowRecord  ) / 2 ) ;

     WHILE ( ( ( highRecord - 1 ) > searchRecord ) AND
             ( ( lowRecord + 1  ) < searchRecord ) )
      DO
       BEGIN

         IndexSeek ( f.indexFile , searchRecord ) ;

         IndexRead ( f.indexFile , tempIndex ) ;

         IF ( tempIndex.index > newIndex.index )
          THEN
           BEGIN

             IF ( highRecord = searchRecord )
              THEN
                 lowRecord := highRecord

              ELSE
               BEGIN

                 highRecord := searchRecord ;

                 searchRecord :=
                    lowRecord +
                    Trunc ( ( highRecord - lowRecord ) / 2 ) ;

               END ;  {  ELSE  }

           END    {  IF  }

          ELSE
           BEGIN

             IF ( lowRecord = searchRecord )
              THEN
                 highRecord := lowRecord

              ELSE
               BEGIN

                 lowRecord  := searchRecord ;

                 searchRecord :=
                    lowRecord +
                    Round ( ( highRecord - lowRecord ) / 2 ) ;

               END ;  {  ELSE  }

           END ;  {  ELSE  }

        END ;  {  WHILE  }

      searchRecord := lowRecord ;

      REPEAT

        IndexSeek ( f.indexFile , searchRecord ) ;
        IndexRead ( f.indexFile , tempIndex ) ;

        IF ( tempIndex.index < newIndex.index )
         THEN
            Inc ( searchRecord ) ;

      UNTIL ( ( tempIndex.index > newIndex.index ) OR
              ( searchRecord > highRecord ) OR
              ( searchRecord >= IndexFileSize ( f.indexfile ) ) ) ;

      InsertRecord ( f.indexFile ,
                     newIndex , searchRecord , SizeOf ( newIndex ) )

   END ;  {  InsertIndex  }





 PROCEDURE   ResetIndexed ( VAR f                : IFile ) ;

   BEGIN  {  ResetIndexed  }

     Reset ( f.baseFile , 1 ) ;
     Reset ( f.indexFile , 1 ) ;

     fileError := NO_ERROR ;

   END ;  {  ResetIndexed  }





 PROCEDURE   ReWriteIndexed ( VAR f              : IFile ) ;

   BEGIN  {  ReWriteIndexed  }

     ReWrite ( f.baseFile , 1 ) ;
     ReWrite ( f.indexFile , 1 ) ;

     fileError := NO_ERROR ;

   END ;  {  ReWriteIndexed  }





 PROCEDURE   SeekIndexed ( VAR f                 : IFile ;
                               position          : LONGINT ;
                               size              : WORD ) ;

   BEGIN  {  SeekIndexed  }

     fileError := NO_ERROR ;

     Seek ( f.baseFile , ( position * size ) ) ;

   END ;  {  SeekIndexed  }





 PROCEDURE   ReadIndexed ( VAR f                 : IFile ;
                           VAR buffer                    ;
                               size              : WORD ) ;

  VAR
       position                                  : LONGINT ;
       index                                     : IndexStr
                                                     ABSOLUTE
                                                     BUFFER ;
       numRead                                   : WORD ;
       indexPosition                             : LONGINT ;

   BEGIN  {  ReadIndexed  }

     fileError := NO_ERROR ;

     position := SearchIndex ( f , index , indexPosition ) ;

     IF ( position < 0 )
      THEN
       BEGIN

         fileError := INDEX_NOT_FOUND ;

         Exit ;

       END ;  {  IF  }

     SeekIndexed ( f , position , size ) ;

     BlockRead ( f.baseFile , buffer , size , numRead ) ;

     IF ( numRead < size )
      THEN
         fileError := READ_LESS_BYTES_THAN_EXPECTED ;

   END ;  {  ReadIndexed  }





 FUNCTION    IndexFilePos ( VAR f                : FILE )
                                                 : LONGINT ;

   BEGIN  {  IndexFilePos  }

     IndexFilePos := FilePos ( f ) DIV SizeOf ( IndexType ) ;

   END ;  {  IndexFilePos  }





 PROCEDURE   WriteIndexed ( VAR f                : IFile ;
                            VAR buffer                   ;
                                size             : WORD ) ;

  VAR
       position                                  : LONGINT ;
       index                                     : IndexStr
                                                     ABSOLUTE
                                                     BUFFER ;
       numWritten                                : WORD ;
       indexPosition                             : LONGINT ;

   BEGIN  {  WriteIndexed  }

     fileError := NO_ERROR ;

     position := SearchIndex ( f , index , indexPosition ) ;

     IF ( position >= 0 )
      THEN
       BEGIN

         SeekIndexed ( f , position , size ) ;

         BlockWrite ( f.baseFile , buffer , size , numWritten ) ;

         IF ( numWritten < size )
          THEN
             fileError := LESS_BYTES_WRITTEN_THAN_EXPECTED ;

         Exit ;

       END ; {  IF  }

     SeekIndexed ( f , FileSizeIndexed ( f , size ) , size ) ;

     BlockWrite ( f.baseFile , buffer , size , numWritten ) ;

     IF ( numWritten < size )
      THEN
         fileError := LESS_BYTES_WRITTEN_THAN_EXPECTED ;

     InsertIndex ( f , index , FilePosIndexed ( f , size ) - 1 ) ;

   END ;  {  WriteIndexed  }





 PROCEDURE   CloseIndexed ( VAR f                : IFile ) ;

   BEGIN  {  CloseIndexed  }

     fileError := NO_ERROR ;

     Close ( f.baseFile ) ;
     Close ( f.indexFile ) ;

   END ;  {  CloseIndexed  }





 FUNCTION    FilePosIndexed ( VAR f              : IFile ;
                                  size           : WORD )
                                                 : LONGINT ;

   BEGIN  {  FilePosIndexed  }

     fileError := NO_ERROR ;

     FilePosIndexed := FilePos ( f.baseFile ) DIV size ;

   END ;  {  FilePosIndexed  }





 PROCEDURE   AssignIndexed ( VAR f               : IFile ;
                                 indexFile       : STRING ) ;

  CONST
       INDEX_EXT                                 = 'IDX' ;
       FILE__EXT                                 = 'FIL' ;

  VAR
       dotPosition                               : BYTE ;

   BEGIN  {  AssignIndexed  }

     fileError := NO_ERROR ;

     IF ( indexFile = '' )
      THEN
       BEGIN

         fileError := INVALID_FILE_NAME ;

       END ;  {  IF  }

     dotPosition := Pos ( '.' , indexFile ) ;

     IF ( dotPosition <> 0 )
      THEN
       BEGIN

         fileError := INVALID_FILE_NAME ;

         Exit ;

       END ;  {  IF  }

     Assign ( f.indexFile ,    indexFile + '.' + INDEX_EXT ) ;
     Assign ( f.baseFile ,     indexFile + '.' + FILE__EXT ) ;

     f.fileName := indexFile ;


   END ;  {  AssignIndexed  }





 PROCEDURE   DeleteIndexed ( VAR f               : IFile ;
                             VAR buffer          ;
                                 size            : WORD ) ;

  VAR
       position                                  : LONGINT ;
       index                                     : IndexStr
                                                     ABSOLUTE
                                                     BUFFER ;
       numWritten                                : WORD ;
       indexPosition                             : LONGINT ;
       tempIndex                                 : IndexType ;

   BEGIN  {  DeleteIndexed  }

     fileError := NO_ERROR ;

     position := SearchIndex ( f , index , indexPosition ) ;

     IF ( position < 0 )
      THEN
       BEGIN

         fileError := INDEX_NOT_FOUND ;

         Exit ;

       END ; {  IF  }

     DeleteRecord ( f.baseFile , position , size ) ;

     DeleteRecord ( f.indexFile , indexPosition , SizeOf ( IndexType ) ) ;

     IndexReset ( f.indexFile ) ;

     WHILE ( NOT ( EOF ( f.indexFile ) ) )
      DO
       BEGIN

         IndexRead ( f.indexFile , tempIndex ) ;

         IF ( tempIndex.position > indexPosition )
          THEN
           BEGIN

             Dec ( tempIndex.position ) ;

             IndexSeek ( f.indexFile , IndexFilePos ( f.indexFile ) - 1 ) ;

             IndexWrite ( f.indexFile , tempIndex ) ;

           END ;  {  THEN  }

       END ;  {  WHILE  }

   END ;  {  DeleteIndexed  }





 FUNCTION    IndexedError (     errorNum         : WORD )
                                                 : STRING ;

   BEGIN  {  IndexedError  }

     CASE errorNum
      OF

         NO_ERROR                         :
            IndexedError := 'no error' ;

         NOT_ENOUGH_MEMORY                :
            IndexedError := 'not enough memory to complete operation' ;

         READ_LESS_BYTES_THAN_EXPECTED    :
            IndexedError := 'file read error' ;

         INDEX_NOT_FOUND                  :
            IndexedError := 'index was not found' ;

         LESS_BYTES_WRITTEN_THAN_EXPECTED :
            IndexedError := 'file write error' ;

         INVALID_FILE_NAME                :
            IndexedError := 'file name invalid' ;

      ELSE

         IndexedError := 'FATAL ERROR!!  Unknown  error!' ;

         END ;  {  CASE errorNum  }

     END ;  {  IndexedError  }





BEGIN

  fileError      := 0 ;

END .