home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / u_mind / skeleton.bas next >
Encoding:
BASIC Source File  |  1985-03-05  |  23.3 KB  |  342 lines
  1. 1 CLS:KEY OFF:AQ$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 !@#$%^&*()_-+={}[]:;'?/>.<,|\":IN=0:ON ERROR GOTO 49000:CURRENT=-1
  2. 100 GOSUB 50000:GOSUB 46000:STAT1$="A"
  3. 110 IF MAXSIZE=0 THEN GOTO 100 ELSE CURRENT=-1
  4. 500 REM ************************************************************
  5. 501 REM *** Main Menu Function         Process: Display choices, get choice
  6. 502 REM ***                                     then call appropriate routine
  7. 503 REM ************************************************************
  8. 505 IF CURRENT=-1 THEN C$=" NONE" ELSE C$=STR$(CURRENT)
  9. 510 CLS:LOCATE 1,1:A$="Current Record ="+C$:A1$="Number of entered records ="+STR$(GOOD):A2$="Maximum number of records ="+STR$(MAXSIZE):A3$="Current Data Disk Volume: "+V$
  10. 520 PRINT TAB(1);A$;TAB(80-LEN(A1$));A1$:LOCATE 2,1:PRINT TAB(40-(LEN(A2$)/2));A2$:LOCATE 3,1:PRINT TAB(40-LEN(A3$)/2);A3$
  11. 525 LOCATE 4,1:PRINT STRING$(79,"_");:LOCATE 19,1:PRINT STRING$(79,"_");
  12. 530 LOCATE 6,1:A$="---> Main Menu Choices <---":PRINT TAB(40-(LEN(A$)/2));A$
  13. 540 LOCATE 8,20:PRINT "G)et A Record.":LOCATE 9,20:PRINT "S)earch For And List Records."
  14. 550 LOCATE 10,20:PRINT"A)dd A Record.":LOCATE 11,20:PRINT"D)elete Current Record.":LOCATE 12,20:PRINT"U)pdate Current Record.":LOCATE 13,20:PRINT"X)-tend Work To New Data Diskette."
  15. 560 LOCATE 14,20:PRINT"I)nitialize New Data Diskette.":LOCATE 15,20:PRINT"Q)uit And Return To BASIC."
  16. 580 A$="Enter your choice (G,S,A,D,U,X,I, or Q):  ":LOCATE 18,1:PRINT TAB(40-(LEN(A$)/2));A$:ROW=18:COLUMN=((40-LEN(A$)/2)+LEN(A$)-1):A1%=1:AX$="GgSsAaDdUuXxIiQq":GOSUB 40130
  17. 590 IF AN$="" GOTO 580
  18. 600 IF AN$="Q" OR AN$="q" THEN CLOSE:GOSUB 50000:CLS:PRINT"Program Finished...":END
  19. 610 IF AN$="G" OR AN$="g" THEN GOSUB 680:GOSUB 39000:GOTO 500
  20. 620 IF AN$="S" OR AN$="s" THEN GOSUB 680:GOSUB 45000:GOTO 500
  21. 630 IF AN$="A" OR AN$="a" THEN GOSUB 41000:GOTO 500
  22. 640 IF AN$="D" OR AN$="d" THEN GOSUB 680:PAGE=0:GOSUB 2000:GOSUB 7000:GOSUB 42000:GOTO 500
  23. 650 IF AN$="U" OR AN$="u" THEN GOSUB 680:GOSUB 43000:GOTO 500
  24. 660 IF AN$="X" OR AN$="x" THEN GOSUB 680:GOSUB 46000:GOTO 500
  25. 670 IF AN$="I" OR AN$="i" THEN GOSUB 680:GOSUB 47000:GOTO 500
  26. 680 CLS:LOCATE 24,1:PRINT STRING$(79,"=");:RETURN
  27. 2000 REM ************************************************************
  28. 2001 REM *** Display Screen Info Routine    In: PAGE = page #
  29. 2002 REM ***                                        or
  30. 2003 REM ***                                    FL = field #
  31. 2004 REM ***                               Out: Screen info on that page is
  32. 2005 REM ***                                    displayed, then exit to
  33. 2006 REM ***                                    caller.
  34. 2007 REM ************************************************************
  35. 7000 REM ************************************************************
  36. 7001 REM *** Display Record Fields Routine  In: Page = page #
  37. 7002 REM ***                               Out: Working strings displayed,
  38. 7003 REM ***                                    then exit to caller
  39. 7004 REM ************************************************************
  40. 12000 REM ************************************************************
  41. 12001 REM *** Block Record Routine     In: Working strings filled
  42. 12002 REM ***                         Out: Record strings filled then exit
  43. 12003 REM ***                              to caller.
  44. 12004 REM ************************************************************
  45. 17000 REM ************************************************************
  46. 17001 REM *** Unblock Record Routine   In: Record strings filled
  47. 17002 REM ***                         Out: Working strings filled then
  48. 17003 REM ***                              exit to caller.
  49. 17004 REM ************************************************************
  50. 22000 REM ************************************************************
  51. 22001 REM *** Input A Field Routine    In: FL = field number to input
  52. 22002 REM ***                         Out: Working string filled after
  53. 22003 REM ***                              passing edit check, then exit
  54. 22004 REM ***                              to caller.
  55. 22005 REM ************************************************************
  56. 32000 REM ************************************************************
  57. 32001 REM *** Get a Record Routine      In: RECNUM = record number to get
  58. 32002 REM ***                          Out: Record strings filled (need to be
  59. 32003 REM ***                               unblocked.)
  60. 32004 REM ************************************************************
  61. 32010 GET 1,RECNUM:RETURN
  62. 33000 REM ************************************************************
  63. 33001 REM *** Hash Keyfield Routine    In: KY$ = Key field
  64. 33002 REM ***                         Out: RECNUM = Hashed record specifier
  65. 33003 REM ************************************************************
  66. 33010 X#=0:FOR ZZ=1 TO LEN(KY$):X#=X#+ZZ*ASC(MID$(KY$,ZZ,1)):NEXT ZZ
  67. 33020 X#=X#*X#*X#*X#:X$=STR$(X#):RECNUM=VAL(MID$(X$,5,4)):X#=0
  68. 33030 RECNUM=INT(MAXSIZE*RECNUM/9999):IF RECNUM<=0 THEN RECNUM=1
  69. 33040 RETURN
  70. 34000 REM ************************************************************
  71. 34001 REM Delete a record routine    IN: RECNUM = record number to delete
  72. 34002 REM                           OUT: Record is deleted
  73. 34003 REM                                CURRENT = -1
  74. 34004 REM ************************************************************
  75. 34010 GOOD=GOOD-1:STAT1$="D":GOSUB 12000:GOSUB 35000:CURRENT=-1:STAT1$="A":LSET STAT$=STAT1$:OPEN "O",#2,NA$+".def":GOOD=GOOD-1:PRINT#2,MAXSIZE,GOOD:CLOSE #2:RETURN
  76. 35000 REM ************************************************************
  77. 35001 REM *** Put a Record Routine     In: RECNUM = record number to put
  78. 35002 REM ***                              Record strings must be filled
  79. 35003 REM ***                         Out: CURRENT = Record number
  80. 35004 REM ***                              Record is writted to disk file
  81. 35005 REM ************************************************************
  82. 35010 PUT 1,RECNUM:CURRENT=RECNUM:OPEN "O",#2,NA$+".DEF":GOOD=GOOD+1:PRINT#2,MAXSIZE,GOOD:CLOSE #2:RETURN
  83. 36000 REM ************************************************************
  84. 36001 REM Error Response Routine   In:ERROR = 1,2,3, or 4
  85. 36002 REM                             ER$= error string if ER = 4
  86. 36003 REM                         OUT: Error message is printed, waits
  87. 36004 REM                              For 'c' or 'C' keypress, then
  88. 36005 REM                              exits to caller
  89. 36006 REM ************************************************************
  90. 36010 LOCATE 25,1:PRINT STRING$(79,32);:A$=" ERROR! ":P=40-LEN(A$)/2
  91. 36020 BEEP:ON ER GOTO 36030,36040,36050,36060
  92. 36030 B$="Record Not Found... Press <C> to Continue":GOTO 36070
  93. 36040 B$="Data Diskette Is Full... Press <C> to Continue":GOTO 36070
  94. 36050 B$="No Current Record In Memory... Press <C> to Continue":GOTO 36070
  95. 36060 B$="Entry Must Not Be "+ER$+"... Press <C> to Continue"
  96. 36070 LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,40-LEN(B$)/2:PRINT B$;
  97. 36080 LOCATE 24,P:PRINT A$;:CT=1
  98. 36090 Z$=INKEY$:IF Z$="C" OR Z$="c" GOTO 36150
  99. 36100 CT=CT+1:IF CT=4 THEN CT=1
  100. 36110 IF CT=1 THEN LOCATE 24,1:PRINT STRING$(35,"/");:LOCATE 24,44:PRINT STRING$(36,"/");:GOTO 36090
  101. 36120 IF CT=2 THEN LOCATE 24,1:PRINT STRING$(35,"-");:LOCATE 24,44:PRINT STRING$(36,"-");:GOTO 36090
  102. 36130 IF CT=3 THEN LOCATE 24,1:PRINT STRING$(35,"\");:LOCATE 24,44:PRINT STRING$(36,"\");:GOTO 36090
  103. 36140 LOCATE 24,1:PRINT STRING$(79,"=");:LOCATE 25,1:PRINT STRING$(79,32);:RETURN
  104. 36150 LOCATE 24,1:PRINT STRING$(79,"=");:LOCATE 25,1:PRINT STRING$(79,32);:RETURN
  105. 37000 REM ************************************************************
  106. 37001 REM *** Submenu #1 Function    Process: Display choices M)enu, U)pdate,
  107. 37002 REM ***                                 D)elete, A)dd, and S)witch
  108. 37003 REM ***                                 page.  Get choice and
  109. 37004 REM ***                                 Branch to appropriate function
  110. 37005 REM ************************************************************
  111. 37010 LOCATE 25,1:PRINT STRING$(79,32);:A$="Enter choice: M)enu, U)pdate, D)elete, A)dd, S)witch page: ":LOCATE 25,1:PRINT A$;
  112. 37020 ROW=25:COLUMN=LEN(A$)+2:AX$="MmUuDdAaSs":A1%=1:GOSUB 40130:IF AN$="" GOTO 37010
  113. 37030 IF AN$="M" OR AN$="m" THEN RETURN
  114. 37040 IF AN$="U" OR AN$="u" GOTO 43000
  115. 37050 IF AN$="D" OR AN$="d" GOTO 42000
  116. 37070 IF AN$="A" OR AN$="a" GOTO 41000
  117. 37080 PAGE=PAGE+1:IF PAGE>ND THEN PAGE=1
  118. 37090 CLS:FL=0:GOSUB 2000:GOSUB 7000:GOTO 37000
  119. 38000 REM ************************************************************
  120. 38001 REM *** Submenu #2 Function      Process: Ask for R)estore, S)witch
  121. 38002 REM ***                                   Page, or M)enu and
  122. 38003 REM ***                                   Branch to appropriate function
  123. 38004 REM ************************************************************
  124. 38010 LOCATE 25,1:PRINT STRING$(79,32);:A$="Please choose: R)estore, S)witch page, or M)enu ":LOCATE 25,1:PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:A1%=1:AX$="RrSsMm":GOSUB 40130
  125. 38020 TEST$=AN$:IF AN$="" GOTO 38010
  126. 38030 IF TEST$="M" OR TEST$="m" THEN CURRENT=-1:RETURN
  127. 38040 IF TEST$="P" OR TEST$="p" THEN GOSUB 36000:GOTO 38010
  128. 38050 IF TEST$<>"s" AND TEST$<>"S" GOTO 38100
  129. 38060 PAGE=PAGE+1:IF PAGE>ND THEN PAGE=1
  130. 38070 CLS:FL=0:GOSUB 2000:GOSUB 7000:GOTO 38010
  131. 38100 STAT1$="A":GOSUB 12000:GOSUB 35000:CURRENT=RECNUM:GOTO 37000
  132. 39000 REM ************************************************************
  133. 39001 REM *** Get a Record         Process: Accepts key field, searches
  134. 39002 REM ***                               for record, if found, displays
  135. 39003 REM ***                               it and verifies that its the
  136. 39004 REM ***                               right one.  If not, continue
  137. 39005 REM ***                               search until error.  Otherwise,
  138. 39006 REM ***                               display the record and branch
  139. 39007 REM ***                               to Submenu #1 Function
  140. 39008 REM ************************************************************
  141. 39010 PAGE=1:FL=0:GOSUB 2000:FL=1:GOSUB 22000:KY$=F$(1):GOSUB 33000
  142. 39020 CURRENT=RECNUM
  143. 39030 GOSUB 32000:IF STAT$="E" THEN ER=1:CURRENT=-1:GOTO 36000
  144. 39040 IF STAT$="D" GOTO 39200
  145. 39050 GOSUB 17000:IF KY$<>LEFT$(F$(1),LEN(KY$)) GOTO 39200
  146. 39060 GOSUB 7000:LOCATE 25,1:PRINT STRING$(79,32);:A$="Is this it (Y/N)? ":LOCATE 25,1:PRINT A$;
  147. 39070 ROW=25:COLUMN=LEN(A$)+2:AX$="YyNn":A1%=1:GOSUB 40130:IF AN$="" GOTO 39060
  148. 39080 IF AN$="y" OR AN$="Y" THEN CURRENT=RECNUM:GOTO 37000
  149. 39200 RECNUM=RECNUM+1:IF RECNUM>MAXSIZE THEN RECNUM=1
  150. 39210 IF RECNUM=CURRENT THEN ER=1:CURRENT=-1:GOTO 36000
  151. 39220 GOTO 39030
  152. 40127 REM ************************************************************
  153. 40128 REM *** Alphanumeric Input routine   IN: ROW,COLUMN, A1%,ax$  OUT: AN$
  154. 40129 REM ************************************************************
  155. 40130 AN$="":A%=0:LOCATE ROW,COLUMN,0,1,20:PRINT STRING$(A1%,CHR$(22));
  156. 40131 IF A%=A1% THEN 40134 ELSE LOCATE ROW,COLUMN+A%,0,1,20:PRINT CHR$(22);
  157. 40132 A$=INKEY$:IF A$="" THEN 40132 ELSE IF INSTR(AX$,A$) THEN AN$=AN$+A$:LOCATE ROW,COLUMN+A%,0,1,20:PRINT A$;:A%=A%+1:GOTO 40131
  158. 40133 ON INSTR(CHR$(8)+CHR$(13),A$) GOTO 40135,40138:GOTO 40131
  159. 40134 A$=INKEY$:IF A$="" THEN 40134 ELSE 40133
  160. 40135 IF A%<A1% THEN LOCATE ROW,COLUMN+A%,0,1,20:PRINT CHR$(22);
  161. 40136 A%=A%-1:IF A%<0 THEN A%=0:GOTO 40131:ELSE AN$=LEFT$(AN$,LEN(AN$)-1):GOTO 40131
  162. 40138 LOCATE ROW,COLUMN+A%,0,1,20:PRINT STRING$(A1%-A%," ");
  163. 40139 RETURN
  164. 40147 REM ************************************************************
  165. 40148 REM ***  FORMATTED NUMERIC INPUT  IN:ROW,COLUMN,AF$   OUT: AN$
  166. 40149 REM ************************************************************
  167. 40150 GOSUB 40200:PV=LEN(AF$)-1:R1=ROW:C1=COLUMN:AN$="":A%=0:LOCATE ROW,COLUMN:PRINT AF$;:A1%=LEN(AF$)
  168. 40151 IF A%=>LEN(AF$) THEN 40156 ELSE A%=INSTR(A%+1,AF$,CHR$(22)):LOCATE ROW,COLUMN+A%-1
  169. 40152 A$=INKEY$:IF A$=""THEN 40152 ELSE IF INSTR("1234567890",A$) THEN PRINT A$;:GOTO 40151
  170. 40153 ON INSTR(CHR$(8)+CHR$(13),A$) GOTO 40150, 40159
  171. 40154 GOTO 40151
  172. 40156 A$=INKEY$:IF A$="" THEN 40156 ELSE 40153
  173. 40159 AN$="":FOR Z=C1 TO C1+PV:AN$=AN$+CHR$(SCREEN(R1,Z)):NEXT Z:RETURN
  174. 40200 FOR Z=1 TO LEN(AF$):IF MID$(AF$,Z,1)="/" THEN MID$(AF$,Z,1)=CHR$(22)
  175. 40210 NEXT Z:RETURN
  176. 41000 REM ************************************************************
  177. 41001 REM *** Add A Record Function       Process: Fill input strings
  178. 41002 REM ***                                      write it disk, then
  179. 41003 REM ***                                      exit to caller on
  180. 41004 REM ***                                      error, or to submenu #1
  181. 41005 REM ************************************************************
  182. 41020 STAT1$="A":LSET STAT$=STAT1$:PAGE=0:FOR A=1 TO NF:FL=A:GOSUB 2000:GOSUB 22000:NEXT A
  183. 41030 LOCATE 25,1:PRINT STRING$(79,32);:A$="Press <Y> to add record or <N> to abort":LOCATE 25,1:PRINT A$;
  184. 41040 ROW=25:COLUMN=LEN(A$)+2:AX$="YyNn":A1%=1:GOSUB 40130:IF AN$="N" OR AN$="n"THEN CURRENT=-1:RETURN
  185. 41045 IF AN$="" GOTO 41030
  186. 41050 KY$=F$(1):GOSUB 33000
  187. 41060 GOSUB 32000:IF STAT$="A" GOTO 41100
  188. 41070 GOSUB 12000:GOSUB 35000:CURRENT=RECNUM:GOTO 37000
  189. 41100 RECNUM=RECNUM+1:IF RECNUM>MAXSIZE THEN RECNUM=1
  190. 41110 IF RECNUM=CURRENT THEN ER=2:GOTO 36000
  191. 41120 GOTO 41060
  192. 42000 REM ************************************************************
  193. 42001 REM *** Delete Current Record Function   Process: Verify delete
  194. 42002 REM ***                                           then erase it from
  195. 42003 REM ***                                           from view by marking
  196. 42004 REM ***                                           Stat$ as "D"
  197. 42005 REM ************************************************************
  198. 42007 IF CURRENT=-1 THEN ER=3:GOTO 36000
  199. 42010 LOCATE 25,1:PRINT STRING$(79,32);:A$="Press <Y> to delete this record or <N> to abort.":LOCATE 25,1:PRINT A$;
  200. 42020 ROW=25:COLUMN=LEN(A$)+2:AX$="YyNn":A1%=1:GOSUB 40130:IF AN$="N" OR AN$="n" THEN LOCATE 25,1:PRINT STRING$(79,32);:RETURN
  201. 42025 IF AN$="" GOTO 42010
  202. 42040 RECNUM=CURRENT:GOTO 34000
  203. 43000 REM ************************************************************
  204. 43001 REM *** Update Current Record Function   Process: Allow modifications
  205. 43002 REM ***                                           to specified fields,
  206. 43003 REM ***                                           make changes to record,
  207. 43004 REM ***                                           then exit to caller.
  208. 43005 REM ************************************************************
  209. 43010 STAT1$="A":LSET STAT$=STAT1$:KY=0:IF CURRENT=-1 THEN ER=3:GOTO 36000
  210. 43020 LOCATE 25,1:PRINT STRING$(79,32);:A$="Enter field number to modify "
  211. 43030 LOCATE 25,1:PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:AX$="0123456789":A1%=LEN(STR$(NF))-1:GOSUB 40130:FL=VAL(AN$):IF FL=0 THEN LOCATE 25,1:PRINT STRING$(79,32);:RETURN
  212. 43035 IF AN$="" GOTO 43020
  213. 43040 IF FL>NF GOTO 43020
  214. 43050 PAGE=0:GOSUB 2000:GOSUB 7000:GOSUB 22000:IF FL=1 THEN KY=1
  215. 43060 LOCATE 25,1:PRINT STRING$(79,32);:A$="Any more changes (Y/N)? ":LOCATE 25,1:PRINT A$;
  216. 43070 ROW=25:COLUMN=LEN(A$)+2:AX$="YyNn":A1%=1:GOSUB 40130:IF AN$="Y" OR AN$="y" GOTO 43020
  217. 43075 IF AN$="" GOTO 43060
  218. 43080 IF KY=1 GOTO 43100 ELSE RECNUM=CURRENT:GOOD=GOOD-1:GOSUB 12000:GOSUB 35000:GOTO 37000
  219. 43100 RECNUM=CURRENT:GOSUB 34000:KY$=F$(1):GOSUB 33000:CURRENT=RECNUM
  220. 43110 GOTO 41060
  221. 45000 REM ************************************************************
  222. 45001 REM *** Search and List Function     Process: Look for records matching
  223. 45002 REM ***                                       any specified parameters
  224. 45003 REM ***                                       and display them
  225. 45004 REM ************************************************************
  226. 45010 LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,1:A$="Enter record # to start search or <ENTER> to start at current record ":PRINT A$;
  227. 45020 ROW=25:COLUMN=LEN(A$)+2:A1%=LEN(STR$(MAXSIZE)):AX$="0123456789":GOSUB 40130:RECNUM=VAL(AN$)
  228. 45030 IF RECNUM<>0 GOTO 45050 ELSE IF CURRENT=-1 THEN RECNUM=1:GOTO 45060
  229. 45040 RECNUM=CURRENT:GOTO 45060
  230. 45050 IF RECNUM>MAXSIZE THEN RECNUM=1
  231. 45060 LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,1:A$="Do you wish to display records that have been deleted (Y/N)? ":PRINT A$;
  232. 45070 ROW=25:COLUMN=LEN(A$)+2:AX$="YyNn":A1%=1:GOSUB 40130:IF AN$="" GOTO 45060
  233. 45080 DEL$=AN$
  234. 45090 LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,1:A$="Do you wish to select by a field's contents (Y/N)? ":PRINT A$;
  235. 45100 ROW=25:COLUMN=LEN(A$)+2:AX$="YyNn":A1%=1:GOSUB 40130:IF AN$="" GOTO 45090
  236. 45110 TEST$=AN$:IF TEST$="N" OR TEST$="n" GOTO 45200 ELSE LOCATE 25,1:PRINT STRING$(79,32);
  237. 45120 LOCATE 25,1:A$="Enter field number to test ":PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:AX$="0123456789":A1%=LEN(STR$(NF)):GOSUB 40130:IF AN$="" GOTO 45120 ELSE FL=VAL(AN$):PAGE=0:GOSUB 2000
  238. 45130 LOCATE 25,1:PRINT STRING$(79,32);:A$="Enter test string":LOCATE 25,1:PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:AX$=AQ$:A1%=35:GOSUB 40130:IF AN$="" GOTO 45130
  239. 45140 COMPARE$=RIGHT$(AN$,LEN(AN$)-1):TYPE$=LEFT$(AN$,1):IF TYPE$<>"<" AND TYPE$<>">" AND TYPE$<>"=" GOTO 45130
  240. 45200 GOSUB 32000:IF STAT$="E" GOTO 45300
  241. 45210 IF STAT$<>"D" GOTO 45220
  242. 45215 IF DEL$="N" OR DEL$="n" GOTO 45300
  243. 45220 IF TEST$="Y" OR TEST$="y" GOTO 45400
  244. 45230 GOSUB 17000:PAGE=1:FL=0:GOSUB 2000:GOSUB 7000:LOCATE 25,1:PRINT STRING$(79,32);:IF STAT$="A" THEN S$="Active" ELSE S$="Deleted"
  245. 45240 A$="Status: "+S$+": Continue search (Y/N)":LOCATE 25,1:PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:A1%=1:AX$="YyNn":GOSUB 40130:IF AN$="Y" OR AN$="y" GOTO 45300
  246. 45250 IF AN$="" GOTO 45240 ELSE IF STAT$="D" GOTO 38000
  247. 45260 CURRENT=RECNUM:GOTO 37000
  248. 45300 RECNUM=RECNUM+1:IF RECNUM>MAXSIZE THEN CURRENT=-1:RETURN
  249. 45310 GOTO 45200
  250. 45400 GOSUB 17000:IF TYPE$<>"<" GOTO 45500
  251. 45410 IF LEFT$(F$(FL),LEN(COMPARE$))=COMPARE$ GOTO 45230
  252. 45420 GOTO 45300
  253. 45500 IF TYPE$<>">" GOTO 45600
  254. 45510 FOR A=1 TO LEN(F$(FL))-LEN(COMPARE$)
  255. 45520 IF MID$(F$(FL),A,LEN(COMPARE$))=COMPARE$ GOTO 45230
  256. 45530 NEXT A:GOTO 45300
  257. 45600 IF F$(FL)=COMPARE$ GOTO 45230
  258. 45610 GOTO 45300
  259. 46000 REM ************************************************************
  260. 46001 REM *** X-tend Work To New Disk Function  Process: Prompt for new
  261. 46002 REM ***                                            data disk mount, then
  262. 46003 REM ***                                            read in MAXSIZE from
  263. 46004 REM ***                                            .DEF file and return
  264. 46005 REM ***                                            to caller
  265. 46006 REM ************************************************************
  266. 46010 CURRENT=-1:LOCATE 25,1:PRINT STRING$(79,32);:A$="Mount data disk in drive "+LEFT$(NA$,1)+", then press <C> to continue":LOCATE 25,1:PRINT A$;
  267. 46020 ROW=25:COLUMN=LEN(A$)+2:AX$="Cc":A1%=1:GOSUB 40130:IF AN$="" GOTO 46010
  268. 46030 IN=2:OPEN "I",#2,NA$+".DEF":INPUT#2,MAXSIZE,GOOD:CLOSE:OPEN "i",1,NA$+".vol":INPUT#1,V$:CLOSE:OPEN "r",1,NA$+".DAT",SIZE:IN=0:RETURN
  269. 46100 IN=0:LOCATE 25,1:PRINT STRING$(79,32);:GOSUB 47000:GOTO 46000
  270. 47000 REM ************************************************************
  271. 47001 REM *** Initialize New Data Disk Function  Process: Write records to data
  272. 47002 REM ***                                             disk until error
  273. 47003 REM ***                                             occurs.  Error
  274. 47004 REM ***                                             routine will then
  275. 47005 REM ***                                             branch back to line
  276. 47006 REM ***                                             47500 where ".DEF"
  277. 47007 REM ***                                             file is written.
  278. 47008 REM ************************************************************
  279. 47010 CLOSE:CURRENT=-1:IN=1:LOCATE 25,1:PRINT STRING$(79,32);:A$="S)pecify number of records, or U)se all available disk space? ":LOCATE 25,1:PRINT A$;
  280. 47020 ROW=25:COLUMN=LEN(A$)+2:AX$="SsUu":A1%=1:GOSUB 40130:IF AN$="" GOTO 47020
  281. 47030 IF AN$="U" OR AN$="u" GOTO 47100 ELSE LOCATE 25,1:PRINT STRING$(79,32);:A$="How many data records?":LOCATE 25,1:PRINT A$;
  282. 47040 ROW=25:COLUMN=LEN(A$)+2:AX$="0123456789":A1%=6:GOSUB 40130:NU=VAL(AN$):IF AN$="" OR NU=0 GOTO 47030
  283. 47050 GOTO 47110
  284. 47060 LOCATE 25,1:PRINT STRING$(79,32);:LOCATE 25,1:A$="Enter volume name:":PRINT A$;:ROW=25:COLUMN=LEN(A$)+2:AX$=AQ$:A1%=25:GOSUB 40130:V$=AN$:IF AN$="" GOTO 47060
  285. 47070 OPEN "o",1,NA$+".VOL":PRINT#1,V$:CLOSE:RETURN
  286. 47100 NU=-1
  287. 47110 GOSUB 47060:OPEN "o",2,NA$+".DEF":PRINT#2,100000!,100000!:CLOSE
  288. 47120 OPEN "R",#1,NA$+".DAT",SIZE
  289. 47125 STAT1$="E":FOR Z=1 TO NF:F$(Z)=STRING$(80,32):NEXT Z:GOSUB 12000
  290. 47140 CT=1
  291. 47150 LOCATE 25,1:PRINT STRING$(79,32);
  292. 47160 A$="Stand by... Initializing record #":LOCATE 25,1:PRINT A$;
  293. 47200 LOCATE 25,LEN(A$)+1:PRINT CT;:PUT 1,CT
  294. 47210 CT=CT+1:IF NU=-1 GOTO 47200 ELSE NU=NU-1
  295. 47220 IF NU=0 GOTO 47500 ELSE GOTO 47200
  296. 47500 CLOSE:CT=CT-1:OPEN "O",#2,NA$+".DEF":PRINT#2,CT,0:CLOSE #2
  297. 47510 IN=0:LOCATE 25,1:PRINT STRING$(79,32);:RETURN
  298. 49000 REM ************************************************************
  299. 49001 REM *** BASIC Error Handler         Process: This is really only set
  300. 49002 REM ***                                      up to handle the DISK
  301. 49003 REM ***                                      SPACE full error when
  302. 49004 REM ***                                      initializing a new data
  303. 49005 REM ***                                      disk indicated by variable
  304. 49006 REM ***                                      IN = 1.  Otherwise ERROR
  305. 49007 REM ***                                      code is reported, files are
  306. 49008 REM ***                                      closed, and program ends.
  307. 49009 REM ************************************************************
  308. 49010 IF IN=0 GOTO 49100
  309. 49020 IF IN=1 AND ERR=61 THEN RESUME 47500
  310. 49030 IF IN=2 AND ERR=53 THEN RESUME 46100
  311. 49100 CLS:RESET:PRINT "Internal ERROR #";ERR;" in line #";ERL:PRINT"Consult BASIC manual appendix A for explanation.":END
  312. 50000 REM ************************************************************
  313. 50001 REM *** Program Title Display Function     Process: Used to display
  314. 50002 REM ***                                             program title and
  315. 50003 REM ***   Display idea credit to:                   author at beginning
  316. 50004 REM ***      John Vandergrift                       and end of program
  317. 50005 REM ***                                             execution.
  318. 50006 REM ************************************************************
  319. 50010 BEEP:CLS:A$=TI$:A1$="B":A2$="Y":A3$=AU$:C=10
  320. 50020 GOSUB 50060
  321. 50030 A$=STRING$(LEN(A$)," "):A1$=" ":A2$=" ":A3$=STRING$(LEN(A3$)," "):C=9
  322. 50040 GOSUB 50060
  323. 50050 FOR Z=1 TO 2000:NEXT Z:RETURN
  324. 50060 FOR I=1 TO C
  325. 50070 LOCATE I,40-LEN(A$)/2:PRINT A$;
  326. 50080 LOCATE 12,4*I:PRINT A1$;
  327. 50090 LOCATE 12,81-(4*I):PRINT A2$;
  328. 50100 LOCATE 24-I,41-(LEN(A3$)/2):PRINT A3$;
  329. 50110 NEXT I
  330. 50120 RETURN
  331. 60000 REM *** Do not remove lines 60000 through 60009!
  332. 60001 REM *** This program SKELETON.BAS is to be used with the Ultra-Mind
  333. 60002 REM *** intelligent database program generator.  It is copyright, (C),
  334. 60003 REM *** 1983, by The FreeSoft Company, P.O. Box 27608, St. Louis, MO
  335. 60004 REM *** 63146.  For copies of this and the other Ultra-Utility programs,
  336. 60005 REM *** send 2 double sided or 4 single sided diskettes and a postage
  337. 60006 REM *** paid self addressed return mailer to the address above.  Specify
  338. 60007 REM *** that you want LIBRARIES #1 and #2.  The Ultra-Utilities include
  339. 60008 REM *** Ultra-Zap, Ultra-Format, Ultra-File, Ultra-Optimize, and
  340. 60009 REM *** Ultra-Mind.  Lines 60000 through 60009 all be removed from all
  341. 60010 REM *** programs generated by Ultra-Mind.
  342. 60009 REM *** Ul