home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib33a.dsk / MARCH.1988 / BINARY.UP.bas < prev    next >
BASIC Source File  |  2023-02-26  |  5KB  |  111 lines
  1. 10  REM  ***************************
  2. 20  REM  * BINARY.UP               *
  3. 30  REM  * BY GARY LITTLE          *
  4. 40  REM  ***************************
  5. 100  NORMAL : TEXT : NOTRACE : HOME 
  6. 110  IF  PEEK(48896) = 76  THEN 130
  7. 120  PRINT "THIS PROGRAM REQUIRES PRODOS.": END 
  8. 130 D$ =  CHR$(4)
  9. 140  PRINT D$;"PREFIX": INPUT PX$
  10. 150 CD = 8192: REM  CODE START
  11. 160 EC = CD +21: REM  ERROR CODE LOCATION
  12. 170 PN = CD +22: REM  PATHNAME LOCATION
  13. 180 DT = 10752: REM  BLOCK BUFFER ADDRESS ($2A00)
  14. 190  DIM F$(255): REM  FILENAMES
  15. 200  FOR I = CD TO CD +360: READ X: POKE I,X: NEXT 
  16. 210  PRINT "[BINARY.UP]": PRINT 
  17. 220  PRINT "PRODOS TO BINARY II FILE CONVERTER"
  18. 230  PRINT "(VERSION 1.50 --- APRIL 5, 1987)"
  19. 240  PRINT "BY ";: INVERSE : PRINT "GARY B. LITTLE": NORMAL 
  20. 250  PRINT : PRINT "THIS IS A PUBLIC DOMAIN PROGRAM.": PRINT 
  21. 260  PRINT "THIS PROGRAM CREATES A BINARY II"
  22. 270  PRINT "FILE FROM A GROUP OF PRODOS FILES."
  23. 280  PRINT : PRINT "ENTER THE NAME OF THE DIRECTORY IN"
  24. 290  PRINT "WHICH THE PRODOS FILES ARE STORED"
  25. 300  PRINT "( E.G. /MYDISK/MYFILES/ ):": PRINT 
  26. 310  INPUT "";PF$: IF PF$ = ""  THEN  HOME : END 
  27. 320  ONERR  GOTO 340
  28. 330  PRINT D$;"PREFIX";PF$: POKE 216,0: GOTO 360
  29. 340  PRINT : PRINT "THAT DIRECTORY DOES NOT EXIST."
  30. 350  PRINT "PRESS ANY KEY TO CONTINUE:";: GET A$: PRINT A$: PRINT : GOTO 280
  31. 360  HOME : PRINT "ENTER THE NAMES OF THE PRODOS FILES"
  32. 370  PRINT "(PRESS [RETURN] WHEN DONE):"
  33. 380 NF = 1
  34. 390  PRINT : PRINT "ENTER THE NAME OF PRODOS FILE #";NF;": ";
  35. 400  INPUT "";F$(NF):L =  LEN(F$(NF))
  36. 410  IF L >15  THEN  PRINT "ERROR: ILLEGAL FILENAME.": GOTO 390
  37. 420  IF L = 0  THEN 470
  38. 430  POKE PN,L: FOR I = 1 TO L: POKE PN +I, ASC( MID$ (F$(NF),I,1)): NEXT 
  39. 440  CALL CD +18: REM  GET SIZE OF FILE
  40. 450  IF  PEEK(EC) < >0  THEN  PRINT "ERROR: CAN'T FIND FILE.": GOTO 390
  41. 460 NF = NF +1: GOTO 390
  42. 470 NF = NF -1: IF NF = 0  THEN  HOME : END 
  43. 480  PRINT : PRINT "ENTER THE PATHNAME OF THE BINARY II"
  44. 490  PRINT "FILE TO BE CREATED: ";: INPUT "";AB$
  45. 500  IF AB$ = ""  THEN  HOME : GOTO 1060
  46. 510 L =  LEN(AB$): IF L >64  THEN 480
  47. 520  ONERR  GOTO 540
  48. 530  PRINT D$;"CREATE";AB$;",TBIN": POKE 216,0: GOTO 560
  49. 540  IF  PEEK(222) = 19  THEN  PRINT D$;"DELETE";AB$: GOTO 530
  50. 550  GOTO 830
  51. 560  POKE PN,L: FOR I = 1 TO L: POKE PN +I, ASC( MID$ (AB$,I,1)): NEXT 
  52. 570  CALL CD +0: GOSUB 1000: REM  OPEN BINARY II FILE
  53. 580  HOME 
  54. 590  FOR J = 1 TO NF
  55. 600 L =  LEN(F$(J))
  56. 610  POKE PN,L: FOR I = 1 TO L: POKE PN +I, ASC( MID$ (F$(J),I,1)): NEXT 
  57. 620  PRINT "STORING... ";
  58. 630  FOR I = 1 TO L
  59. 640 CH =  ASC( MID$ (F$(J),I,1)): IF CH <128  THEN CH = CH +128
  60. 650  PRINT  CHR$(CH);: NEXT : PRINT 
  61. 660  REM  CREATE THE HEADER
  62. 670  CALL CD +3: GOSUB 1000: REM  OPEN/FORM HEADER
  63. 680  POKE DT +127,NF -J: REM  FILES TO FOLLOW
  64. 690  REM  WRITE THE HEADER
  65. 700  CALL CD +9: GOSUB 1000
  66. 710 EF =  PEEK(DT +20) +256 * PEEK(DT +21) +65536 * PEEK(DT +22)
  67. 720  IF EF = 0  THEN 780
  68. 730  CALL CD +6: REM  READ 128 BYTES
  69. 740  IF  PEEK(EC) = 76  THEN 780: REM  BRANCH IF EOF
  70. 750  GOSUB 1000
  71. 760  CALL CD +9: GOSUB 1000: REM  WRITE 128 BYTES
  72. 770  GOTO 730
  73. 780  CALL CD +15: GOSUB 1000: REM  CLOSE PRODOS FILE
  74. 790  NEXT J
  75. 800  CALL CD +12: REM  CLOSE BINARY II FILE
  76. 810  PRINT : PRINT "THE BINARY II FILE, ";AB$;","
  77. 820  PRINT "HAS NOW BEEN CREATED.": GOTO 1060
  78. 830  PRINT : PRINT "ERROR: CAN'T CREATE ";AB$
  79. 840  PRINT "APPLESOFT ERROR #"; PEEK(222): GOTO 1060
  80. 1000 EN =  PEEK(EC): REM  GET ERROR CODE
  81. 1010  IF EN = 0  THEN  RETURN 
  82. 1020  POP : PRINT D$;"CLOSE"
  83. 1030  IF EN = 70  OR EN = 64  THEN  PRINT : PRINT "ERROR: FILE NOT FOUND": GOTO 1060
  84. 1040  IF EN = 72  THEN  PRINT : PRINT "ERROR: DISK IS FULL": GOTO 1060
  85. 1050  POP : PRINT : PRINT "ERROR: MLI CODE #";EN: GOTO 1060
  86. 1060  PRINT D$;"PREFIX";PX$: END 
  87. 5000  DATA  76,116,32,76,132,32,76,247,32,76,11,33,76,21,33
  88. 5010  DATA  76,27,33,76,87,32,0,0,0,0,0,0,0,0,0
  89. 5020  DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  90. 5030  DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  91. 5040  DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  92. 5050  DATA  0,0,0,0,0,0,0,0,0,0,0,0,32,0,191
  93. 5060  DATA  196,85,33,32,39,33,24,173,103,33,109,93,33,141,103
  94. 5070  DATA  33,173,104,33,109,94,33,141,104,33,96,32,0,191,200
  95. 5080  DATA  57,33,32,39,33,173,62,33,141,78,33,96,32,236,32
  96. 5090  DATA  169,10,141,0,42,169,2,141,18,42,173,103,33,141,117
  97. 5100  DATA  42,173,104,33,141,118,42,169,23,141,1,42,169,42,141
  98. 5110  DATA  2,42,174,22,32,189,22,32,157,23,42,202,16,247,32
  99. 5120  DATA  0,191,196,0,42,32,39,33,169,71,141,1,42,169,76
  100. 5130  DATA  141,2,42,32,0,191,200,63,33,32,39,33,173,68,33
  101. 5140  DATA  141,70,33,141,56,33,141,19,42,173,4,42,201,15,240
  102. 5150  DATA  9,32,0,191,209,18,42,32,39,33,96,162,127,169,0
  103. 5160  DATA  157,0,42,202,16,250,96,32,236,32,32,0,191,202,69
  104. 5170  DATA  33,144,5,201,76,208,1,24,32,39,33,96,32,0,191
  105. 5180  DATA  203,77,33,32,39,33,96,169,0,56,32,39,33,169,0
  106. 5190  DATA  141,21,32,32,0,191,204,55,33,96,141,21,32,144,8
  107. 5200  DATA  104,104,32,0,191,204,53,33,96,1,0,1,0,3,22
  108. 5210  DATA  32,0,34,0,3,22,32,0,38,0,4,0,0,42,128
  109. 5220  DATA  0,0,0,4,0,0,42,128,0,0,0,10,22,32,0
  110. 5230  DATA  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  111. 5240  DATA  0