12-Oct-85 19:06:45-MDT,2884;000000000001 Return-Path: Received: from BRL-TGR.ARPA by SIMTEL20.ARPA with TCP; Sat 12 Oct 85 19:06:39-MDT Received: from usenet by TGR.BRL.ARPA id a004657; 12 Oct 85 20:42 EDT From: "R.D.Eager" Newsgroups: net.sources Subject: uudecode in GW-BASIC Message-ID: <284@ukc.UUCP> Date: 12 Oct 85 13:00:41 GMT Keywords: uudecode,GW-BASIC To: unix-sources@BRL-TGR.ARPA 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