home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / unix_c / mail / uudecode.bsc < prev    next >
Encoding:
Text File  |  1989-03-21  |  2.8 KB  |  103 lines
  1. 12-Oct-85 19:06:45-MDT,2884;000000000001
  2. Return-Path: <unix-sources-request@BRL.ARPA>
  3. Received: from BRL-TGR.ARPA by SIMTEL20.ARPA with TCP; Sat 12 Oct 85 19:06:39-MDT
  4. Received: from usenet by TGR.BRL.ARPA id a004657; 12 Oct 85 20:42 EDT
  5. From: "R.D.Eager" <rde@ukc.uucp>
  6. Newsgroups: net.sources
  7. Subject: uudecode in GW-BASIC
  8. Message-ID: <284@ukc.UUCP>
  9. Date: 12 Oct 85 13:00:41 GMT
  10. Keywords: uudecode,GW-BASIC
  11. To:       unix-sources@BRL-TGR.ARPA
  12.  
  13.  
  14. Here is a simple uudecode program written in GW-BASIC (actually for
  15. the Ferranti Advance 86b, but I guess it makes little difference.
  16.  
  17. I hope this is useful to those who don't have access to binary
  18. file transfers from their news systems to their PCs, or who don't
  19. have uudecode at all.
  20.  
  21. --------------------------------------------------------------------------
  22. 1000 DEFINT A-Z
  23. 1010 REM Trap filing errors
  24. 1020 ON ERROR GOTO 1500
  25. 1030 CLS
  26. 1040 LOCATE 5,11
  27. 1050 PRINT STRING$(40," ")
  28. 1060 LOCATE 5,11
  29. 1070 INPUT "Enter name of input file: ", INFILE$
  30. 1080 OPEN INFILE$ FOR INPUT AS #1
  31. 1090 LOCATE 8,10
  32. 1100 PRINT STRING$(40," ")
  33. 1110 LOCATE 8,10
  34. 1120 INPUT "Enter name of output file: ", OUTFILE$
  35. 1130 OPEN "R", #2,OUTFILE$, 1
  36. 1140 FIELD #2, 1 AS N$
  37. 1150 REM Search for header line
  38. 1160 LINE INPUT #1,A$
  39. 1170 IF LEFT$(A$,5) <>"begin" THEN 1160
  40. 1180 LOCATE 11,10
  41. 1190 PRINT "Header = ";A$
  42. 1200 SP = ASC(" ")
  43. 1210 DIM BUF(5000)
  44. 1220 P = 0
  45. 1230 REM Main loop
  46. 1240 LINE INPUT #1, A$
  47. 1250 P = 0
  48. 1260 COUNT = ASC(LEFT$(A$,1)) - SP
  49. 1270 IF COUNT = 0 THEN 1460
  50. 1280 ADJ = COUNT MOD 4
  51. 1290 FOR I = 2 TO LEN(A$) STEP 4
  52. 1300    X1 = ASC(MID$(A$,I,I)) - SP
  53. 1310    X2 = ASC(MID$(A$,I+1,I+1)) - SP
  54. 1320    X3 = ASC(MID$(A$,I+2,I+2)) - SP
  55. 1330    X4 = ASC(MID$(A$,I+3,I+3)) - SP
  56. 1340    P = P + 1
  57. 1350    BUF(P) = (X2\16) + (X1*4)
  58. 1360    P = P + 1
  59. 1370    BUF(P) = (X3\4) + ((X2 MOD 16) * 16)
  60. 1380    P = P + 1
  61. 1390    BUF(P) = X4 + ((X3 MOD 4) * 64)
  62. 1400 NEXT I
  63. 1410 FOR I = 1 TO P
  64. 1420   LSET N$ = CHR$(BUF(I))
  65. 1430   PUT #2
  66. 1440 NEXT I
  67. 1450 GOTO 1240
  68. 1460 END
  69. 1470 REM
  70. 1480 REM Error trapping routine for file handling
  71. 1490 REM
  72. 1500 IF ERL <> 1080 GOTO 1550          ' not input file problem
  73. 1510 LOCATE 22,20
  74. 1520 PRINT "Can't open input file"
  75. 1530 GOSUB 1680
  76. 1540 RESUME 1040
  77. 1550 IF ERL <> 1120 GOTO 1600          ' not output file problem
  78. 1560 LOCATE 22,20
  79. 1570 PRINT "Can't open output file"
  80. 1580 GOSUB 1680
  81. 1590 RESUME 1090
  82. 1600 IF ERL <> 1160 THEN 1670
  83. 1610 LOCATE 22,20
  84. 1620 PRINT "Header line not found"
  85. 1630 GOSUB 1680
  86. 1640 GOSUB 1680
  87. 1650 LOCATE 24,1
  88. 1660 END
  89. 1670 ERROR ERR
  90. 1680 FOR I = 1 TO 3000: NEXT I
  91. 1690 LOCATE 22,20
  92. 1700 PRINT STRING$(30," ")
  93. 1710 RETURN
  94. --------------------------------------------------------------------------
  95. -- 
  96.            Bob Eager
  97.  
  98.            rde@ukc.UUCP
  99.            rde@ukc
  100.            ...!mcvax!ukc!rde
  101.  
  102.            Phone: +44 227 66822 ext 7589
  103.