home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / qbasic / qbtree42.arc / TREETEST.BAS < prev    next >
BASIC Source File  |  1989-10-19  |  20KB  |  868 lines
  1. DECLARE SUB AutoCreateData (recs%)
  2. DECLARE SUB BumpCurrRecLineUp ()
  3. DECLARE SUB DoFunctions ()
  4. DECLARE SUB TitleScreen ()
  5. DECLARE SUB UpdateScreen ()
  6. DECLARE SUB ShowFKeys (OnOff%)
  7. DECLARE SUB OpenFiles ()
  8. DECLARE SUB CreateFiles ()
  9. DECLARE SUB ClearMsgArea ()
  10. DECLARE SUB CloseFiles ()
  11. DECLARE FUNCTION GetKey% ()
  12.  
  13. '{BTREE42 TEST PROGRAM v1.10 by Cornel Huth 09/27/89}
  14.  
  15. REM $INCLUDE: 'QBTREE42.BI'
  16.                
  17. DEFINT A-Z
  18.  
  19. TYPE RegType
  20.    ax AS INTEGER
  21.    bx AS INTEGER
  22.    cx AS INTEGER
  23.    dx AS INTEGER
  24.    BP AS INTEGER
  25.    SI AS INTEGER
  26.    DI AS INTEGER
  27.    FLAGS AS INTEGER
  28. END TYPE
  29.  
  30. CONST PROGID = "QBTREE42 TEST PROGRAM"
  31.  
  32. CLS
  33.  
  34. DIM SHARED fk$(1 TO 10)
  35. fk$(1) = "Help   "
  36. fk$(2) = "AddRec "
  37. fk$(3) = "Update "
  38. fk$(4) = "GetEQU "
  39. fk$(5) = "GetPOS "
  40. fk$(6) = "GetRNO "
  41. fk$(7) = "DelKey "
  42. fk$(8) = "DelRec "
  43. fk$(9) = "StatKY  "
  44. fk$(10) = "StatDT "
  45.  
  46. DIM SHARED StatError$(200 TO 230)
  47. StatError$(200) = "Key not found"
  48. StatError$(201) = "Key already exists"
  49. StatError$(202) = "End of file"
  50. StatError$(203) = "Top of file"
  51. StatError$(204) = "Empty file"
  52. StatError$(205) = "Disk full"
  53. StatError$(206) = "Data pointer invalid"
  54. StatError$(207) = "Key pointer invalid"
  55. StatError$(208) = "File not BTREE40"
  56.  
  57. StatError$(210) = "Stack overflow"
  58. StatError$(211) = "Function not implemented"
  59. StatError$(220) = "Record length invalid"
  60. StatError$(221) = "Key length invalid"
  61. StatError$(222) = "File not open"
  62. StatError$(223) = "Invalid null key assignment"
  63. StatError$(224) = "Invalid record number"
  64. StatError$(225) = "No more handles"
  65. StatError$(226) = "File not found"
  66. StatError$(227) = "File needs to be converted"
  67. StatError$(228) = "File not QBTREE"
  68. StatError$(229) = "Lock already in force"
  69. StatError$(230) = "File already exists"
  70.  
  71. DIM SHARED kf$(0 TO 2)
  72. DIM SHARED df$
  73. DIM SHARED CurrKey
  74. DIM SHARED stat
  75. DIM SHARED CurrRecLine
  76. DIM SHARED iregs AS RegType
  77. DIM SHARED oregs AS RegType
  78. DIM SHARED pstack(1 TO 10, 1 TO 3)
  79. DIM SHARED DEBUG AS INTEGER
  80.  
  81. kf$(0) = ""
  82. df$ = ""
  83. CurrRecLine = 3
  84. IF INSTR(COMMAND$, "/D") THEN DEBUG = -1 ELSE DEBUG = 0
  85. TitleScreen
  86. kf$(1) = "TESTTREE.NX1"
  87. kf$(2) = "TESTTREE.NX2"
  88. df$ = "TESTTREE.DAT"
  89. CreateFiles
  90. CurrKey = 1
  91. UpdateScreen
  92. ShowFKeys 1
  93. DoFunctions
  94. ShowFKeys 0
  95. CloseFiles
  96. LOCATE 24, 1
  97.  
  98. SUB AutoCreateData (recs)
  99.  
  100. DataHdr$ = "DATA ..."
  101. CurrKey = 1
  102. UpdateScreen
  103.  
  104. FOR i = 1 TO recs
  105.    ThisKey$ = "KEY" + LTRIM$(STR$(i))
  106.    ThisData$ = ThisKey$ + "\" + DataHdr$
  107.  
  108.    ClearMsgArea
  109.    LOCATE 22, 2
  110.    PRINT "Adding record  stat:";
  111.    stat = AddRecord(CurrKey, 1, ThisKey$, ThisData$)
  112.    PRINT stat
  113.    IF stat = 0 THEN
  114.       LOCATE CurrRecLine, 1
  115.       PRINT ">"; ThisKey$; "<"
  116.       LOCATE CurrRecLine, 20
  117.       PRINT ">"; ThisData$; "<"
  118.       BumpCurrRecLineUp
  119.    ELSE
  120.       BEEP
  121.       SLEEP 2
  122.    END IF
  123.    a$ = INKEY$
  124.    IF a$ <> "" THEN EXIT FOR
  125. NEXT
  126.  
  127. END SUB
  128.  
  129. SUB BumpCurrRecLineUp
  130.                      
  131. CurrRecLine = CurrRecLine + 1
  132. IF CurrRecLine > 19 THEN
  133.    CurrRecLine = 19
  134.    iregs.ax = &H601             '{video func 6, scroll up 1 line}
  135.    iregs.bx = &H700             '{normal attribute}
  136.    iregs.cx = &H200             '{row 3 column 0}
  137.    iregs.dx = 19 * 256 + 68     '{row 20 column 69}
  138.    CALL INTERRUPT(&H10, iregs, oregs)
  139. END IF
  140.  
  141. END SUB
  142.  
  143. SUB ClearMsgArea
  144.  
  145. LOCATE 22, 2
  146. PRINT SPACE$(39)
  147.  
  148. END SUB
  149.  
  150. SUB CloseFiles
  151.  
  152. ClearMsgArea
  153. LOCATE 22, 2
  154. PRINT "Closing "; kf$(1); " stat:";
  155. stat = CloseKeyFile(1)
  156. PRINT stat
  157. IF stat THEN BEEP: SLEEP 2 ELSE SLEEP 1
  158.  
  159. ClearMsgArea
  160. LOCATE 22, 2
  161. PRINT "Closing "; kf$(2); " stat:";
  162. stat = CloseKeyFile(2)
  163. PRINT stat
  164. IF stat THEN BEEP: SLEEP 2
  165.  
  166. CurrKey = 1
  167. kf$(1) = SPACE$(12)
  168. UpdateScreen
  169.  
  170. ClearMsgArea
  171. LOCATE 22, 2
  172. PRINT "Closing "; df$; " stat:";
  173. stat = CloseDataFile(1)
  174. PRINT stat
  175. IF stat THEN BEEP: SLEEP 2
  176.  
  177. df$ = SPACE$(12)
  178. UpdateScreen
  179.  
  180. ClearMsgArea
  181.  
  182. END SUB
  183.  
  184. SUB CreateFiles
  185.  
  186. ClearMsgArea
  187. LOCATE 22, 2
  188. INPUT "Create new test files? (y/n) ", a$
  189. IF UCASE$(a$) = "Y" THEN
  190.    ClearMsgArea
  191.    LOCATE 22, 2
  192.    a$ = ""
  193.    INPUT "Auto-create test data? (y/n) ", a$
  194. ELSE
  195.    OpenFiles
  196.    EXIT SUB
  197. END IF
  198.  
  199. ClearMsgArea
  200. CurrKey = 1
  201. LOCATE 22, 2
  202. PRINT "Creating kfile "; kf$(CurrKey); " stat:";
  203. stat = CreateKeyFile(kf$(CurrKey), 9)
  204. PRINT stat
  205. IF stat THEN BEEP: SLEEP 2
  206. IF stat = 205 THEN LOCATE 24, 1: SYSTEM
  207.  
  208. ClearMsgArea
  209. CurrKey = 2
  210. LOCATE 22, 2
  211. PRINT "Creating kfile "; kf$(CurrKey); " stat:";
  212. stat = CreateKeyFile(kf$(CurrKey), 15)
  213. PRINT stat
  214. IF stat THEN BEEP: SLEEP 2
  215. IF stat = 205 THEN LOCATE 24, 1: SYSTEM
  216.  
  217. ClearMsgArea
  218. LOCATE 22, 2
  219. PRINT "Creating dfile "; df$; " stat:";
  220. stat = CreateDataFile(df$, 20)
  221. PRINT stat
  222. IF stat THEN BEEP: SLEEP 2
  223. IF stat = 205 THEN LOCATE 24, 1: SYSTEM
  224.  
  225. ClearMsgArea
  226.  
  227. OpenFiles
  228.  
  229. IF UCASE$(a$) = "Y" THEN
  230.    DO
  231.       ClearMsgArea
  232.       LOCATE 22, 2
  233.       a$ = ""
  234.       INPUT "How many records? (0-32000) ", a$
  235.       recs = VAL(a$)
  236.       IF recs = 0 THEN EXIT SUB
  237.       IF recs <= 32000 THEN EXIT DO
  238.    LOOP
  239.    AutoCreateData recs
  240. END IF
  241.  
  242. END SUB
  243.  
  244. SUB DoFunctions
  245.  
  246. DO
  247.    UpdateScreen
  248.    k = GetKey
  249.    SELECT CASE k
  250.    CASE 27              '{Esc}
  251.       EXIT DO
  252.   
  253.    CASE 60              '{F2 Add record}
  254.       ClearMsgArea
  255.       LOCATE 22, 2
  256.       INPUT "key:", ke$
  257.       ke$ = UCASE$(ke$)
  258.       IF LEN(ke$) > 0 AND LEFT$(ke$, 1) <> " " THEN
  259.          ClearMsgArea
  260.          LOCATE 22, 2
  261.          INPUT "data:", rec$
  262.          ClearMsgArea
  263.          LOCATE 22, 2
  264.          PRINT "Adding record  stat:";
  265.          stat = AddRecord(CurrKey, 1, ke$, rec$)
  266.          PRINT stat
  267.          IF stat THEN
  268.             BEEP
  269.             SLEEP 2
  270.          ELSE
  271.             ClearMsgArea
  272.             LOCATE 22, 2
  273.             stat = GetEqual(CurrKey, 1, ke$, rec$)
  274.             IF stat = 0 THEN
  275.                BumpCurrRecLineUp
  276.                LOCATE CurrRecLine, 1
  277.                PRINT ">"; ke$; "<"
  278.                LOCATE CurrRecLine, 20
  279.                PRINT ">"; rec$; "<"
  280.             ELSE
  281.                BEEP
  282.                SLEEP 2
  283.             END IF
  284.          END IF
  285.      
  286.       END IF
  287.   
  288.    CASE 61              '{F3 Update record}
  289.       ClearMsgArea
  290.       LOCATE 22, 2
  291.       INPUT "data:", rec$
  292.       ClearMsgArea
  293.       LOCATE 22, 2
  294.       PRINT "Updating record  stat:";
  295.       stat = UpdateRecord(1, rec$)
  296.       PRINT stat
  297.       IF stat THEN
  298.          BEEP
  299.          SLEEP 2
  300.       ELSE
  301.          ClearMsgArea
  302.          LOCATE 22, 2
  303.          PRINT "Validating update  stat:";
  304.          stat = GetEqual(CurrKey, 1, ke$, rec$)
  305.          PRINT stat
  306.          IF stat = 0 THEN
  307.             BumpCurrRecLineUp
  308.             LOCATE CurrRecLine, 1
  309.             PRINT ">"; ke$; "<"
  310.             LOCATE CurrRecLine, 20
  311.             PRINT ">"; rec$; "<"
  312.          ELSE
  313.             BEEP
  314.             SLEEP 2
  315.          END IF
  316.       END IF
  317.   
  318.    CASE 62              '{F4 Get equal}
  319.       ClearMsgArea
  320.       LOCATE 22, 2
  321.       INPUT "key:", ke$
  322.       ke$ = UCASE$(ke$)
  323.       IF LEN(ke$) > 0 AND LEFT$(ke$, 1) <> " " THEN
  324.          ClearMsgArea
  325.          LOCATE 22, 2
  326.          PRINT "Getting equal  stat:";
  327.          stat = GetEqual(CurrKey, 1, ke$, rec$)
  328.          PRINT stat
  329.          IF stat = 0 THEN
  330.             BumpCurrRecLineUp
  331.             LOCATE CurrRecLine, 1
  332.             PRINT ">"; ke$; "<"
  333.             LOCATE CurrRecLine, 20
  334.             PRINT ">"; rec$; "<"
  335.          ELSE
  336.             BEEP
  337.             SLEEP 2
  338.          END IF
  339.       ELSE
  340.          ClearMsgArea
  341.       END IF
  342.   
  343.    CASE 80, 116         '{down arrow  Get next   ctrl right arrow Auto next}
  344.       DO
  345.          ClearMsgArea
  346.          LOCATE 22, 2
  347.          PRINT "Getting next  stat:";
  348.          stat = GetNext(CurrKey, 1, ke$, rec$)
  349.          PRINT stat
  350.          IF stat = 0 THEN
  351.             BumpCurrRecLineUp
  352.             LOCATE CurrRecLine, 1
  353.             PRINT ">"; ke$; "<"
  354.             LOCATE CurrRecLine, 20
  355.             PRINT ">"; rec$; "<"
  356.          ELSE
  357.             BEEP
  358.             SLEEP 2
  359.             EXIT DO
  360.          END IF
  361.          a$ = INKEY$
  362.          IF a$ = CHR$(27) THEN EXIT DO
  363.          UpdateScreen
  364.       LOOP UNTIL k = 80
  365.  
  366.    CASE 72, 115         '{up arrow  Get prev   ctrl left arrow  Auto prev}
  367.       DO
  368.          ClearMsgArea
  369.          LOCATE 22, 2
  370.          PRINT "Getting prev  stat:";
  371.          stat = GetPrev(CurrKey, 1, ke$, rec$)
  372.          PRINT stat
  373.          IF stat = 0 THEN
  374.             BumpCurrRecLineUp
  375.             LOCATE CurrRecLine, 1
  376.             PRINT ">"; ke$; "<"
  377.             LOCATE CurrRecLine, 20
  378.             PRINT ">"; rec$; "<"
  379.          ELSE
  380.             BEEP
  381.             SLEEP 2
  382.             EXIT DO
  383.          END IF
  384.          a$ = INKEY$
  385.          IF a$ = CHR$(27) THEN EXIT DO
  386.          UpdateScreen
  387.       LOOP UNTIL k = 72
  388.  
  389.    CASE 63              '{F5 Get position}
  390.       ClearMsgArea
  391.       LOCATE 22, 2
  392.       PRINT "Get current record  stat:";
  393.       stat = GetPosition(CurrKey, recno&)
  394.       PRINT stat
  395.       IF stat = 0 THEN
  396.          ClearMsgArea
  397.          LOCATE 22, 2
  398.          PRINT "Record#:"; recno&
  399.       ELSE
  400.          BEEP
  401.          SLEEP 2
  402.       END IF
  403.  
  404.    CASE 64              '{F6 Get direct}
  405.       ClearMsgArea
  406.       LOCATE 22, 2
  407.       INPUT "Record#:", recno&
  408.       ClearMsgArea
  409.       LOCATE 22, 2
  410.       PRINT "Get direct  stat:";
  411.       stat = GetDirect(1, recno&, rec$)
  412.       PRINT stat
  413.       IF stat = 0 THEN
  414.          BumpCurrRecLineUp
  415.          LOCATE CurrRecLine, 20
  416.          PRINT "["; rec$; "]"
  417.       ELSE
  418.          BEEP
  419.          SLEEP 2
  420.       END IF
  421.   
  422.    CASE 65              '{F7 Delete key}
  423.       ClearMsgArea
  424.       LOCATE 22, 2
  425.       PRINT "Delete key  stat:";
  426.       stat = DeleteKey(CurrKey, ke$)
  427.       PRINT stat
  428.       IF stat = 0 THEN
  429.          x = StatKeyFile(CurrKey, kl, k&, bf)
  430.          LOCATE CurrRecLine, 1
  431.          PRINT ">"; SPACE$(kl); "<"
  432.       ELSE
  433.          BEEP
  434.          SLEEP 2
  435.       END IF
  436.    CASE 66              '{F8 Delete record}
  437.       ClearMsgArea
  438.       LOCATE 22, 2
  439.       PRINT "Delete record  stat:";
  440.       stat = DeleteRecord(CurrKey, 1, ke$)
  441.       PRINT stat
  442.       IF stat = 0 THEN
  443.          x = StatKeyFile(CurrKey, kl, k&, bf)
  444.          x = StatDataFile(1, rl, r&, bf)
  445.          LOCATE CurrRecLine, 1
  446.          PRINT ">"; SPACE$(kl); "<"
  447.          LOCATE CurrRecLine, 20
  448.          PRINT ">"; SPACE$(rl); "<"
  449.       ELSE
  450.          BEEP
  451.          SLEEP 2
  452.       END IF
  453.   
  454.    CASE 67              '{F9 Status key file}
  455.       ClearMsgArea
  456.       LOCATE 22, 2
  457.       stat = StatKeyFile(CurrKey, keylen, keys&, bfile)
  458.       IF stat = 0 THEN
  459.          PRINT "Keylen="; keylen; " keys="; keys&; " QB#="; bfile
  460.       ELSE
  461.          BEEP
  462.          PRINT "stat:"; stat
  463.          SLEEP 2
  464.       END IF
  465.  
  466.    CASE 68              '{F10 Status data file}
  467.       ClearMsgArea
  468.       LOCATE 22, 2
  469.       stat = StatDataFile(1, reclen, recs&, bfile)
  470.       IF stat = 0 THEN
  471.          PRINT "Reclen="; reclen; " recs="; recs&; " QB#="; bfile
  472.       ELSE
  473.          BEEP
  474.          PRINT "stat:"; stat
  475.          SLEEP 2
  476.       END IF
  477.   
  478.    CASE 59              '{F1 Help last error code}
  479.       ClearMsgArea
  480.       LOCATE 22, 2
  481.       IF stat THEN
  482.          PRINT stat; "="; StatError$(stat)
  483.       ELSE
  484.          PRINT stat; "="; "No error"
  485.       END IF
  486.  
  487.    CASE 4               '{^D toggle DEBUG}
  488.       DEBUG = NOT DEBUG
  489.       TitleScreen
  490.  
  491.    CASE 5               '{^E Erase (Delete) range of keys and records}
  492.       ClearMsgArea
  493.       LOCATE 22, 2
  494.       INPUT "Lower range to DEL:", lr$
  495.       lr$ = UCASE$(lr$)
  496.       ClearMsgArea
  497.       LOCATE 22, 2
  498.       INPUT "Upper range to DEL:", ur$
  499.       ur$ = UCASE$(ur$)
  500.       x = StatKeyFile(CurrKey, kl, k&, bf)
  501.       ur$ = ur$ + SPACE$(kl - LEN(ur$))
  502.       x = StatDataFile(1, rl, r&, bf)
  503.       stat = GetEqual(CurrKey, 1, lr$, rec$)
  504.       DO WHILE (lr$ <= ur$ AND stat = 0)
  505.          IF stat = 0 THEN
  506.             BumpCurrRecLineUp
  507.             LOCATE CurrRecLine, 1
  508.             PRINT ">"; lr$; "<"
  509.             LOCATE CurrRecLine, 20
  510.             PRINT ">"; rec$; "<"
  511.             stat = DeleteRecord(CurrKey, 1, lr$)
  512.             IF stat = 0 THEN
  513.                LOCATE CurrRecLine, 1
  514.                PRINT ">"; SPACE$(kl); "<"
  515.                LOCATE CurrRecLine, 20
  516.                PRINT ">"; SPACE$(rl); "<"
  517.                stat = GetNext(CurrKey, 1, lr$, rec$)
  518.             ELSE
  519.                ClearMsgArea
  520.                LOCATE 22, 2
  521.                PRINT "Error in deleting this key/rec"
  522.                EXIT DO
  523.             END IF
  524.          ELSE
  525.             stat = GetNext(CurrKey, 1, lr$, rec$)
  526.          END IF
  527.       LOOP
  528.       BumpCurrRecLineUp
  529.       LOCATE CurrRecLine, 1
  530.       PRINT ">"; lr$; "<"
  531.       LOCATE CurrRecLine, 20
  532.       PRINT ">"; rec$; "<"
  533.        
  534.    CASE 6               '{^F Get first key}
  535.       ClearMsgArea
  536.       LOCATE 22, 2
  537.       PRINT "Getting first key  stat:";
  538.       stat = GetFirst(CurrKey, 1, ke$, rec$)
  539.       PRINT stat
  540.       IF stat = 0 THEN
  541.          BumpCurrRecLineUp
  542.          LOCATE CurrRecLine, 1
  543.          PRINT ">"; ke$; "<"
  544.          LOCATE CurrRecLine, 20
  545.          PRINT ">"; rec$; "<"
  546.       ELSE
  547.          BEEP
  548.          SLEEP 2
  549.       END IF
  550.  
  551.    CASE 12              '{^L Get last key}
  552.       ClearMsgArea
  553.       LOCATE 22, 2
  554.       PRINT "Getting last key  stat:";
  555.       stat = GetLast(CurrKey, 1, ke$, rec$)
  556.       PRINT stat
  557.       IF stat = 0 THEN
  558.          BumpCurrRecLineUp
  559.          LOCATE CurrRecLine, 1
  560.          PRINT ">"; ke$; "<"
  561.          LOCATE CurrRecLine, 20
  562.          PRINT ">"; rec$; "<"
  563.       ELSE
  564.          BEEP
  565.          SLEEP
  566.       END IF
  567.  
  568.    CASE 14              '{^N Next kfile}
  569.       CurrKey = CurrKey + 1
  570.       IF CurrKey > 2 THEN CurrKey = 1
  571.   
  572.    CASE 16              '{^P Put key}
  573.       ClearMsgArea
  574.       LOCATE 22, 2
  575.       INPUT "key:", ke$
  576.       ke$ = UCASE$(ke$)
  577.       IF LEN(ke$) > 0 AND LEFT$(ke$, 1) <> " " THEN
  578.          ClearMsgArea
  579.          LOCATE 22, 2
  580.          PRINT "Putting key  stat:";
  581.          stat = PutKey(CurrKey, 1, ke$)
  582.          PRINT stat
  583.          IF stat = 0 THEN
  584.             BumpCurrRecLineUp
  585.             LOCATE CurrRecLine, 1
  586.             PRINT ">"; ke$; "<"
  587.             stat = GetEqual(CurrKey, 1, ke$, rec$)
  588.             LOCATE CurrRecLine, 20
  589.             IF stat = 0 THEN
  590.                PRINT ">"; rec$; "<"
  591.             ELSE
  592.                PRINT ">ERROR"; stat; "<"
  593.             END IF
  594.          ELSE
  595.             BEEP
  596.             SLEEP 2
  597.          END IF
  598.       ELSE
  599.          ClearMsgArea
  600.       END IF
  601.   
  602.    CASE 18              '{^R Rewind key file}
  603.       ClearMsgArea
  604.       LOCATE 22, 2
  605.       PRINT "Rewind key file  stat:";
  606.       stat = RewindKeyFile(CurrKey)
  607.       PRINT stat
  608.       IF stat <> 0 THEN
  609.          BEEP
  610.          SLEEP 2
  611.       END IF
  612.  
  613.    CASE 22              '{^V Get BTree version}
  614.       ClearMsgArea
  615.       LOCATE 22, 2
  616.       PRINT "BTREE version:";
  617.       stat = QBTreeVer(ver)
  618.       PRINT (1! * ver / 100)
  619.  
  620.    CASE 26              '{^Z Flush key files and data file}
  621.       FOR k = 1 TO 2
  622.          ClearMsgArea
  623.          LOCATE 22, 2
  624.          PRINT "Flushing key"; k; " stat:";
  625.          st = FlushKeyFile(k, 1)
  626.          PRINT st
  627.          IF st <> 0 THEN
  628.             BEEP
  629.             SLEEP 2
  630.             stat = st
  631.          END IF
  632.       NEXT
  633.       ClearMsgArea
  634.       LOCATE 22, 2
  635.       PRINT "Flushing data 1  stat:";
  636.       st = FlushDataFile(1, 1)
  637.       PRINT st
  638.       IF st THEN stat = st
  639.       
  640.    CASE ELSE
  641.    END SELECT
  642. LOOP
  643.  
  644. END SUB
  645.  
  646. SUB fil
  647.  
  648. fx = FREEFILE
  649. FOR i = 1 TO 12
  650. OPEN "a" + CHR$(65 + i) FOR OUTPUT AS #fx
  651. fx = fx + 1
  652. NEXT
  653.  
  654. END SUB
  655.  
  656. FUNCTION GetKey
  657.  
  658. DO
  659.    a$ = INKEY$
  660.    xit = 0
  661.    IF LEN(a$) = 1 THEN
  662.       fk = ASC(a$)
  663.    ELSEIF LEN(a$) = 2 THEN
  664.       fk = ASC(RIGHT$(a$, 1))
  665.       xit = 1
  666.    END IF
  667. 'LOCATE 1, 1: PRINT fk
  668.    SELECT CASE fk
  669.       CASE 4, 5, 6, 8, 12, 14, 16, 18, 22, 26, 27
  670.          EXIT DO
  671.       CASE 59 TO 68, 72, 80, 115, 116
  672.          IF xit THEN EXIT DO
  673.       CASE ELSE
  674.    END SELECT
  675. LOOP
  676.  
  677. GetKey = fk
  678.  
  679. END FUNCTION
  680.  
  681. SUB OpenFiles
  682.  
  683. ClearMsgArea
  684. LOCATE 22, 2
  685. PRINT "Opening "; kf$(1); " stat:";
  686. stat = OpenKeyFile(kf$(1), 1)
  687. PRINT stat
  688. IF stat THEN BEEP: LOCATE 24, 1: SYSTEM
  689.  
  690. ClearMsgArea
  691. LOCATE 22, 2
  692. PRINT "Opening "; kf$(2); " stat:";
  693. stat = OpenKeyFile(kf$(2), 2)
  694. PRINT stat
  695. IF stat THEN BEEP: LOCATE 24, 1: SYSTEM
  696.  
  697. ClearMsgArea
  698. LOCATE 22, 2
  699. PRINT "Opening "; df$; " stat:";
  700. stat = OpenDataFile(df$, 1)
  701. PRINT stat
  702. IF stat THEN BEEP: LOCATE 24, 1: SYSTEM
  703.  
  704. ClearMsgArea
  705.  
  706. END SUB
  707.  
  708. SUB ShowFKeys (OnOff)
  709.  
  710. IF OnOff THEN
  711.    LOCATE 24, 1
  712.    FOR i = 1 TO 9 STEP 2
  713.       COLOR 15, 0
  714.       PRINT "F" + LTRIM$(STR$(i));
  715.       COLOR 7, 0
  716.       PRINT fk$(i);
  717.    NEXT
  718.    COLOR 15, 0
  719.    PRINT CHR$(24);
  720.    COLOR 7, 0
  721.    PRINT "prev ";
  722.    COLOR 15, 0
  723.    PRINT "^F";
  724.    COLOR 7, 0
  725.    PRINT "irst ";
  726.    COLOR 15, 0
  727.    PRINT "^N";
  728.    COLOR 7, 0
  729.    PRINT "XT Kf ";
  730.    COLOR 15, 0
  731.    PRINT "^E";
  732.    COLOR 7, 0
  733.    PRINT "raRng";
  734.    COLOR 15, 0
  735.    PRINT "^V";
  736.    COLOR 7, 0
  737.    PRINT "er";
  738.    LOCATE 25, 1
  739.    FOR i = 2 TO 10 STEP 2
  740.       COLOR 15, 0
  741.       PRINT "F" + LTRIM$(STR$(i));
  742.       COLOR 7, 0
  743.       PRINT fk$(i);
  744.    NEXT
  745.    COLOR 15, 0
  746.    PRINT CHR$(25);
  747.    COLOR 7, 0
  748.    PRINT "next ";
  749.    COLOR 15, 0
  750.    PRINT "^L";
  751.    COLOR 7, 0
  752.    PRINT "ast  ";
  753.    COLOR 15, 0
  754.    PRINT "^P";
  755.    COLOR 7, 0
  756.    PRINT "utKey ";
  757.    COLOR 15, 0
  758.    PRINT "^R";
  759.    COLOR 7, 0
  760.    PRINT "ewind";
  761.    COLOR 15, 0
  762.    PRINT "^Z";
  763.    COLOR 7, 0
  764.    PRINT "fl";
  765. ELSE
  766.    LOCATE 24, 1
  767.    PRINT SPACE$(80);
  768.    LOCATE 25, 1
  769.    PRINT SPACE$(80);
  770. END IF
  771.  
  772. END SUB
  773.  
  774. SUB TitleScreen
  775.  
  776. LOCATE 1, 1
  777. PRINT PROGID
  778. LOCATE 1, 38
  779. IF DEBUG THEN PRINT "DEBUG" ELSE PRINT SPACE$(5)
  780. LOCATE 1, 73
  781. COLOR 15, 0
  782. PRINT "Esc";
  783. COLOR 7, 0
  784. PRINT "=quit"
  785. LOCATE 2, 1
  786. PRINT STRING$(70, 196);
  787. LOCATE 2, 70
  788. PRINT CHR$(194); STRING$(5, 196); CHR$(194); CHR$(196); CHR$(196); CHR$(194); CHR$(196)
  789. FOR i = 1 TO 10
  790.    LOCATE i + 2, 70
  791.    PRINT CHR$(179); SPACE$(5); CHR$(179); SPACE$(2); CHR$(179); CHR$(32)
  792. NEXT
  793. LOCATE i + 2, 70
  794. PRINT CHR$(195); STRING$(5, 196); CHR$(197); CHR$(196); CHR$(196); CHR$(197); CHR$(196)
  795. LOCATE i + 3, 70
  796. PRINT CHR$(179);
  797. PRINT " SEC "; CHR$(179); "OF"; CHR$(179); "I"
  798. LOCATE i + 4, 70
  799. PRINT CHR$(195); STRING$(5, 196); CHR$(197); CHR$(196); CHR$(196); CHR$(197); CHR$(196)
  800. LOCATE i + 5, 70
  801. PRINT CHR$(179); SPACE$(5); CHR$(179); SPACE$(2); CHR$(179); CHR$(32)
  802. LOCATE i + 6, 70
  803. PRINT CHR$(192); STRING$(5, 196); CHR$(193); CHR$(196); CHR$(196); CHR$(193); CHR$(196)
  804.  
  805. LOCATE 21, 1
  806. PRINT CHR$(218) + STRING$(78, 196) + CHR$(191)
  807. LOCATE 22, 1
  808. PRINT CHR$(179); TAB(80); CHR$(179)
  809. LOCATE 23, 1
  810. PRINT CHR$(192) + STRING$(78, 196) + CHR$(217)
  811.  
  812. LOCATE 22, 41
  813. PRINT "kfile:"
  814. LOCATE 22, 62
  815. PRINT "dfile:"
  816.       
  817. END SUB
  818.  
  819. SUB UpdateScreen
  820.  
  821.  
  822. COLOR 15, 0
  823. LOCATE 22, 47
  824. PRINT kf$(CurrKey)
  825. LOCATE 22, 68
  826. PRINT df$
  827. COLOR 7, 0
  828. IF DEBUG THEN
  829.    a = 1
  830.    x = GetDebugInfo(CurrKey, cukysc, cukyof, iflag, stkcnt, pstack())
  831.    FOR i = 1 TO (stkcnt \ 4)
  832.       LOCATE i + 2, 71
  833.       s$ = LTRIM$(STR$(pstack(i, 1)))
  834.       PRINT SPACE$(5 - LEN(s$)); s$
  835.       LOCATE i + 2, 77
  836.       t = pstack(i, 2)
  837.       o$ = LTRIM$(STR$(t))
  838.       PRINT SPACE$(2 - LEN(o$)); o$
  839.       LOCATE i + 2, 80
  840.       i$ = LTRIM$(STR$(pstack(i, 3)))
  841.       PRINT i$
  842.    NEXT
  843.    r = i - 1 + 3
  844.    t = 10 - (i - 1)
  845.    FOR i = 1 TO t
  846.       LOCATE r, 71
  847.       PRINT SPACE$(5)
  848.       LOCATE r, 77
  849.       PRINT SPACE$(2)
  850.       LOCATE r, 80
  851.       PRINT " "
  852.       r = r + 1
  853.    NEXT
  854.    r = r + 3
  855.    s$ = LTRIM$(STR$(cukysc))
  856.    o$ = LTRIM$(STR$(cukyof))
  857.    i$ = LTRIM$(STR$(iflag))
  858.    LOCATE r, 71
  859.    PRINT SPACE$(5 - LEN(s$)); s$
  860.    LOCATE r, 77
  861.    PRINT SPACE$(2 - LEN(o$)); o$
  862.    LOCATE r, 80
  863.    PRINT i$
  864. END IF
  865.  
  866. END SUB
  867.  
  868.