home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / DATABASE / DIMS103.ARK / DCREATE.ASC < prev    next >
Text File  |  1986-12-07  |  4KB  |  134 lines
  1. 10 ' DCREATE by Dan Dugan -- public domain
  2. 900 GOTO 1015
  3. 1000 PRINT CHR$(7):PRINT
  4.     "To create a new file, you must first 'done' this file and then enter
  5. 1005 PRINT"DCREATE from the DIMS main menu.
  6. 1010 PRINT:DEFINT A-Z:GOTO 1670        'return to DEDIT
  7. 1015 PRINT CHR$(12);            'clear screen (TERM DEP)
  8. 1020 PRINT:PRINT"DCREATE March 20, 1982
  9. 1030 DEFINT A-Z
  10. 1040 ON ERROR GOTO 1950
  11. 1050 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  12.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  13.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  14. 1060 PRINT: PRINT"Please define the record size for your new file.
  15. 1070 PRINT"You can choose size 1 or size 2.  Size 2 uses up twice as much disk
  16. 1080 PRINT"space as size 1.  Your usable storage per record equals the record
  17. 1090 PRINT"size minus the number of fields.
  18. 1100 PRINT
  19. 1110 PRINT"      1  128 characters per record (bytes)
  20. 1120 PRINT"      2  255 characters per record (bytes)
  21. 1130 PRINT: INPUT"    "; FT        'file type
  22. 1140    IF FT=0 THEN FT=1
  23. 1150    IF FT=1 THEN FT$=" ": GOTO 1190
  24. 1160    IF FT=2 THEN FT$="2": GOTO 1190
  25. 1170    IF FT<0 OR FT>2 THEN 1670
  26. 1180 GOTO 1060
  27. 1190 PRINT: PRINT"Here is a directory of the files currently on the disk...
  28. 1200 PRINT: WIDTH 70: FILES DD$(3)+"*.D?": WIDTH 255
  29. 1210 PRINT:PRINT:PRINT"Remember, if you create a file name which is the same as one ":
  30. PRINT"that already exists, you will destroy the old file on the disc.":PRINT
  31. 1220 PRINT "Now create a new file...";
  32. 1230 GOSUB 1800 ' open up files
  33. 1240 '
  34.  
  35.                 DEFINE FILE STRUCTURE
  36.  
  37. 1250 N=0 'number of records in file
  38. 1260 C=1 ' change flag
  39. 1270 GOSUB 1770        'cs
  40. 1280 PRINT F$
  41. 1290 PRINT"Define file structure;  enter field name and type:
  42. 1300 PRINT"(to finish, enter 'stop')"
  43. 1310 FOR I=1 TO 15*FT
  44. 1320 PRINT
  45. 1330    PRINT"Name (4 char) of field ";:PRINT USING"##";I;
  46. 1340    INPUT T$
  47. 1350    IF T$="" THEN GOTO 1330
  48. 1360    IF T$="stop" THEN 1500
  49. 1370    INPUT"Field type (a or n)      ";T1$
  50. 1380    IF T1$="" THEN T1$="a"
  51. 1390    IF T1$<>"a" THEN GOTO 1410
  52. 1400    GOTO 1450
  53. 1410    IF T1$<>"n" THEN GOTO 1430
  54. 1420    GOTO 1450
  55. 1430    PRINT"Type must be 'a' or 'n'
  56. 1440    GOTO 1370
  57. 1450    T$=T$+"     "
  58. 1460    T$=LEFT$(T$,4) ' chop down to 4 char
  59. 1470    T$=T$+","+T1$
  60. 1480    N$(I)=T$:C(I)=1
  61. 1490 NEXT I
  62. 1500 NC=I-1
  63. 1510 N$(I)="stop0" ' end cue for many routines
  64. 1520 GOSUB 1770 'cs5
  65. 1530 PRINT"Structure definition complete."
  66. 1540 PRINT: PRINT"Name:  "F$; TAB(20); "Type: "FT
  67. 1550 PRINT:PRINT"Fields are:"
  68. 1560 PRINT
  69. 1570 FOR I=1 TO NC
  70. 1580    IF LEFT$(N$(I),4)="stop" THEN GOTO 1630
  71. 1590    PRINT USING"##"; I;
  72. 1600    PRINT ".  "; LEFT$(N$(I),4); " "; RIGHT$(N$(I),1)
  73. 1610 NEXT I
  74. 1620 '
  75.  
  76.                 FINISH
  77.  
  78. 1630 PRINT
  79. 1640 INPUT"Do you approve?  (y/n) ", A$
  80. 1650 IF A$="" THEN A$="y"
  81. 1660 IF A$<>"y" THEN CLOSE: GOTO 1060
  82. 1670 CHAIN DD$(1)+"DEDIT",1000
  83. 1680 '
  84.  
  85.  
  86.                 UCV
  87.  
  88. 1690 Y$=""
  89. 1700 FOR J=1 TO LEN(X$)
  90. 1710    Y$=Y$+" "
  91. 1720    X=ASC(MID$(X$,J, 1))
  92. 1730    IF 96<X AND X<123 THEN MID$(Y$,J,1)=CHR$(X-32): GOTO 1750
  93. 1740    MID$(Y$,J,1)=MID$(X$,J,1)
  94. 1750 NEXT J
  95. 1760 RETURN
  96. 1770 '
  97.  
  98.  
  99.                 CLEAR SCREEN (TERM DEP)
  100.  
  101. 1780 PRINT CHR$(12);
  102. 1790 RETURN
  103. 1800 '
  104.  
  105.  
  106.                 OPEN UP FILES SUB
  107.                 GET NAME
  108.  
  109. 1810 F$=""
  110. 1820 C=0 ' clear change flag
  111. 1830 PRINT: PRINT TAB(13);: INPUT"Name of the file you want to open"; F$
  112. 1840 IF F$="" THEN 1830
  113. 1850 X$=F$
  114. 1860 GOSUB 1680 ' UCverter
  115. 1870 F$=Y$ ' make UC
  116. 1880 '
  117.  
  118.                 OPEN UP FILES FOR REAL
  119.  
  120. 1890 OPEN "R",1,DD$(3)+F$+".D"+FT$
  121. 1900 FIELD #1,128 AS R$
  122. 1910 OPEN "R",2,DD$(4)+F$+".DD"+FT$
  123. 1920 FIELD #2, 128 AS S$
  124. 1930 RETURN
  125. 1940 '
  126. 1950 '
  127.  
  128.                 ERROR HANDLING ROUTINES
  129.  
  130. 1960 IF ERR=53 AND ERL=1200 THEN RESUME 1210
  131. 1970 IF ERR=64 AND ERL=1890 THEN PRINT"*** Bad file name!":CLOSE:RESUME 1190
  132. 1980 IF ERR=61 AND (ERL=1890 OR ERL=1910) THEN CLOSE:RESUME 1190
  133. 1990 ON ERROR GOTO 0
  134. *** Bad file name!":CLOSE:RESUM