home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST334.PRG < prev    next >
Encoding:
Text File  |  1989-08-29  |  3.4 KB  |  93 lines
  1. *******************
  2.  
  3. FUNCTION O_memtext
  4.  
  5.    PARAMETERS _mem, _txt
  6.  
  7.    * The numeric and date writing portion of this function was
  8.    * written by the Wizzard: Essor Maso...
  9.  
  10.    IF PCOUNT() != 2                              && Not enough parameters
  11.       RETURN(.F.)
  12.    ELSEIF TYPE("_mem") + TYPE("_txt") != "CC"    && Wrong data type
  13.       RETURN(.F.)
  14.    ELSEIF !FILE(_mem)                            && FIle NOT file
  15.       RETURN(.F.)
  16.    ELSEIF FILE(_txt)                             && File is there
  17.       RETURN(.F.)
  18.    ENDIF
  19.  
  20.    _fh1 = FOPEN(_mem)            && File handle for the mem file
  21.    _fp1 = FSEEK(_fh1, 0, 2)      && Get's ID for the file.
  22.    FSEEK(_fh1, 0)                && repositions the pointer
  23.    IF _fp1 < 2
  24.       FCLOSE(_fh1)
  25.       RETURN(.F.)
  26.    ENDIF
  27.    _fh2 = FCREATE(_txt)          && File handle for the txt file
  28.    DO WHILE FSEEK(_fh1, 0, 1) + 1 < _fp1
  29.       _realvar = SPACE(18)
  30.       FREAD(_fh1, @_realvar, 18)
  31.       _name = LEFT(_realvar, AT(CHR(0), _realvar) - 1 )
  32.       _data = SUBSTR(_realvar, 12, 1)
  33.       _dtyp = BIN2W(RIGHT(_realvar, 2))
  34.       IF _data $ "├╠"
  35.          _drng = 14 + _dtyp
  36.       ELSE
  37.          _drng = 22
  38.       ENDIF
  39.       _dval = SPACE(_drng)
  40.       FREAD(_fh1, @_dval, _drng)          && String of value
  41.       _nval = SUBSTR(_dval, 15)
  42.       FWRITE(_fh2, _name, LEN(_name))
  43.       FWRITE(_fh2, SPACE(12 - LEN(_name)), 12 - LEN(_name))
  44.       FWRITE(_fh2, "  =  ", 5)
  45.       IF     _data = CHR(195) && character
  46.          _nval = '"' + STRTRAN(STRTRAN(_nval, "'", "`"), '"', "'") + '"'
  47.          FWRITE(_fh2, _nval, LEN(_nval))
  48.  
  49.       ELSEIF _data = CHR(204) && logical
  50.          FWRITE(_fh2, IF((ASC(_nval) = 1), ".T.", ".F."))
  51.  
  52.       ELSEIF _data = CHR(206) && numeric
  53.          _dval = SUBSTR(_dval, 15)
  54.          _pad1 = Modulus(ASC(SUBSTR(_dval, 8, 1)), 128) * 16
  55.          _pad2 = INT(ASC(SUBSTR(_dval, 7, 1)) / 16)
  56.          _powr = _pad1 + _pad2 - 1023
  57.          _mins = INT(ASC(SUBSTR(_dval, 8, 1)) / 16) >= 8
  58.          _man0 = Modulus(ASC(SUBSTR(_dval, 7, 1)), 16) / 16
  59.          _man1 = BIN2W(SUBSTR(_dval, 5, 2)) / (65536*16)
  60.          _man2 = BIN2W(SUBSTR(_dval, 3, 2)) / (65536 * 65536 * 16)
  61.          _man3 = BIN2W(SUBSTR(_dval, 1, 2)) / (65536 * 65536 * 65536 * 16)
  62.          _mant = _man0 + _man1 + _man2 + _man3
  63.          _numb = IF(_mins, -(1 + _mant) * (2 ^ _powr), (1 + _mant) * (2 ^ _powr))
  64.          _sdec = ASC(RIGHT(_realvar, 1))
  65.  
  66.           FWRITE(_fh2, TRANSFORM(_numb, "@B"))
  67.  
  68.       ELSEIF _data = CHR(196) && date
  69.          _dval = SUBSTR(_dval, 15)
  70.          _pad1 = Modulus(ASC(SUBSTR(_dval, 8, 1)), 128) * 16
  71.          _pad2 = INT(ASC(SUBSTR(_dval, 7, 1)) / 16)
  72.          _powr = _pad1 + _pad2 - 1023
  73.          _mins = INT(ASC(SUBSTR(_dval, 8, 1)) / 16) >= 8
  74.          _man0 = Modulus(ASC(SUBSTR(_dval, 7, 1)), 16) / 16
  75.          _man1 = BIN2W(SUBSTR(_dval, 5, 2)) / (65536*16)
  76.          _man2 = BIN2W(SUBSTR(_dval, 3, 2)) / (65536 * 65536 * 16)
  77.          _man3 = BIN2W(SUBSTR(_dval, 1, 2)) / (65536 * 65536 * 65536 * 16)
  78.          _mant = _man0 + _man1 + _man2 + _man3
  79.          _numb = IF(_mins, -(1 + _mant) * (2 ^ _powr), (1 + _mant) * (2 ^ _powr))
  80.          _sdec = ASC(RIGHT(_realvar, 1))
  81.           FWRITE(_fh2, "CTOD(" + DTOC(CTOD("01/01/0100") + _numb - 1757585) + ")")
  82.  
  83.       ELSE
  84.          FWRITE(_fh2, "error", 5)
  85.       ENDIF
  86.       FWRITE(_fh2, CHR(13)+CHR(10), 2)
  87.    ENDDO
  88.    FCLOSE(_fh1)
  89.    FCLOSE(_fh2)
  90.    RETURN(.T.)
  91.  
  92. * End of File
  93.