rde@ukc.UUCP (R.D.Eager) (10/12/85)
Here is a simple uudecode program written in GW-BASIC (actually for
the Ferranti Advance 86b, but I guess it makes little difference.
I hope this is useful to those who don't have access to binary
file transfers from their news systems to their PCs, or who don't
have uudecode at all.
--------------------------------------------------------------------------
1000 DEFINT A-Z
1010 REM Trap filing errors
1020 ON ERROR GOTO 1500
1030 CLS
1040 LOCATE 5,11
1050 PRINT STRING$(40," ")
1060 LOCATE 5,11
1070 INPUT "Enter name of input file: ", INFILE$
1080 OPEN INFILE$ FOR INPUT AS #1
1090 LOCATE 8,10
1100 PRINT STRING$(40," ")
1110 LOCATE 8,10
1120 INPUT "Enter name of output file: ", OUTFILE$
1130 OPEN "R", #2,OUTFILE$, 1
1140 FIELD #2, 1 AS N$
1150 REM Search for header line
1160 LINE INPUT #1,A$
1170 IF LEFT$(A$,5) <>"begin" THEN 1160
1180 LOCATE 11,10
1190 PRINT "Header = ";A$
1200 SP = ASC(" ")
1210 DIM BUF(5000)
1220 P = 0
1230 REM Main loop
1240 LINE INPUT #1, A$
1250 P = 0
1260 COUNT = ASC(LEFT$(A$,1)) - SP
1270 IF COUNT = 0 THEN 1460
1280 ADJ = COUNT MOD 4
1290 FOR I = 2 TO LEN(A$) STEP 4
1300 X1 = ASC(MID$(A$,I,I)) - SP
1310 X2 = ASC(MID$(A$,I+1,I+1)) - SP
1320 X3 = ASC(MID$(A$,I+2,I+2)) - SP
1330 X4 = ASC(MID$(A$,I+3,I+3)) - SP
1340 P = P + 1
1350 BUF(P) = (X2\16) + (X1*4)
1360 P = P + 1
1370 BUF(P) = (X3\4) + ((X2 MOD 16) * 16)
1380 P = P + 1
1390 BUF(P) = X4 + ((X3 MOD 4) * 64)
1400 NEXT I
1410 FOR I = 1 TO P
1420 LSET N$ = CHR$(BUF(I))
1430 PUT #2
1440 NEXT I
1450 GOTO 1240
1460 END
1470 REM
1480 REM Error trapping routine for file handling
1490 REM
1500 IF ERL <> 1080 GOTO 1550 ' not input file problem
1510 LOCATE 22,20
1520 PRINT "Can't open input file"
1530 GOSUB 1680
1540 RESUME 1040
1550 IF ERL <> 1120 GOTO 1600 ' not output file problem
1560 LOCATE 22,20
1570 PRINT "Can't open output file"
1580 GOSUB 1680
1590 RESUME 1090
1600 IF ERL <> 1160 THEN 1670
1610 LOCATE 22,20
1620 PRINT "Header line not found"
1630 GOSUB 1680
1640 GOSUB 1680
1650 LOCATE 24,1
1660 END
1670 ERROR ERR
1680 FOR I = 1 TO 3000: NEXT I
1690 LOCATE 22,20
1700 PRINT STRING$(30," ")
1710 RETURN
--------------------------------------------------------------------------
--
Bob Eager
rde@ukc.UUCP
rde@ukc
...!mcvax!ukc!rde
Phone: +44 227 66822 ext 7589