home *** CD-ROM | disk | FTP | other *** search
/ The CIA World Factbook 1992 / k3bimage.iso / sel / 12 / 0156 / copfile.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1982-03-13  |  3.5 KB  |  155 lines

  1. 10  COMMON DRIVEID$,FILEID$
  2. 15  DIM CATARRY$(100)
  3. 20  CLS
  4. 30  PRINT " "
  5. 40  PRINT "     EASY-File Copy Files"
  6. 50  PRINT " "
  7. 60  PRINT " "
  8. 70  INPUT " File to be copied"; FROMFILE$
  9. 80  PRINT " "
  10. 90  INPUT " File to be created"; TOFILE$
  11. 100  I=0
  12. 110  PRINT " Enter up to 100 categories to be"
  13. 120  PRINT " copied."
  14. 130  FOR I= 1 TO 100
  15. 135  IF ENDSW <=> 0 THEN 190
  16. 140  INPUT " Category ==>";CATARRY$(I)
  17. 150  IF LEN(CATARRY$(I)) > 40 THEN PRINT " Too Long -- Reenter" ELSE 180
  18. 160  GOTO 140
  19. 180  IF LEN(CATARRY$(I))= 0   THEN ENDSW=I-1
  20. 190  NEXT
  21. 200  CLS
  22. 210  PRINT " "
  23. 220  PRINT "    EASY-File Copy Files "
  24. 230  PRINT " "
  25. 240  PRINT "  Place "+FROMFILE$+" in appropriate drive"
  26. 250  PRINT " "
  27. 260  PRINT "  Place "+TOFILE$+" in appropriate drive"
  28. 270  PRINT " "
  29. 280  INPUT " Do you want to COPY or CREATE file?
  30. 290  INPUT " Enter option";OPTION$
  31. 291  IF OPTION$="Copy" THEN 300
  32. 292  IF OPTION$="Create" THEN 300
  33. 293  GOTO 290
  34. 300  GOSUB 330
  35. 305  IF OPTION$= "COPY" THEN 600
  36. 310  IF OPTION$="CREATE" THEN 400
  37. 320  PRINT " Invalid Response"
  38. 330  OPEN FROMFILE$ AS #1 LEN = 128
  39. 331  FIELD #1, 2 AS FBUCKET1$, 2 AS FBUCKET2$, 2 AS FBUCKET3$, 2 AS FBUCKET4$, 40 AS FLINE1$, 40 AS FLINE2$, 40 AS FLINE3$
  40. 340  OPEN TOFILE$ AS #2 LEN = 128
  41. 341  FIELD #2, 2 AS TBUCKET1$, 2 AS TBUCKET2$, 2 AS TBUCKET3$, 2 AS TBUCKET4$, 40 AS TLINE1$, 40 AS TLINE2$, 40 AS TLINE3$
  42. 350  RETURN
  43. 400  LSET TBUCKET1$ = MKI$(2)
  44. 410  LSET TBUCKET2$ = MKI$(2)
  45. 420  LSET TBUCKET3$ = MKI$(2)
  46. 430  LSET TBUCKET4$ = MKI$(1)
  47. 440  PRINT " "
  48. 450  INPUT "  Company Name==>";NAM$
  49. 460  INPUT "  Purpose     ==>";PURP$
  50. 470  LSET TLINE1$ = NAM$
  51. 480  LSET TLINE2$ = PURP$
  52. 490  LSET TLINE3$ = " "
  53. 495  LOCATE 23,$
  54. 500  COLOR  31, 0, 14
  55. 510  PRINT "File Being Built"
  56. 520  COLOR 15,9,4
  57. 530  LOCATE 23,8
  58. 540  PUT #2,1
  59. 550  TFIRSTCAT=2
  60. 555  TLASTCAT=2
  61. 560  TLASTREC=2
  62. 565  TNUMCAT = 1
  63. 570  FIRSTSW = 1
  64. 571  LSET BUCKET1$=MKI$(0)
  65. 572  LSET BUCKET2$=MKI$(0)
  66. 573  LSET BUCKET3$=MKI$(0)
  67. 574  LSET BUCKET4$=MKI$(3)
  68. 575  LSET LINE1$=" "
  69. 577  LSET LINE3$=" "
  70. 578  FOR I=2 TO 1003
  71. 579  PUT #2,I
  72. 580  NEXT
  73. 585  PRINT " File has been Built"
  74. 600  GET #1,1
  75. 620  FLASTCAT=CVI(FBUCKET2$)
  76. 630  FRECNUM=CVI(FBUCKET1$)
  77. 640  IF FIRSTSW=1
  78. 650  GET #2,1
  79. 655  TFIRSTCAT=CVI(TBUCKET1$)
  80. 660  TLASTCAT=CVI(TBUCKET2$)
  81. 665  TLASTREC=CVI(TBUCKET3$)
  82. 670  TNUMCAT=CVI(TBUCKET4$)
  83. 675  LSET LINE2$=" "
  84. 680  FIRSTSW=0
  85. 700  IF FRECNUM = 0   THEN GOTO 1500
  86. 710  GET #1,FRECNUM
  87. 720  GOSUB 900
  88. 725  FRECNUM=CVI(BUCKET2$)
  89. 730  IF FOUND=1      THEN GOSUB 1000
  90. 735  GOTO 700
  91. 900  FOUND=0
  92. 910  FOR I=1 TO ENDSW
  93. 915  IF FOUND=1  THEN 950
  94. 920  LFLINE1 = LEN(CATARRY$(I)
  95. 925  IF CATARRY$(I) = LEFT$ (FLINE1$, LFLINE1) THEN FOUND =1
  96. 950  NEXT
  97. 960  RETURN
  98. 1000  IF FIRSTSW = 1  THEN 1050
  99. 1005  TLASTSAVE = TLASTCAT
  100. 1008  GOSUB 1300
  101. 1010  TLASTCAT = TLASTREC+1
  102. 1020  TLASTREC = TLASTREC +1
  103. 1030  TNUMCAT=TNUMCAT+1
  104. 1050  FIRSTSW=0
  105. 1060  TRECNUM=TLASTREC
  106. 1070  IF TRECNUM > 1000  THEN GOTO 1400
  107. 1080  LSET TBUCKET1$= MKI$(TLASTSAVE)
  108. 1090  LSET TBUCKET2$=MKI$(0)
  109. 1100  LSET TBUCKET4$=MKI$(2)
  110. 1110  LSET TLINE1$=FLINE1$
  111. 1120  LSET TLINE2$=FLINE2$
  112. 1130  LSET TLINE3$=FLINE3$
  113. 1135  PRINT "   "+CATARRY#I(I)" being copied"
  114. 1140  LSET TBUCKET3$=MKI$(0)
  115. 1150  IF CVI(FBUCKET3$) <> 0 THEN LSET TBUCKET3$= MKI$(TRECNUM+1)
  116. 1160  PUT #2,TRECNUM
  117. 1170  FRECNUM2=CVI(FBUCKET3$)
  118. 1180  TFROMSUB=0
  119. 1200  IF FRECNUM2=0 THEN 1290
  120. 1205  GET #1,FRECNUM2
  121. 1210  TLASTREC=TLASTREC+1
  122. 1211  LSET TBUCKET1$=MKI$(TLASTCAT)
  123. 1212  LSET TBUCKET2$=MKI$(0)
  124. 1213  IF CVI(FBUCKET2$) <> 0 THEN LSET TBUCKET2$=MKI$(TLASTREC+1)
  125. 1214  LSET TBUCKET3$=MKI$(TFROMSUB)
  126. 1215  LSET TBUCKET4$=MKI$(3)
  127. 1216  LSET TLINE1$=FLINE1$
  128. 1217  LSET TLINE2$=FLINE2$
  129. 1218  LSET TLINE3$=FLINE3$
  130. 1219  TRECNUM=TLASTREC
  131. 1220  IF TRECNUM > 1000 THEN GOTO 1400
  132. 1225  PUT #2,TRECNUM
  133. 1230  FRECNUM2=CVI(FBUCKET2$)
  134. 1240  TFROMSUB=TRECNUM
  135. 1250  GOTO 1200
  136. 1290  RETURN
  137. 1300  GET #2,TLASTCAT
  138. 1310  LSET TBUCKET2$=MKI$(TLASTREC+1)
  139. 1320  PUT #2,TLASTCAT
  140. 1330  RETURN
  141. 1400  REM   File Overflow Routine
  142. 1410  PRINT "File "+TOFILE$+" if Full"
  143. 1420  PRINT "Category Copy Aborted"
  144. 1430  GOTO 1510
  145. 1500  PRINT "Copy is Complete"
  146. 1510  GET #2,1
  147. 1520  LSET TBUCKET1$=MKI$(TFIRSTCAT)
  148. 1525  LSET TBUCKET2$=MKI$(TLASTCAT)
  149. 1530  LSET TBUCKET3$=MKI$(LASTREC)
  150. 1540  LSET TBUCKET4$=MKI$(TNUMCAT)
  151. 1545  PUT #2,1
  152. 1550  CLOSE #1
  153. 1560  CLOSE #2
  154. 1570  CHAIN DRIVEID$+"FileMenu"
  155.