home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST915.PRG < prev    next >
Encoding:
Text File  |  1989-08-08  |  4.3 KB  |  126 lines
  1. *******************************************************************************
  2. * Written by Essor Maso.                                                      *
  3. * Modified to include ToolkiT Windowing Logic
  4. *   by Stephen Straley
  5. * A diagnostic tool to view memory variables easily.                          *
  6. * It is assumed that F7 is set to DISP_MEM.                                   *
  7. *******************************************************************************
  8.  
  9. PROCEDURE Disp_mem
  10.  
  11.    PARAMETERS _tdum, _tdum1, _tdum2
  12.  
  13.    _tdum = IF((TYPE("_tdum") != "C"), "", UPPER(LTRIM(TRIM(_tdum))))
  14.  
  15.    IF PCOUNT() = 3   && This came from the SET KEY TO
  16.       _tdum = ""
  17.    ENDIF
  18.  
  19.    && Save memory variables
  20.    SAVE TO S_______ ALL EXCEPT _tdum*
  21.  
  22.    PRIVATE _1vn,_1vt,_1vr,_1mc,_1sc,_1fh,_1fl
  23.  
  24.    IF TYPE("scrcursor") = "U"
  25.       scrcursor = .T.
  26.    ENDIF
  27.    SET CURSOR OFF
  28.    Windowpush(2,2,20,65,"WHITE","BLACK","WHITE","BLACK")
  29.    _1fh=FOPEN('S_______.MEM')
  30.    _1fl=FSEEK(_1fh,0,2)
  31.    FSEEK(_1fh,0)
  32.    Clear_area()
  33.    IF _1fl<2
  34.       Wsayget(1,1,"There are no memory variables present.")  && File contains EOF marker.
  35.    ELSE
  36.       _count = 1
  37.       _vars  = 0
  38.       _bytes = 0
  39.       DO WHILE FSEEK(_1fh,0,1)+1<_1fl
  40.          * Variable specific information is contained in the first 18 bytes of the
  41.          * variable packet. The value of the variable is contained from positon 33 on.
  42.          _1mw=SPACE(18)
  43.          FREAD(_1fh,@_1mw,18)  && Get the variable specific information.
  44.          * The variable name is in the first 10 position with a CHR(0) terminator.
  45.          _1vn=LEFT(_1mw,AT(CHR(0),_1mw)-1)
  46.          * The variable type is in position 12 of the packet.
  47.          * C3h is character or memo, CCh is logical, CEh is numeric, C4h is date.
  48.          _1vt=SUBSTR(_1mw,12,1)
  49.          * For character and logical variables, position 17 and 18 contain the hex
  50.          * value for the range of the data. For numeric and date variables, the 
  51.          * range is 8. This points to the end of the variable packet.
  52.          _1vr=BIN2W(RIGHT(_1mw,2))
  53.          IF _1vt$[├╠]  && C3=CHR(195)=├, CC=chr(204)=╠.
  54.             _1mc=14+_1vr
  55.          ELSE
  56.             _1mc=22
  57.          ENDIF
  58.          FSEEK(_1fh,_1mc,1)   && Go to next packet.
  59.          IF _1vr>51.AND._1vt$[├╠]
  60.             _1r=STRTRAN(LEFT(&_1vn,50),'','')
  61.             _ttemp = LEFT(_1vn+SPACE(10),10) + "  TYPE " + TYPE(_1vn) + ["] + _1r + ["]
  62.          ELSE
  63.             _1r=STRTRAN(&_1vn,'','')
  64.             _ttemp = LEFT(_1vn+SPACE(10),10) + "  TYPE " + TYPE(_1vn) + "  " + IF(TYPE(_1vn) = "C", ["]+_1r+["], STRVALUE(&_1vn))
  65.          ENDIF
  66.          IF     TYPE(_1vn) = "C"
  67.             _bytes = _bytes + LEN(&_1vn.)
  68.             _a = LEN(&_1vn.)
  69.          ELSEIF TYPE(_1vn) = "N"
  70.             _bytes = _bytes + 9
  71.             _a = 9
  72.          ELSEIF TYPE(_1vn) = "L"
  73.             _bytes = _bytes + 2
  74.             _a = 2
  75.          ELSEIF TYPE(_1vn) = "D"
  76.             _bytes = _bytes + 9
  77.             _a = 9
  78.          ENDIF
  79.  
  80.          IF EMPTY(_tdum)
  81.             Wsayget(_count, 1, IF( LEN(_ttemp) > 51, SUBSTR(_ttemp, 1, 50), _ttemp) )
  82.             Wsayget(_count, 49, TRIM(TRANSFORM(_a, "9999999"))+" bytes")
  83.             _count = _count + 1
  84.             _vars = _vars + 1
  85.          ELSE
  86.             IF _tdum $ _1vn
  87.                Wsayget(_count, 1, IF( LEN(_ttemp) > 51, SUBSTR(_ttemp, 1, 50), _ttemp) )
  88.                Wsayget(_count, 49, TRIM(TRANSFORM(_a, "9999999"))+" bytes")
  89.                _vars = _vars + 1
  90.                _count = _count + 1
  91.             ENDIF
  92.          ENDIF
  93.             
  94.          IF ROW() > 14
  95.             Wsayget(_count+2,1,'Press Q TO Quit, anything else to continue')
  96.             INKEY(0)
  97.             IF CHR(LASTKEY())$"Qq"
  98.                End_disp()
  99.                RETURN
  100.             ELSE
  101.                Clear_area()
  102.                _count = 1
  103.             ENDIF
  104.          ENDIF
  105.       ENDDO
  106.    ENDIF
  107.    End_disp()
  108.  
  109. *******************
  110.  
  111. PROCEDURE End_disp
  112.  
  113.    ERASE S_______.MEM
  114.    IF _count > 0
  115.       Wsayget(_count+1,1,SPACE(50))
  116.       Wsayget(_count+2,1,SPACE(50))
  117.       Wsayget(_count+2,1,"Memory Variables Displayed " + LTRIM(STR(_vars)) + " with " + LTRIM(STR(_bytes)) + " bytes used ")
  118.       Wsayget(_count+3,1,"Any Key to Continue....")
  119.       INKEY(0)
  120.    ENDIF
  121.    Windowpop()
  122.    FCLOSE(_1fh)
  123.    SET CURSOR (scrcursor)
  124.  
  125. * End of File
  126.