home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / PCMAG / VOL10N02.ZIP / FOXIDX.PRG < prev    next >
Encoding:
Text File  |  1990-10-15  |  5.0 KB  |  144 lines
  1. * FOXIDX.PRG
  2. * Display some information for all .IDX files
  3. * in the current directory
  4. *
  5. PROCEDURE FoxIdx
  6. PRIVATE filespec, idxname
  7. filespec = "*.IDX"                     && Change to ".NDX" if
  8.                                        && INDEX=NDX in CONFIG.FP
  9. idxname = SYS(2000, filespec)          && Find first matching file
  10. DO WHILE ! EMPTY(idxname)              && For each match
  11.    DO PrintInfo WITH idxname           && Print some info
  12.    idxname = SYS(2000, filespec, 1)    && Find next matching
  13. ENDDO
  14.  
  15. RETURN
  16.  
  17. * PROCEDURE PrintInfo
  18. * Print some info for the FoxPro index file whose
  19. * name was passed as a parameter
  20. *
  21. PROCEDURE PrintInfo                    && Print some info
  22. PARAMETERS iname                       && Name of idx file
  23. PRIVATE ikey, ifor
  24. ?
  25. ? "Filename:   "+iname
  26. ikey = IdxKey(iname)                   && Get index key
  27. IF ("" == ikey)                        && If it is null
  28.    IF FERROR() # 0                     && Check for error
  29.       ikey = "Error: "+FerrorTxt(ferror())
  30.    ENDIF
  31. ENDIF
  32.  
  33. ? "Key:        "+ikey
  34.  
  35. IF IsKeyFor(iname)                     && If index has FOR clause
  36.    ifor = KeyFor(iname)                && Get it
  37.    IF ("" == ifor)                     && If it is null
  38.       IF FERROR() # 0                  && Check for error
  39.          ifor = "Error: "+FerrorTxt(ferror())
  40.       ENDIF
  41.    ENDIF
  42.    ? "FOR clause: "+ifor
  43. ELSE                                   && No FOR clause
  44.    IF FERROR() # 0                     && Check for error
  45.       ifor = "Error: "+FerrorTxt(ferror())
  46.       ? "FOR clause: "+ifor
  47.    ELSE
  48.       ? "FOR clause: "+"*none*"
  49.    ENDIF
  50. ENDIF
  51. RETURN
  52.  
  53. * FUNCTION FerrorTxt(error number from FERROR())
  54. * Return the text for the associated error number
  55. * returned from FERROR()
  56. *
  57. FUNCTION FerrorTxt
  58. PARAMETER errno
  59. DO CASE
  60.  CASE errno = 2
  61.    RETURN "File not found"
  62.  CASE errno = 4
  63.    RETURN "Too many files open (insufficient handles)"
  64.  CASE errno = 5
  65.    RETURN "Access denied"
  66.  CASE errno = 6
  67.    RETURN "Invalid file handle"
  68.  CASE errno = 8
  69.    RETURN "Out of memory"
  70.  CASE errno = 25
  71.    RETURN "Seek past beginning of file"
  72.  CASE errno = 29
  73.    RETURN "Disk full"
  74.  CASE errno = 31
  75.    RETURN "Error opening file, or EOF encountered"
  76.  OTHERWISE
  77.    RETURN "Unknown error"
  78. ENDCASE
  79. RETURN
  80.  
  81. * FUNCTION KeyFor("index filename")
  82. * Return the FOR expression for a FoxPro index file.
  83. *
  84. FUNCTION KeyFor                         && Return FOR clause
  85. PARAMETERS idxname                      && Index filename
  86. PRIVATE handle, forclause
  87. handle = FOPEN(idxname,10)              && Open for read only
  88. IF handle = -1                          && -1 means error
  89.    RETURN ""                            && So set it to null string
  90. ENDIF
  91. = FSEEK(handle,236,0)                   && Goto byte pos 236
  92. forclause = TRIM(FREAD(handle,220))     && Read the FOR clause
  93. IF FERROR() # 0                         && If error occurred
  94.    forclause=""                         && Set it to null string
  95. ENDIF
  96. =FCLOSE(handle)                         && Close the file
  97. forclause = SUBSTR(forclause,1,;
  98.      AT(CHR(0),forclause))              && Remove trailing nulls
  99. RETURN forclause                        && Return result
  100.  
  101. *
  102. * FUNCTION IsKeyFor("Index Filename")
  103. * Return .T. if FoxPro index has a FOR clause, .F. otherwise.
  104. *
  105. FUNCTION IsKeyFor
  106. PARAMETERS idxname                      && Index filename
  107. PRIVATE handle, retcode
  108. retcode = .F.                           && Init to false
  109. handle = FOPEN(idxname,10)              && Open for read only
  110. IF handle = -1                          && -1 means error
  111.    RETURN retcode                       && So set it to FALSE
  112. ENDIF
  113. = FSEEK(handle,14,0)                    && Goto byte pos 14
  114. iopt = FREAD(handle,1)                  && Get index options
  115. IF FERROR() # 0                         && If error occurred
  116.    retcode=.F.                          && Set it to FALSE
  117. ENDIF
  118. =FCLOSE(handle)                         && Close the file
  119. IF (iopt == CHR(8)) .OR. (iopt == CHR(9))
  120.    retcode = .T.                        && 8 or 9 if there
  121. ENDIF                                   && is a FOR clause
  122. RETURN retcode                          && Return result
  123.  
  124. * FUNCTION IdxKey("index filename")
  125. * Return the KEY expression for a FoxPro index.
  126. *
  127. FUNCTION IdxKey                         && Return FOR clause
  128. PARAMETERS idxname                      && Index filename
  129. PRIVATE handle, keyclause
  130. handle = FOPEN(idxname,10)              && Open for read only
  131. IF handle == -1                         && -1 means error
  132.    RETURN ""                            && So set it to null string
  133. ENDIF
  134. = FSEEK(handle,16,0)                    && Goto byte pos 16
  135. keyclause = TRIM(FREAD(handle,220))     && Read the KEY clause
  136. IF FERROR() # 0                         && If error occurred
  137.    keyclause=""                         && Set it to null string
  138. ENDIF
  139. =FCLOSE(handle)                         && Close the file
  140. keyclause = SUBSTR(keyclause,1,;
  141.             AT(CHR(0),keyclause))       && Remove trailing nulls
  142. RETURN keyclause                        && Return result
  143.  
  144.