home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
progbas
/
baswiz13.arj
/
TERM.BAS
< prev
Wrap
BASIC Source File
|
1990-07-08
|
6KB
|
148 lines
' +----------------------------------------------------------------------+
' | |
' | BASWIZ Copyright (c) 1990 Thomas G. Hanlin III |
' | |
' | The BASIC Wizard's Library |
' | |
' +----------------------------------------------------------------------+
REM $INCLUDE: 'BASWIZ.BI'
DEFINT A-Z
Rows = 25: Columns = 80 ' assume 25x80
GetDisplay Adapter, Mono ' get display type
IF INSTR(COMMAND$, "/43") THEN ' if /43 switch used...
IF Adapter = 4 OR Adapter = 6 THEN ' ...and EGA or VGA...
WIDTH , 43 ' ...set 43x80 mode
Rows = 43
END IF
END IF
WInit Rows, Columns, ErrCode ' initialize window handler
IF ErrCode THEN
PRINT "Error: insufficient memory"
END
END IF
MainWin = 0 ' background window handle
IF NOT Mono THEN ' if color display...
WColor MainWin, 7, 1 ' ...use white on blue
WClear MainWin
END IF
WWriteLn MainWin, "BASWIZ tiny terminal program. Use Alt-X to exit."
WWriteLn MainWin, "PgUp to send a file, PgDn to receive one."
WWriteLn MainWin, ""
WCursor MainWin, 2 ' turn on the cursor
IF INSTR(COMMAND$, "/COM4") THEN ' if /COM4 switch used...
CommPort = 4 ' ...set to COM4
ELSEIF INSTR(COMMAND$, "/COM3") THEN ' if /COM3 switch used...
CommPort = 3 ' ...set to COM3
ELSEIF INSTR(COMMAND$, "/COM2") THEN ' if /COM2 switch used...
CommPort = 2 ' ...set to COM2
ELSE
CommPort = 1 ' ...otherwise assume COM1
END IF
TCInit CommPort, 1024, 128, ErrCode ' initialize comm handler
IF ErrCode THEN
PRINT "Error: insufficient memory"
TCDone
WDone
END
END IF
IF INSTR(COMMAND$, "/300") THEN ' if /300 switch used...
TCSpeed 300& ' ...set speed to 300 bps
ELSEIF INSTR(COMMAND$, "/1200") THEN ' if /1200 switch used...
TCSpeed 1200& ' ...set speed to 1200 bps
ELSE
TCSpeed 2400& ' ...else set speed to 2400 bps
END IF
TCParms "N", 8, 1 ' no parity, 8 bit words, 1 stop
Change = -1 ' set screen update flag
DO
IF Change THEN ' if something changed...
WUpdate ' ...update the display
Change = 0 ' ...clear screen update flag
END IF
IF TCInStat% THEN ' if we've received something...
DO ' ...get and "display" it
WWrite MainWin, TCInkey$
LOOP WHILE TCInStat%
Change = -1 ' ...set screen update flag
END IF
DO ' if a key was pressed...
ky$ = INKEY$ ' ...get it
IF LEN(ky$) = 1 THEN TCWrite ky$ ' ...send it to the comm port
LOOP WHILE LEN(ky$) = 1
IF ky$ = CHR$(0) + CHR$(73) THEN ' if PgUp...
GOSUB SendFile ' ...send a file
ELSEIF ky$ = CHR$(0) + CHR$(81) THEN ' if PgDn...
GOSUB RecvFile ' ...receive a file
END IF
LOOP UNTIL ky$ = CHR$(0) + CHR$(45) ' repeat until Alt-X
TCDTR 0 ' drop the DTR (hang up)
TCDone ' terminate comm handler
WDone ' terminate window handler
END ' terminate program
SendFile:
WWrite MainWin, "*** File to send: "
WInput MainWin, "", CHR$(13) + CHR$(27), "", 80, File$, ExitKey$
WWriteLn MainWin, ""
File$ = UCASE$(LTRIM$(RTRIM$(File$)))
IF LEN(File$) = 0 OR ExitKey$ = CHR$(27) THEN
Change = -1
RETURN
END IF
WWrite MainWin, "*** Press <X> for Xmodem, <1> for Xmodem-1K, <Q> to Quit"
WUpdate
DO
ky$ = UCASE$(INKEY$)
LOOP UNTIL ky$ = "X" OR ky$ = "1" OR ky$ = "Q"
SELECT CASE ky$
CASE "X": Protocol$ = "Xmodem"
CASE "1": Protocol$ = "Xmodem-1K"
CASE "Q": RETURN
END SELECT
FOpen File$, "R", 1024, Handle, ErrCode
IF ErrCode THEN
WWriteLn MainWin, "*** Unable to open file " + File$
RETURN
END IF
StartXmodemSend Handle, Protocol$, MaxRec, Record, EstTime$, ErrCode
IF ErrCode THEN
WWriteLn MainWin, "*** No response from other computer. Aborted."
FClose Handle
WUpdate
RETURN
END IF
WWriteLn MainWin, "*** Transfer protocol: " + Protocol$
WWriteLn MainWin, "*** Estimated transfer time: " + EstTime$
WWriteLn MainWin, "*** Blocks to send: " + STR$(MaxRec)
WWriteLn MainWin, ""
WWriteLn MainWin, "*** Sending block" + STR$(Record)
WUpdate
DO
XmodemSend Handle, Protocol$, MaxRec, Record, ErrCount, ErrCode
SELECT CASE ErrCode
CASE -11: WWriteLn MainWin, "*** Transfer aborted"
CASE -10: WWriteLn MainWin, "*** Transfer done"
CASE -6: WWriteLn MainWin, "*** Too many errors. Aborted."
CASE -5 TO -1: WWriteLn MainWin, "*** Error in block, retrying."
CASE 0: WWriteLn MainWin, "*** Sending block" + STR$(Record)
CASE IS > 0: WWriteLn MainWin, "*** Error reading file"
CASE ELSE: WWriteLn MainWin, "*** Unknown, code = " + STR$(ErrCode)
END SELECT
WUpdate
LOOP UNTIL ErrCode <= -6 OR ErrCode > 0
WClose Handle
RETURN
RecvFile:
WWriteLn MainWin, "*** File receive not yet implemented ***"
RETURN