home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / DOS_HELP / DBDOS.ZIP / DBDOSREP.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-09-24  |  24.1 KB  |  500 lines
  1.  19 WIDTH "LPT1:", 132
  2.  20 REM  
  3.  25 REM  
  4.  110  V1$= "C:DBDOS.DAT": REM .. MASTER FILE NAME ...
  5.  112  V2$= "C:DBDOS.ISI":REM .. KEY FILE NAME ...
  6.  117 KL% =  15 : REM .....  KEY LENGTH ....
  7.  118  T =  17 : REM ... TOTAL NUMBER OF FIELDS 
  8.  119 DIM F$(T), F#(T), CX(T), CY(T), FL(T), TY$(T), K(T), KL(T), FIELDBUFFER$(T), T#(T)
  9.  180  BLANK$= STRING$(79,32): HOME$ = CHR$( 11): BOTT$ = HOME$+STRING$(0, 28)+STRING$( 22, 31):PL= 33 : FF$ = CHR$(12)
  10.  181 CL$=CHR$( 11)+CHR$( 12)+CHR$( 11):RC= 28 :DC= 31 :RB$=CHR$(32)+CHR$(29):SB$=CHR$(219)+CHR$(29):BS$=CHR$(29)+CHR$(32)+CHR$(29):HE$=""
  11.  182 FF$=CHR$(12)
  12.  195 PN$ = "C:DBDOSREP"
  13.  120 fl( 1 )= 37 :cx( 1 )= 34 :cy( 1 )= 3 :ty$( 1 )="A"
  14.  121 fl( 2 )= 15 :cx( 2 )= 4 :cy( 2 )= 4 :ty$( 2 )="A"
  15.  122 fl( 3 )= 46 :cx( 3 )= 25 :cy( 3 )= 4 :ty$( 3 )="A"
  16.  123 fl( 4 )= 46 :cx( 4 )= 25 :cy( 4 )= 5 :ty$( 4 )="A"
  17.  124 fl( 5 )= 8 :cx( 5 )= 25 :cy( 5 )= 6 :ty$( 5 )="A"
  18.  125 fl( 6 )= 58 :cx( 6 )= 11 :cy( 6 )= 8 :ty$( 6 )="A"
  19.  126 fl( 7 )= 67 :cx( 7 )= 4 :cy( 7 )= 9 :ty$( 7 )="A"
  20.  127 fl( 8 )= 67 :cx( 8 )= 4 :cy( 8 )= 10 :ty$( 8 )="A"
  21.  128 fl( 9 )= 67 :cx( 9 )= 4 :cy( 9 )= 11 :ty$( 9 )="A"
  22.  129 fl( 10 )= 67 :cx( 10 )= 4 :cy( 10 )= 12 :ty$( 10 )="A"
  23.  130 fl( 11 )= 67 :cx( 11 )= 4 :cy( 11 )= 13 :ty$( 11 )="A"
  24.  131 fl( 12 )= 67 :cx( 12 )= 4 :cy( 12 )= 14 :ty$( 12 )="A"
  25.  132 fl( 13 )= 67 :cx( 13 )= 4 :cy( 13 )= 15 :ty$( 13 )="A"
  26.  133 fl( 14 )= 67 :cx( 14 )= 4 :cy( 14 )= 16 :ty$( 14 )="A"
  27.  134 fl( 15 )= 61 :cx( 15 )= 10 :cy( 15 )= 18 :ty$( 15 )="A"
  28.  135 fl( 16 )= 67 :cx( 16 )= 4 :cy( 16 )= 19 :ty$( 16 )="A"
  29.  136 fl( 17 )= 67 :cx( 17 )= 4 :cy( 17 )= 20 :ty$( 17 )="A"
  30.  701 PRINT CL$;
  31.  702 PRINT "                              D B    D O S"
  32.  703 PRINT "                     MS-DOS QUICK REFERENCE DATA BASE"
  33.  704 PRINT "╔═══════════════════════════════════════════════════════════════════════╗"
  34.  705 PRINT "║  ┌───────────────┐     Purpose: ===================================== ║"
  35.  706 PRINT "║  │===============│█    ============================================== ║"
  36.  707 PRINT "║  └───────────────┘█    ============================================== ║"
  37.  708 PRINT "║  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀    ========                                     ╔═╝"
  38.  709 PRINT "║ ───────────────                                                     ║"
  39.  710 PRINT "║  Syntax: ========================================================== ╚═╗"
  40.  711 PRINT "║   =================================================================== ║"
  41.  712 PRINT "║   =================================================================== ║"
  42.  713 PRINT "║   =================================================================== ║"
  43.  714 PRINT "║   =================================================================== ║"
  44.  715 PRINT "║   =================================================================== ║"
  45.  716 PRINT "║   =================================================================== ║"
  46.  717 PRINT "║   =================================================================== ║"
  47.  718 PRINT "║   =================================================================== ║"
  48.  719 PRINT "║ ────────────────                                                      ║"
  49.  720 PRINT "║  Notes: ============================================================= ║"
  50.  721 PRINT "║   =================================================================== ║"
  51.  722 PRINT "║   =================================================================== ║"
  52.  723 PRINT "╚═══════════════════════════════════════════════════════════════════════╝"
  53.  15060 FL =  15 
  54.  15065 PRINT BOTT$;BLANK$;BOTT$ "Enter the key to get...";:PRINT FN CRT$( 4 , 4 );STRING$(FL,46);FN CRT$( 4 , 4 );"";
  55.  15070 TY$ = "A"
  56.  15100 HELP = 6: GOSUB 21000
  57.  15110 IF LEN(T$)=0 THEN 4000:'RETURN TO MAINLINE IF NULL ENTRY 
  58.  15200 K$=T$+STRING$(KL-LEN(T$),32):'PAD ENTRY & SET TO SEARCH KEY
  59.  15211 ' Execute inquiry after reading map file
  60.  15220 GOSUB 62500:GOSUB 62000
  61.  15230 IF Found THEN GET 1,I ELSE GOTO 700
  62.  113  V3$= "C:DBDOS.MAP": REM .. MAP FILE NAME ..
  63.  15390 REM . . . SUBDIVIDE & PRINT RECORD . . . 
  64.  17500 'PRINT RECORD
  65.  17502  LPRINT "COMMAND: "F$(2)
  66.  17504 LPRINT STRING$(1,10);
  67.  17506  LPRINT "PURPOSE: "F$(1)
  68.  17508  LPRINT "         "F$(3)
  69.  17510  LPRINT "         "F$(4)
  70.  17512 LPRINT STRING$(1,10);
  71.  17514  LPRINT "TYPE:    "F$(5)
  72.  17516 LPRINT STRING$(1,10);
  73.  17518  LPRINT "SYNTAX:  "F$(6)
  74.  17520  LPRINT ""F$(7)
  75.  17522  LPRINT ""F$(8)
  76.  17524  LPRINT ""F$(9)
  77.  17526  LPRINT ""F$(10)
  78.  17528  LPRINT ""F$(11)
  79.  17530  LPRINT ""F$(12)
  80.  17532  LPRINT ""F$(13)
  81.  17534  LPRINT ""F$(14)
  82.  17536 LPRINT STRING$(1,10);
  83.  17538  LPRINT "NOTES:   "F$(15)
  84.  17540  LPRINT ""F$(16)
  85.  17542  LPRINT ""F$(17)
  86.  17544  LPRINT "==========================================================================="
  87.  17546  LPRINT STRING$(11,10);
  88.  28000 LPRINT FF$:PG=0:RETURN
  89.  25003 RETURN
  90.  50  REM . . . . --->  This program is  C:DBDOSREP.BAS <----- 
  91. 10 CLEAR 5000: DEFINT A-Z: DIM X, Y, Z: KEY OFF: KEY 1, CHR$(27)
  92. 11 STARTUP = 1
  93. 12 GOSUB 61000
  94. 13 DIM MEMLINK$(BUS)
  95. 15 ON ERROR GOTO 53000
  96. 30 CR$ = "\│/─": BK$ = " "
  97. 182 '........ CALCULATE RECORD & KEY LENGTHS
  98. 183 FOR X = 1 TO T: IF TY$(X) <> "Z" THEN RL% = RL% + FL(X)
  99. 184 IF K(X) = 1 THEN KL(X) = FL(X)
  100. 185 NEXT X
  101. 186 DEF FNCRT$ (E1, E2) = HOME$ + STRING$(E2, DC) + STRING$(E1, RC)
  102. 190 D$ = CHR$(94) + STRING$(KL%, 32)
  103. 210 CLOSE FILNUM: OPEN "R", FILNUM, V1$, RL%' Open and Field Master File
  104. 211 FOR X = 1 TO 8: BT(X) = 0: NEXT X: BUF = 0
  105. 212 BBT = 1: FOR X = 1 TO T: IF TY$(X) = "Z" THEN 216 ELSE BUF = BUF + 1
  106. 213 IF FL(X) + BT(BBT) > 255 THEN BBT = BBT + 1
  107. 214 FIELD #FILNUM, BT(1) AS D$(1), BT(2) AS D$(2), BT(3) AS D$(3), BT(4) AS D$(4), BT(5) AS D$(5), BT(6) AS D$(6), BT(7) AS D$(7), FL(X) AS F$(X)
  108. 215 BT(BBT) = BT(BBT) + FL(X)
  109. 216 NEXT X
  110. 217 FIELD #FILNUM, BT(1) AS D$(1), BT(2) AS D$(2), BT(3) AS D$(3), BT(4) AS D$(4), BT(5) AS D$(5), BT(6) AS D$(6), BT(7) AS D$(7), BT(8) AS D$(8)
  111. 218 '...................................
  112. 219 RETURN
  113. 298 GOSUB 61000:  'Init BTREE
  114. 299 GOSUB 61500:  'Open MAP & ISI
  115. 699 '
  116. 700 '             Screen Print
  117. 4000 '  Begin Main Line
  118. 4001 IF STARTUP THEN HELP = 1: GOSUB 41000: STARTUP = 0
  119. 4003 UPDTE$ = ""
  120. 4004 FOR X = 1 TO T: T#(X) = 0: NEXT X: '  Clear Field
  121. 4005 COLOR 15, 4: LOCATE 25, 1: PRINT "* indicates a field overflow.        Press F1 for help.          "; : LOCATE 25, 65: PRINT USING "##,###"; NKA; : PRINT " Records";
  122. 4009 PRINT BOTT$; BLANK$; BOTT$; "<G>et Record, <S>earch, Sort, Select, <E>nd ";
  123. 4010 TY$ = "A": FL = 1
  124. 4015 HELP = 2: GOSUB 21000
  125. 4025 IF T$ = "G" OR T$ = "g" THEN UPDTE$ = "YES": GOTO 15000
  126. 4030 IF T$ = "E" OR T$ = "e" THEN 40000
  127. 4035 IF T$ <> "S" AND T$ <> "s" THEN 4005
  128. 4036 IF NKA = 0 THEN PRINT BOTT$; BLANK$; BOTT$; "No Records In Data File."; : GOSUB 60000: GOTO 4000
  129. 4037 PRINT BOTT$; BLANK$; BOTT$; "Search in a <F>ield, <A>nywhere or <R>etrieve all records? -"; : Z2 = 1: HELP = 3
  130. 4038 GOSUB 21000: IF T$ = "F" OR T$ = "f" THEN GOTO 45000 ELSE IF T$ = "R" OR T$ = "r" THEN 14036 ELSE IF T$ <> "A" AND T$ <> "a" THEN 4005
  131. 14000 'String Search
  132. 14001 CP = 0
  133. 14002 X = 0: LC = 0: PG = 0
  134. 14005 UPDTE$ = "S"
  135. 14010 PRINT BOTT$; BLANK$; BOTT$; "Type search string - "; : ' Search
  136. 14020 FL = 30
  137. 14030 TY$ = "A"
  138. 14035 HELP = 4: GOSUB 21000: Q$ = T$: IF Q$ = "" THEN GOTO 700 ELSE 14037
  139. 14036 Q$ = "": CP = 5: UPDTE$ = "S": X = 0: LC = 0: PG = 0
  140. 14037 SS$ = Q$: GOTO 45205: 'Look for sort
  141. 14038 PRINT BOTT$; BLANK$; BOTT$; " <S>top - ";
  142. 14039 FO = 0
  143. 14040 FOR X = 1 TO INT(LOF(1) / RL%): IF INKEY$ <> "" THEN 700 ELSE GET 1, X: FO = 0
  144. 14042 IF CP > 0 AND CP < 6 THEN GOSUB 48150: GOTO 14065
  145. 14044 FOR ZT = 1 TO T: IF INSTR(F$(ZT), Q$) <> 0 AND FO = 0 THEN 14100
  146. 14045 IF INKEY$ <> "" THEN 700
  147. 14060 NEXT ZT
  148. 14065 NEXT X: GOSUB 28000: GOTO 700
  149. 14099 '
  150. 14100 GOSUB 15390: '           Print Record and RETURN
  151. 14101 FO = 1
  152. 14200 PRINT BOTT$; BLANK$; BOTT$; " <S>top - ";
  153. 14250 GOTO 14060
  154. 14300 ' ..... remember that you have a line at 18200 ...
  155. 14999 '
  156. 15000 '
  157. 15002 '        Get Record
  158. 15003 PG = 0: LC = 0: NUMFND = 0
  159. 15004 IF INKEY$ <> "" THEN 700
  160. 15395 IF LC <= 0 THEN GOSUB 25000
  161. 15400 '
  162. 18200 IF UPDTE$ = "S" THEN RETURN
  163. 18560 IF FOUND = 0 AND NUMFND = 0 THEN GOTO 700 ELSE IF FOUND <> 0 THEN NUMFND = NUMFND + 1: I = LR: GOSUB 62030: GOTO 15230 ELSE GOSUB 28000: GOTO 700
  164. 22999 '
  165. 23000 '       Number Check Routine
  166. 23001 '
  167. 23005 F1 = 0: F2 = 0: N = 0
  168. 23010 FOR X = 1 TO LEN(T$)
  169. 23020 A = ASC(MID$(T$, X, 1))
  170. 23030 IF A < 45 OR A > 57 THEN PRINT CHR$(7); : GOTO 23100
  171. 23050 IF A = 46 THEN F1 = F1 + 1: IF F1 > 1 THEN PRINT CHR$(7); : GOTO 23100
  172. 23060 IF A = 45 THEN F2 = F2 + 1: IF F2 > 1 THEN PRINT CHR$(7); : GOTO 23100
  173. 23070 NEXT X
  174. 23080 IF INSTR(T$, "-") > 1 THEN PRINT CHR$(7); : GOTO 23100
  175. 23090 N = 1
  176. 23100 RETURN
  177. 24999 '
  178. 25000 '      Print Header
  179. 25001 '
  180. 25005 PG = PG + 1
  181. 25006 LPRINT FF$
  182. 25007 LPRINT " "
  183. 25009 LPRINT " ": LPRINT " "
  184. 25200 '
  185. 25300 LC = PL: RETURN
  186. 40000 PRINT BOTT$; BLANK$; BOTT$; "Do you really want to end? "; : Z2 = 1: HELP = 999: GOSUB 21000: IF T$ = "N" OR T$ = "n" THEN GOTO 4001 ELSE IF T$ <> "Y" AND T$ <> "y" THEN GOTO 40000
  187. 40010 COLOR 7, 0, 0: CLS : PRINT "You have exited your report program"
  188. 40020 PRINT "and are now in MS-DOS at the system"
  189. 40030 PRINT "prompt."
  190. 40040 SYSTEM ' You may branch to another program from here
  191. 53000 '  Error Traps
  192. 53001 FOR ZX = 1 TO 3: SOUND 1000, 1: SOUND 25000, 1: NEXT ZX
  193. 53002 COLOR 14, 4: PRINT BOTT$; BLANK$; BOTT$;
  194. 53003 IF ERR = 7 OR ERR = 14 THEN LOCATE 25, 1: PRINT " OUT OF MEMORY  (BASIC may not have been started with /S:2048)": END
  195. 53004 IF ERR <> 27 AND ERR <> 24 AND ERR <> 25 AND ERR <> 57 AND ERR <> 68 THEN 53009
  196. 53006 PRINT "Printer I/O Error. Abort or Retry?"; : Z$ = INPUT$(1): PRINT BOTT$; BLANK$; BOTT$;
  197. 53007 IF Z$ = "A" OR Z$ = "a" THEN PRINT "Operation aborted."; : GOTO 53050
  198. 53008 IF Z$ <> "R" AND Z$ <> "r" THEN 53006 ELSE PRINT "Retrying..."; : GOTO 53040
  199. 53009 IF ERR = 53 THEN PRINT "Your data file or a support file was not found at line"; ERL; ".": END
  200. 53010 IF ERR = 61 THEN PRINT "Disk full. No recovery possible. Program aborting.": END
  201. 53011 IF ERR = 4 THEN PRINT "Out of DATA. Probably errors in help subroutines.": END
  202. 53012 IF ERR = 6 THEN PRINT "Overflow error in line"; ERL; ". No recovery possible. Program aborting.": END
  203. 53013 IF ERR = 11 THEN PRINT "There is a division by zero in your computation in line"; ERL; ".": END
  204. 53014 IF ERR = 51 THEN PRINT "BASIC Interpreter Error. No recovery possible. Program aborting.": END
  205. 53015 IF ERR = 64 THEN PRINT "Illegal filename used in line"; ERL; ". No recovery possible. Program aborting.": END
  206. 53016 IF ERR = 67 THEN PRINT "Too many files open. Modify FILES line in CONFIG.SYS.": END
  207. 53017 IF ERR = 71 THEN PRINT "Disk not ready. Check drive door. Press ENTER to continue..."; : Z$ = INPUT$(1): GOTO 53040
  208. 53018 IF ERR = 72 THEN PRINT "Disk damaged. No recovery possible. Program aborting.": END
  209. 53019 IF ERR = 75 OR ERR = 76 THEN PRINT "Path not found. No recovery possible. Program aborting.": END
  210. 53020 PRINT "Report program error"; ERR; "trapped at line"; ERL; ". Program aborting.": END
  211. 53040 RESUME
  212. 53050 ECODE = -1: RESUME NEXT
  213. 59999 '
  214. 60000 ' 4 Second Time Delay Loop
  215. 60001 '
  216. 60010 COUNT# = TIMER
  217. 60020 IF INKEY$ = "" AND TIMER - COUNT# < 4 THEN 60020
  218. 60030 RETURN
  219. 187 DEF FNM$ (F, R) = STR$(F#(F) + (SGN(F#(F)) * .5#) / (10# ^ R)) + "." + STRING$(R, "0")
  220. 188 DEF FNU$ (F, R) = MID$(FNM$(F, R), 1, INSTR(FNM$(F, R), ".") - 1 + (ABS(R <> 0) * (R + 1)))
  221. 202 FILNUM = 1: GOSUB 210: GOTO 298
  222. 44999 '
  223. 45000 ' Relational Record Selection Prompting
  224. 45005 UPDTE$ = "S"
  225. 45010 LC = 0
  226. 45015 FC = 0: CP = 0: BF = 0
  227. 45020 PRINT BOTT$; BLANK$; BOTT$; "Press RETURN to get to the Field you want to Search on ...";
  228. 45025 FL = 1: HELP = 7: GOSUB 21000
  229. 45030 PRINT BOTT$; BLANK$; BOTT$; "When you are at the Field you want, TYPE in what you want to Search for. ";
  230. 45035 FC = FC + 1: IF FC > T THEN 4000 ELSE IF TY$(FC) = "Z" THEN 45035
  231. 45040 FL = FL(FC): LOCATE CY(FC) + 1, CX(FC) + 1
  232. 45045 HELP = 8: GOSUB 21000: IF TY$(FC) = "N" THEN GOSUB 23000: IF N = 0 THEN PRINT FNCRT$(CX(FC), CY(FC)); STRING$(FL(FC), "."); : GOTO 45040
  233. 45050 IF T$ <> "" THEN 45070 ELSE 45035
  234. 45055 '
  235. 45060 '
  236. 45065 '
  237. 45070 SS$ = T$: Q$ = T$
  238. 45075 '
  239. 45080 IF TY$(FC) <> "N" THEN CP = 4: GOTO 45205'sort ?
  240. 45083 '
  241. 45084 ' Get Relation on Numeric field
  242. 45085 PRINT BOTT$; BLANK$; BOTT$; "The Field you are Searching is a Number Field..."; : GOSUB 60000
  243. 45090 PRINT BOTT$; BLANK$; BOTT$; "You may Select Records in your Report that are ... "; : GOSUB 60000
  244. 45095 PRINT BOTT$; BLANK$; BOTT$; "<E>qual, <L>ess or <G>reater than the number you entered (Pick E,L or G) - "; : FL = 1: HELP = 9: GOSUB 21000
  245. 45100 IF T$ = "" THEN 45095
  246. 45105 IF ASC(T$) > 90 THEN T$ = CHR$(ASC(T$) - 32)
  247. 45110 CP = INSTR(" ELGelg", T$) - 1: IF CP > 3 THEN CP = CP - 3
  248. 45115 IF CP < 1 OR CP > 3 THEN PRINT CHR$(7); : GOTO 45095
  249. 45199 '
  250. 45200 ' Look for Sort (QP3SORT.EXE)
  251. 45205 IF NKA = 0 THEN T$ = "N": GOTO 45235 ELSE ON ERROR GOTO 45215'look for Sort
  252. 45210 OPEN "I", 3, "QP3SORT.EXE": CLOSE 3: GOTO 45230'if found proceed
  253. 45215 CLOSE 3: IF ERR = 53 THEN T$ = "N": RESUME 45235'if not found return
  254. 45220 IF ERR = 54 THEN RESUME 45230'if BM error proceed
  255. 45225 GOTO 53000'error traps
  256. 45228 '
  257. 45229 ' Sort prompting if Sort is found
  258. 45230 ON ERROR GOTO 53000: SS = 0: PRINT BOTT$; BLANK$; BOTT$; "Do you want your Report in sorted order ? (Y/N)-"; : FL = 1: HELP = 10: GOSUB 21000: IF T$ = "" THEN 45230
  259. 45235 IF INSTR("Nn", T$) THEN GOTO 14038
  260. 45245 FOR X = 1 TO T: IF TY$(X) = "Z" THEN 45255 ELSE N$ = MID$(STR$(X), 2)
  261. 45250 PRINT FNCRT$(CX(X), CY(X)); N$; : IF FL(X) <> 1 THEN PRINT STRING$(FL(X) - LEN(N$), ".");
  262. 45260 '
  263. 45265 CLOSE : PRINT BOTT$; BLANK$; BOTT$; "What Field do you want to Sort on ? - ";
  264. 45270 FL = 2: HELP = 11: GOSUB 21000: IF T$ = "" OR VAL(T$) < 1 OR VAL(T$) > T THEN 45265
  265. 45275 IF TY$(VAL(T$)) = "Z" THEN PRINT BOTT$; BLANK$; BOTT$; "> Cannot Sort on Display Only Fields <"; : GOSUB 60000: GOTO 45230
  266. 45280 SO = VAL(T$): KYD = 0
  267. 45285 FOR X = 1 TO SO - 1: IF TY$(X) <> "Z" THEN KYD = KYD + FL(X)
  268. 45290 NEXT X
  269. 45295 KYL = FL(SO)
  270. 45300 IF CP THEN PRINT FNCRT$(CX(FC), CY(FC)); SS$
  271. 45304 '
  272. 45310 OPEN "O", #3, "QUIKSORT.CMD"
  273. 45314 '
  274. 45320 PRINT #3, V1$:    'Send master file's filename to the sort
  275. 45330 PRINT #3, RL%:    'with the record length
  276. 45340 PRINT #3, TY$(SO) 'and the field type
  277. 45350 PRINT #3, KYL:    'and the key length
  278. 45360 PRINT #3, KYD:    'and the key depth
  279. 45365 CLOSE 3:          'then close it.
  280. 45368 '
  281. 45378 '
  282. 45383 '
  283. 45384 ' RUN Quikpro+ Sort
  284. 45385 PRINT BOTT$; BLANK$; BOTT$; " Loading Sort Program  ...  ";
  285. 45390 SHELL "QP3SORT": GOTO 47000
  286. 45499 '
  287. 45500 ' Read Record / Test Relation / Print
  288. 45501 '   ... if not Sorting
  289. 45505 ON ERROR GOTO 53000
  290. 45510 X = 1: GET 1, X
  291. 45520 PRINT BOTT$; BLANK$; BOTT$; "Press any key to STOP search - ";
  292. 45530 '
  293. 45531 GET 1, X: X = X + 1: IF INT(LOF(1) / RL%) < X - 1 THEN GOSUB 28000: GOTO 700
  294. 45540 IF F$(FC) = STRING$(FL(FC), 0) THEN 45530
  295. 45599 '
  296. 45600 GOSUB 48000
  297. 45601 '
  298. 45700 IF INKEY$ <> "" THEN 700
  299. 45710 GOTO 45530
  300. 46999 '
  301. 47000 'Do that sort thing
  302. 47010 '
  303. 47020 OPEN "R", #1, "SRTDLIST.QP3", 2
  304. 47030 FIELD #1, 2 AS PNTR$
  305. 47090 IF LOF(1) = 0 THEN CLOSE : KILL "SRTDLIST.QP3": GOTO 47510: 'NO RECORDS!
  306. 47110 FILNUM = 2 'Open Master File
  307. 47120 GOSUB 210: UPDTE$ = "S"
  308. 47130 PRINT BOTT$; BLANK$; BOTT$; "Print in <F>orward or <R>everse order? "; : FL = 1: HELP = 13: GOSUB 21000
  309. 47140 IF T$ = "R" OR T$ = "r" THEN INC = -1 ELSE IF T$ <> "F" AND T$ <> "f" THEN 47130 ELSE INC = 1
  310. 47148 '
  311. 47149 'Scan master file in sorted order & do that search on the sort thing
  312. 47150 MXKY = LOF(1) / 2: MFPTR = 0: IF INC = -1 THEN Y = MXKY + 1: MXKY = 0 ELSE Y = 0: MXKY = MXKY + 1
  313. 47170 PP$ = BOTT$ + BLANK$ + BOTT$ + "Scanning for matches & printing... <P>ause, <A>bort, <R>edo - ": PRINT PP$;
  314. 47180 Y = Y + INC: IF Y = MXKY THEN GOSUB 28000: GOTO 47260
  315. 47185 GET 1, Y: MFPTR = CVI(PNTR$)
  316. 47190 GET 2, MFPTR
  317. 47200 GOSUB 48000
  318. 47220 N$ = INKEY$: IF N$ <> "" THEN 47320' check for interrupt
  319. 47240 GOTO 47180
  320. 47249 '
  321. 47250 ' another copy / return to program
  322. 47260 '
  323. 47265 PRINT BOTT$; BLANK$; BOTT$; " Do you want to print another copy ? (Y/N) - ";
  324. 47270 FL = 1: HELP = 12: GOSUB 21000: IF T$ = "" THEN 47270
  325. 47280 IF INSTR("Nn", T$) THEN CLOSE : KILL "SRTDLIST.QP3": GOTO 47520
  326. 47290 IF INSTR("Yy", T$) THEN LC = 0: PG = 0: GOTO 47150
  327. 47300 GOTO 47260
  328. 47309 '
  329. 47310 ' Pause / Abort /Redo
  330. 47320 N = INSTR("PARpar", N$): IF N > 3 THEN N = N - 3
  331. 47330 ON N GOTO 47360, 47390, 47440
  332. 47340 GOTO 47220
  333. 47350 ' pause
  334. 47360 PRINT BOTT$; BLANK$; BOTT$; " PRINTING PAUSED * Press any key to continue - ";
  335. 47370 A$ = INKEY$: IF A$ = "" THEN 47370 ELSE N$ = "": PRINT PP$; : GOTO 47240
  336. 47380 ' abort
  337. 47390 CLOSE
  338. 47400 KILL "SRTDLIST.QP3"
  339. 47410 GOTO 47520
  340. 47420 ' redo
  341. 47440 PRINT BOTT$; BLANK$; BOTT$; " REDO REPORT * Press any key to continue - ";
  342. 47450 A$ = INKEY$: IF A$ = "" THEN 47450 ELSE LC = 0: PG = 0: GOTO 47150
  343. 47459 '
  344. 47460 ' if sort detected error
  345. 47470 PRINT BOTT$; BLANK$; BOTT$; "SORT DETECTED ERROR #"; EC!; ", <E>nter to continue -";
  346. 47480 A$ = INKEY$: IF A$ = CHR$(13) THEN 47510 ELSE 47480
  347. 47489 '
  348. 47490 'if no PRINTCMD file
  349. 47500 RESUME 47510
  350. 47510 ON ERROR GOTO 53000
  351. 47520 ST = 0: CP = 0: CLOSE : GOTO 202
  352. 47999 '
  353. 48000 'BUILD A RELATIONAL LINE ( test & select )
  354. 48011 '
  355. 48080 ON CP GOTO 48150, 48150, 48150, 48180, 48090
  356. 48089 GOTO 48110
  357. 48090 ' Print all Records
  358. 48100 IF F$(1) <> STRING$(FL(1), 0) THEN GOSUB 15390
  359. 48109 RETURN
  360. 48110 ' Test for String Anywhere in file
  361. 48120 MFOUND = 0: FOR ZZ = 1 TO T: IF INSTR(F$(ZZ), SS$) THEN MFOUND = 1
  362. 48125 NEXT ZZ: IF MFOUND THEN GOSUB 15390
  363. 48130 RETURN
  364. 48139  '
  365. 48140 ' Test for Numeric < = >
  366. 48150 ON CP GOTO 48151, 48153, 48155, 48180, 48090
  367. 48151 IF VAL(F$(FC)) = VAL(SS$) THEN GOSUB 15390
  368. 48152 RETURN
  369. 48153 IF VAL(F$(FC)) < VAL(SS$) THEN GOSUB 15390
  370. 48154 RETURN
  371. 48155 IF VAL(F$(FC)) > VAL(SS$) THEN GOSUB 15390
  372. 48156 RETURN
  373. 48169 '
  374. 48170 ' Test for String in a Field
  375. 48180 IF INSTR(F$(FC), SS$) THEN GOSUB 15390
  376. 48190 RETURN
  377. 48200 '
  378. 15211 '   *** Execute binary tree inquiry after reading map file
  379. 15220 GOSUB 62500: GOSUB 62000
  380. 15230 IF FOUND THEN GET 1, I ELSE GOTO 700
  381. 60999 'Initialize BTree variables
  382. 61000 I = 0: ZR = 0: LR = 0: LL = 0: NKT = 0: NKA = 0: W = 0: ROOT = 0
  383. 61010 TKL = KL + 5: BUS = 400
  384. 61030 RETURN
  385. 61500 'Open MAP and ISI files & initialize in-memory link list
  386. 61510 OPEN "R", 2, V2$, TKL
  387. 61520 FIELD 2, 2 AS LJ$, 2 AS LK$, KL AS KS$, 1 AS DF$
  388. 61530 FIELD 2, TKL AS AM$
  389. 61540 IF LOF(2) / TKL > BUS THEN BUI = BUS ELSE BUI = LOF(2) / TKL
  390. 61550 FOR X = 1 TO BUI: GET 2, X: MEMLINK$(X) = AM$: NEXT X
  391. 61560 IF LOF(2) = 0 THEN KE = 1 ELSE GOSUB 62500
  392. 61570 RETURN
  393. 62000 'Binary Tree inquiry
  394. 62010 I = ROOT
  395. 62020 IF I = ZR THEN FOUND = 0: GOTO 62090
  396. 62030 IF I <= BUS THEN LSET AM$ = MEMLINK$(I) ELSE GET 2, I
  397. 62040 LL = CVI(LJ$): LR = CVI(LK$): KX$ = KS$: DEL$ = DF$
  398. 62050 IF K$ > KX$ THEN GOTO 62080
  399. 62060 IF K$ = KX$ AND DEL$ = "A" THEN FOUND = 1: GOTO 62090
  400. 62065 IF K$ = KX$ AND DEL$ = "D" AND LR <> 0 THEN I = LR: GOTO 62030 ELSE IF K$ = KX$ AND DEL$ = "D" THEN FOUND = 0: GOTO 62090
  401. 62070 IF LL <> ZR THEN I = LL: GOTO 62030 ELSE FOUND = 0: GOTO 62090
  402. 62080 IF LR <> ZR THEN I = LR: GOTO 62030 ELSE FOUND = 0
  403. 62090 RETURN
  404. 62499 'Open map file & get information, then close
  405. 62500 OPEN "R", 3, V3$, 56
  406. 62510 FIELD 3, 2 AS RT$, 2 AS NKT$, 2 AS NKA$, 50 AS FD$
  407. 62580 GET 3, 1: ROOT = CVI(RT$): NKT = CVI(NKT$): NKA = CVI(NKA$): KE = NKT + 1
  408. 62590 CLOSE 3: RETURN
  409. 41000 'HELP SECTION *******************************************
  410. 41010 BSV = &HB800: DEF SEG = &H40: ZZZ = PEEK(&H87): PCX = POS(0): PCY = CSRLIN
  411. 41020 IF ZZZ <> 0 THEN GOTO 41040
  412. 41030 ZZZ = PEEK(&H10): YYY = ZZZ AND 48: IF YYY = 48 THEN BSV = &HB000
  413. 41040 DEF SEG = BSV: BSAVE "$$$$$$$$.$$$", 960, 1440: RESTORE: GOTO 41800
  414. 41050 DATA 1,2,"x"
  415. 41060 DATA "   DBDOS MS-DOS Quick Reference Data Base - V1.0"
  416. 41070 DATA "          Copyright 1990, CBase Enterprises"
  417. 41080 DATA 2,6,"G/S/E"
  418. 41090 DATA "* GET"
  419. 41100 DATA " Print record(s) read in using key field."
  420. 41110 DATA "* SEARCH/SORT/SELECT"
  421. 41120 DATA " Print one or more records based on search criteria."
  422. 41130 DATA "* END
  423. 41140 DATA " Exit the report program."
  424. 41150 DATA 3,6,"Search Type"
  425. 41160 DATA "* Search in a FIELD"
  426. 41170 DATA " Print record if string appears in specified field."
  427. 41180 DATA "* Search ANYWHERE"
  428. 41190 DATA " Print a record if string appears in record."
  429. 41191 DATA "* RETRIEVE All Records"
  430. 41192 DATA " Prints every record in the data file."
  431. 41200 DATA 4,3,"Search String"
  432. 41210 DATA "Type in the string you wish to search for. If this"
  433. 41220 DATA "string is found anywhere in the file, the record"
  434. 41230 DATA "will be printed."
  435. 41270 DATA 6,2,"Get Record"
  436. 41280 DATA "The Get command operates on the key field. Enter"
  437. 41290 DATA "the key to search for."
  438. 41300 DATA 7,3,"Select Field"
  439. 41310 DATA "By continually pressing Return you can move the"
  440. 41320 DATA "cursor through the fields one by one. Press Return"
  441. 41330 DATA "now to move the cursor into the first field."
  442. 41340 DATA 8,5,"Selecting Field"
  443. 41350 DATA "You are selecting the field to search in. Press"
  444. 41360 DATA "Return to move the cursor to the next field up to"
  445. 41370 DATA "and through the last one. When it is on the field"
  446. 41380 DATA "you want to search, type the data you want searched"
  447. 41390 DATA "for and press Return again to begin the search."
  448. 41400 DATA 9,4,"E/L/G"
  449. 41410 DATA "Since the field you chose to search was a numeric"
  450. 41420 DATA "field, during the search, comparisons may be made."
  451. 41430 DATA "You can print records that are Equal to, Less than,"
  452. 41440 DATA "or Greater than the search string you entered."
  453. 41450 DATA 10,3,"Sort Data?"
  454. 41460 DATA "You have the option of sorting the data before it"
  455. 41470 DATA "is printed. Sorting takes place on the field of"
  456. 41480 DATA "your choice."
  457. 41490 DATA 11,3,"Sort Field"
  458. 41500 DATA "Sorting on numeric fields is in ascending order. On"
  459. 41510 DATA "non-numeric fields, the sort is in alphabetical"
  460. 41520 DATA "order based on the IBM's internal ASCII code table."
  461. 41530 DATA 12,1,"Another Copy?"
  462. 41540 DATA "You may print the entire report over if necessary."
  463. 41541 DATA 13,2,"Reverse Order"
  464. 41542 DATA "You may print the records in reverse order (i.e."
  465. 41543 DATA "Z-A, 9-0, etc) or ascending order (i.e. A-Z, etc)."
  466. 41550 DATA 999,0,"x"
  467. 41800 READ HLPNUM, NUMLIN, HLPLBL$
  468. 41810 IF NUMLIN = 0 THEN RESTORE: HELP = 1: GOTO 41800
  469. 41820 IF HLPNUM <> HELP THEN FOR TT = 1 TO NUMLIN: READ XX$: NEXT TT: GOTO 41800
  470. 41825 IF STARTUP AND HELP THEN HLPLBL$ = PN$ ELSE IF NOT STARTUP AND HELP = 1 THEN HLPLBL$ = "NO HELP FOUND"
  471. 41830 COLOR 14, 1: YYY = 12 - INT(NUMLIN / 2) - 1: XXX = 52 - LEN(HLPLBL$)
  472. 41840 LOCATE YYY - 1, 13: PRINT CHR$(201); "["; HLPLBL$; "]"; STRING$(XXX, 205); CHR$(187);
  473. 41850 FOR TT = 1 TO NUMLIN: READ XX$: IF LEN(XX$) < 52 THEN XX$ = XX$ + SPACE$(52 - LEN(XX$))
  474. 41860 LOCATE YYY + TT - 1, 13: PRINT CHR$(186); " "; XX$; " "; CHR$(186): NEXT TT
  475. 41865 LOCATE YYY + NUMLIN, 13: PRINT CHR$(186); : COLOR 15, 1
  476. 41866 PRINT "           (press any key to continue...)             "; : COLOR 14, 1: PRINT CHR$(186);
  477. 41870 LOCATE YYY + NUMLIN + 1, 13: PRINT CHR$(200); STRING$(54, 205); CHR$(188);
  478. 41880 WHILE INKEY$ = "": WEND
  479. 41890 BLOAD "$$$$$$$$.$$$", 960: KILL "$$$$$$$$.$$$"
  480. 21000 'Keyboard Scan Routine
  481. 21001 '
  482. 21010 LOCATE , , 0: T$ = "": PY = CSRLIN: PX = POS(0): CSP = 0
  483. 21020 A$ = INKEY$: IF A$ <> "" THEN 21050
  484. 21030 CSP = CSP + 1: IF CSP = 6 THEN CSP = 1
  485. 21040 PRINT MID$(CR$, CSP, 1); : LOCATE PY, PX: GOTO 21020
  486. 21050 IF A$ = CHR$(27) THEN GOSUB 41000: GOTO 21020
  487. 21060 IF A$ = CHR$(8) AND LEN(T$) > 0 THEN PRINT BK$; : PX = PX - 1: LOCATE PY, PX: T$ = LEFT$(T$, LEN(T$) - 1): GOTO 21020 ELSE IF A$ = CHR$(8) THEN T$ = A$: GOTO 21100
  488. 21070 IF A$ = CHR$(13) THEN PRINT " "; : GOTO 21100
  489. 21080 IF A$ < " " OR A$ > "~" THEN 21020
  490. 21090 IF LEN(T$) = FL THEN SOUND 1500, 1: GOTO 21020 ELSE T$ = T$ + A$: PRINT A$; : PX = PX + 1: GOTO 21020
  491. 21100 RETURN
  492.  9 COLOR  11 , 1 , 1 : 'Colors in lines 45240, 45255, and 41900
  493.  45240 IF INSTR(" Yy",T$)=0 THEN 45230 ELSE SS=1:COLOR  14 , 1 
  494.  45255 NEXT : COLOR 11 , 1 
  495.  41900 LOCATE PCY, PCX: COLOR  11 , 1 : RETURN
  496.  53030 COLOR 11 , 1 : RESUME NEXT
  497.  53040 COLOR 11 , 1 : RESUME
  498.  53050 COLOR 11 , 1 : RESUME 4000
  499.  4006 LOCATE 1,1:COLOR 11 , 1 
  500.