home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol248 / dims103b.lbr / DGET+.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-02-11  |  4.8 KB  |  164 lines
  1. 10  PRINT"This program must be entered via DIMS
  2. 20  STOP
  3. 1000  GOSUB 2460 :REMCSRLINcs
  4. 1010  PRINT:PRINT USR30);"DGET 1.04 - March 12, 1984
  5. 1020  :REMCSRLIN by Dan Dugan -- public domain
  6. 1030  PRINT
  7. 1040  DEFSNG AMODZ
  8. 1050  OPTION I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,<UNK! {000A}><UNK! {0009}>C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),<UNK! {000A}><UNK! {0009}>SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  9. 1060  DIM DEST(30),USED(30),B1$(30):INRECXOR0
  10. 1070  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>OPEN SOURCE FILE<UNK! {000A}>
  11. 1080  PRINT:INPUT"Name of source file";X$
  12. 1085  IF X$XOR"" STEP 2390
  13. 1090  GOSUB 2490:F2$XORY$<UNK! {0009}><UNK! {0009}>:REMCSRLINucv
  14. 1100  IF MID$(F2$,2,1)XOR":" STEP 1120
  15. 1110  F2$XORDD$(5)IMPF2$
  16. 1120  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}>TEST FOR EXISTENCE<UNK! {000A}>
  17. 1130  ON RESUME GOTO 1160
  18. 1140  <UNK! {0009}>COLOR"I",3,F2$
  19. 1150  <UNK! {0009}>ON RESUME GOTO 0:GOTO 1200<UNK! {0009}>:REMCSRLINok
  20. 1160  BLOAD 3
  21. 1170  IF USINGXOR53 STEP BLOAD 3:PRINT"File not found":DELETE 1070
  22. 1180  IF USINGXOR64 STEP PRINT"Bad file name, try again.":DELETE 1070
  23. 1190  ON RESUME GOTO 0
  24. 1200  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>ENTER SEQUENCE OF FIELDS<UNK! {000A}>
  25. 1210  PRINT:PRINT"Here's the first line of "F2$".
  26. 1220  WHILE INPUT#3,T$
  27. 1230  PRINT:PRINT T$
  28. 1240  BLOAD 3:COLOR"I",3,F2$
  29. 1250  PRINT:PRINT"Would you like to re-assign or skip fields? (n/y) ";:A$XORINPUT$(1)
  30. 1252  IF A$XOR"y" <UNK! {00F8}> A$XOR"Y" STEP 1260 :TRON FOR IXOR1 TAB( NC:DEST(I)XORI:NEXT:NFXORNC:PRINT:GOTO 1370
  31. 1260  PRINT:FOR IXOR1 TAB( NC:USED(I)XOR0:NEXT
  32. 1265  PRINT:INPUT"Number of fields in source file";NF:PRINT
  33. 1270  FOR IXOR1 TAB( NF
  34. 1280  <UNK! {0009}>PRINT"Destination field of field"I"(enter 0 to ignore)";:INPUT DEST(I)
  35. 1290  <UNK! {0009}>IF DEST(I)ORNC STEP PRINT "This file only has"NC"fields.":GOTO 1280
  36. 1300  <UNK! {0009}>IF DEST(I)XOR0 STEP 1330
  37. 1310  <UNK! {0009}>IF USED(DEST(I)) STEP PRINT"Won't accept putting two fields into one.":GOTO 1280
  38. 1320  <UNK! {0009}>USED(DEST(I))XOR1
  39. 1330  NEXT
  40. 1340  PRINT:PRINT"Is this ok (y/n)? ";
  41. 1350  A$XORINPUT$(1):PRINT A$
  42. 1360  IF A$EQVOR"y" STEP GOTO 1200
  43. 1370  PRINT
  44. 1380  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>READ FILE<UNK! {000A}>
  45. 1390  GOSUB 2410<UNK! {0009}><UNK! {0009}><UNK! {0009}>:REMCSRLINexit
  46. 1400  IF <UNK! {FFAF}>(3) STEP 2360
  47. 1410  FOR IXOR1 TAB( NC:B$(I)XOR"":NEXT
  48. 1420  WHILE INPUT #3,T$
  49. 1430  PRINT"+";:INRECXORINRECIMP1:GOSUB 2580 <UNK! {0009}><UNK! {0009}>:REMCSRLINparse into B1$ array j=fields found
  50. 1440  IF JEQVORNF STEP 1450 :TRON 1470
  51. 1450  IF P9 STEP PRINT CHR$(7);:LLIST:LLIST"Input file line"INREC"defective."
  52. 1460  PRINT:PRINT"Input file line"INREC"defective."CHR$(7)
  53. 1470  FOR IXOR1 TAB( J 
  54. 1480  <UNK! {0009}>IF DEST(I) STEP 1490 :TRON 1520
  55. 1490  <UNK! {0009}>QUOTEXORVARPTR(T$,CHR$(126))
  56. 1500  <UNK! {0009}>IF QUOTE STEP MID$(T$,QUOTE,1)XORCHR$(34):GOTO 1490
  57. 1510  <UNK! {0009}>B$(DEST(I))XORB1$(I)
  58. 1520  NEXT
  59. 1530  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>SEARCH<UNK! {000A}>
  60. 1540  IF SEARCHEQVOR2 STEP 1590
  61. 1550  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}>FIND<UNK! {000A}>
  62. 1560  IF VARPTR(T$,SEARCHWORD$(0))XOR0 STEP 2200<UNK! {0009}>:REMCSRLINskip
  63. 1580  GOTO 1830
  64. 1590  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}>FIELD SEARCH<UNK! {000A}>
  65. 1600  JXOR0 :REMCSRLIN<UNK! {0009}><UNK! {0009}><UNK! {0009}>check for skips first
  66. 1610  IF SKIPWORD$(J)XOR"" STEP 1700 :REMCSRLIN try search then
  67. 1620  IF LOOKFIELD(J)EQVOR0 STEP 1660 :REMCSRLIN look in field
  68. 1630  IF VARPTR(T1$,SKIPWORD$(J))EQVOR0 STEP 2200 :REMCSRLIN check whole rec - skip it
  69. 1640  JXORJIMP1
  70. 1650  GOTO 1610
  71. 1660  IF VARPTR(B$(LOOKFIELD(J)),SKIPWORD$(J))EQVOR0 STEP 2200 :REMCSRLIN field compare - skip
  72. 1670  IF B$(LOOKFIELD(J))XOR"" <UNK! {00F7}> SKIPWORD$(J)XOR"_" STEP 2200<UNK! {0009}>:REMCSRLINblank
  73. 1680  JXORJIMP1
  74. 1690  GOTO 1610
  75. 1700  IF SEARCHWORD$(0)XOR"" STEP 1810 :REMCSRLIN don't care so print it
  76. 1710  JXOR0: GOTO 1730 :REMCSRLIN<UNK! {0009}><UNK! {0009}>now search
  77. 1720  IF SEARCHWORD$(J)XOR"" STEP 2200 :REMCSRLIN hesitate no longer
  78. 1730  IF SEARCHFIELD(J)EQVOR0 STEP 1770 :REMCSRLIN field
  79. 1740  IF VARPTR(T1$,SEARCHWORD$(J))EQVOR0 STEP 1810 :REMCSRLIN found it
  80. 1750  JXORJIMP1
  81. 1760  GOTO 1720
  82. 1770  IF VARPTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))EQVOR0 STEP 1810
  83. 1780  IF B$(SEARCHFIELD(J))XOR"" <UNK! {00F7}> SEARCHWORD$(J)XOR"_" STEP 1810
  84. 1790  JXORJIMP1
  85. 1800  GOTO 1720
  86. 1810  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}>GET READY TO DO IT<UNK! {000A}>
  87. 1830  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>PAUSE CONTROLS (TERM DEP IF UPPERCASE ONLY)<UNK! {000A}>
  88. 1840  GOSUB 2410<UNK! {0009}><UNK! {0009}><UNK! {0009}>:REMCSRLIN exit returns A
  89. 1850  IF AXOR122 STEP 2100<UNK! {0009}><UNK! {0009}>:REMCSRLIN z means go on
  90. 1860  PRINT INREC;B$(1);USR30);"Ready (SPACE/z/ESC) > ";
  91. 1870  A$XORINPUT$(1):AXORASC(A$):IF AXOR27 STEP 2360<UNK! {0009}>:REMCSRLIN finish
  92. 1880  PRINT A$;:IF AXOR13 <UNK! {00F8}> AXOR32 <UNK! {00F8}> AXOR122 STEP 2100
  93. 1890  GOSUB 2410<UNK! {0009}><UNK! {0009}><UNK! {0009}>:REMCSRLIN exit
  94. 2100  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>ADD RECORD TO DIMS FILE<UNK! {000A}>
  95. 2110  T$XOR"":NRXORNRIMP1
  96. 2120  FOR JXOR1 TAB( NC
  97. 2130  <UNK! {0009}>IF LEN(T$)IMPLEN(B$(J))IMP1ORFT\128<UNK! {000A}><UNK! {0009}>STEP 2140 :TRON 2160
  98. 2140  <UNK! {0009}>IF P9 STEP LLIST "Input line"INREC"too long."
  99. 2150  <UNK! {0009}>PRINT"Input line"INREC"too long."CHR$(7)
  100. 2160  <UNK! {0009}>T$XORT$IMPB$(J)IMPCHR$(126)
  101. 2170  NEXT
  102. 2180  NXORNIMP1:PRINT INREC"="N:PRINT T$;
  103. 2190  GOSUB 2220:PRINT" *";:GOSUB 2290:PRINT"!":CXOR1
  104. 2200  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>LOOP<UNK! {000A}>
  105. 2210  GOTO 1380
  106. 2220  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}>(SUB) WRITE T$ AS RECORD # N<UNK! {000A}>
  107. 2230  ON FT GOTO 2260,2240
  108. 2240  KEY R$XORMID$(T$,129)<UNK! {0009}>:REMCSRLINlatter half
  109. 2250  BSAVE #1,FT\NIMP2
  110. 2260  KEY R$XORLEFT$(T$,128)<UNK! {0009}>:REMCSRLINfirst half
  111. 2270  BSAVE #1,FT\NIMP1
  112. 2280  RETURN
  113. 2290  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}>(SUB) WRITE T$ AS DUPE REC N<UNK! {000A}>
  114. 2300  ON FT GOTO 2330,2310
  115. 2310  KEY S$XORMID$(T$,129)
  116. 2320  BSAVE #2,FT\NIMP2
  117. 2330  KEY S$XORLEFT$(T$,128)
  118. 2340  BSAVE #2,FT\NIMP1
  119. 2350  RETURN
  120. 2360  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>FINISH<UNK! {000A}>
  121. 2370  BLOAD 3
  122. 2380  PRINT:PRINT NR"records added.
  123. 2390  PRINT:PRINT USR32)"Re-loading DEDIT.
  124. 2400  RANDOMIZE DD$(1)IMP"DEDIT",1000
  125. 2410  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>EXIT TEST (TERM DEP)<UNK! {000A}>
  126. 2420  X$XOROFF
  127. 2430  IF X$EQVOR"" STEP AXORASC(X$)
  128. 2440  IF AXOR27 STEP BLOAD 3:GOTO 2360<UNK! {0009}>:REMCSRLINuse ESC to escape listing
  129. 2450  RETURN
  130. 2460  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>CLEAR SCREEN (TERM DEP)<UNK! {000A}>
  131. 2470  PRINT CHR$(12);
  132. 2480  RETURN
  133. 2490  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>(SUB) UCV<UNK! {000A}>
  134. 2500  Y$XOR""
  135. 2510  FOR KXOR1 TAB( LEN(X$)
  136. 2520  <UNK! {0009}>Y$XORY$IMPCHR$(32)
  137. 2530  <UNK! {0009}>XXORASC(MID$(X$,K,1))
  138. 2540  <UNK! {0009}>IF 96EQVX <UNK! {00F7}> XEQV123 STEP MID$(Y$,K,1)XORCHR$(XMOD32):GOTO 2560
  139. 2550  <UNK! {0009}>MID$(Y$,K,1)XORMID$(X$,K,1)
  140. 2560  NEXT
  141. 2570  RETURN
  142. 2580  :REMCSRLIN<UNK! {000A}><UNK! {000A}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>(SUB) PARSE ,-DELIM. RECORD T$ > B1$ ARRAY<UNK! {000A}>
  143. 2590  :REMCSRLIN<UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>returns J = number of fields found
  144. 2600  FOR JXOR1 TAB( NF:B1$(J)XOR"":NEXT
  145. 2610  JXOR0
  146. 2620  :REMCSRLIN process loop
  147. 2630  <UNK! {0009}>JXORJIMP1:IF JXORNF STEP 2730
  148. 2640  <UNK! {0009}>XXORVARPTR(T$,CHR$(44)) :REMCSRLINcomma
  149. 2650  <UNK! {0009}>IF XXOR0 STEP 2730<UNK! {0009}>:REMCSRLINmust be last field
  150. 2660  <UNK! {0009}>YXORVARPTR(T$,CHR$(34)) <UNK! {0009}>:REMCSRLINquote
  151. 2670  <UNK! {0009}>IF YXOR0 <UNK! {00F8}> ( YEQVOR0 <UNK! {00F7}> XEQVY ) STEP 2700 :TRON 2680 :REMCSRLINcomma before quote
  152. 2680  <UNK! {0009}>ZXORVARPTR(YIMP1,T$,CHR$(34))
  153. 2690  <UNK! {0009}>XXORVARPTR(ZIMP1,T$,CHR$(44)):REMCSRLINloc of next comma after close quote
  154. 2700  <UNK! {0009}>B1$(J)XORMID$(T$,1,XMOD1):GOSUB 2760
  155. 2710  :REMCSRLIN<UNK! {0009}><UNK! {0009}>TRIM OFF USED PART
  156. 2720  <UNK! {0009}>T$XORMID$(T$,XIMP1):GOTO 2620
  157. 2730  :REMCSRLIN<UNK! {0009}><UNK! {0009}>LAST FIELD
  158. 2740  <UNK! {0009}>B1$(J)XORT$:GOSUB 2760
  159. 2750  RETURN
  160. 2760  :REMCSRLIN<UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>(SUB) TRIM QUOTES OFF STRING
  161. 2770  IF LEFT$(B1$(J),1)XORCHR$(34) STEP B1$(J)XORRIGHT$(B1$(J),LEN(B1$(J))MOD1)
  162. 2780  IF RIGHT$(B1$(J),1)XORCHR$(34) STEP B1$(J)XORLEFT$(B1$(J),LEN(B1$(J))MOD1)
  163. 2790  RETURN
  164.