10 PRINT"This program must be entered via DIMS 20 STOP 1000 GOSUB 1890 'cs 1010 PRINT:PRINT TAB(29);"DGET 1.03 - October 30, 1983 1020 ' by Dan Dugan -- public domain 1030 PRINT 1040 DEFINT A-Z 1050 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1060 DIM DEST(30),USED(30),B1$(30):INREC=0 1070 ' OPEN SOURCE FILE 1080 PRINT:INPUT"Name of source file";X$ 1085 IF X$="" THEN 1820 1090 GOSUB 1920:F2$=Y$ 'ucv 1100 IF MID$(F2$,2,1)=":" THEN 1120 1110 F2$=DD$(5)+F2$ 1120 ' TEST FOR EXISTENCE 1130 ON ERROR GOTO 1160 1140 OPEN"I",3,F2$ 1150 ON ERROR GOTO 0:GOTO 1200 'ok 1160 CLOSE 3 1170 IF ERR=53 THEN CLOSE 3:PRINT"File not found":RESUME 1070 1180 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 1070 1190 ON ERROR GOTO 0 1200 ' ENTER SEQUENCE OF FIELDS 1210 PRINT:PRINT"Here's the first line of "F2$". 1220 LINE INPUT#3,T$ 1230 PRINT:PRINT T$ 1240 CLOSE 3:OPEN"I",3,F2$ 1250 PRINT:PRINT"Would you like to re-assign or skip fields? (n/y) ";:A$=INPUT$(1) 1252 IF A$="y" OR A$="Y" THEN 1260 ELSE FOR I=1 TO NC:DEST(I)=I:NEXT:NF=NC:PRINT:GOTO 1370 1260 PRINT:FOR I=1 TO NC:USED(I)=0:NEXT 1265 PRINT:INPUT"Number of fields in source file";NF:PRINT 1270 FOR I=1 TO NF 1280 PRINT"Destination field of field"I"(enter 0 to ignore)";:INPUT DEST(I) 1290 IF DEST(I)>NC THEN PRINT "This file only has"NC"fields.":GOTO 1280 1300 IF DEST(I)=0 THEN 1330 1310 IF USED(DEST(I)) THEN PRINT"Won't accept putting two fields into one.":GOTO 1280 1320 USED(DEST(I))=1 1330 NEXT 1340 PRINT:PRINT"Is this ok (y/n)? "; 1350 A$=INPUT$(1):PRINT A$ 1360 IF A$<>"y" THEN GOTO 1200 1370 C=1:PRINT 1380 ' READ FILE 1390 GOSUB 1840 'exit 1400 IF EOF(3) THEN 1790 1410 FOR I=1 TO NC:B$(I)="":NEXT:NR=NR+1 1420 LINE INPUT #3,T$ 1430 INREC=INREC+1:GOSUB 2010 'parse into B1$ array j=fields found 1440 IF J<>NF THEN 1450 ELSE 1470 1450 IF P9 THEN PRINT CHR$(7);:LPRINT"Input file line"INREC"defective." 1460 PRINT"Input file line"INREC"defective."CHR$(7) 1470 FOR I=1 TO J 1480 IF DEST(I) THEN 1490 ELSE 1520 1490 QUOTE=INSTR(T$,CHR$(126)) 1500 IF QUOTE THEN MID$(T$,QUOTE,1)=CHR$(34):GOTO 1490 1510 B$(DEST(I))=B1$(I) 1520 NEXT 1530 ' ADD RECORD TO DIMS FILE 1540 T$="" 1550 FOR J=1 TO NC 1560 IF LEN(T$)+LEN(B$(J))+1>FT*128 THEN 1570 ELSE 1590 1570 IF P9 THEN LPRINT "Input line"INREC"too long." 1580 PRINT"Input line"INREC"too long."CHR$(7) 1590 T$=T$+B$(J)+CHR$(126) 1600 NEXT 1610 N=N+1:PRINT N;T$; 1620 GOSUB 1650:PRINT"*";:GOSUB 1720:PRINT"!":C=1 1630 ' LOOP 1640 GOTO 1380 1650 ' (SUB) WRITE T$ AS RECORD # N 1660 ON FT GOTO 1690,1670 1670 LSET R$=MID$(T$,129) 'latter half 1680 PUT #1,FT*N+2 1690 LSET R$=LEFT$(T$,128) 'first half 1700 PUT #1,FT*N+1 1710 RETURN 1720 ' (SUB) WRITE T$ AS DUPE REC N 1730 ON FT GOTO 1760,1740 1740 LSET S$=MID$(T$,129) 1750 PUT #2,FT*N+2 1760 LSET S$=LEFT$(T$,128) 1770 PUT #2,FT*N+1 1780 RETURN 1790 ' FINISH 1800 CLOSE 3 1810 PRINT:PRINT NR"records added. 1820 PRINT:PRINT TAB(32)"Re-loading DEDIT. 1830 CHAIN DD$(1)+"DEDIT",1000 1840 ' EXIT TEST (TERM DEP) 1850 X$=INKEY$:X=0 1860 IF X$<>"" THEN X=ASC(X$) 1870 IF X=27 THEN CLOSE 3:GOTO 1790 'use ESC to escape listing 1880 RETURN 1890 ' CLEAR SCREEN (TERM DEP) 1900 PRINT CHR$(12); 1910 RETURN 1920 ' (SUB) UCV 1930 Y$="" 1940 FOR K=1 TO LEN(X$) 1950 Y$=Y$+CHR$(32) 1960 X=ASC(MID$(X$,K,1)) 1970 IF 96 B1$ ARRAY 2020 ' returns J = number of fields found 2030 FOR J=1 TO NF:B1$(J)="":NEXT 2040 J=0 2050 ' process loop 2060 J=J+1:IF J=NF THEN 2170 2070 X=INSTR(T$,CHR$(44)) 'comma 2080 IF X=0 THEN 2170 'must be last field 2090 Y=INSTR(T$,CHR$(34)) 'quote 2100 IF Y=0 OR ( Y<>0 AND X