Liren Large Software Subsidy 5/05.iso/a/a075/1.img/TOOLKIT1.EXE/SST239.PRG

Text File | 1989-10-22 | 5.7 KB | 204 lines

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

FUNCTION Packdbt

   PARAMETERS _tfile

   * This function has two anciliary funtions
   * that are part of this main routine.  They
   * are: MAKEDBTHEAD() and COPYDBT()

   IF PCOUNT() = 0
      RETURN(.F.)
   ELSE
      IF TYPE("_tfile") != "C"
         RETURN(.F.)
      ELSE
         IF !FILE(_tfile)
            RETURN(.F.)
         ELSE
            IF !ISA_DBF(_tfile)
               RETURN(.F.)
            ENDIF
         ENDIF
      ENDIF
   ENDIF

   IF EMPTY(AT(".", _tfile))
      _root = _tfile
      _dbt  = ".DBT"
      _ext  = ".DBF"
   ELSE
      _root = Parsing(@_tfile, ".")
      _dbt  = ".DBT"
      _ext  = "." + _tfile
   ENDIF

   USE (_root + _ext)
   _thehead = HEADER()
   _theleng = RECSIZE()
   _thenumb = LASTREC()
   USE

   * Now get the number of memos in the file
   * and their beginning byte position.
   * The 'whereat' variable is a _string which
   * needs to be parsed in order to determine
   * the position of the .DBT.
   _whereat = ""
   _memos = FTYPECNT(_root + _ext , "M", @_whereat)

   _fhandle = FOPEN(_root + _ext, 2)    && Original Database  <-- IN READ/WRITE MODE
   _newdbt  = FCREATE("SJSTEMP.$$$")    && New .DBT file
   _olddbt  = FOPEN(_root + _dbt)       && Original .DBT file
   IF !MAKEDBTHEAD(_newdbt, _olddbt)    && Creates the header
      RETURN(.F.)                       && An error has occured
   ENDIF

   * if the _dbhandle is o.k., continue, otherwise, quit
   _written = 1

   FSEEK(_fhandle, _thehead, 0)
   FOR _qqaz = 1 TO _thenumb
      _string = SPACE(_theleng)
      _justok = FSEEK(_fhandle, 0, 1)      && Gets the file pointer
      FREAD(_fhandle, @_string, _theleng)  && Get the record
      STORE _whereat TO _tempparse         && Store the parse to a temp
      FOR _qqay = 1 TO _memos
         _z = PARSING(@_tempparse)
         _dbtpoint = VAL(SUBSTR(_string, VAL(_z), 10))
         IF !EMPTY(_dbtpoint)
            _writeback = TRANSFORM(_written, "9999999999")
            _string = SUBSTR(_string, 1, VAL(_z) -1) + _writeback + ;
                     SUBSTR(_string, VAL(_z)+10)
            _numblocks = COPYDBT(_olddbt, _newdbt, _dbtpoint, _written)
            IF EMPTY(_numblocks)   && An error has occured.
               RETURN(.F.)
            ENDIF
            _written = _written + _numblocks
         ENDIF
      NEXT
      * Reposition the file pointer to the beginning of the record
      FSEEK(_fhandle, _justok, 0)
      * Write out the new _string which in turn points to the next record
      FWRITE(_fhandle, _string)
      IF FERROR() != 0
         RETURN(.F.)
      ENDIF
   NEXT
   FWRITE(_newdbt,  I2BIN(26), 1)
   FCLOSE(_fhandle)
   FCLOSE(_newdbt)
   FCLOSE(_olddbt)
   ERASE &_root.&_dbt.
   RENAME SJSTEMP.$$$ TO &_root.&_dbt.
   RETURN(.T.)

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

FUNCTION Makedbthead

   PARAMETERS handle1, handle2

   * handle1 is the file handle to the temp DBT
   * handle2 is the file handle to the good DBT file

   FSEEK(handle2, 0, 0)
   FWRITE(handle1, I2BIN(3), 1)
   FOR _qqaz = 2 TO 100
      FWRITE(handle1, I2BIN(0), 1)
   NEXT
   FWRITE(handle1, "Packed b_qqay Steve Straley's ToolkiT(tm) ")
   FWRITE(handle1, "Published b_qqay Four Season's Publishing - 212-599-2141")
   IF FERROR() != 0
      RETURN(.F.)
   ENDIF
   DO WHILE FSEEK(handle1, 0, 1) != 512
      FWRITE(handle1, I2BIN(0), 1)
   ENDDO
   RETURN((FERROR() = 0))

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

FUNCTION Copydbt

   PARAMETERS _filepoint, _farpoint, _filestart, _farstart

   *          old dbt   , new dbt,   old point,  new point

   * take the file pointer for the old dbt file '_farpoint'
   * and write out the contents to the new dbt file in the
   * file pointer '_filepoint'.  The position in the old dbt
   * file to start looking at is in '_filestart' and the return
   * value will be the block pointer in the new dbt file

   * _seedpoint is the original file position in the old DBT file

   _seedpoint = FSEEK(_filepoint, 1, 0)

   * set the file pointer in the NEW dbt to the end of the last
   * block _written to it

   bytecount = 0

   * go to the beginning block pointer in the old dbt

   FSEEK(_filepoint, (512 * _filestart), 0)

   * read the file and find the end of memo counter
   * and if the byte is not 1A, then write out the
   * byte to the new DBT file.

*   _www = " "
*   DO WHILE .T.
*      FREAD(_filepoint, @_www, 1)
*      IF BIN2I(_www) != 26
*         bytecount = bytecount + 1
*         FWRITE(_farpoint, _www)
*         IF FERROR() != 0
*            RETURN(0)
*         ENDIF
*      ELSE
*         EXIT
*      ENDIF
*   ENDDO

   _notnow = .T.
   DO WHILE _notnow
      _www = SPACE(512)
      FREAD(_filepoint, @_www, 512)
      IF EMPTY(AT(CHR(26),_www))  && No memo marker
         bytecount = bytecount + 512
         FWRITE(_farpoint, _www)
      ELSE
         bytecount = bytecount + ( AT(CHR(26),_www)-1 )
         FWRITE(_farpoint, _www, ( AT(CHR(26),_www)-1 ) )
         _notnow = .F.
      ENDIF
      IF FERROR() != 0
         RETURN(0)
      ENDIF
   ENDDO


   * find out how man_qqay blocks were _written out
   * to the new file.

   _blckcount = (INT(bytecount / 512)) + 1

   * figure out how man_qqay bytes until the end of the
   * next memo file, reposition the files, and return
   * the number of blocks _written

   _remaining = (_blckcount * 512) - bytecount - 1
   FWRITE(_farpoint, I2BIN(26), 1)
   FWRITE(_farpoint, I2BIN(32), _remaining)
   IF FERROR() != 0
      RETURN(0)
   ENDIF
   FSEEK(_filepoint, _seedpoint, 0)            && Original dbt
   RETURN(_blckcount)

* End of File