home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progbas / baswiz13.arj / TERM.BAS < prev   
Encoding:
BASIC Source File  |  1990-07-08  |  6.2 KB  |  148 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |           BASWIZ  Copyright (c) 1990  Thomas G. Hanlin III           |
  4. '   |                                                                      |
  5. '   |                       The BASIC Wizard's Library                     |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    REM $INCLUDE: 'BASWIZ.BI'
  10.    DEFINT A-Z
  11.  
  12.    Rows = 25: Columns = 80                     ' assume 25x80
  13.    GetDisplay Adapter, Mono                    ' get display type
  14.    IF INSTR(COMMAND$, "/43") THEN              ' if /43 switch used...
  15.       IF Adapter = 4 OR Adapter = 6 THEN       ' ...and EGA or VGA...
  16.          WIDTH , 43                            ' ...set 43x80 mode
  17.          Rows = 43
  18.       END IF
  19.    END IF
  20.    WInit Rows, Columns, ErrCode                ' initialize window handler
  21.    IF ErrCode THEN
  22.       PRINT "Error: insufficient memory"
  23.       END
  24.    END IF
  25.    MainWin = 0                                 ' background window handle
  26.    IF NOT Mono THEN                            ' if color display...
  27.       WColor MainWin, 7, 1                     ' ...use white on blue
  28.       WClear MainWin
  29.    END IF
  30.    WWriteLn MainWin, "BASWIZ tiny terminal program.  Use Alt-X to exit."
  31.    WWriteLn MainWin, "PgUp to send a file, PgDn to receive one."
  32.    WWriteLn MainWin, ""
  33.    WCursor MainWin, 2                          ' turn on the cursor
  34.  
  35.    IF INSTR(COMMAND$, "/COM4") THEN            ' if /COM4 switch used...
  36.       CommPort = 4                             ' ...set to COM4
  37.    ELSEIF INSTR(COMMAND$, "/COM3") THEN        ' if /COM3 switch used...
  38.       CommPort = 3                             ' ...set to COM3
  39.    ELSEIF INSTR(COMMAND$, "/COM2") THEN        ' if /COM2 switch used...
  40.       CommPort = 2                             ' ...set to COM2
  41.    ELSE
  42.       CommPort = 1                             ' ...otherwise assume COM1
  43.    END IF
  44.    TCInit CommPort, 1024, 128, ErrCode         ' initialize comm handler
  45.    IF ErrCode THEN
  46.       PRINT "Error: insufficient memory"
  47.       TCDone
  48.       WDone
  49.       END
  50.    END IF
  51.  
  52.    IF INSTR(COMMAND$, "/300") THEN             ' if /300 switch used...
  53.       TCSpeed 300&                             ' ...set speed to 300 bps
  54.    ELSEIF INSTR(COMMAND$, "/1200") THEN        ' if /1200 switch used...
  55.       TCSpeed 1200&                            ' ...set speed to 1200 bps
  56.    ELSE
  57.       TCSpeed 2400&                            ' ...else set speed to 2400 bps
  58.    END IF
  59.    TCParms "N", 8, 1                           ' no parity, 8 bit words, 1 stop
  60.  
  61.    Change = -1                                 ' set screen update flag
  62.    DO
  63.       IF Change THEN                           ' if something changed...
  64.          WUpdate                               ' ...update the display
  65.          Change = 0                            ' ...clear screen update flag
  66.       END IF
  67.       IF TCInStat% THEN                        ' if we've received something...
  68.          DO                                    ' ...get and "display" it
  69.             WWrite MainWin, TCInkey$
  70.          LOOP WHILE TCInStat%
  71.          Change = -1                           ' ...set screen update flag
  72.       END IF
  73.       DO                                       ' if a key was pressed...
  74.          ky$ = INKEY$                          ' ...get it
  75.          IF LEN(ky$) = 1 THEN TCWrite ky$      ' ...send it to the comm port
  76.       LOOP WHILE LEN(ky$) = 1
  77.       IF ky$ = CHR$(0) + CHR$(73) THEN         ' if PgUp...
  78.          GOSUB SendFile                        ' ...send a file
  79.       ELSEIF ky$ = CHR$(0) + CHR$(81) THEN     ' if PgDn...
  80.          GOSUB RecvFile                        ' ...receive a file
  81.       END IF
  82.    LOOP UNTIL ky$ = CHR$(0) + CHR$(45)         ' repeat until Alt-X
  83.    TCDTR 0                                     ' drop the DTR (hang up)
  84.    TCDone                                      ' terminate comm handler
  85.    WDone                                       ' terminate window handler
  86.    END                                         ' terminate program
  87.  
  88.  
  89.  
  90. SendFile:
  91.    WWrite MainWin, "*** File to send: "
  92.    WInput MainWin, "", CHR$(13) + CHR$(27), "", 80, File$, ExitKey$
  93.    WWriteLn MainWin, ""
  94.    File$ = UCASE$(LTRIM$(RTRIM$(File$)))
  95.    IF LEN(File$) = 0 OR ExitKey$ = CHR$(27) THEN
  96.       Change = -1
  97.       RETURN
  98.    END IF
  99.    WWrite MainWin, "*** Press <X> for Xmodem, <1> for Xmodem-1K, <Q> to Quit"
  100.    WUpdate
  101.    DO
  102.       ky$ = UCASE$(INKEY$)
  103.    LOOP UNTIL ky$ = "X" OR ky$ = "1" OR ky$ = "Q"
  104.    SELECT CASE ky$
  105.       CASE "X": Protocol$ = "Xmodem"
  106.       CASE "1": Protocol$ = "Xmodem-1K"
  107.       CASE "Q": RETURN
  108.    END SELECT
  109.    FOpen File$, "R", 1024, Handle, ErrCode
  110.    IF ErrCode THEN
  111.       WWriteLn MainWin, "*** Unable to open file " + File$
  112.       RETURN
  113.    END IF
  114.    StartXmodemSend Handle, Protocol$, MaxRec, Record, EstTime$, ErrCode
  115.    IF ErrCode THEN
  116.       WWriteLn MainWin, "*** No response from other computer.  Aborted."
  117.       FClose Handle
  118.       WUpdate
  119.       RETURN
  120.    END IF
  121.    WWriteLn MainWin, "*** Transfer protocol: " + Protocol$
  122.    WWriteLn MainWin, "*** Estimated transfer time: " + EstTime$
  123.    WWriteLn MainWin, "*** Blocks to send: " + STR$(MaxRec)
  124.    WWriteLn MainWin, ""
  125.    WWriteLn MainWin, "*** Sending block" + STR$(Record)
  126.    WUpdate
  127.    DO
  128.       XmodemSend Handle, Protocol$, MaxRec, Record, ErrCount, ErrCode
  129.       SELECT CASE ErrCode
  130.          CASE -11: WWriteLn MainWin, "*** Transfer aborted"
  131.          CASE -10: WWriteLn MainWin, "*** Transfer done"
  132.          CASE -6: WWriteLn MainWin, "*** Too many errors.  Aborted."
  133.          CASE -5 TO -1: WWriteLn MainWin, "*** Error in block, retrying."
  134.          CASE 0: WWriteLn MainWin, "*** Sending block" + STR$(Record)
  135.          CASE IS > 0: WWriteLn MainWin, "*** Error reading file"
  136.          CASE ELSE: WWriteLn MainWin, "*** Unknown, code = " + STR$(ErrCode)
  137.       END SELECT
  138.       WUpdate
  139.    LOOP UNTIL ErrCode <= -6 OR ErrCode > 0
  140.    WClose Handle
  141.    RETURN
  142.  
  143.  
  144.  
  145. RecvFile:
  146.    WWriteLn MainWin, "*** File receive not yet implemented ***"
  147.    RETURN
  148.