home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST237.PRG < prev    next >
Encoding:
Text File  |  1989-08-08  |  2.0 KB  |  82 lines
  1. *****************
  2.  
  3. FUNCTION Ftypecnt
  4.  
  5.    PARAMETERS _thefile, _thetype, _position, _fnumb
  6.  
  7.    * _thefile is the database file to look at
  8.    * _thetype is the file type sought for
  9.    * _position is a string, passed by reference, which will be
  10.    *           build in the function which will point to what
  11.    *           positions each field type is found.
  12.  
  13.    IF PCOUNT() < 2
  14.       RETURN(-1)
  15.    ENDIF
  16.  
  17.    IF PCOUNT() = 2
  18.       IF TYPE("_thefile")+TYPE("_thetype") != "CC"
  19.          RETURN(-1)
  20.       ENDIF
  21.    ELSE
  22.       IF TYPE("_thefile")+TYPE("_thetype")+TYPE("_position") != "CCC"
  23.          RETURN(-1)
  24.       ENDIF
  25.    ENDIF
  26.  
  27.    _fnumb = IF((TYPE("_fnumb") != "L"), .F., _fnumb)
  28.  
  29.    PRIVATE _location, _return, _f1, _header, _count, _fname, _ftype, ;
  30.            _fwhy, _flen
  31.  
  32.    _location = 0
  33.  
  34.    _return = LTRIM(STR(SELECT()))
  35.  
  36.    IF !ISA_DBF(_thefile)     && Not a dbf file... then don't
  37.       RETURN(.F.)           && proceed
  38.    ENDIF
  39.  
  40.    SELECT 0
  41.    USE (_thefile)
  42.    _header = HEADER()
  43.    USE
  44.    SELECT &_return.
  45.    _f1 = FOPEN(_thefile)
  46.    FSEEK(_f1, 32, 0)       && Past the basic header stuff
  47.    _count = 0
  48.    DO WHILE FSEEK(_f1, 0, 1) < (_header - 31)
  49.       _fname = SPACE(11)
  50.       _ftype = SPACE(1)
  51.       _fwhy  = SPACE(4)
  52.       _flen  = SPACE(1)
  53.       _fdec  = SPACE(1)
  54.       FREAD(_f1, @_fname, 11)
  55.       FREAD(_f1, @_ftype, 1)
  56.       FREAD(_f1, @_fwhy, 4)
  57.       FREAD(_f1, @_flen, 1)
  58.       FREAD(_f1, @_fdec, 1)
  59.       _location = _location + BIN2I(_flen)
  60.       IF _ftype = UPPER(_thetype)
  61.          IF PCOUNT() >= 3
  62.             IF _fnumb
  63.                _position = _position + "/" + LTRIM(STR(_count))
  64.             ELSE
  65.                _position = _position + "/" + LTRIM(STR(_location - 8))
  66.             ENDIF
  67.          ENDIF
  68.          _count = _count + 1
  69.       ENDIF
  70.       FSEEK(_f1, 14, 1)
  71.    ENDDO
  72.    FCLOSE(_f1)
  73.    IF PCOUNT() >= 3
  74.       IF SUBSTR(_position, 1, 1) = "/"
  75.          _position = SUBSTR(_position, 2)
  76.       ENDIF
  77.    ENDIF
  78.    RETURN(_count)
  79.       
  80. * End of File
  81.  
  82.