home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / hamradio / list-log.lbr / LIST_LOG.BQS / LIст_LOG.BAS
Encoding:
BASIC Source File  |  1987-02-08  |  8.5 KB  |  290 lines
  1. 10 '**VARIABLES**
  2. 25 'FTL$= FILE TO LOAD
  3. 26 'FTS$= FILE TO SAVE
  4. 50 'W$
  5. 60 'Y$
  6. 70 'D$
  7. 80 'E$
  8. 90 'F$
  9. 100 'YN$ = TEMP STRING, USE ANYTIME
  10. 110 'NN$ = INPUT 
  11. 120 'DT$ = DATE STRING (YY/MM/DD)
  12. 130 'LEXT = LENGTH OF EXTENTION
  13. 140 'SF$ = STRING TO FIND
  14. 150 'N$
  15. 160 'NN$
  16. 170 '
  17. 179 '**DEFINES**
  18. 180 WT$="WAIT"
  19. 181 CG$="COLLECT GARBAGE"
  20. 182 S$=" ,"
  21. 183 P$=STRING$(7,42) '*$
  22. 184 C=1        'RECORD #
  23. 190 DEFSTR M
  24. 195 LMX=600 'MAX # LOG ENTRIES
  25. 200 DIM M(LMX,2)
  26. 210 EXT$="000"
  27. 220 I=1 'CONTACT #
  28. 225 CLS$=CHR$(26) 'CLEAR SCREEN
  29. 230 PF = 0 'PRINT FLAG
  30. 235 BEL$=CHR$(7) 'console bell
  31. 240 DUP = -1
  32. 270 '
  33. 1000 PRINT CLS$
  34. 1100 PRINT:PRINT "LIST/LOG.BAS  p.p.p."
  35. 1103 GOSUB 26000
  36. 1110 PRINT "ENTER A LIST OF TWO FIELDS:"
  37. 1112 PRINT:PRINT "FIELD ONE: 18 CHARS (255 MAX) - NO COMMAS!"  
  38. 1115 PRINT "FIELD TWO: 55 CHARS (255 MAX) - COMMAS OK, NO ";CHR$(34)
  39. 1200 GOTO 3000
  40. 1250 GOSUB 17800
  41. 1300 PF=0:GOSUB 26000:PRINT TAB(3) "-MENU:" C-1 "RECORDS IN LOG --"FRE(0)" BYTES FREE--"
  42. 1305 ON ERROR GOTO 17010
  43. 1310 IF FRE(0) < 1000 THEN GOSUB 27000
  44. 1400 PRINT
  45. 1500 PRINT TAB(5) "1 - CREATE LOG      6 - SEARCH FIELD 1"
  46. 1600 PRINT TAB(5) "2 - VIEW   LOG      7 - SEARCH FIELD 2"
  47. 1700 PRINT TAB(5) "3 - EDIT   LOG      8 - READ LOG FROM DISK"
  48. 1800 PRINT TAB(5) "4 - SORT ON FIELD 1 9 - WRITE LOG TO  DISK"
  49. 1900 PRINT TAB(5) "5 - CHANGE DISKS    0 - EXIT"
  50. 1910 PRINT SPC(24)"G - "CG$
  51. 2000 PRINT "CHOICE: ? ";
  52. 2100 A$=INPUT$(1)
  53. 2210 IF A$=CHR$(13) GOTO 1300
  54. 2215 IF A$="G" OR A$="g" THEN GOSUB 27000
  55. 2220 IF A$= CHR$(&H30) THEN GOTO 1250
  56. 2300 A=VAL(A$)
  57. 2400 ON A GOSUB 2700,9200,10800,17100,25000,5600,7400,14600,12700
  58. 2500 IF A > 9 OR A < 1 THEN GOTO 2800
  59. 2600 IF A <> 1 GOTO 1300
  60. 2700 RETURN
  61. 2800 PRINT:PRINT " ENTER 1 - 7"
  62. 2900 GOTO 2100
  63. 3000 PRINT:PRINT "ENTER <CR> FOR MENU - - D FOR 'DUPLICATE CHECK ON'"
  64. 3050 PRINT
  65. 3100 GOSUB 26000: PRINT FRE(0)" BYTES FREE"
  66. 3110 IF FRE(0) < 1000 THEN GOSUB 27000
  67. 3130 PRINT:PRINT "RECORD #"C"      ENTER M FOR MENU"
  68. 3150 PRINT SPC(17);STRING$(17,45);"*"
  69. 3200 INPUT "ENTER FIELD 1: ";N$
  70. 3300 IF N$="D" OR N$="d" THEN GOSUB 20000:GOTO 3100
  71. 3400 IF N$="M" OR N$="m" THEN GOTO 5200
  72. 3450 IF N$="" THEN N$= M(C-1,1):PRINT SPC(17);N$
  73. 3500 IF DUP < 1 GOTO 3900
  74. 3600 FOR I = 1 TO C
  75. 3700 IF N$ = M(I,1) THEN GOTO 4000
  76. 3800 NEXT I
  77. 3900 GOTO 4200
  78. 4000 GOSUB 26000:PRINT P$;P$"DUPE RECORD #";I;P$;P$
  79. 4100 GOTO 3100
  80. 4200 PRINT SPC(17);STRING$(54,45);"*"
  81. 4300 PRINT"ENTER FIELD 2: ? ";
  82. 4310 LINE INPUT F$
  83. 4320 IF F$="" THEN F$=M(C-1,2):PRINT SPC(17);F$
  84. 4340 IF LEN(N$) > 18 THEN PRINT:PRINT P$;P$; "LENGTH FIELD 1 > 18";P$;P$
  85. 4350 IF LEN(F$) > 55 THEN PRINT:PRINT P$;P$;"LENGTH FIELD 2 > 55";P$;P$
  86. 4360 GOSUB 26000:PRINT "RECORD # "C"  OK ?"
  87. 4400 PRINT "ENTER <CR> TO ACCEPT AND CONTINUE ";
  88. 4500 GOSUB 18000
  89. 4600 IF YN=(-1) GOTO 3100
  90. 4700 PRINT:PRINT
  91. 4750 IF N$="" AND F$= "" THEN GOTO 3100
  92. 4760 IF LEFT$(F$,1)=" " THEN GOTO 3100
  93. 4800 M(C,1)=N$
  94. 4900 M(C,2)=F$
  95. 5000 C=C+1
  96. 5100 GOTO 5300
  97. 5200 GOSUB 1300
  98. 5300 GOTO 3100
  99. 5600 PRINT CLS$
  100. 5700 GOSUB 26000:PRINT "SEARCH FIELD 1"
  101. 5800 PRINT:INPUT "ENTER STRING TO FIND";SF$
  102. 5900 PRINT:PRINT "PRINTER ON  "
  103. 6000 GOSUB 18000
  104. 6100 IF YN=1 THEN PF=1 ELSE PF = 0
  105. 6200 PRINT CLS$:PRINT "SEARCHING"
  106. 6300 GOSUB 18600
  107. 6400 SFL=LEN(SF$)
  108. 6500 FOR I = 1 TO C
  109. 6600 IF SF$ = LEFT$(M(I,1),SFL) THEN GOSUB 18900
  110. 6700 NEXT I
  111. 6800 PRINT:PRINT "DONE ";
  112. 6900 GOSUB 18000
  113. 7000 IF YN=1 OR YN=0 GOTO 7300
  114. 7100 IF YN=(-1) GOTO 5700
  115. 7200 GOTO 6900
  116. 7300 RETURN
  117. 7400 PRINT CLS$
  118. 7500 GOSUB 26000:PRINT "SEARCH FIELD 2"
  119. 7600 PRINT:INPUT "ENTER STRING TO FIND";SF$
  120. 7700 PRINT:PRINT "PRINTER ON  ";
  121. 7800 GOSUB 18000
  122. 7900 IF YN=1 THEN PF=1 ELSE PF = 0
  123. 8000 PRINT CLS$:PRINT "SEARCHING"
  124. 8100 GOSUB 18600
  125. 8200 SFL=LEN(SF$)
  126. 8300 FOR I = 1 TO C
  127. 8400 IF SF$ = LEFT$(M(I,2),SFL) THEN GOSUB 18900
  128. 8500 NEXT I
  129. 8600 PRINT:PRINT "DONE ";
  130. 8700 GOSUB 18000
  131. 8800 IF YN=1 OR YN=0 GOTO 9100
  132. 8900 IF YN=(-1) GOTO 7500
  133. 9000 GOTO 6900
  134. 9100 RETURN
  135. 9200 PRINT CLS$:INPUT "STARTING AT WHAT RECORD #";K
  136. 9300 IF K<1 OR K> LMX THEN K=1
  137. 9500 PRINT CLS$:PRINT "LIST LOG"
  138. 9600 PRINT:PRINT "PRINTER ON ";
  139. 9700 GOSUB 18000
  140. 9800 IF YN=1 THEN PF=1 ELSE PF = 0
  141. 9900 PRINT
  142. 10000 GOSUB 18600
  143. 10100 FOR I=K TO K+19 
  144. 10200 GOSUB 18900
  145. 10300 NEXT I
  146. 10400 PRINT "MORE ?   <CR> CONTINUES  ";
  147. 10500 GOSUB 18000
  148. 10600 IF YN=1 OR YN=0 THEN K=K+20:PRINT:GOTO 10100    
  149. 10700 RETURN
  150. 10800 PRINT CLS$:PRINT "EDIT LOG"
  151. 10900 INPUT "CHANGE RECORD #";L
  152. 10910 IF L<1 OR L> LMX THEN L=1
  153. 10950 GOSUB 26000:PRINT:PRINT "RECORD "L
  154. 10975 IF M(L,1)="" THEN GOSUB 26000:PRINT "RECORD #"L" BLANK":GOTO 12600
  155. 11000 PRINT:PRINT "FIELD 1:  "M(L,1)
  156. 11050 PRINT "FIELD 2:  "M(L,2)
  157. 11100 PRINT
  158. 11150 PRINT:PRINT "RE-ENTER FIELD - CR TO LEAVE UNCHANGED - * TO DELETE"
  159. 11200 PRINT:PRINT "FIELD 1: "M(L,1)
  160. 11205 PRINT SPC(9);STRING$(17,45);"*"
  161. 11210 INPUT "       ";N$
  162. 11250 IF N$=CHR$(42) THEN N$="*"+M(L,1):NN$=M(L,2):PRINT:PRINT:PRINT "DELETED":GOTO 11700
  163. 11300 IF N$="" THEN N$=M(L,1)
  164. 11400 PRINT:PRINT
  165. 11500 PRINT "FIELD 2: "M(L,2)"
  166. 11510 PRINT SPC(9);STRING$(54,45);"*"
  167. 11520 LINE INPUT "         ";NN$
  168. 11600 IF NN$="" THEN NN$=M(L,2)
  169. 11700 PRINT
  170. 11750 PRINT "RECORD "L" OK ?  <CR> CONTINUES ";
  171. 11900 GOSUB 18000
  172. 12000 IF YN=1 OR YN=0  GOTO 12400
  173. 12100 IF YN=(-1) THEN  PRINT:GOTO 10950
  174. 12200 PRINT:PRINT "ENTER Y OR N ";
  175. 12300 GOTO 11900
  176. 12400 M(L,1)=N$
  177. 12500 M(L,2)=NN$
  178. 12550 IF YN=0 THEN L=L+1:PRINT:GOTO 10950
  179. 12600 RETURN
  180. 12700 ON ERROR GOTO 16300
  181. 12800 GOSUB 26000:PRINT "ENTER FILENAME TO SAVE:"
  182. 12810 INPUT " <CR> RETURNS TO MENU";FTS$
  183. 13000 IF FTS$="" THEN GOTO 14200
  184. 13100 NAME FTS$ AS FTS$
  185. 13200 ON ERROR GOTO 16700
  186. 13300 KILL FTS$+".BAK"
  187. 13400 NAME FTS$ AS FTS$+".BAK" 
  188. 13500 PRINT:PRINT FTS$
  189. 13600 OPEN "O",#1,FTS$
  190. 13700 FOR I=1 TO ( C - 1 )
  191. 13750 IF LEFT$(M(I,1),1)=CHR$(42) GOTO 13900
  192. 13800 PRINT #1,M(I,1);" ,";CHR$(34);M(I,2);CHR$(34)
  193. 13900 NEXT I
  194. 14000 CLOSE#1
  195. 14100 PRINT "DATA SENT TO DISK"
  196. 14150 GOSUB 26000
  197. 14200 RETURN
  198. 14300 FOR C = 1 TO 400
  199. 14400 NEXT
  200. 14500 RETURN
  201. 14600 GOSUB 26000:PRINT  "ENTER NAME OF FILE TO LOAD:"
  202. 14610 INPUT "     <CR> RETURNS TO MENU";FTL$
  203. 14700 IF FTL$="" THEN GOTO 15900
  204. 14710 GOSUB 26000
  205. 14800 PRINT FTL$ " TO LOAD"
  206. 14900 ON ERROR GOTO 16100
  207. 15000 OPEN "I",#1,FTL$
  208. 15100 I=C
  209. 15200 INPUT #1,M(I,1),M(I,2)
  210. 15300 I=I+1
  211. 15400 IF M(I,1)= "0" AND M(I,2)= "0" THEN 15700
  212. 15500 IF EOF(1) THEN 15700
  213. 15600 GOTO 15200
  214. 15700 CLOSE
  215. 15800 C=I
  216. 15900 RETURN
  217. 16000 '*** ERROR ROUTINES ***
  218. 16100 PRINT "ERROR # " ERR
  219. 16110 IF ERR=53 THEN PRINT "FILE NOT ON DISK":CLOSE
  220. 16112 IF ERR=62 THEN PRINT "NO DATA IN FILE":CLOSE
  221. 16200 RESUME 14600
  222. 16300 IF ERR=53 THEN RESUME 13500
  223. 16400 IF ERR=58 THEN RESUME 13200
  224. 16500 PRINT "ERROR # "ERR
  225. 16600 RESUME
  226. 16700 IF ERR=53 THEN GOTO 17000
  227. 16750 PRINT "ERROR(2) #"ERR
  228. 16800 IF ERR= 61 THEN PRINT " DISK FULL !!": RESUME 14500
  229. 16900 IF ERR= 57 THEN PRINT "DISK READ/WRITE ERROR": RESUME 14500
  230. 17000 RESUME NEXT
  231. 17010 GOSUB 26000:PRINT P$;"ERROR #"ERR;" LOG MAY BE LOST"P$;BEL$
  232. 17020 PRINT:PRINT P$;"SAVE LOG TO DISK NOW!";P$:RESUME 1300
  233. 17100 PRINT
  234. 17125 PRINT "SORTING   HIT ANY KEY TO STOP"
  235. 17150 SF=0
  236. 17200 FOR I=1 TO C
  237. 17250 IF M(I+1,1)="" GOTO 17400
  238. 17299 IF M(I,1) > M(I+1,1) THEN SWAP M(I,1),M(I+1,1):SWAP M(I,2),M(I+1,2):SF=1
  239. 17300 YN$=INKEY$
  240. 17310 IF YN$ <> "" THEN GOTO 17700
  241. 17400 NEXT
  242. 17500 IF SF=1 GOTO 17125
  243. 17700 RETURN
  244. 17800 GOSUB 26000:PRINT "EXIT TO BASIC AND ERASE LOG ";
  245. 17810 GOSUB 18000
  246. 17820 IF YN=(-1) THEN GOTO 17890
  247. 17830 IF YN=1 THEN GOTO 17895
  248. 17890 RETURN
  249. 17895 ON ERROR GOTO 0
  250. 17899 END
  251. 17900 '***SUBROUTINE AREA***
  252. 18000 PRINT " (Y/N) ?";
  253. 18100 YN$=INPUT$(1)
  254. 18200 IF YN$=CHR$(13) THEN YN=0:GOTO 18500
  255. 18300 IF YN$="N" OR YN$="n" THEN YN=(-1):GOTO 18500
  256. 18400 IF YN$="Y" OR YN$="y" THEN YN=1:GOTO 18500
  257. 18450 YN=255
  258. 18500 RETURN
  259. 18600 PRINT "  # ";TAB(7);"FIELD ONE";TAB(26);"FIELD TWO"
  260. 18700 PRINT
  261. 18800 RETURN
  262. 18900 IF I < 10 THEN PRINT "  ";I;
  263. 19000 IF I > 9 AND I < 100 THEN PRINT " ";I;
  264. 19100 IF I > 99 THEN PRINT I;
  265. 19200 PRINT TAB(7);M(I,1);TAB(26);M(I,2)
  266. 19300 IF PF=1 GOTO 19500
  267. 19400 RETURN
  268. 19500 IF M(I,1) = "" GOTO 19900
  269. 19550 IF I < 10 THEN LPRINT "  ";I;
  270. 19600 IF I > 9 AND I < 100 THEN LPRINT " ";I;
  271. 19700 IF I > 99 THEN LPRINT I;
  272. 19800 LPRINT TAB(7);M(I,1);TAB(26);M(I,2)
  273. 19900 RETURN
  274. 20000 DUP=DUP*(-1)
  275. 20100 RETURN
  276. 25000 PRINT CLS$
  277. 25100 PRINT "REPLACE DISK IN DRIVE"
  278. 25200 PRINT "READY "
  279. 25300 GOSUB 18000
  280. 25400 RESET
  281. 25500 RETURN 
  282. 26000 PRINT:PRINT:PRINT:PRINT:RETURN
  283. 27000 PRINT:PRINT P$;P$;CG$;P$;P$
  284. 27010 GOSUB 18000
  285. 27020 IF YN=1 THEN PRINT WT$:PRINT FRE(X$)
  286. 27030 RETURN 
  287. PRINT:RETURN
  288. 27000 PRINT:PRINT P$;P$;CG$;P$;P$
  289. 27010 GOSUB 18000
  290. 27020 IF YN=1