Main Menu

KB#00095-Conversion: LISTING.BB7 modified for Open Basic

Title:

Conversion: LISTING.BB7 modified for Open Basic

Description:

The following is a modified listing.bb7 for an Open Basic conversion given to us courtesy of Mike Rainbird. It includes modification for bringing programs over--not sure if works on all Open Basic. 


------------------- BXSND.OB follows -------------------- 
0010 REM " SEND PROGRAMS AND DATA FROM BB7 TO BBX 
0020 REM " <BXSND> 
0030 REM " (C) COPYRIGHT 1985, BASIS INC. ALL RIGHTS RESERVED. 
0100 REM 100" SETUP 
0110 BEGIN 
0120 PRINT 'CS',"SEND PROGRAMS AND DATA TO BBX",'LF','LF' 
0130 REM "********************** 
0140 REM "** 
0150 REM "** SET W5$ TO THE NAME OF THE SENDING BASIC 
0160 REM "** (BBX, SMC, BI, BBM, BB3, ETC.) 
0170 REM "** 
0180 REM "********************** 
0190 LET W5$="VS" 
1000 REM 1000************************************** 
1010 REM "** 
1020 REM "** GET A FILE LIST INTO F0$ 
1030 REM "** EACH VARIABLE-LENGTH NAME IS TERMINATED WITH A $00$ 
1040 REM "** 
1045 LET F0$="" 
1050 REM "***************************************** 
1051 INPUT (0,ERR=1051)"Filelist or Individual files ? (F/I) : ",TYPE$:("F"=970 
1051:0,"I"=1052) 
1060 PRINT "ENTER FILE NAMES TO SEND, ONE PER LINE (NULL LINE TO END)" 
1080 INPUT "FILE: ",Z$; IF Z$="" THEN GOTO 2080 
1090 IF Z$(LEN(Z$))="*" THEN GOSUB 9000; IF Z$="" THEN GOTO 1080 ELSE GOTO 1120
1100 OPEN (1,ERR=1140)Z$ 
1110 CLOSE (1) 
1120 LET F0$=F0$+Z$+$00$ 
1130 GOTO 1080 
1140 PRINT 'RB',"CANNOT OPEN ",Z$ 
1150 GOTO 1080 
2000 REM 2000************************************** 
2010 REM "** 
2020 REM "** OPEN SENDING FILE ON CHANNEL 7 
2030 REM "** IF FILE IS SERIAL PORT THE SET B9$ TO "COMM" 
2040 REM "** IF FILE IS INDEXED FILE IT NEEDS RECORD LENGTH 128 
2050 REM "** IF FILE IS STRING THEN NO PREPERATION IS NEEDED 
2060 REM "** 
2070 REM "***************************************** 
2080 IF F0$="" THEN STOP 
2090 LET B9$="" 
2100 PRINT 'LF', 
2110 INPUT "NAME OF OUTPUT FILE (OR PORT): ",Z$ 
2120 OPEN (7,ERR=2190)Z$ 
2130 IF ASC(FID(7))>16 THEN GOTO 2230 
2140 LET F$=FID(7); IF F$(10,1)=$07$ THEN GOTO 3000 
2150 PRINT 'LF','RB',"OUTPUT FILE MUST BE INDEXED WITH RECORD SIZE 128.",'LF' 
2160 GOTO 2100 
2190 PRINT "File: "+Z$+" Doesn't exist. Do you wish to create it? ",; INPUT (0 
2190:,ERR=2190)EH$:("Y"=2191,"y"=2191,"n"=2195,""=2195,"N"=2195) 
2192 STRING Z$,ERR=2195; GOTO 2120 
2195 GOSUB 6600 
2200 IF Z$="" THEN GOTO 2100 
2210 OPEN (7)Z$ 
2220 GOTO 3000 
2230 REM " COMMUNICATIONS 
2240 LET B9$="COMM" 
2250 PRINT "YOU SHOULD NOW START UP THE RECEIVING PROGRAM" 
2260 GOSUB 8500 
3000 REM 3000*************************************** 
3010 REM "** 
3020 REM "** SEND THE FILES 
3030 REM "** 
3040 REM "****************************************** 
3050 PRINT 'LF',"NOW SENDING FILES..." 
3060 LET B0$="<<BXBEGIN>>" 
3070 LET B$=W5$ 
3080 GOSUB 7000 
3110 REM " MAIN LOOP 
3120 IF F0$="" THEN GOTO 3310 
3130 LET Z=POS($00$=F0$) 
3140 LET F$=F0$(1,Z-1) 
3150 IF Z=LEN(F0$) THEN GOTO 3180 
3160 LET F0$=F0$(Z+1) 
3170 GOTO 3190 
3180 LET F0$="" 
3190 REM " OPEN THE FILE 
3200 OPEN (1,ERR=3110)F$ 
3210 PRINT 'LF',F$, 
3220 GOSUB 6400 
3230 IF F$>"" THEN GOTO 3270 
3240 PRINT 'RB',"...UNABLE TO SEND THIS TYPE OF FILE", 
3250 CLOSE (1) 
3260 GOTO 3110 
3270 LET B$=F$ 
3280 GOSUB 7000 
3290 IF F$(1,1)<>$04$ THEN GOTO 4500 
3300 GOTO 4000 
3310 REM " ALL DONE 
3320 LET B$="<<EOF>>" 
3330 GOSUB 7000 
3340 GOSUB 7150 
3350 PRINT 'LF','LF',"DONE" 
3360 STOP 
4000 REM 4000************************************** 
4010 REM "** 
4020 REM "** SEND A PROGRAM FILE 
4030 REM "** 
4040 REM "***************************************** 
4050 GOSUB 6200 
4060 REM LOOP 
4070 GOSUB 6000 
4080 IF Z$="" THEN GOTO 4130 
4090 LET SPLAT=SPLAT+1; IF MOD(SPLAT,1000)=0 THEN PRINT ".", 
4100 LET B$=Z$ 
4110 GOSUB 7000 
4120 GOTO 4060 
4130 LET B$="<<EOF>>" 
4140 GOSUB 7000 
4150 CLOSE (1) 
4160 GOTO 3110 
4500 REM 4500************************************* 
4510 REM "** 
4520 REM "** INDEXED/KEYED/SERIAL/STRING FILES 
4530 REM "** 
4540 REM "**************************************** 
4550 REM LOOP 
4560 LET SPLAT=SPLAT+1; IF MOD(SPLAT,1000)=0 THEN PRINT ".", 
4580 IF F$(2,1)>$00$ THEN LET B$=KEY(1,END=4660); GOSUB 7000 
4630 READ RECORD (1,END=4660)B$; GOSUB 7000 
4650 GOTO 4550 
4660 LET B$="<<EOF>>" 
4670 GOSUB 7000 
4680 CLOSE (1) 
4690 GOTO 3110 
6000 REM 6000,5**************************** 
6005 REM "** 
6010 REM "** FETCH NEXT PROGAM LINE AND RETURN IN Z$ IN LISTED FORM 
6015 REM "** ASSUME PROGRAM FILE OPENED ON CHANNEL 1 
6020 REM "** ASSUME P$ CONTAINING PROGRAM INFORMATION 
6025 REM "** RETURN Z$="" IF END OF PROGRAM REACHED 
6030 REM "** 
6035 REM "********************************* 
6040 LET Z$=P$,P$="" 
6045 READ (1,END=6065)P$; IF P$="" THEN GOTO 6045 
6046 IF Z$="" THEN GOTO 6040 
6050 LET P=POS(":"=P$); IF P>0 AND P<7 THEN LET Z$=Z$+P$(P+1),P$=""; GOTO 6045 
6065 RETURN 
6085 READ RECORD (1,SIZ=1024)Z$ 
6090 LET P$=P$+Z$ 
6095 RETURN 
6200 REM 6200******************************* 
6210 REM "** 
6220 REM "** INITIALIZE INPUT FROM PROGRAM FILE 
6230 REM "** ASSUMES PROGRAM OPENED ON CHANNEL 1 
6240 REM "** SETS UP P$ FOR PROCESSING BY GOSUB 6000 
6250 REM "** 
6260 REM "*********************************** 
6270 LET P$=FID(1); CLOSE (1); ERASE "TMP"+FID(0),ERR=6275 
6275 LIST PROGRAM P$(35),"TMP"+FID(0) 
6280 OPEN (1)"TMP"+FID(0); LET P$="" 
6290 RETURN 
6400 REM 6400********************************* 
6410 REM "** 
6420 REM "** RETURN BBX TYPE FID FOR FILE OPENED ON CHANNEL 1 IN F$ 
6430 REM "** RETURN F$="" IF FILE TYPE NOT APPLICABLE 
6440 REM "** SEE THE BBX MANUAL FOR FID FORMAT 
6450 REM "** 
6460 REM "************************************ 
6461 LET F$=FID(1),NEWVOL=INT(DEC(F$(25,4))*1.25),NEWVOL$=BIN(NEWVOL,3) 
6462 LET NAME$=F$(35) 
6463 FOR III=1 TO 999 
6464 LET P=POS("/"=NAME$) 
6465 IF P=0 THEN EXITTO 6470 
6466 LET NAME$=NAME$(P+1) 
6467 NEXT III 
6470 IF POS($0000$=NAME$)>0 THEN LET NAME$=NAME$(1,POS($0000$=NAME$)-1) 
6480 IF F$(10,1)=$04$ THEN LET F$=F$(10,2)+$00$+F$(12,3)+F$(15,2)+NAME$ ELSE LE 
6480:T F$=F$(10,2)+$00000000$+F$(15,2)+NAME$ 
6490 IF F$(1,1)=$02$ THEN LET F$(2,1)=CHR(ASC(F$(2))); REM EC(F$(3,4))>32767 TH 
6490:EN LET F$(2,1)=CHR(ASC(F$(2))-2) 
6495 IF POS(F$(1,1)=$00020407$)=0 THEN LET F$=""; RETURN 
6510 IF F$(1,1)=$07$ OR F$(1,1)=$03$ THEN LET F$(3,6)=$000000000000$ 
6520 RETURN 
6600 REM 6600************************************** 
6610 REM "** 
6620 REM "** CREATE AN OUTPUT FILE Z$. 
6630 REM "** SHOULD BE STRING FILE, OR INDEXED FILE WITH RECORD LENGTH 128 
6640 REM "** RETURN Z$="" IF FAILED 
6650 REM "** 
6660 REM "***************************************** 
6670 PRINT 'LF','RB',"FILE DOES NOT EXIST. PLEASE USE THE APPROPRIATE" 
6680 PRINT "UTILITY PROGRAM TO DEFINE YOUR OUTPUT FILE AS AN" 
6690 PRINT "INDEXED FILE WITH RECORD SIZE 128. BE SURE TO" 
6700 PRINT "MAKE THE FILE LARGE ENOUGH TO HOLD ALL YOUR INFORMATION." 
6710 PRINT "" 
6720 LET Z$=""; RETURN 
7000 REM 7000********************************** 
7010 REM "** 
7020 REM "** SEND VARIABLE-LENGTH BUFFER B$ 
7030 REM "** 
7040 REM "************************************* 
7050 LET B0$=B0$+STR(LEN(B$):"00000")+B$ 
7060 IF LEN(B0$)<=128 THEN RETURN 
7070 LET Z$=B0$(1,128),B0$=B0$(129) 
7080 IF B9$<>"COMM" THEN GOTO 7110 
7090 GOSUB 8000 
7100 GOTO 7060 
7110 WRITE RECORD (7,END=7130)Z$ 
7120 GOTO 7060 
7130 PRINT 'LF','RB',"OUTPUT FILE IS FULL!" 
7140 STOP 
7150 REM " FLUSH BUFFER B0$ 
7160 DIM Z$(128) 
7170 LET Z$(1)=B0$,B0$="" 
7180 GOTO 7080 
8000 REM 8000********************************* 
8010 REM "** 
8020 REM "** COMMUNICATIONS INTERFACE ROUTINES 
8030 REM "** OPEN COMMUNICATIONS PORT ON CHANNEL 7 
8040 REM "** GOSUB 8500 TO INITIALIZE 
8050 REM "** GOSUB 8100 TO SEND 1024-BYTE BUFFER IN Z$ 
8060 REM "** 
8070 REM "************************************ 
8100 REM 8100" SEND A 128-BYTE DATA PACKET (Z$) 
8110 REM " B0 = PACKET NUMBER 
8120 REM " B1 = CURRENT TRANSFER SIZE 
8121 PRINT (7)"Y", 
8140 GOSUB 8800 
8150 IF Z9$<>"Y" THEN GOTO 8140 
8160 LET B2$=LRC(Z$) 
8170 LET Z1$=STR(B0:"0000")+HTA(Z$)+HTA(B2$) 
8180 REM " SEND PACKET WITH PACKET NUMBER AND CHECKSUM 
8190 LET Z1=1 
8200 LET Z=LEN(Z1$(Z1)) 
8210 IF Z>B1 THEN LET Z=B1 
8220 PRINT (7)Z1$(Z1,Z), 
8230 GOSUB 8800 
8240 IF Z9$="N" THEN GOTO 8220 
8250 IF Z9$="Y" THEN GOTO 8280 
8260 LET B1=2^NUM(Z9$) 
8270 GOTO 8180 
8280 LET Z1=Z1+B1 
8290 IF Z1<=LEN(Z1$) THEN GOTO 8200 
8300 REM " PACKET SENT 
8310 LET B0=B0+1 
8320 IF B0>9999 THEN LET B0=0 
8330 RETURN 
8500 REM 8500" INITIALIZE COMM OUT 
8510 REM " CLEAR INPUT BUFFER 
8520 READ RECORD (7,SIZ=1000,TIM=1,ERR=8530)Z9$ 
8530 REM " WAIT FOR OK 
8540 PRINT "WAITING FOR RECEIVING PROGRAM....." 
8550 GOSUB 8800 
8560 IF Z9$<>"B" THEN GOTO 8550 
8570 PRINT (7)"Y", 
8580 LET B0=0,B1=256 
8600 RETURN 
8800 REM 8800,5" FETCH A CHARACTER AND STRIP HI BIT 
8805 READ RECORD (7,SIZ=1,TIM=60,ERR=8815)Z9$ 
8810 GOTO 8840 
8815 IF ERR=0 THEN GOTO 8830 
8820 PRINT 'LF','RB',"ERROR",ERR," DURING READ" 
8825 STOP 
8830 PRINT "*** WAITING FOR RECEIVING PROGRAM ***", 
8835 GOTO 8800 
8845 IF POS(Z9$="YN012345678B")=0 THEN GOTO 8805 
8850 RETURN 
9000 REM 9000" DO WILD CARD SCAN 
9010 INPUT (0,ERR=9010)"WILD CARD SCAN FROM WHICH DISK? ",D0:(7) 
9020 DIM A$(20) 
9030 REM GET D0,1,ERR=9500,A$ 
9040 OPEN (1,ERR=9500)A$(4,6) 
9050 LET A$=FID(1); IF A$(10,1)<>$0A$ THEN CLOSE (1); GOTO 9500 
9060 LET L=LEN(Z$)-1,Z0$=Z$(1,L),Z$=""; IF L>6 THEN GOTO 9400 
9070 LET F$=KEY(1,END=9100); READ (1) 
9080 LET F$=F$(4,6); IF F$(1,L)<>Z0$ THEN GOTO 9070 
9085 PRINT " ",F$ 
9090 LET F$=F$+$00$,Z$=Z$+F$(1,POS($00$=F$)); GOTO 9070 
9100 IF Z$>"" THEN LET Z$=Z$(1,LEN(Z$)-1) 
9400 CLOSE (1); RETURN 
9500 PRINT 'RB',"CANNOT ACCESS DIRECTORY ON DRIVE",D0; GOTO 9000 
9700 REM 9700 "enter filelist " 
9710 PRINT 'LF' 
9720 LET FILELIST$=""; INPUT "Enter filelist name (nnnnnn.f) ",FILELIST$ 
9721 REM LET FILELIST$="/util/fl/"+FILELIST$ 
9730 CLOSE (20); OPEN (20,ERR=9720)FILELIST$ 
9740 READ (20,END=9790)Z$ 
9750 LET F0$=F0$+Z$+$00$ 
9760 GOTO 9740 
9790 CLOSE (20) 
9800 GOTO 1060 



Last Modified: 12/05/2000 Product: PRO/5 Operating System: All platforms

BASIS structures five components of their technology into the BBx Generations.

  Google+ View BASIS LinkedIN ProfileVisit our Twitter Feed Check out our Facebook Public Profile Click to View the BASIS youTube channel