home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / database / dims103.ark / DUNFLAG.ASC < prev    next >
Encoding:
Text File  |  1986-12-07  |  4.1 KB  |  186 lines
  1. 10 PRINT"This program must be entered from DEDIT.":STOP
  2. 1000 GOSUB 2060 'cs
  3. 1010 PRINT:PRINT TAB(29);"DUNFLAG March 11, 1984
  4. 1015 ' by Dan Dugan -- public domain
  5. 1020 PRINT
  6. 1030 DEFINT A-Z
  7. 1040 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  8.  
  9.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  10.  
  11.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  12. 1060 '                SET UP
  13. 1065 PRINT"Here are the fields in "F$":"
  14. 1070 GOSUB 2290        'show fields
  15. 1075 PRINT
  16. 1080 INPUT"Number of field to unflag? ",F
  17. 1085 IF F=0 THEN 1740    'quit
  18. 1090 PRINT:INPUT"String to find and remove";FLAG$
  19. 1100 L=LEN(FLAG$)
  20. 1150 '
  21.  
  22.  
  23.  
  24.  
  25.                 RECORD WORK LOOP
  26.  
  27.  
  28. 1160 C2=0 ' first time
  29. 1170 LC=0 ' count
  30. 1180 '
  31. 1190 FOR I=T1 TO T2 '        <==== FOR
  32. 1200 GOSUB 2210 ' get rec
  33. 1205 IF ASC(T$)=0 THEN PRINT"0";:GOTO 1720
  34. 1210 PRINT"+";
  35. 1220 T1$=T$ ' save it
  36. 1230 IF SKIPPARSE=1 THEN 1250
  37. 1240 GOSUB 1780 ' parse record string
  38. 1250 IF SEARCH=0 THEN 1540
  39. 1260 '
  40.  
  41.  
  42.  
  43.                 SEARCH
  44.  
  45.  
  46. 1270 IF SEARCH<>2 THEN 1320
  47. 1275 '
  48.  
  49.  
  50.         FIND
  51.  
  52.  
  53. 1280 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1720
  54. 1300 GOSUB 1780 ' parse
  55. 1310 GOTO 1540
  56. 1320 '
  57.  
  58.  
  59.         FIELD SEARCH
  60.  
  61.  
  62. 1330 J=0 '            check for skips first
  63. 1340 IF SKIPWORD$(J)="" THEN 1420 ' try search then
  64. 1350 IF LOOKFIELD(J)<>0 THEN 1390 ' look in field
  65. 1360 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 1720 ' whole rec search - skip it
  66. 1370 J=J+1
  67. 1380 GOTO 1340
  68. 1390 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 1720 ' field compare - skip
  69. 1400 J=J+1
  70. 1410 GOTO 1340
  71. 1420 IF SEARCHWORD$(0)="" THEN 1520 ' don't care so print it
  72. 1430 J=0: GOTO 1450 '        now search
  73. 1440 IF SEARCHWORD$(J)="" THEN 1720 ' hesitate no longer
  74. 1450 IF SEARCHFIELD(J)<>0 THEN 1490 ' field
  75. 1460 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 1520 ' found it
  76. 1470 J=J+1
  77. 1480 GOTO 1440
  78. 1490 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1520
  79. 1500 J=J+1
  80. 1510 GOTO 1440
  81. 1520 '
  82.  
  83.  
  84.         GET READY TO DO IT
  85.  
  86.  
  87. 1530 IF SKIPPARSE=1 THEN GOSUB 1780 ' parse
  88. 1540 '
  89.  
  90.  
  91.  
  92.                 PAUSE CONTROLS (TERM DEP IF UPPERCASE ONLY)
  93.  
  94.  
  95. 1541 GOSUB 2030            ' exit returns A
  96. 1542 IF A=122 THEN 1560        ' z means go on
  97. 1543 PRINT I;B$(1);TAB(14);"Ready (SPACE/z/r/n/ESC) >";
  98. 1544 A$=INPUT$(1):A=ASC(A$):IF A=27 THEN CLOSE 3:GOTO 1740
  99. 1545 PRINT A$:IF A=13 OR A=32 OR A=122 THEN 1560
  100. 1546 IF A=114 THEN I=IPREV:GOTO 1200 ' r
  101. 1547 IF A=110 THEN 1548 ELSE 1540 ' n or loop
  102. 1548 INPUT"Enter number of desired record:  ";I:GOTO 1200
  103. 1550 GOSUB 2030            ' exit
  104. 1560 '
  105.  
  106.  
  107.  
  108.                 DO IT
  109.  
  110.  
  111. 1570 TEST=INSTR(B$(F),FLAG$)
  112. 1580 IF TEST THEN 1590 ELSE 1720
  113. 1590 B$(F)=LEFT$(B$(F),TEST-1)+MID$(B$(F),TEST+L)
  114. 1600 '                ASSEM CHANGED REC STR & PUT TO DISK
  115. 1610 T$=""
  116. 1620 FOR J=1 TO NC
  117. 1630    T$=T$+B$(J)+CHR$(126)
  118. 1640 NEXT
  119. 1650 GOSUB 2350:PRINT"*";:GOSUB 2420:PRINT"!"
  120. 1720    GOSUB 2030 ' check exit
  121. 1730 NEXT I '            END OF RECORD WORK LOOP
  122. 1740 '
  123.  
  124.  
  125.                 FINISH
  126.  
  127.  
  128. 1760 PRINT:PRINT:PRINT TAB(32)"Re-loading DEDIT.
  129. 1770 CHAIN DD$(1)+"DEDIT",1000
  130. 1780 '
  131.  
  132.  
  133.  
  134.  
  135.                 (SUB) PARSE STRING
  136.  
  137.  
  138. 1790 K=0
  139. 1800 M=INSTR(T$,CHR$(126)) ' delimiter
  140. 1810 IF M=0 THEN RETURN
  141. 1820 K=K+1
  142. 1830 B$(K)=""
  143. 1840 B$(K)=MID$(T$,1,M-1)
  144. 1850 T$=MID$(T$,M+1)
  145. 1860 GOTO 1800
  146. 2030 '
  147.  
  148.  
  149.  
  150.                 (SUB) EXIT TEST (TERM DEP)
  151.  
  152.  
  153. 2040 X$=INKEY$
  154. 2042 IF X$<>"" THEN A=ASC(X$)
  155. 2045 IF A=27 THEN CLOSE 3:GOTO 1740    'use ESC to escape listing
  156. 2050 RETURN
  157. 2060 '
  158.  
  159.  
  160.  
  161.                 (SUB) CLEAR SCREEN (TERM DEP)
  162.  
  163.  
  164. 2070 PRINT CHR$(12);
  165. 2080 RETURN
  166. 2210 '
  167.  
  168.  
  169.  
  170.                 (SUB) GET RECORD "I" IN T$
  171.  
  172.  
  173. 2220 T$="" ' necessary!
  174. 2230 ON FT GOTO 2260,2240
  175. 2240    GET#1,FT*I+2 ' latter half
  176. 2250    T$=LEFT$(R$,127)
  177. 2260    GET#1,FT*I+1 ' whole or first half
  178. 2270    T$=R$+T$
  179. 2280 RETURN
  180. 2290 '
  181.  
  182.  
  183.                 SHOW FIELDS (SUB)
  184.  
  185.  
  186. 2300 FOR K=1 TO NC
  187. 2310    PRINT TAB(29);
  188. 2320    PRINT USING"##";K;:PRINT".  "LEFT$(N$(K),4)"  "RIGHT$(N$(K),1)
  189. 2330 NEXT
  190. 2340 RETURN
  191. 2350 '
  192.  
  193.  
  194.                 PUT T$ AS RECORD I (SUB)
  195.  
  196.  
  197. 2360 ON FT GOTO 2390,2370
  198. 2370 LSET R$=MID$(T$,129)    'latter half
  199. 2380 PUT #1,FT*I+2
  200. 2390 LSET R$=LEFT$(T$,128)
  201. 2400 PUT #1,FT*I+1
  202. 2410 RETURN
  203. 2420 '
  204.  
  205.  
  206.                 PUT T$ AS DUPE REC I (SUB)
  207.  
  208.  
  209. 2430 ON FT GOTO 2460,2440
  210. 2440 LSET S$=MID$(T$,129)
  211. 2450 PUT #2,FT*I+2
  212. 2460 LSET S$=LEFT$(T$,128)
  213. 2470 PUT #2,FT*I+1
  214. 2480 RETURN
  215. FT GOTO 2460,2440
  216. 2440 LSET S$=MID$(T$,129)
  217. 2450 PUT #2,FT*I+2
  218. 2460 LSET S$=LEFT$(T$,128)
  219.