home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol061 / dget.asc < prev    next >
Encoding:
Text File  |  1984-04-29  |  3.0 KB  |  138 lines
  1. 1000 GOSUB 7180 'cs
  2. 1010 PRINT:PRINT TAB(29);"DGET - March 20, 1982
  3. 1015 ' by Dan Dugan -- public domain
  4. 1020 PRINT
  5. 1030 DEFINT A-Z
  6. 1040 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  7.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  8.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  9. 1055 DIM DEST(30),USED(30)
  10. 1060 '
  11.  
  12.                 OPEN SOURCE FILE
  13.  
  14. 1070 PRINT:INPUT"Name of source file";X$
  15. 1080 GOSUB 7290:F2$=Y$        'ucv
  16. 1090 IF MID$(F2$,2,1)=":" THEN 1120
  17. 1100 F2$=DD$(5)+F2$
  18. 1120 '
  19.  
  20.         TEST FOR EXISTENCE
  21.  
  22. 1130 ON ERROR GOTO 1160
  23. 1140    OPEN"I",3,F2$
  24. 1150    ON ERROR GOTO 0:GOTO 1210    'ok
  25. 1160 CLOSE 3
  26. 1170 IF ERR=53 THEN CLOSE 3:PRINT"File not found":RESUME 1060
  27. 1180 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 1060
  28. 1190 ON ERROR GOTO 0
  29. 1210 '
  30.  
  31.                 ENTER SEQUENCE OF FIELDS
  32.  
  33. 1212 PRINT:PRINT"Here's the first line of "F2$".
  34. 1214 LINE INPUT#3,T1$
  35. 1216 PRINT:PRINT T1$
  36. 1218 CLOSE 3:OPEN"I",3,F2$
  37. 1220 PRINT:INPUT"Number of fields in the source file records";NF
  38. 1225 PRINT:FOR I=1 TO NC:USED(I)=0:NEXT
  39. 1230 FOR I=1 TO NF
  40. 1240    PRINT"Destination field of field"I;:INPUT DEST(I)
  41. 1245    IF DEST(I)>NC THEN 1240
  42. 1247    IF DEST(I)=0 THEN 1270
  43. 1250    IF USED(DEST(I)) THEN 1240
  44. 1260    USED(DEST(I))=1
  45. 1270 NEXT
  46. 1280 PRINT:PRINT"Is this ok (y/n)?";
  47. 1282 A$=INPUT$(1):PRINT A$
  48. 1284 IF A$<>"y" THEN CLOSE 3:GOTO 1060
  49. 1286 C=1:PRINT
  50. 1300 '
  51.  
  52.                 READ FILE
  53.  
  54. 1305 GOSUB 7140            'exit
  55. 1310 IF EOF(3) THEN 7020
  56. 1315 FOR I=1 TO NC:B$(I)="":NEXT:NR=NR+1
  57. 1320 FOR I=1 TO NF
  58. 1330    IF EOF(3) THEN 7020
  59. 1340    INPUT#3,T1$
  60. 1350    IF DEST(I) THEN 1352 ELSE 1360
  61. 1352    QUOTE=INSTR(T1$,CHR$(126))
  62. 1353    IF QUOTE THEN MID$(T1$,QUOTE,1)=CHR$(34):GOTO 1352
  63. 1355    B$(DEST(I))=T1$
  64. 1360 NEXT
  65. 1370 '
  66.  
  67.                 ADD RECORD TO DIMS FILE
  68.  
  69. 1380 T$=""
  70. 1390 FOR J=1 TO NC
  71. 1400    IF LEN(T$)+LEN(B$(J))+1>FT*128
  72.     THEN PRINT"Record too long."
  73. 1410    T$=T$+B$(J)+CHR$(126)
  74. 1420 NEXT
  75. 1425 N=N+1:PRINT N;T$;
  76. 1430 GOSUB 1450:PRINT"*";:GOSUB 1520:PRINT"!":C=1
  77. 1440 '
  78.  
  79.                 LOOP
  80.  
  81. 1445 GOTO 1300
  82. 1450 '
  83.  
  84.         (SUB) WRITE T$ AS RECORD # N
  85.  
  86. 1460 ON FT GOTO 1490,1470
  87. 1470 LSET R$=MID$(T$,129)    'latter half
  88. 1480 PUT #1,FT*N+2
  89. 1490 LSET R$=LEFT$(T$,128)    'first half
  90. 1500 PUT #1,FT*N+1
  91. 1510 RETURN
  92. 1520 '
  93.  
  94.         (SUB) WRITE T$ AS DUPE REC N
  95.  
  96. 1530 ON FT GOTO 1560,1540
  97. 1540 LSET S$=MID$(T$,129)
  98. 1550 PUT #2,FT*N+2
  99. 1560 LSET S$=LEFT$(T$,128)
  100. 1570 PUT #2,FT*N+1
  101. 1580 RETURN
  102. 7020 '
  103.  
  104.                 FINISH
  105.  
  106. 7024 CLOSE 3
  107. 7025 PRINT:PRINT NR"records added.
  108. 7030 PRINT:PRINT TAB(32)"Re-loading DEDIT.
  109. 7040 CHAIN DD$(1)+"DEDIT",1000
  110. 7140 '
  111.  
  112.  
  113.                 EXIT TEST (TERM DEP)
  114.  
  115. 7150 X$=INKEY$:X=0
  116. 7152 IF X$<>"" THEN X=ASC(X$)
  117. 7160 IF X=27 THEN CLOSE 3:GOTO 7020    'use ESC to escape listing
  118. 7170 RETURN
  119. 7180 '
  120.  
  121.  
  122.                 CLEAR SCREEN (TERM DEP)
  123.  
  124. 7190 PRINT CHR$(12);
  125. 7200 RETURN
  126. 7290 '
  127.  
  128.                 (SUB) UCV
  129.  
  130. 7300 Y$=""
  131. 7310 FOR K=1 TO LEN(X$)
  132. 7320    Y$=Y$+CHR$(32)
  133. 7330    X=ASC(MID$(X$,K,1))
  134. 7340    IF 96<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32):GOTO 7360
  135. 7350    MID$(Y$,K,1)=MID$(X$,K,1)
  136. 7360 NEXT
  137. 7370 RETURN
  138.