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.
