home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / basnet / fonedir.bas < prev    next >
BASIC Source File  |  1987-05-07  |  16KB  |  460 lines
  1. 100 ' FONEDIR.BAS
  2. 110 '
  3. 120 ' demonstrates the use of locks
  4. 130 '
  5. 140 e$="                                                                              "
  6.  
  7. 500 OPEN "fone.dir" AS #1 LEN = 48
  8. 510 FIELD #1, 4 AS NEXTREC$, 44 AS FILLER$
  9. 520 FIELD #1, 30 AS NOMBRE$, 3 AS AREA$, 7 AS NMBR$, 4 AS EXTENTION$
  10. 530 FIELD #1, 48 AS ZAPIT$
  11. 600 'set up file if necessary
  12. 610 IF LOF(1) < 48 THEN LSET NEXTREC$ = "2": LSET FILLER$ = STRING$(44,"x") : PUT #1,1
  13.  
  14. 700 'set up net access
  15. 710 gosub 10000
  16. 720 'get the file handle for later use
  17. 730 gosub 11000
  18.  
  19. 1000 '
  20. 1001 ' this routine displays the menu
  21. 1002 '
  22. 1003 CLS
  23. 1005 LOCATE 3,20
  24. 1007 PRINT "      PHONE DIRECTORY PROGRAM"
  25. 1015 LOCATE 5,20
  26. 1021 PRINT "************* MAIN MENU ************"
  27. 1022 LOCATE 6,20
  28. 1023 PRINT "*                                  *"
  29. 1025 LOCATE 7,20
  30. 1030 PRINT "*   1. Display Current Directory   *"
  31. 1035 LOCATE 8,20
  32. 1040 PRINT "*                                  *"
  33. 1045 LOCATE 9,20
  34. 1050 PRINT "*   2. Add a Directory Entry       *"
  35. 1055 LOCATE 10,20
  36. 1060 PRINT "*                                  *"
  37. 1065 LOCATE 11,20
  38. 1070 PRINT "*   3. Modify a Directory Entry    *"
  39. 1075 LOCATE 12,20
  40. 1080 PRINT "*                                  *"
  41. 1085 LOCATE 13,20
  42. 1090 PRINT "*   4. Delete an Entry             *"
  43. 1095 LOCATE 14,20
  44. 1100 PRINT "*                                  *"
  45. 1105 LOCATE 15,20
  46. 1120 PRINT "*   5. Exit                        *"
  47. 1122 LOCATE 16,20
  48. 1125 PRINT "*                                  *"
  49. 1126 LOCATE 17,20
  50. 1127 PRINT "************************************"
  51.  
  52. 1130 LOCATE 20,20
  53. 1140 PRINT "Enter Selection > <"
  54. 1150 SELECT$ = ""
  55. 1160 LOCATE 20,37,1
  56. 1170 WHILE SELECT$ < "1" OR SELECT$ > "5" : SELECT$ = INKEY$ : WEND
  57. 1180 SELECT = VAL(SELECT$)
  58. 1190 ON SELECT GOSUB 2000,3000,4000,5000,6000
  59. 1200 GOTO 1000
  60.  
  61. 2000 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  62. 2001 'routine to display the directory
  63. 2002 '
  64. 2003 on error goto 16000
  65. 2010 GET #1,1
  66. 2012 if Err <> 0 then err = 0 : goto 2999
  67. 2015 on error goto 0
  68. 2020 MAXREC = VAL(NEXTREC$)
  69. 2022 CLS
  70. 2025    PRINT SPC(23) "PHONE DIRECTORY"
  71. 2027    PRINT SPC(23) "---------------"
  72. 2033    PRINT "Rec #    Person's Name                      Phone Number      Ext."
  73. 2036    PRINT "-----    ------------------------------     --------------    ------"
  74.  
  75. 2040 FOR COUNT = 2 TO (MAXREC - 1)
  76. 2042    noerr = 0
  77. 2045    on error goto 15000
  78. 2047    GET #1,COUNT
  79. 2048    if noerr <> 0 then goto 2100
  80. 2050    locate (count + 4),1:PRINT (count - 1);:locate (count + 4),10
  81. 2060    PRINT NOMBRE$;
  82. 2070    PRINT "     " + "(" + AREA$ + ") ";
  83. 2080    PRINT LEFT$(NMBR$,3) + "-" + RIGHT$(NMBR$,4);
  84. 2090    PRINT "    " + "<" + EXTENTION$ + ">"
  85. 2095    on error goto 0
  86. 2100 NEXT
  87. 2110 PRINT: PRINT: PRINT "Press any key to return to the menu.";
  88. 2120 WHILE INKEY$ = "": WEND
  89. 2999 RETURN
  90.  
  91. 3000 '
  92. 3001 ' routine to add a new record to the file
  93. 3002 '
  94. 3010 ' first we print the entry screen
  95. 3020 GOSUB 7000
  96. 3025 LOCATE 2,34:PRINT "ADD A RECORD"
  97. 3030 ' now go collect the data
  98. 3040 GOSUB 8000
  99. 3050 'lock the header record and get the next available record
  100. 3051 recno% = 1 'the header record
  101. 3053 gosub 13000 ' lock it
  102. 3055 if ErrCode% <> 0 then goto 3999
  103. 3060 GET #1,recno%
  104. 3070 NEXTREC = VAL(NEXTREC$)
  105. 3080 ' set it up and write it out
  106. 3090 LSET NOMBRE$ = TEMPNAME$ : LSET AREA$ = TEMPAREA$ : LSET NMBR$ = TEMPNMBR$ : LSET EXTENTION$ = TEMPEXT$
  107. 3092 recno% = nextrec
  108. 3095 gosub 13000 'lock the record
  109. 3100 PUT #1,NEXTREC
  110. 3105 gosub 14000 'release the record lock
  111. 3110 'increment the next record pointer
  112. 3120 TEMPREC$ = STR$(NEXTREC+1)
  113. 3130 LSET NEXTREC$ = TEMPREC$ :LSET FILLER$ = STRING$(44,"x")
  114. 3140 PUT #1,1
  115. 3150 recno% = 0 'set up for the header record
  116. 3160 gosub 14000 ' release the record lock on the header
  117. 3999 RETURN
  118.  
  119. 4000 '
  120. 4001 'routine to modify an entry
  121. 4002 '
  122. 4010 'get the record to be modified
  123. 4020 CLS
  124. 4025 LOCATE 2,32:PRINT "CHANGE A RECORD"
  125. 4030 LOCATE 10,1:PRINT USING "&";E$:LOCATE 10,20
  126. 4040 INPUT "What record do you wish to change? =>",RECNO$
  127. 4041 IF VAL(RECNO$) = 0 THEN LOCATE 12,1:PRINT USING "&";E$:LOCATE 12,22:PRINT "*** Your entry is not numeric ***":goto 4030
  128. 4050 recno% = VAL(recno$)
  129. 4060 recno% = recno% + 1      'treat the first record as record 0
  130. 4063 gosub 13000      'log and lock the record
  131. 4064 if ErrCode% <> 0 then goto 4999
  132. 4070 GET #1,recno%
  133. 4080 'now print the entry screen
  134. 4090 GOSUB 7000
  135. 4100 'next print the data from the record to be modified
  136. 4105 LOCATE 2,32:PRINT "CHANGE A RECORD"
  137. 4110 LOCATE 6,44
  138. 4120 PRINT NOMBRE$
  139. 4130 LOCATE 11,32
  140. 4140 PRINT AREA$
  141. 4150 LOCATE 16,24
  142. 4160 PRINT left$(NMBR$,3)
  143. 4162 locate 16,30
  144. 4165 print mid$(nmbr$,4,4)
  145. 4170 LOCATE 21,32
  146. 4180 PRINT EXTENTION$
  147. 4190 ' now get the replacement data
  148. 4200 GOSUB 8000
  149. 4210 ' set it up and write it out
  150. 4220 if tempname$ <> "" then LSET NOMBRE$ = TEMPNAME$
  151. 4221 if temparea$ <> "" then LSET AREA$ = TEMPAREA$ 
  152. 4222 if tempnmbr$ <> "" then LSET NMBR$ = TEMPNMBR$
  153. 4223 if tempext$ <> "" then LSET EXTENTION$ = TEMPEXT$
  154. 4230 PUT #1,recno%
  155. 4240 gosub 14000 ' clear the record lock
  156. 4999 RETURN
  157.  
  158. 5000 '
  159. 5001 'routine to delete an existing record
  160. 5002 '
  161. 5010 'get the record to be deleted
  162. 5020 CLS
  163. 5025 LOCATE 2,32:PRINT "DELETE A RECORD"
  164. 5030 LOCATE 10,1:PRINT USING "&";E$:LOCATE 10,20
  165. 5040 INPUT "What record do you wish to delete? =>",RECNO$
  166. 5041 IF VAL(RECNO$)=0 THEN LOCATE 12,1:PRINT USING "&";E$:LOCATE 12,22:PRINT "*** Your entry is not numeric ***":goto 5030
  167. 5050 recno% = VAL(recno$)
  168. 5060 recno% = recno% + 1 ' treat the first record as record 0
  169. 5065 gosub 13000 'lock the record
  170. 5068 if ErrCode% <> 0 then goto 5999
  171. 5070 GET #1,recno%
  172. 5080 'display the record to be deleted
  173. 5090 'print the screen
  174. 5100 GOSUB 7000
  175. 5105 LOCATE 2,32:PRINT "DELETE A RECORD"
  176. 5110 'print the data
  177. 5120 GOSUB 9000
  178. 5130 'provide a chance to bail out
  179. 5140 LOCATE 24,15
  180. 5150 PRINT "PRESS Y TO DELETE THIS RECORD, N TO ABORT. ";
  181. 5160 DOIT$ = ""
  182. 5170 WHILE DOIT$ <> "Y" AND DOIT$ <> "y" AND DOIT$ <> "n" AND DOIT$ <> "N" : DOIT$ = INKEY$ :WEND
  183. 5180 IF DOIT$ <> "Y" AND DOIT$ <> "y" THEN gosub 14000: RETURN
  184. 5190 LSET ZAPIT$ = "* deleted *" + STRING$(53," ")
  185. 5200 PUT #1,recno%
  186. 5210 gosub 14000 ' release the lock
  187. 5999 RETURN
  188.  
  189. 6000 '
  190. 6001 'exit routine
  191. 6002 '
  192. 6010 CLOSE 1
  193. 6020 SYSTEM
  194. 6999 RETURN
  195.  
  196. 7000 '
  197. 7001 'routine to print the entry screen
  198. 7002 '
  199. 7010 CLS
  200. 7050 LOCATE 5,10
  201. 7060 PRINT "Person's Name (up to 30 letters) <______________________________>"
  202. 7070 LOCATE 10,10
  203. 7100 PRINT "Area Code (3 digits) <___>"
  204. 7110 LOCATE 15,10
  205. 7120 PRINT "Phone Number <___>-<____>"
  206. 7130 LOCATE 20,10
  207. 7140 PRINT "Extension (4 digits) <____>"
  208. 7999 RETURN
  209.  
  210. 8000 '
  211. 8001 'collect the data
  212. 8002 '
  213. 8003 LOCATE 5,44 :TEMPNAME$ = ""
  214. 8004 valnam$ = ""
  215. 8005 WHILE VALNAM$ = "":VALNAM$ = INKEY$:WEND
  216. 8007 locate 5,(len(tempname$)+44)
  217. 8009 IF VALNAM$ = chr$(13) THEN 8032
  218. 8010 LOCATE 5,(LEN(TEMPNAME$)+44):print valnam$
  219. 8020 TEMPNAME$ = TEMPNAME$ + VALNAM$
  220. 8025 IF LEN(TEMPNAME$) < 31 THEN locate 5,(Len(Tempname$)+44):goto 8004
  221.  
  222. 8032 y%=32
  223. 8035 x%=10
  224. 8037 TEMPAREA$ = ""
  225. 8040 LOCATE 10,32
  226. 8042 vallen%=3
  227. 8045 errloc% = 12
  228. 8050 gosub 17000
  229. 8057 LOCATE errloc%,10:PRINT e$
  230. 8060 TEMPAREA$ = NUMBVAL$
  231.  
  232. 8065 Y%=24:X%=15
  233. 8070 LOCATE X%,Y%
  234. 8071 TEMPNMBR$ = ""
  235. 8072 VALLEN%=3
  236. 8075 ERRLOC%=17
  237. 8077 GOSUB 17000
  238. 8080 LOCATE errloc%,10:PRINT e$
  239. 8081 TEMPNMBRLFT$=NUMBVAL$
  240.  
  241. 8082 X%=15:Y%=30
  242. 8083 LOCATE X%,Y%
  243. 8084 VALLEN%=4
  244. 8085 ERRLOC%=17
  245. 8086 GOSUB 17000
  246. 8088 LOCATE errloc%,10:PRINT e$
  247. 8089 TEMPNMBRRHT$ = NUMBVAL$
  248. 8090 TEMPNMBR$ = TEMPNMBRLFT$ + TEMPNMBRRHT$
  249.  
  250. 8100 X%=20:Y%=32
  251. 8101 TEMPEXT$ = ""
  252. 8102 LOCATE X%,Y%
  253. 8103 VALLEN% = 4
  254. 8104 ERRLOC% = 22
  255. 8106 GOSUB 17000
  256. 8107 LOCATE errloc%,10:PRINT e$
  257. 8110 TEMPEXT$ = NUMBVAL$
  258. 8999 RETURN
  259.  
  260. 9000 '
  261. 9001 ' routine to fill in data on the entry screen for delete routine
  262. 9002 '
  263. 9010 LOCATE 5,44
  264. 9020 PRINT LEFT$(NOMBRE$,LEN(NOMBRE$))
  265. 9030 LOCATE 10,32
  266. 9040 PRINT AREA$
  267. 9050 LOCATE 15,24
  268. 9060 PRINT left$(NMBR$,3)
  269. 9062 locate 15,30
  270. 9065 print mid$(nmbr$,4,4)
  271. 9070 LOCATE 20,32
  272. 9080 PRINT EXTENTION$
  273. 9999 RETURN
  274.  
  275. 10000 '
  276. 10010 ' routines for network use
  277. 10020 '
  278.  
  279. 10100 '  This section contains the routine names and
  280. 10101 '  offsets for the BASNET library
  281. 10102 ' the return is after everything is set up for NetWare calls
  282.  
  283. 10110 XTNDOPN  =   0   'xtndopn(Mode%, Filename$, Handle%, ErrCode%)
  284. 10111 SETATTR  =   3   'setattr(Func%, Filename$, Attribute%, ErrCode%)
  285. 10112 EOJSTAT  =   6   'eojstat(Flag%)
  286. 10113 PRLH.LOG =   9   'PRLH.Log(FileHandle%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  287. 10114 PRLH.REL =  12   'PRLH.Rel(FileHandle%,HiByteOffset%,LoByteOffset%,ErrCode%)
  288. 10115 PRLH.CLR =  15   'PRLH.Clr(FileHandle%,HiByteOffset%,LoByteOffset%,Errcode%)
  289. 10116 PRLF.LOG =  18   'PRLF.Log(fcb%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  290. 10117 PRLF.REL =  21   'PRLF.Rel(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  291. 10118 PRLF.CLR =  24   'PRLF.Clr(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
  292. 10119 PRLS.LCK =  27   'PRLS.Lck(Flags%,TimeOut%,ErrCode%)
  293. 10120 PRLS.REL =  30   'PRLS.Rel(ErrCode%)
  294. 10121 PRLS.CLR =  33   'PRLS.Clr(ErrCode%)
  295. 10122 OPENSEM  =  36   'OpenSem(Sema4$,SemaValu%,HiHandle%,LoHandle%,OpenCnt%,RetCode%)
  296. 10123 EXAMSEM  =  39   'ExamSem(HiHandle%,LoHandle%,SemaValu%,OpenCnt%,RetCode%)
  297. 10124 WAITSEM  =  42   'WaitSem(HiHandle%,LoHandle%,TimeOut%,RetCode%)
  298. 10125 SIGSEM   =  45   'SigSem(HiHandle%,LoHandle%,RetCode%)
  299. 10126 CLOSSEM  =  48   'ClosSem(HiHandle%,LoHandle%,RetCode%)
  300. 10127 SETLCK   =  51   'setlck(Func%,Mode%)
  301. 10128 BAKOUTS  =  54   'Bakouts(Func%,RetCode%)
  302. 10129 BTRANS   =  57   'btran(ReturnCode%, Mode%)
  303. 10130 ETRANS   =  60   'etrans(ReturnCode%)
  304. 10131 EXCLOG   =  63   'exclog(ReturnCode%, FcbAddr)
  305. 10132 EXCLCKS  =  66   'exclcks(ReturnCode%, Mode%)
  306. 10133 EXCULKF  =  69   'exculkf(ReturnCode%, FcbAddr)
  307. 10134 EXCULKS  =  72   'exculks(ReturnCode%)
  308. 10135 EXCCLRF  =  75   'excclrf(ReturnCode%, FcbAddr)
  309. 10136 EXCCLRS  =  78   'excclrs(ReturnCode%)
  310. 10137 RECLOG   =  81   'reclog(ReturnCode%, String$)
  311. 10138 RECLCK   =  84   'reclck(ReturnCode%, Mode%)
  312. 10139 RECULK   =  87   'reculk(ReturnCode%, Semaphore$)
  313. 10140 RECULKS  =  90   'reculks(ReturnCode%)
  314. 10141 RECCLR   =  93   'recclr(ReturnCode%, Semaphore$)
  315. 10142 RECCLRS  =  96   'recclrs(ReturnCode%)
  316. 10143 EOJ      =  99   'eoj(ReturnCode%)
  317. 10144 SYSOUT   = 102   'sysout(ReturnCode%)
  318. 10145 ALLOCR   = 105   'allocr(ReturnCode%, Resource%)
  319. 10146 DALLOCR  = 108   'dallocr(ReturnCode%, Resource%)
  320. 10147 VOLSTAT  = 111   'volstat(volume%, reply$)
  321. 10148 LOCDRV   = 114   'locdrv(NumDisks%)
  322. 10149 WSID     = 117   'wsid(ThisStationNum%)
  323. 10150 ERRMODE  = 120   'errmode(mode%)
  324. 10151 BCSMODE  = 123   'bcsmode(mode%)
  325. 10152 CTLSPL   = 126   'ctlspl(mode%)
  326. 10153 SPLREQ   = 129   'splreq(ErrCode%, RequestBlock$, Reply$)
  327. 10154 PIPREQ   = 132   'pipreq(ErrCode%, RequestBlock$, Reply$)
  328. 10155 DPATH    = 135   'dpath(ReturnCode%, RequestBlock$, Reply$)
  329. 10156 SYSLOG   = 138   'syslog(ReturnCode%, RequestBlock$, Reply$)
  330. 10157 FATTR    = 141   'fattr(ReturnCode%, FcbAddr, Attribute%)
  331. 10158 UPDFCB   = 144   'updfcb(RetCode%,FcbAddr)
  332. 10159 CPYFILE  = 147   'cpyfile(ReturnCode%, FcbSource, FcbDest, CountLow, CountHigh)
  333. 10160 NETTOD   = 150   'nettod(time$)
  334. 10161 CLSMODE  = 153   'clsmode(mode%)
  335. 10162 DRVMAP   = 156   'drvmap(ReturnFlags%, drive%)
  336. 10163 RETSHL   = 159   'retshl(RetCode%, Mode%)
  337. 10164 ASCLOG   = 162   'asclog(RetCode%, Asciiz$)
  338. 10165 ASCULKF  = 165   'asculkf(RetCode%, Asciiz$)
  339. 10166 ASCCLRF  = 168   'ascclrf(RetCode%, Asciiz$)
  340. 10167 GETPSN   = 171   'Get_PSN(StationNo%)
  341. 10168 GETSTA   = 174   'Get_STA(Mode%,Segment%,Offset%)
  342. 10169 SETSERV  = 177   'SetServ(Mode%,NewServ%,CurrServ%)
  343. 10170 MODSERV  = 180   'ModServ(Mode%,NewServ%,RetCode%)
  344. 10180 GETDRV   = 183   'GetDrv(Drive%)
  345. 10200     '
  346. 10210     ' Assign the segment address for the library to the variable LibSeg
  347. 10220     '
  348. 10230     def seg = 0
  349. 10240     suboff = peek(&h4f0)+(256*peek(&h4f1))
  350. 10250     subseg = peek(&h4f2)+(256*peek(&h4f3))
  351. 10260     LibSeg = subseg
  352. 10270     def seg
  353. 10280     ' be sure the resident module is in place so we don't blow up
  354. 10290     if LibSeg = 0 or suboff <> 0 then print "*** The resident library must be loaded before running this program ***":end
  355. 10300     '
  356. 10310     ' set the error mode so its more informative
  357. 10320     def seg = LibSeg
  358. 10330     NewMode% = 1
  359. 10340     call errmode(NewMode%)
  360. 10350     def seg
  361.  
  362. 10500    '
  363. 10510    'set the lock mode
  364. 10520    '
  365. 10530 Func% = 1 'set to extended lock mode
  366. 10540 Mode% = 0 'we will get the current lock mode back here
  367. 10548 def seg = LibSeg
  368. 10550 call setlck(Func%,Mode%)
  369. 10555 def seg
  370. 10560 if Mode% <> 1 then print "Lock Mode not set. Press any key to continue. ";: while inkey$ = "": wend
  371. 10999 return
  372.  
  373.  
  374. 11000 ' do an extended open to get the file handle
  375. 11010    Filename$ = "FONE.DIR" + CHR$(0)
  376. 11020    Mode% = 66 'shareable, read/write
  377. 11030    FileHandle% = 0
  378. 11040    ErrCode% = 0
  379. 11045    def seg = LibSeg
  380. 11050    call xtndopn(Mode%, Filename$, FileHandle%, ErrCode%)
  381. 11055    def seg
  382. 11060    if ErrCode% <> 0 then print "Error on file open":stop
  383. 11999    return
  384.  
  385. 12000 ' this routine calculates the byte offset and sets the lock length
  386. 12010 ' for use with the physical record locks
  387. 12020 ' - enter the routine with recno% set to the record to be locked -
  388. 12030 ' the first record = 0
  389. 12040 OffSet# = RecNo% * 64
  390. 12050 FindHi# = OffSet#/65536
  391. 12060 HiOffSet% = FindHi#
  392. 12070 if HiOffSet% > FindHi# then HiOffSet% = HiOffSet% - 1
  393. 12080 LoOffSet% = (FindHi# - HiOffSet%) * 65536!
  394. 12090 HiOffSet$ = str$(HiOffSet%)
  395. 12100 LoOffSet$ = str$(LoOffSet%)
  396. 12110 HiLockLen$ = str$(0)
  397. 12120 LoLockLen$ = str$(48)
  398. 12999 return
  399.  
  400. 13000 '
  401. 13010 ' log and lock the record
  402. 13020 '
  403. 13022 recno% = recno% - 1 'set up recno so the first record is 0
  404. 13025 gosub 12000 ' set up the record data
  405. 13030 Flags% = 1 'set for a log and lock
  406. 13040 TimeOut% = 20
  407. 13050 ErrCode% = 0
  408. 13051 HiLockLen% = 0
  409. 13052 LoLockLen% = 48
  410. 13055 def seg = LibSeg
  411. 13060 call PRLH.Log(FileHandle%,HiOffSet%,LoOffSet%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
  412. 13065 def seg
  413. 13070 if ErrCode% <> 0 then print "*** Record not available. Error *** " ErrCode%
  414. 13080 if ErrCode% <> 0 then print "Press any key to continue ";:while inkey$ = "":wend
  415. 13090 recno% = recno% + 1 'set recno back to its entry value
  416. 13999 return
  417.  
  418. 14000 '
  419. 14010 ' clear the record lock
  420. 14020 '
  421. 14025 gosub 12000 ' set up the record data
  422. 14030 ErrCode% = 0
  423. 14035 def seg = LibSeg
  424. 14040 call PRLH.Clr(FileHandle%,HiOffset%,LoOffset%,ErrCode%)
  425. 14045 def seg
  426. 14999 return
  427.  
  428. 15000 '
  429. 15010 ' error routine
  430. 15020 '
  431. 15030 print "*** This record is in use ***"
  432. 15040 noerr = 1
  433. 15999 resume next
  434.  
  435. 16000 '
  436. 16010 ' error routine for header record
  437. 16020 '
  438. 16030 print "*** The header record is not available ***"
  439. 16040 print "Press any key to continue.";
  440. 16050 while inkey$ <> "": wend
  441. 16999 resume next
  442.  
  443. 17000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  444. 17001 ' Get, Print and Validate numeric data
  445. 17002 '
  446. 17003 NUMBVAL$ = ""
  447. 17005 vlid$ = ""
  448. 17017 locate x%,(y% + len(numbval$))
  449. 17020 while vlid$ = "" or vlid$ = " ":vlid$ = inkey$:wend
  450. 17025 if (vlid$ = chr$(13)) and (len(numbval$) = 0) then 17999
  451. 17030 locate x%,(y% + len(numbval$)):print vlid$
  452. 17035 locate errloc%,10:print using "&";e$
  453. 17100 if (asc(vlid$) > 47) and (asc(vlid$) < 58) then 17200
  454. 17140 locate errloc%,10:print "*** Your entry is not numeric...please re-enter ***"
  455. 17160 goto 17005
  456. 17200 numbval$ = numbval$ + vlid$
  457. 17310 if len(numbval$) = vallen% then 17999
  458. 17320 goto 17005
  459. 17999 return
  460.