home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / bc_sf / sf-draft.dat < prev    next >
Encoding:
Text File  |  1987-05-02  |  30.5 KB  |  575 lines
  1. 10 '      This program was generated by BasiCoder(tm) Copyright 1986 F.Volking
  2. 20 '      The below program is copyright property of F.Volking, however
  3. 30 '      the author does hereby release all rights in the below program.
  4. 40       BCOLOR%=0   :REM change to BCOLOR%=1 if you want COLOR on the screen
  5. 50       BCLR1%=1    :REM command line border color   /default= 1-blue
  6. 60       BCLR2%=7    :REM command line text color     /default= 7-white
  7. 70       BCLR3%=4    :REM command line key color      /default= 4-red
  8. 80       BCLR4%=2    :REM command line message color  /default= 2-green
  9. 90       BCLR6%=8    :REM screen text color           /default= 8-gray
  10. 95       BCLR7%=15   :REM screen data color           /default=15-high white
  11. 100       KEY OFF
  12. 110       DIM ENTEST$(7),DATREC%(2),BCIREC%(2)
  13. 111 rem ***********************************************************************
  14. 140       DIM BCIDATE%(2),BCIMORE%(2),BCILESS%(2),BCIUP%(2),BCIDN%(2),BCIKEY$(2)
  15. 150       GOSUB 41000                                      :REM test string
  16. 160       GOSUB 20000                                      :REM show main
  17. 170       BCMSG$="  Working" : GOSUB 22000                 :REM show message
  18. 180 rem ***********************************************************************
  19. 190       GOSUB 50000                                      :REM open isam file
  20. 200       BCI%=0
  21. 210       GOSUB 53000                                      :REM open data file
  22. 1000 :REM command line processing
  23. 1010    BCMSG$="  Command?" : GOSUB 22000                  :REM show message
  24. 1020    ENSTAT$="25020160" : ENDFLT$="" : GOSUB 40000 : ENFUNC%=ENWAY%
  25. 1030    :REM jump in from function process
  26. 1040    ON ENFUNC% GOTO 1000,1000,1000,1000,1000,1000,65000,4000,4100,2000,5000,3000,7000,6000
  27. 1050    GOTO 1020
  28. 2000 :REM enter a new record
  29. 2010   BCMSG$=" F1: Add a new record" : GOSUB 22000       :REM show message
  30. 2020   BCFUNCMSG$=BCMSG$
  31. 2030   GOSUB 23000                                        :REM blank fields
  32. 2040   BCA%=0 : GOSUB 24000                               :REM null/0 all
  33. 2050   GOTO 30000
  34. 2100   :REM returning from input routines
  35. 2110       BCMSG$="  SAVE? Y or N" : GOSUB 22000          :REM show message
  36. 2120       ENSTAT$="25020170" : ENDFLT$="" : GOSUB 40000
  37. 2130       IF ENRETURN$="Y" OR ENRETURN$="y" THEN GOTO 2160
  38. 2140       IF ENRETURN$="N" OR ENRETURN$="n" THEN GOTO 1000
  39. 2150       SOUND 50,3 : GOTO 2100
  40. 2160   :REM put new data file record away
  41. 2170       BCMSG$=" YES SAVE! Working" : GOSUB 22000      :REM show message
  42. 2180       IF LEFT$(DATKEY$(0),1)>" " THEN GOTO 2220
  43. 2190       BCMSG$="  Bad Key! Do Again!" : GOSUB 22000    :REM show message
  44. 2200       SOUND 50,6
  45. 2210       ENSTAT$="25020160" : ENDFLT$="" : GOSUB 40000 : GOTO 2000
  46. 2220   :REM key test okay continue
  47. 2230       IF BCIDEL%>0 THEN BCRCRD%=BCIDEL% : GOSUB 2290 : GOTO 1000 :REM adding a deleted key
  48. 2240       BCKEY$=DATKEY$(0)
  49. 2250       GOSUB 51000                                    :REM save new key
  50. 2260       DATREC%(0)=BCIREC%(0)
  51. 2270       GOSUB 55000                                    :REM save new data
  52. 2280       GOTO 1000                                      :REM command line
  53. 2290   :REM saving a record which happens to exactly match a deleted one
  54. 2300       BCI%=0
  55. 2310       GOSUB 60600                                    :REM parse today
  56. 2320       GOSUB 60000                                    :REM convert julian
  57. 2330       BCIREC%(0)=BCRCRD%
  58. 2340       GOSUB 50200                                    :REM get key rec
  59. 2350       BCIDATE%(0)=BCJLNK%
  60. 2360       GOSUB 50300                                    :REM put key rec
  61. 2370       DATREC%(0)=BCIREC%(0)
  62. 2380       GOSUB 55000                                    :REM put data rec
  63. 2390       RETURN
  64. 3000 :REM find & show a record
  65. 3010   BCMSG$=" F3: Find a record" : GOSUB 22000          :REM show message
  66. 3020   BCFUNCMSG$=BCMSG$
  67. 3030   GOSUB 23000                                        :REM blank fields
  68. 3040   BCA%=0 : GOSUB 24000                               :REM null/0 all
  69. 3050 :REM collect DATKEY$
  70. 3060 rem ***********************************************************************
  71. 3070   GOSUB 40000
  72. 3080   IF ENPASS%=0 THEN GOSUB 50400 : ENRETURN$=BCISMALL$:REM ##t smallest
  73. 3090   UNIKEY$=ENRETURN$
  74. 3100   GOSUB 52000                                        :REM find isam key
  75. 3110   GOSUB 42000                                        :REM check del-key
  76. 3120   IF BCIERR%=3 THEN GOTO 3170                       :REM file empty
  77. 3130            BCA%=0 : DATREC%(0)=BCRCRD%
  78. 3140            GOSUB 54000                               :REM get data rec
  79. 3150            GOSUB 21000                               :REM show data rec
  80. 3160            GOTO 1000                                 :REM command
  81. 3170       :REM file empty
  82. 3180            BCMSG$="  File Empty" : GOSUB 22000       :REM show message
  83. 3190            BCINKEY$=INKEY$: IF BCINKEY$="" THEN GOTO 3190
  84. 3200            GOTO 1000                                 :REM command
  85. 4000 :REM page up cycle & recycle
  86. 4010   IF BCIUP%(0)<1 THEN GOTO 4300
  87. 4020   BCIREC%(0)=BCIUP%(0)
  88. 4030   GOSUB 50200                                        :REM get key rec
  89. 4040   IF BCIDATE%(0)>0 THEN GOTO 4200                   :REM show rec
  90. 4050   GOTO 4000                                         :REM recycle
  91. 4100 :REM page down cycle & recycle
  92. 4110   IF BCIDN%(0)<1 THEN GOTO 4300
  93. 4120   BCIREC%(0)=BCIDN%(0)
  94. 4130   GOSUB 50200                                        :REM get key rec
  95. 4140   IF BCIDATE%(0)>0 THEN GOTO 4200                   :REM show rec
  96. 4150   GOTO 4100                                         :REM recycle
  97. 4200 :REM show PgUp or PgDn
  98. 4210   GOSUB 23000                                        :REM blank fields
  99. 4220   BCA%=0
  100. 4230   DATREC%(0)=BCIREC%(0)
  101. 4240   GOSUB 54000                                        :REM get data rec
  102. 4250   GOSUB 21000                                        :REM show data rec
  103. 4260   GOTO 1000
  104. 4300 :REM no records to PgUp or PgDn
  105. 4310   BCMSG$="  No Such Record" : GOSUB 22000            :REM show message
  106. 4320   ENSTAT$="25020160" : ENDFLT$="" : GOSUB 40000 : ENFUNC%=ENWAY%
  107. 4330   GOTO 1030
  108. 5000 :REM edit currently showed record
  109. 5010   BCMSG$="  F2:Edit this record" : GOSUB 22000       :REM show message
  110. 5020   BCA%=0
  111. 5030   GOSUB 23000                                        :REM blank fields
  112. 5040   IF DATREC%(0)>0 THEN GOTO 5080
  113. 5050       BCMSG$="  No Record" : GOSUB 22000             :REM show message
  114. 5060       BCINKEY$=INKEY$ : IF BCINKEY$="" THEN GOTO 5060
  115. 5070       GOTO 1000
  116. 5080   :REM good record - do edit
  117. 5090       GOSUB 54000                                    :REM get data rec
  118. 5100       BCKEYHOLD$=DATKEY$(0) : BCRECHOLD%=DATREC%(0)
  119. 5110       GOSUB 21000                                    :REM show data rec
  120. 5120       GOTO 29900                                     :REM data collection
  121. 5200   :REM returning from data entry
  122. 5210       BCMSG$="  SAVE? Y or N" : GOSUB 22000          :REM show message
  123. 5220       ENSTAT$="25020170" : ENDFLT$="" : GOSUB 40000
  124. 5230       IF ENRETURN$="Y" OR ENRETURN$="y" THEN GOTO 5260
  125. 5240       IF ENRETURN$="N" OR ENRETURN$="n" THEN GOTO 1000
  126. 5250       SOUND 50,3 : GOTO 5200
  127. 5260   :REM put new data file record away
  128. 5270       BCMSG$=" YES SAVE! Working" : GOSUB 22000      :REM show message
  129. 5280       IF LEFT$(DATKEY$(0),1)>" " THEN GOTO 5320
  130. 5290       BCMSG$="  Bad Key! Do Again!" : GOSUB 22000    :REM show message
  131. 5300       SOUND 50,6
  132. 5310       ENSTAT$="25020160" : ENDFLT$="" : GOSUB 40000 : DATREC%(0)=BCRECHOLD% : GOTO 5000
  133. 5320   :REM key test okay continue
  134. 5330       IF BCIDEL%>0 THEN BCRCRD%=BCIDEL% : GOSUB 2290 : GOTO 5380 :REM saving an edited key that just happens to exactly match a deleted one
  135. 5340       BCKEY$=DATKEY$(0)
  136. 5350       GOSUB 51000                                    :REM save new key
  137. 5360       DATREC%(0)=BCIREC%(0)
  138. 5370       GOSUB 55000                                    :REM save new data
  139. 5380    :REM branch in for save of edit key that exactly matches a deleted one
  140. 5390       IF BCKEYHOLD$=DATKEY$(0) THEN GOTO 1000        :REM verify unchange
  141. 5400       BCKEY$=BCKEYHOLD$ : GOSUB 52000               :REM find key
  142. 5410       GOSUB 23000                                    :REM blank fields
  143. 5420       BCA%=0 : GOSUB 24000                           :REM null fields
  144. 5430       BCIREC%(0)=BCRCRD% : BCI%=0
  145. 5440       DATREC%(0)=BCRCRD%
  146. 5450       GOSUB 54000                                    :REM get data rec
  147. 5460       GOSUB 21000                                    :REM show rec
  148. 5470    :REM delete old key?
  149. 5480       BCMSG$="Delete old key? Y N" : GOSUB 22000     :REM show message
  150. 5490       ENSTAT$="25220170" : ENDFLT$="" : GOSUB 40000
  151. 5500       IF ENRETURN$="Y" OR ENRETURN$="y" THEN GOTO 5530
  152. 5510       IF ENRETURN$="N" OR ENRETURN$="n" THEN GOTO 1000
  153. 5520       SOUND 50,3 : GOTO 5470
  154. 5530    :REM yes delete the old key
  155. 5540       GOTO 6200                                     :REM delete record
  156. 6000 :REM delete currently showed record
  157. 6010   BCMSG$="  F5:  DELETE?  Y/N" : GOSUB 22000         :REM show message
  158. 6020   BCA%=0
  159. 6030   GOSUB 23000                                        :REM blank fields
  160. 6040   IF DATREC%(0)>0 THEN GOTO 6080
  161. 6050       BCMSG$="  No Record" : GOSUB 22000             :REM show message
  162. 6060       BCINKEY$=INKEY$ : IF BCINKEY$="" THEN GOTO 6060
  163. 6070       GOTO 1000
  164. 6080   :REM good record - do delete
  165. 6090       GOSUB 54000                                    :REM get data rec
  166. 6100       GOSUB 21000                                    :REM show data rec
  167. 6110   :REM collect delete verification
  168. 6120       ENSTAT$="25020170" : ENDFLT$="" : GOSUB 40000
  169. 6130       IF ENRETURN$="Y" OR ENRETURN$="y" THEN GOTO 6200
  170. 6140       IF ENRETURN$="N" OR ENRETURN$="n" THEN GOTO 1000
  171. 6150       SOUND 50,3 : GOTO 6110
  172. 6200   :REM delete current record
  173. 6210       BCMSG$=" Yes DELETE! Working" : GOSUB 22000    :REM show message
  174. 6220       BCIREC%(0)=DATREC%(0)
  175. 6230       GOSUB 50200                                    :REM get key rec
  176. 6240       GOSUB 60600                                    :REM convert DATE$
  177. 6250       GOSUB 60000                                    :REM make Julian
  178. 6260       BCIDATE%(0)=BCJLNK%*(-1)
  179. 6270       GOSUB 50300                                    :REM put key rec
  180. 6280       GOSUB 23000                                    :REM blank fields
  181. 6290       GOTO 1000                                      :REM command
  182. 7000 :REM executive find & show a record
  183. 7010   BCMSG$=" F4: eXecutive Find" : GOSUB 22000         :REM show message
  184. 7020   BCFUNCMSG$=BCMSG$
  185. 7030   GOSUB 23000                                        :REM blank fields
  186. 7040   BCA%=0 : GOSUB 24000                               :REM null/0 all
  187. 7050 :REM collect DATKEY$
  188. 7060 rem ***********************************************************************
  189. 7070   GOSUB 40000
  190. 7080   IF ENPASS%=0 THEN GOSUB 50400 : ENRETURN$=BCISMALL$:REM get smallest
  191. 7090   BCKEY$=ENRETURN$
  192. 7100   GOSUB 52000                                        :REM find isam key
  193. 7110   IF BCIERR%=3 THEN GOTO 7310                       :REM file empty
  194. 7120            BCA%=0 : DATREC%(0)=BCRCRD%
  195. 7130            GOSUB 54000                               :REM get data rec
  196. 7140            GOSUB 21000                               :REM show data rec
  197. 7150            BCI%=0 : BCIREC%(0)=BCRCRD%
  198. 7160            GOSUB 50200                               :REM get key record
  199. 7170            IF BCIDATE%(0)>0 THEN GOTO 1000           :REM active
  200. 7180            BCMSG$="DELETED - F6:UnDelete"
  201. 7190            GOSUB 22000                               :REM show message
  202. 7200            ENSTAT$="25110160" : ENDFLT$=""
  203. 7210            GOSUB 40000 : ENFUNC%=ENWAY%              :REM collect
  204. 7220            IF ENWAY%=15 THEN GOTO 7250              :REM do undelete
  205. 7230            GOSUB 23000                               :REM clear fields
  206. 7240            GOTO 1000                                 :REM command
  207. 7250        :REM do undelete
  208. 7260            GOSUB 60600                               :REM parse today
  209. 7270            GOSUB 60000                               :REM convert
  210. 7280            BCIDATE%(0)=BCJLNK%
  211. 7290            GOSUB 50300                               :REM put key
  212. 7300            GOTO 1000                                 :REM command
  213. 7310       :REM file empty
  214. 7320            BCMSG$="  File Empty" : GOSUB 22000       :REM show message
  215. 7330            BCINKEY$=INKEY$: IF BCINKEY$="" THEN GOTO 7330
  216. 7340            GOTO 1000                                 :REM jump to command
  217. 20000 :REM show main data screen
  218. 20002   CLS
  219. 20004   LOCATE 24,1
  220. 20006   IF BCOLOR%=1 THEN COLOR BCLR1%
  221. 20008   PRINT "╔══════════════════════╦══════╤═══════╤═══════╤═════════╤═════════╤═══════════╗";
  222. 20010   LOCATE 25,1
  223. 20012   PRINT "║                      ║      │       │       │         │         │           ║";
  224. 20014   IF BCOLOR%=1 THEN COLOR BCLR3%
  225. 20016   LOCATE 25,25 : PRINT "F1:";
  226. 20018   LOCATE 25,32 : PRINT "F2:";
  227. 20020   LOCATE 25,40 : PRINT "F3:";
  228. 20022   LOCATE 25,48 : PRINT "F4:";
  229. 20024   LOCATE 25,58 : PRINT "F5:";
  230. 20026   LOCATE 25,68 : PRINT "F6:";
  231. 20028   IF BCOLOR%=1 THEN COLOR BCLR7%
  232. 20030   LOCATE 25,28 : PRINT "New";
  233. 20032   LOCATE 25,35 : PRINT "Edit";
  234. 20034   LOCATE 25,43 : PRINT "Find";
  235. 20036   LOCATE 25,51 : PRINT "X-Find";
  236. 20038   LOCATE 25,61 : PRINT "Delete";
  237. 20040   LOCATE 25,71 : PRINT "UnDelete";
  238. 20042   IF BCOLOR%=1 THEN COLOR BCLR6%
  239. 20060 rem ***********************************************************************
  240. 22000 :REM show message
  241. 22005   IF BCOLOR%=1 THEN COLOR BCLR4%
  242. 22010   LOCATE 25,2 : PRINT "                      ";
  243. 22020   LOCATE 25,3 : PRINT BCMSG$;
  244. 22030   LOCATE 25,2,1,0,7
  245. 22040   RETURN
  246. 23000 rem ***********************************************************************
  247. 25000 :REM temp show of file record
  248. 25010    BCMSG$="  Key Exists" : GOSUB 22000
  249. 25020    BCA%=1
  250. 25030    GOSUB 23000                                       :REM blank fields
  251. 25040    DATREC%(1)=BCRCRD%
  252. 25050    GOSUB 54000                                       :REM get data rec
  253. 25060    GOSUB 21000                                       :REM show data rec
  254. 25070    ENSTAT$="25020130" : ENDFLT$="" : GOSUB 40000
  255. 25080    BCA%=0
  256. 25090    GOSUB 23000                                       :REM blank fields
  257. 25100    GOSUB 21000                                       :REM show data rec
  258. 25110    BCMSG$=BCFUNCMSG$ : GOSUB 22000
  259. 25120    RETURN
  260. 29000 :REM escape from input routines
  261. 29010     IF ENFUNC%=10 THEN GOTO 2100                    :REM add return
  262. 29020     IF ENFUNC%=11 THEN GOTO 5200                    :REM edit return
  263. 29900 :REM data collection
  264. 29910   BCIDEL%=0
  265. 30000 :REM collect DATKEY$
  266. 30030 rem ***********************************************************************
  267. 30040   GOSUB 40000 : DATKEY$(0)=ENRETURN$
  268. 30050   IF ENPASS%=0 THEN GOTO 30090
  269. 30060      BCKEY$=DATKEY$(0) : GOSUB 52000
  270. 30070      IF BCIERR%=0 AND BCIDATE%(1)>0 THEN GOSUB 25000 : DATKEY$(0)="" : GOTO 30000
  271. 30080      IF BCIERR%=0 THEN BCIDEL%=BCRCRD% ELSE BCIDEL%=0
  272. 30090 rem ***********************************************************************
  273. 40000 :REM enput routine begins
  274. 40010    ENROW% =VAL(MID$(ENSTAT$,1,2))
  275. 40020    ENCOL% =VAL(MID$(ENSTAT$,3,2))
  276. 40030    ENLEN% =VAL(MID$(ENSTAT$,5,2))
  277. 40040    ENTEST%=VAL(MID$(ENSTAT$,7,1))
  278. 40050    ENKIND%=VAL(MID$(ENSTAT$,8,1))
  279. 40060    IF BCOLOR%=1 THEN COLOR BCLR7%
  280. 40100 :REM start & restart
  281. 40110    LOCATE ENROW%,ENCOL%,0,0,7
  282. 40120    IF ENKIND%=0 THEN PRINT (LEFT$(ENDFLT$+STRING$(ENLEN%,249),ENLEN%)); ELSE PRINT (RIGHT$(STRING$(ENLEN%,249)+STR$(VAL(ENDFLT$)),ENLEN%));
  283. 40130    ENPASS%=0
  284. 40140    ENRETURN$=""
  285. 40200 :REM cycle & recycle character collection
  286. 40210    LOCATE ENROW%,(ENCOL%+ENPASS%),1,0,7
  287. 40220    ENCHAR$=INKEY$
  288. 40230    IF ENCHAR$="" THEN GOTO 40220                                         :REM recycle
  289. 40235    IF ENTEST%=1 THEN IF ENCHAR$>CHR$(96) AND ENCHAR$<CHR$(123) THEN ENCHAR$=CHR$(ASC(ENCHAR$)-32)
  290. 40240    IF INSTR(ENTEST$(ENTEST%),ENCHAR$)>0 THEN GOTO 40300                  :REM good char
  291. 40250    IF LEN(ENCHAR$)=1 THEN EN%=INT((INSTR(41,ENTEST$(0),ENCHAR$)+1)/2) : GOTO 40270
  292. 40260    EN%=INT((INSTR(ENTEST$(0),ENCHAR$)+1)/2)
  293. 40270    ON EN% GOTO 40510,40520,40530,40540,40550,40560,40570,40580,40590,40600,40610,40620,40630,40640,40650,40660,40670,40680,40690,40700,40710,40720,40800
  294. 40280    SOUND 50,3 : GOTO 40200                                               :REM recycle
  295. 40300    :REM valid character - process
  296. 40310       IF ENPASS%>0 THEN GOTO 40400                                       :REM no field erase
  297. 40320       PRINT STRING$(ENLEN%,249);
  298. 40330       LOCATE ENROW%,ENCOL%,1,0,7
  299. 40400    :REM skip field erase
  300. 40410       ENPASS%=ENPASS%+1
  301. 40420       PRINT ENCHAR$;
  302. 40430       ENRETURN$=ENRETURN$+ENCHAR$
  303. 40440       IF ENPASS%=ENLEN% THEN ENWAY%=0 : GOTO 40900                       :REM exit routine
  304. 40450       GOTO 40200                                                         :REM recycle
  305. 40500 :REM branch control for special key pressed
  306. 40510    ENWAY%=10 : GOTO 40900                                                :REM F1
  307. 40520    ENWAY%=11 : GOTO 40900                                                :REM F2
  308. 40530    ENWAY%=12 : GOTO 40900                                                :REM F3
  309. 40540    ENWAY%=13 : GOTO 40900                                                :REM F4
  310. 40550    ENWAY%=14 : GOTO 40900                                                :REM F5
  311. 40560    ENWAY%=15 : GOTO 40900                                                :REM F6
  312. 40570    SOUND 50,3 : GOTO 40220                                               :REM F7
  313. 40580    SOUND 50,3 : GOTO 40220                                               :REM F8
  314. 40590    SOUND 50,3 : GOTO 40220                                               :REM F9
  315. 40600    SOUND 50,3 : GOTO 40200                                               :REM F10
  316. 40610    ENWAY%=1 : GOTO 40900                                                 :REM up
  317. 40620    ENWAY%=2 : GOTO 40900                                                 :REM down
  318. 40630    ENWAY%=3 : GOTO 40900                                                 :REM left
  319. 40640    ENWAY%=4 : GOTO 40900                                                 :REM rght
  320. 40650    ENWAY%=5 : GOTO 40900                                                 :REM home
  321. 40660    ENWAY%=6 : GOTO 40900                                                 :REM end
  322. 40670    SOUND 50,3 : GOTO 40220                                               :REM ins
  323. 40680    SOUND 50,3 : GOTO 40220                                               :REM del
  324. 40690    ENWAY%=8 : GOTO 40900                                                 :REM PgUp
  325. 40700    ENWAY%=9 : GOTO 40900                                                 :REM PgDn
  326. 40710    ENWAY%=0 : GOTO 40900                                                 :REM CR
  327. 40720    ENWAY%=7 : GOTO 40900                                                 :REM ESC
  328. 40800    :REM backspace character pressed                                       :REM BkSp
  329. 40810       IF ENPASS%<2 THEN GOTO 40100                                       :REM start/restart
  330. 40820       ENPASS%=ENPASS%-1
  331. 40830       LOCATE ENROW%,ENCOL%+ENPASS%,0,0,7
  332. 40840       PRINT CHR$(249);
  333. 40850       ENRETURN$=LEFT$(ENRETURN$,ENPASS%)
  334. 40860       GOTO 40200                                                         :REM recycle
  335. 40900 :REM field exit - finish subroutine
  336. 40910    IF ENPASS%<1 THEN ENRETURN$=ENDFLT$
  337. 40920    IF ENKIND%=1 THEN ENRETURN$=RIGHT$(SPACE$(ENLEN%)+STR$(VAL(ENRETURN$)),ENLEN%)
  338. 40930    LOCATE ENROW%,ENCOL%,0,0,7
  339. 40940    PRINT LEFT$(ENRETURN$+SPACE$(ENLEN%),ENLEN%);
  340. 40950    RETURN
  341. 41000 :REM establish test strings required by enput routine
  342. 41020    FOR BCTEMP%=1 TO 10
  343. 41030       KEY BCTEMP%,""                                                     :REM f1-f10
  344. 41040       ENTEST$(0)=ENTEST$(0)+CHR$(0)+CHR$(58+BCTEMP%)                     :REM 1 - 10
  345. 41050       NEXT
  346. 41060    ENTEST$(0)=ENTEST$(0)+CHR$(0)+CHR$(72)+CHR$(0)+CHR$(80)+CHR$(0)+CHR$(75)
  347. 41070    ENTEST$(0)=ENTEST$(0)+CHR$(0)+CHR$(77)+CHR$(0)+CHR$(71)+CHR$(0)+CHR$(79)+CHR$(0)+CHR$(82)
  348. 41080    ENTEST$(0)=ENTEST$(0)+CHR$(0)+CHR$(83)+CHR$(0)+CHR$(73)+CHR$(0)+CHR$(81)
  349. 41090    ENTEST$(0)=ENTEST$(0)+CHR$(13)+CHR$(0)+CHR$(27)+CHR$(0)+CHR$( 8)
  350. 41100    ENTEST$(1)="ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 .,-"
  351. 41110    ENTEST$(2)=ENTEST$(1)+"abcdefghijklmnopqrstuvwxyz"
  352. 41120    ENTEST$(3)=ENTEST$(2)+"!@#$%^&*()_=+~[{]};:'<>/?\|"+CHR$(34)
  353. 41130    ENTEST$(4)="0123456789"
  354. 41140    ENTEST$(5)=ENTEST$(4)+".-"
  355. 41150    ENTEST$(6)=CHR$(0)
  356. 41160    ENTEST$(7)="yYnN"
  357. 41170 RETURN
  358. 42000 :REM check for deleted record - cycle down then up
  359. 42010    BCI%=0 : BCIREC%(0)=BCRCRD%
  360. 42020    :REM cycle & recycle down key read
  361. 42030         GOSUB 50200                                  :REM get key rec
  362. 42040         IF BCIDATE%(0)>0 THEN BCRCRD%=BCIREC%(0) : RETURN
  363. 42050         IF BCIDN%(0)<1 THEN GOTO 42100
  364. 42060         BCIREC%(0)=BCIDN%(0)
  365. 42070         GOTO 42020
  366. 42080    :REM start up key read
  367. 42090         BCIREC%(0)=BCRCRD%
  368. 42100    :REM cycle & recycle up key read
  369. 42110         GOSUB 50200                                  :REM get key rec
  370. 42120         IF BCIDATE%(0)>0 THEN BCRCRD%=BCIREC%(0) : RETURN
  371. 42130         IF BCIUP%(0)<1 THEN GOTO 42160
  372. 42140         BCIREC%(0)=BCIUP%(0)
  373. 42150         GOTO 42100
  374. 42160    :REM all records deleted
  375. 42170         BCIERR%=3
  376. 42180         RETURN
  377. 43000 :REM reset entire key file to original null format
  378. 43005   IF BCOLOR%=1 THEN COLOR BCLR7%
  379. 43010   PRINT : PRINT : PRINT
  380. 43020   PRINT "Yes .... First run." : PRINT
  381. 43030   PRINT "Initialize key file for this program? (Y/N) ";
  382. 43040   BCINKEY$=INKEY$ : IF BCINKEY$="" THEN GOTO 43040
  383. 43050   IF BCINKEY$="Y" OR BCINKEY$="y" THEN GOTO 43070
  384. 43060   PRINT "No .... end....." : END
  385. 43070   :REM initialize key file
  386. 43080   GOSUB 60600                                        :REM parse today
  387. 43090   GOSUB 60000                                        :REM convert
  388. 43100   LSET BCI0$=MKI$(BCJLNK%)
  389. 43110   LSET BCI1$=MKI$(0)
  390. 43120   LSET BCI2$=MKI$(BCIKEYLEN1%)
  391. 43130   LSET BCI3$=MKI$(0)
  392. 43140   LSET BCI4$=MKI$(0-BCIKEYLEN1%)
  393. 43150   LSET BCI5$=CHR$(255)+SPACE$(BCIKEYLEN1%-1)
  394. 43160   PUT #1,1
  395. 43170   CLOSE
  396. 43180   RUN
  397. 50000 :REM initial open & testing of ISAM key file
  398. 50010   OPEN "R", #1, FILENAME$+".key",(10+BCIKEYLEN1%)
  399. 50020   FIELD #1, 2 AS BCI0$, 2 AS BCI1$, 2 AS BCI2$, 2 AS BCI3$, 2 AS BCI4$, (BCIKEYLEN1%) AS BCI5$
  400. 50030   GOSUB 50400                                        :REM get statrec
  401. 50040   IF (BCIQUANT%-BCIKEYLEN1%)=BCICHECK% THEN RETURN
  402. 50045   IF BCOLOR%=1 THEN COLOR BCLR7%
  403. 50050   CLS : PRINT "Verify! .... Absolute first time this program run?"
  404. 50060   PRINT : PRINT "Enter Y for YES or N for NO! (Y/N) ";
  405. 50070   BCINKEY$=INKEY$ : IF BCINKEY$="" THEN GOTO 50070
  406. 50080   IF BCINKEY$="Y" OR BCINKEY$="y" THEN GOTO 43000
  407. 50090   IF BCINKEY$="n" OR BCINKEY$="N" THEN GOTO 50100 ELSE GOTO 50050
  408. 50100   PRINT : PRINT : PRINT : PRINT
  409. 50110   PRINT "No .... not first time! " : PRINT
  410. 50120   PRINT "Contact programmer! .... FATAL KEY FILE ERROR!"
  411. 50130   PRINT "                            ISAM open routine!"
  412. 50140   END
  413. 50200 :REM get key file record
  414. 50210   GET #1, (BCIREC%(BCI%)+1)
  415. 50220   BCIDATE%(BCI%)   =CVI(BCI0$)
  416. 50230   BCIMORE%(BCI%)   =CVI(BCI1$)
  417. 50240   BCILESS%(BCI%)   =CVI(BCI2$)
  418. 50250   BCIUP%(BCI%)     =CVI(BCI3$)
  419. 50260   BCIDN%(BCI%)     =CVI(BCI4$)
  420. 50270   BCIKEY$(BCI%)    =BCI5$
  421. 50280   RETURN
  422. 50300 :REM put key file record
  423. 50310   LSET BCI0$=MKI$(BCIDATE%(BCI%))
  424. 50320   LSET BCI1$=MKI$(BCIMORE%(BCI%))
  425. 50330   LSET BCI2$=MKI$(BCILESS%(BCI%))
  426. 50340   LSET BCI3$=MKI$(BCIUP%(BCI%))
  427. 50350   LSET BCI4$=MKI$(BCIDN%(BCI%))
  428. 50360   LSET BCI5$=BCIKEY$(BCI%)
  429. 50370   PUT #1, (BCIREC%(BCI%)+1)
  430. 50380   RETURN
  431. 50400 :REM get statistics record from key file
  432. 50410   GET #1,1
  433. 50420   BCIREORG% =CVI(BCI0$)
  434. 50430   BCIQUANT% =CVI(BCI1$)
  435. 50440   BCIKEYLEN%=CVI(BCI2$)
  436. 50450   BCI1STSEQ%=CVI(BCI3$)
  437. 50460   BCICHECK% =CVI(BCI4$)
  438. 50470   BCISMALL$ =BCI5$
  439. 50480   RETURN
  440. 50500 :REM put statistics record into key file
  441. 50510   LSET BCI0$=MKI$(BCIREORG%)
  442. 50520   LSET BCI1$=MKI$(BCIQUANT%)
  443. 50530   LSET BCI2$=MKI$(BCIKEYLEN%)
  444. 50540   LSET BCI3$=MKI$(BCI1STSEQ%)
  445. 50550   LSET BCI4$=MKI$(BCICHECK%)
  446. 50560   LSET BCI5$=BCISMALL$
  447. 50570   PUT #1,1
  448. 50580   RETURN
  449. 51000 :REM save a new ISAM key record
  450. 51010   GOSUB 50400                                        :REM get stat rec
  451. 51020   GOSUB 60600                                        :REM parse today
  452. 51030   GOSUB 60000                                        :REM convert
  453. 51040   BCIDATE%(0)=BCJLNK%
  454. 51050   BCIMORE%(0)=0
  455. 51060   BCILESS%(0)=0
  456. 51070   BCIUP%(0)=0
  457. 51080   BCIDN%(0)=0
  458. 51090   BCIKEY$(0)=LEFT$(BCKEY$+SPACE$(BCIKEYLEN%),BCIKEYLEN%):REM BCODERVAR
  459. 51100   BCIREC%(0)=BCIQUANT%+1
  460. 51110   IF BCIREC%(0)=1 THEN GOTO 51700
  461. 51120   BCIREC%(1)=1
  462. 51200   :REM cycle & recycle ISAM key file read
  463. 51210      BCI%=1 : GOSUB 50200                            :REM get key record
  464. 51220      BCIDIRECT%=ABS(((BCIKEY$(1)>BCIKEY$(0))*1)+((BCIKEY$(1)<BCIKEY$(0))*2)+((BCIKEY$(1)=BCIKEY$(0))*3))
  465. 51230      ON BCIDIRECT% GOTO 51300,51500,51800            :REM 1-< 2-> 3-=
  466. 51300       :REM use less branch
  467. 51310          IF BCILESS%(1)>0 THEN BCIREC%(1)=BCILESS%(1) : GOTO 51200
  468. 51320          BCILESS%(1)=BCIREC%(0)
  469. 51330          BCIUP%(0)=BCIUP%(1)
  470. 51340          BCIUP%(1)=BCIREC%(0)
  471. 51350          BCI%=1 : GOSUB 50300                        :REM put key file rec
  472. 51360          BCIDN%(0)=BCIREC%(1)
  473. 51370          IF BCIUP%(0)=0 THEN GOTO 51700              :REM goto put-new-key
  474. 51380          BCIREC%(1)=BCIUP%(0)
  475. 51390          BCI%=1 : GOSUB 50200                        :REM get key rec
  476. 51400          BCIDN%(1)=BCIREC%(0)
  477. 51410          GOSUB 50300                                 :REM put key file rec
  478. 51420          GOTO 51700                                  :REM goto put-new-key
  479. 51500       :REM use more branch
  480. 51510          IF BCIMORE%(1)>0 THEN BCIREC%(1)=BCIMORE%(1) : GOTO 51200
  481. 51520          BCIMORE%(1)=BCIREC%(0)
  482. 51530          BCIDN%(0)=BCIDN%(1)
  483. 51540          BCIDN%(1)=BCIREC%(0)
  484. 51550          BCI%=1 : GOSUB 50300                        :REM put key file rec
  485. 51560          BCIUP%(0)=BCIREC%(1)
  486. 51570          IF BCIDN%(0)=0 THEN GOTO 51700              :REM goto put-new-key
  487. 51580          BCIREC%(1)=BCIDN%(0)
  488. 51590          BCI%=1 : GOSUB 50200                        :REM get key rec
  489. 51600          BCIUP%(1)=BCIREC%(0)
  490. 51610          GOSUB 50300                                 :REM put key rec
  491. 51620          GOTO 51700                                  :REM go put-new-key
  492. 51700   :REM put new key
  493. 51710      BCI%=0
  494. 51720      GOSUB 50300                                     :REM put new key rec
  495. 51730      BCIQUANT%=BCIQUANT%+1
  496. 51740      BCICHECK%=BCIQUANT%-BCIKEYLEN%
  497. 51750      IF BCIKEY$(0)<BCISMALL$ THEN BCISMALL$=BCIKEY$(0) : BCI1STSEQ%=BCIREC%(0)
  498. 51760      GOSUB 50500                                     :REM put stat rec
  499. 51800      :REM branch in for pre-existing ISAM key
  500. 51810           RETURN                                     :REM ISAM save DONE!
  501. 52000 :REM look for a key in the ISAM file
  502. 52010   GOSUB 50400 : IF BCIQUANT%=0 THEN BCIERR%=3 : GOTO 52430:REM no keys-return
  503. 52020   BCI%=1 : BCIREC%(1)=1 : BCIERR%=0
  504. 52030   BCIKEY$(0)=LEFT$(BCKEY$+SPACE$(BCIKEYLEN%),BCIKEYLEN%):REM BCODERVAR
  505. 52100   :REM cycle & recycle ISAM key find
  506. 52110      GOSUB 50200                                     :REM get key rec
  507. 52120      BCIDIRECT%=ABS(((BCIKEY$(1)>BCIKEY$(0))*1)+((BCIKEY$(1)<BCIKEY$(0))*2)+((BCIKEY$(1)=BCIKEY$(0))*3))
  508. 52130      ON BCIDIRECT% GOTO 52200,52300,52400
  509. 52200         :REM use less branch
  510. 52210            IF BCILESS%(1)>0 THEN BCIREC%(1)=BCILESS%(1) : GOTO 52100:REM recycle read
  511. 52220            BCIERR%=1
  512. 52230            GOTO 52400                                :REM find done
  513. 52300         :REM use more branch
  514. 52310            IF BCIMORE%(1)>0 THEN BCIREC%(1)=BCIMORE%(1) : GOTO 52100:REM recycle read
  515. 52320            BCIERR%=2
  516. 52330            GOTO 52400                                :REM find done
  517. 52400      :REM find complete
  518. 52410         BCRCRD%=BCIREC%(1)
  519. 52420      :REM branch from no keys at all error
  520. 52430         RETURN
  521. 53000 :REM open & field data file
  522. 53010   OPEN "r", #2,
  523. 60000 :REM - Julian Routine - convert calendar date into julian number
  524. 60010     BCJLNY%=BCJLNY%-20
  525. 60020     IF BCJLNM%>2 THEN BCJLNM%=BCJLNM%-3 : GOTO 60050
  526. 60030        BCJLNM%=BCJLNM%+9
  527. 60040        BCJLNY%=BCJLNY%-1
  528. 60050     BCJLNY1!=CSNG(BCJLNY%)
  529. 60060     BCJLNK%=(FIX((1461*BCJLNY1!)/4))+(FIX(((153*BCJLNM%)+2)/5))+BCJLND%
  530. 60070     RETURN
  531. 60100 :REM - Julian Routine - convert julian number into calendar date
  532. 60110     BCJLNK1!=CSNG(BCJLNK%)
  533. 60120     BCJLNY%=FIX(((4*BCJLNK1!)-1)/1461)
  534. 60130     BCJLNY1!=CSNG(BCJLNY%)
  535. 60140     BCJLND%=FIX(((4*BCJLNK1!)-1)-(1461*BCJLNY1!))
  536. 60150     BCJLND%=FIX((BCJLND%+4)/4)
  537. 60160     BCJLNM%=FIX(((5*BCJLND%)-3)/153)
  538. 60170     BCJLND%=((5*BCJLND%)-3)-(153*BCJLNM%)
  539. 60180     BCJLND%=FIX((BCJLND%+5)/5)
  540. 60190     IF BCJLNM%<10 THEN BCJLNM%=BCJLNM%+3 : GOTO 60220
  541. 60200        BCJLNM%=BCJLNM%-9
  542. 60210        BCJLNY%=BCJLNY%+1
  543. 60220     BCJLNY%=BCJLNY%+20
  544. 60230     RETURN
  545. 60500 :REM parse jdate$ to month%, day%, year%
  546. 60510     BCJLNM%=FIX(VAL(LEFT$(BCJDATE$,2)))
  547. 60520     BCJLND%=FIX(VAL(MID$(BCJDATE$,3,2)))
  548. 60530     BCJLNY%=FIX(VAL(RIGHT$(BCJDATE$,2)))
  549. 60535     IF BCJLNY%>99 THEN BCJLNY%=BCJLNY%-1900
  550. 60540     IF BCJLNY%<8 THEN BCJLNY%=BCJLNY%+100
  551. 60545     IF BCJLNY%<20 THEN BCJLNY%=20 : BCJLND%=1 : BCJLNM%=3
  552. 60550     IF BCJLNY%>108 THEN BCJLNY%=108 : BCJLND%=31 : BCJLNM%=12
  553. 60555     RETURN
  554. 60600 :REM parse current DATE$ into jlnm%, jlnd%, jlny%
  555. 60610     BCJLNM%=FIX(VAL(LEFT$(DATE$,2)))
  556. 60620     BCJLND%=FIX(VAL(MID$(DATE$,4,2)))
  557. 60630     BCJLNY%=FIX(VAL(RIGHT$(DATE$,2)))
  558. 60635     IF BCJLNY%>99 THEN BCJLNY%=BCJLNY%-1900
  559. 60640     IF BCJLNY%<8 THEN BCJLNY%=BCJLNY%+100
  560. 60645     IF BCJLNY%<20 THEN BCJLNY%=20 : BCJLND%=1 : BCJLNM%=3
  561. 60650     IF BCJLNY%>108 THEN BCJLNY%=108 : BCJLND%=31 : BCJLNM%=12
  562. 60655     RETURN
  563. 65000 :REM exit?
  564. 65010       BCMSG$="  EXIT? Y or N" : GOSUB 22000          :REM show message
  565. 65020       ENSTAT$="25020170" : ENDFLT$="" : GOSUB 40000  :REM collect
  566. 65030       IF ENRETURN$="Y" OR ENRETURN$="y" THEN GOTO 65060
  567. 65040       IF ENRETURN$="N" OR ENRETURN$="n" THEN GOTO 1000
  568. 65050       SOUND 50,3 : GOTO 65020                        :REM recycle
  569. 65060       CLOSE : CLS
  570. 65065       IF BCOLOR%=1 THEN COLOR BCLR7%
  571. 65070       PRINT "Attempting chain to program MENU."
  572. 65080       PRINT "Current default drive & directory."
  573. 65090       CHAIN "MENU"
  574. 65100 :REM last line
  575.