home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 014 / append.arc / APPEND.BAS (.txt) next >
Encoding:
GW-BASIC  |  1985-12-06  |  4.1 KB  |  128 lines
  1. 10  '*************************************************************************
  2. 20  '*************************************************************************
  3. 30  '
  4. 40  'APPEND,  Version 1.0
  5. 50  'Author:  J. Crone
  6. 60  'Date:    1-25-82
  7. 70  '
  8. 80  'Copyright 1982 by Personal Computer Age.  All rights reserved.
  9. 90  'This program is published for the personal use of readers of Personal
  10. 100  'Compurter Age.  Commercial use is prohibited.
  11. 110  '
  12. 120  '*************************************************************************
  13. 130  '*************************************************************************
  14. 140  '
  15. 150  '
  16. 160  'Initialize.
  17. 170  DEFINT A-Z:KEY OFF:CLS
  18. 180  CLOSE 'any oper files.
  19. 190  'Set the following variable equal to a number slightly larger than
  20. 200  'the length of the average line in the files you will be appending.
  21. 210  AVG.LINE.LEN=140
  22. 220  ARRAY.SIZE = FRE(0)/(AVG.LINE.LEN + 1)
  23. 230  DIM TRANSFER$(ARRAY.SIZE)
  24. 240  '
  25. 250  '
  26. 260  'Display title and instructins.
  27. 261  DATA "           FILE APPEND PROGRAM           "
  28. 270  DATA "To append a file to an existing document, copy both files to"
  29. 280  DATA "floppy diskette (which should be in Drive a:), or to the main"
  30. 290  DATA "directory.  "
  31. 300  DATA "   "
  32. 310  DATA "Enter file names as requested.  An output file is required"
  33. 320  DATA "and may be a new file or an existing file.  Up to eight"
  34. 330  DATA "append files may be entered. "
  35. 331  DATA "    "
  36. 332  DATA "After completion the output file will contain all files "
  37. 340  DATA "in the order entered. "
  38. 341  DATA "  "
  39. 350  DATA "Type '/' as the last entry to start execution."
  40. 351  DATA " "
  41. 360  DATA "Note: this utility works on text files only, and assumes a"
  42. 365  DATA "maximum line length of 140 characters.  Longer lines require a"
  43. 366  DATA "program change."
  44. 370  COLOR 0,7:READ TEXT$:LOCATE 3,(40-(LEN(TEXT$)/2)):PRINT TEXT$:COLOR 7,0
  45. 380  COL = 10:FOR I = 5 TO 15:LOCATE I,COL:READ TEXT$:PRINT TEXT$:NEXT I
  46. 390  PRINT:FOR I=17 TO 21:LOCATE I,COL:READ TEXT$:PRINT TEXT$:NEXT I
  47. 400  '
  48. 410  '
  49. 420  LOCATE 25,25:COLOR 8,1:INPUT "Press Return Key to continue!",I$:COLOR 0,1
  50. 430  'Get output file name.
  51. 440  ON ERROR GOTO 960
  52. 450  I = 1
  53. 460  CLS
  54. 470  COL=25:LOCATE 13,COL:LINE INPUT; "Output File Name    - ",FILE.NAME$(I)
  55. 480  IF INSTR(FILE.NAME$(I),"/") THEN GOTO 870 'Abort.
  56. 490  OPEN FILE.NAME$(I) FOR APPEND AS #1
  57. 500  '
  58. 510  '
  59. 520  'Get append file names.
  60. 530  FOR I = 2 TO 9
  61. 540  LOCATE 25,1:PRINT SPC(79)
  62. 550  LOCATE 12 + I,COL: PRINT USING "Append File Name  _## - ";(I-1);
  63. 560  LINE INPUT FILE.NAME$(I)
  64. 570  IF INSTR(FILE.NAME$(I),"/") THEN GOTO 650 'done.
  65. 580  'Test for good file specification.
  66. 590  OPEN FILE.NAME$(I) FOR INPUT AS #2:CLOSE #2
  67. 600  NEXT I
  68. 610  IF I = 10 THEN I = 9
  69. 620  ON ERROR GOTO 0
  70. 630  '
  71. 640  '
  72. 650  'Do the job.
  73. 660  LOCATE 25,1:PRINT SPC(79)
  74. 670  FOR J = 2 TO (I-1)
  75. 680  LOCATE 25,1:PRINT SPC(79);
  76. 690  COLOR 23,0:LOCATE 25.25:PRINT "Appending ",FILE.NAME$(J);:COLOR 7,0
  77. 700  OPEN FILE.NAME$(J) FOR INPUT AS #2
  78. 710  ERASE TRANSFER$ 'Garbage collection, the fast way.
  79. 720  DIM TRANSFER$(ARRAY.SIZE)
  80. 730  FOR K = 0 TO ARRAY.SIZE 'Read lines from input file.
  81. 740  IF EOF(2) THEN GOTO 770
  82. 750  LINE INPUT #2,TRANSFER$(K)
  83. 760  NEXT K
  84. 770  IF K = 0 THEN GOTO 820
  85. 780  FOR L = 0 TO (K-1) 'Write lines to output file.
  86. 790  PRINT #1, TRANSFER$(L)
  87. 800  NEXT L
  88. 810  GOTO 710
  89. 820  CLOSE #2 'Input file.
  90. 830  NEXT J
  91. 840  CLOSE #1 'Output file.
  92. 850  '
  93. 860  '
  94. 870  'More work to do?
  95. 880  LOCATE 25,1:PRINT SPC(79);:LOCATE 24,15
  96. 890  PRINT
  97. 891  LINE INPUT; "Job Complete.  More files to transfer? (Y/N) ";RESPONSE$
  98. 900  IF LEFT$(RESPONSE$,1) = "Y" OR LEFT$(RESPONSE$,1) = "y" THEN GOTO 930
  99. 910  CLS:SYSTEM 'system 'Job complete, return to DOS.
  100. 920  'Erase screen and go again.
  101. 930  FOR I = 11 TO 25: LOCATE I,1:PRINT SPC(78);: NEXT I
  102. 940  GOTO 430
  103. 950  '
  104. 960  'Trap common errors.
  105. 970  BEEP
  106. 980  MSG52$ = "Last entry must be `\'"
  107. 990  MSG53$ = "That file does not exist.  Please reenter."
  108. 1000  MSG64$ = "Incorrect file specification.  Please reenter."
  109. 1010  MSG67$ = "Bad file name or too many files.  Reenter or use a new disk."
  110. 1020  MSG70$ = "Remove write protect tab from disk."
  111. 1030  MSG71$ = "Put a disk in the drive and close the door."
  112. 1040  LOCATE 25,1:PRINT SPC(79);:LOCATE 25,1
  113. 1050  TRAP = 0
  114. 1060  IF ERR = 52 THEN PRINT MSG52$;:TRAP = 1
  115. 1070  IF ERR = 53 THEN PRINT MSG53$;: TRAP = 1
  116. 1080  IF ERR = 64 THEN PRINT MSG54$;: TRAP = 1
  117. 1090  IF ERR = 67 THEN PRINT MSG67$;: TRAP = 1
  118. 1100  IF ERR = 70 THEN PRINT MSG70$;: TRAP = 1
  119. 1110  IF ERR = 71 THEN PRINT MSG71$;: TRAP = 1
  120. 1120  IF TRAP = 0 THEN GOTO 1160
  121. 1130  'Found the problem.  Go back and try again.
  122. 1140  LOCATE 12 + I,1:PRINT SPC(79);
  123. 1150  IF I = 1 THEN RESUME 470 ELSE RESUME 550
  124. 1160  'Not a common error. Let the system handle it.
  125. 1170  ON ERROR GOTO 0:CLOSE
  126. 1180  SAV.ERR = ERR:RESUME 1190
  127. 1190  ERROR SAV.ERR:SYSTEM
  128.