home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / clipper / partidx3.arj / PARTINDX.PRG < prev    next >
Encoding:
Text File  |  1990-05-16  |  3.7 KB  |  141 lines
  1. * PARTINDX.prg    - Generate partial index
  2. *
  3. *
  4. * Version Date     Comment                                        Done by
  5. * ======= ======== ============================================== ===========
  6. *   1.00  05/15/90 Initial version.                               K. Foley
  7. *
  8.  
  9.  
  10. * Parameters
  11. *
  12. *  IdxKey       Character   - Actual expresion index file is to be based on
  13. *  IdxFileName  Character   - Name of the index file to be built.
  14. *                             Must specify .ntx extension
  15. *  MaxIdxRcs    Numeric     - Best guess for upper limit on number of records
  16. *  KeyExpr      Character   - Expression used in conjunction with KeyValue
  17. *                             to halt indexing.
  18. *  KeyValue     Variable    - Matching value for &KeyValue
  19. *  UserFilter   Character   - Optional user specified filtering function
  20. *
  21. *  NOTE: Assumes database is already positioned at starting record.
  22. *        The last key in the index will usually NOT belong to the
  23. *        KeyValue.  To restrict the use of this eronius key, use SET FILTER,
  24. *        after the partial index has been built and used.
  25. *        Since the index being used is small, SET FILTER will not
  26. *        dramatically impede performance, as it would have if a larger index
  27. *        was being used.
  28. *
  29. *  EXAMPLE:  This example builds a partial index called BOB.NTX that only
  30. *            contains keys for records with FILEID equal to 20555 .
  31. *
  32. *  use BENE2CL
  33. *  set index to BENE2CL
  34. *  seek " 20555"
  35. *  PartIndex("str(FILEID,6,0)+str(SEQUENCE,2,0)","bob.ntx",75,"FILEID",20555)
  36. *  set index to bob
  37. *  set filter to FILEID = 20555
  38. *
  39. *
  40.  
  41.  
  42. * PROCEDURE PARTINDX
  43.   Private UserFilter
  44.     UserFilter = ""
  45.   Parameters IdxKey, IdxFileName, MaxIdxRcs, KeyExpr, KeyValue, UserFilter
  46.   Private LoopVar, NullVar, SubScript
  47.   Private IdxAryRcs[MaxIdxRcs], handle, Scrn, OldColor, AddIt
  48.  
  49.   * Show indexing message for progress report
  50.  
  51.   * OldColor = SETCOLOR()
  52.   * Scrn = MsgDisp("Wait. Indexing record xxx",.f.,"w+/r","w+/r",-1)
  53.   * SETCOLOR("W+/R")
  54.  
  55.   * Build array of record pointers
  56.  
  57.   IdxAryRcs[MaxIdxRcs] = LASTREC()
  58.  
  59.   LoopVar = 0
  60.   do while LoopVar < MaxIdxRcs .and. !eof() .and. ;
  61.      &KeyExpr = KeyValue
  62.      AddIt = .F.
  63.      if empty(UserFilter)
  64.        AddIt = .T.
  65.      else
  66.        if &UserFilter
  67.          AddIt = .T.
  68.        endif
  69.      endif
  70.      if AddIt
  71.        LoopVar = LoopVar + 1
  72.        IdxAryRcs[LoopVar] = RECNO()
  73.  
  74.        * Show indexing status
  75.        @ 11,49 say LoopVar picture "999"
  76.      endif
  77.     skip
  78.   enddo
  79.  
  80.   * Assign EOF pointers to all unused array cells
  81.  
  82.   for NullVar= LoopVar + 1 to MaxIdxRcs
  83.     IdxAryRcs[NullVar] = LASTREC()
  84.   next
  85.  
  86.   * Close original index
  87.  
  88.   set index to
  89.  
  90.   * Sort pointers in numeric order to prevent an early indexing termination
  91.   * via goto'ing an early EOF pointer.
  92.  
  93.   ASORT(IdxAryRcs)
  94.  
  95.   * Create the partial index
  96.  
  97.   SubScript = -1
  98.   index on xFAKEOUT() to &IdxFileName.
  99.  
  100.   * Close the partial index
  101.  
  102.   set index to
  103.  
  104.   * Rewrite index file header.  Remove the index expression xFAKEOUT
  105.   * and replace it with the actual index value expression.
  106.  
  107.   handle = FOPEN(IdxFileName,2)
  108.   if handle > 0
  109.     FSEEK(handle,22,0)
  110.     FWRITE(handle,IdxKey + space(200),200)
  111.   endif
  112.   FCLOSE(handle)
  113.  
  114.   * SpclEfex( "TB", "P", Scrn, 20 )
  115.   * SETCOLOR(OldColor)
  116.  
  117.   RELEASE IdxAryRcs, Scrn
  118.  
  119.   * Set the index back to the partial index,
  120.  
  121.   set index to &IdxFileName.
  122.  
  123. RETURN
  124.  
  125.  
  126. FUNCTION xFAKEOUT
  127.  
  128.   SubScript = SubScript + 1
  129.   if SubScript > 0
  130.     GOTO IdxAryRcs[SubScript]
  131.  
  132.     * Show indexing status
  133.  
  134.     @ 11,49 say LoopVar picture "999"
  135.     LoopVar = LoopVar - 1
  136.   else
  137.     GOTO IdxAryRcs[1]
  138.   endif
  139.  
  140. RETURN &IdxKey
  141.