Retro video games delivered to your door every month!
Click above to get retro games delivered to your door ever month!
X-Hacker.org- FAST TEXT SEARCH for Clipper v.2.0 - * program...: <u>show2.prg</u> http://www.X-Hacker.org [<<Previous Entry] [^^Up^^] [Next Entry>>] [Menu] [About The Guide]
   * PROGRAM...: SHOW2.PRG
   * AUTHOR....: John A. Reesman
   * ..........: Index Applications Incorporated
   * ..........: 8546 Broadway, Suite 208
   * ..........: San Antonio, TX  78217 USA
   * ..........: (210) 822-4818
   * DATE......: 07/25/93
   * NOTICE....: Copyright 1989-1993 Index Applications Incorporated
   * NOTES.....: Demonstration program for CFTS routines
   * ..........: This program demostrates using CFTS functions with
   * ..........: text files.
   
   parameters NOCOLOR
   
   *********************************************************
   * GLOBAL variables
   *********************************************************
   
   private IABUFF,PREC,STAND_CLR,START_CLR
   private OPENMODE,VERTYPE,VAND,VBEG,VEND,VONE
   private IAFILE,XHANDLE,RECLEN,FHANDLE
   
   *********************************************************
   * eof GLOBAL variables
   *********************************************************
   
   *********************************************************
   * GLOBAL initialization
   *********************************************************
   
   if pcount() = 1         && run in b/w regardless of video type
   
      NOCOLOR = if( upper( NOCOLOR ) = 'M', .t., .f. )
   
   else
   
      NOCOLOR = .f.
   
   endif
   
   VBEG = 1                && verify at begining of string only
   VEND = 2                && verify at end of string only
   VAND = 3                && verify all tokens in target
   VONE = 4                && don't tokenize target
   
   VERTYPE = VAND          && default verify type
   IAFILE = 'Show2.ia'     && name of our CFTS index file
   IABUFF = 20             && size of our CFTS internal buffer
   OPENMODE = .t.          && open in exclusive mode
   RECLEN   = 122          && length of records in show.txt
   
   set scoreboard off
   set deleted off
   set wrap on
   set exclusive on
   
   if iscolor() .and. ! NOCOLOR        && establish our color scheme
   
       STAND_CLR   =  'W+/B,N/W,,,W+/B'
   
   else
   
       STAND_CLR   =  'W/N,N/W,,,W/N'
   
   endif
   
   START_CLR = setcolor( STAND_CLR )   && save original screen colors
   
   select 0
   
   fspec = 'show.txt'                  && open the test file
   
   FHANDLE = fopen( fspec, 0 )         && open test file as read only
   
   if FHANDLE != -1
   
       if ! file( IAFILE )
   
           tone( 260, 2 )
   
           ans = 'Y'
   
           @ row()+1,00 say IAFILE + ' does not exist. Create? (y/n)';
               get ans picture '!' valid if( ans $ 'YN', .t., .f. )
   
           read
           clear gets

           if ans != 'Y'

               fclose( FHANDLE )
               quit

           endif

       && when using text files, we cannot take advantage of
       && Cfts_Index() as it is geared for use with .dbfs.
       && Consequently, the following code mimics the operation
       && of Cfts_Index(), but uses the CFTS functions directly.

           XHANDLE = cftscrea( IAFILE, IABUFF, 3, .t. ,1 )

           if XHANDLE >= 0

               instring = space( RECLEN + 1 )

               bytesread = fread( FHANDLE, @instring, RECLEN )

               do while bytesread = RECLEN       && strip off the CR/LF

               instring = trim( substr( instring, 1, RECLEN - 2 ) )

               ans = cftsadd( XHANDLE, instring )

                   if ans < 1

                      ? 'error generating ' + IABUF

                   endif

               instring = space( RECLEN + 1 )

               bytesread = fread( FHANDLE, @instring, RECLEN )

               enddo

               cfts_close( XHANDLE )    && play safe and flush IA buffers

               XHANDLE = cfts_open( IAFILE, IABUFF, OPENMODE )
   
           endif
   
       else
   
           XHANDLE = cfts_open( IAFILE, IABUFF, OPENMODE )
   
       endif
   
   else
   
       ? 'error: unable to open ' + fspec
       quit
   
   endif

   if iscolor() .and. ! NOCOLOR        && establish our color scheme

      STAND_CLR   =  'W+/B,N/W,,,W+/B'

   else
   
      STAND_CLR   =  'W/N,N/W,,,W/N'

   endif

   START_CLR = setcolor( STAND_CLR )    && save original screen colors
                                        && and set new color
   clear screen

   *********************************************************
   * eof GLOBAL initialization
   *********************************************************

   *********************************************************
   * Main Loop
   *********************************************************

   instring = space( RECLEN + 1 )

   do while .t.

       searchstr = space( 120 )

       @ 24,00 say 'Find:' get searchstr picture '@S72'
       read
       clear gets

       if lastkey() != 27 .and. !empty( searchstr ) && didn't ESCAPE
                                                    && and enter a string
           clear screen                             && set up for searching
           
           cfts_set( XHANDLE, trim( searchstr ) )

           ans = cfts_next( XHANDLE ) && get a 'hit' from the index

           do while ans > 0        && verify all hits until we're done
                                   && CFTS returns the record number of
                                   && a 'hit'. We use this number times
                                   && the size of the records in the text
                                   && to calculate the byte offset of the
                                   && record in the file.

               fseek( FHANDLE, ( ans - 1 ) * RECLEN, 0 )

               instring = space( RECLEN + 1 )

               bytesread = fread( FHANDLE, @instring, RECLEN )

               instring = trim( substr( instring, 1, RECLEN - 2 ) )

               if cfts_veri(XHANDLE,instring,trim(searchstr),VERTYPE)=1

               if row() >= 24  && it's not a fancy screen, but let's clear it
                               && when we've used up what we've got
                   clear screen

               endif

               @ row(), 00 say substr( instring, 1, RECLEN - 2 )
               wait

               endif

               ans = cfts_next( XHANDLE )  && get the next hit

           enddo

       else

           if lastkey() = 27

               exit          && user pressed ESCAPE, exit from loop

           endif

       endif
   
   enddo

   fclose( FHANDLE )         && close text file

   cfts_close( XHANDLE )

   setcolor( START_CLR )     && restore our original screen colors

   quit

   *********************************************************
   * eof Main Loop
   *********************************************************

Online resources provided by: http://www.X-Hacker.org --- NG 2 HTML conversion by Dave Pearson