home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / baswiz14.zip / TERM.BAS < prev   
BASIC Source File  |  1990-09-24  |  8KB  |  218 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.    IF INSTR(COMMAND$, "/B") THEN Mono = -1
  21.    WFixColor Mono                              ' colors --> mono (if need be)
  22.  
  23.    WInit Rows, Columns, ErrCode                ' initialize window handler
  24.    IF ErrCode THEN
  25.       PRINT "Error: insufficient memory"
  26.       END
  27.    END IF
  28.    MainWin = 0                                 ' background window handle
  29.    Win = MainWin                               ' same, for ANSIprint routine
  30.    WColor MainWin, 7, 0
  31.    WClear MainWin
  32.    WWriteLn MainWin, "BASWIZ tiny terminal program.  Use Alt-X to exit."
  33.    WWriteLn MainWin, "PgUp to send a file, PgDn to receive one."
  34.    WWriteLn MainWin, ""
  35.    WCursor MainWin, 2                          ' turn on the cursor
  36.  
  37.    IF INSTR(COMMAND$, "/COM4") THEN            ' if /COM4 switch used...
  38.       CommPort = 4                             ' ...set to COM4
  39.    ELSEIF INSTR(COMMAND$, "/COM3") THEN        ' if /COM3 switch used...
  40.       CommPort = 3                             ' ...set to COM3
  41.    ELSEIF INSTR(COMMAND$, "/COM2") THEN        ' if /COM2 switch used...
  42.       CommPort = 2                             ' ...set to COM2
  43.    ELSE
  44.       CommPort = 1                             ' ...otherwise assume COM1
  45.    END IF
  46.    TCInit CommPort, 1024, 128, ErrCode         ' initialize comm handler
  47.    IF ErrCode THEN
  48.       PRINT "Error: insufficient memory"
  49.       TCDone
  50.       WDone
  51.       END
  52.    END IF
  53.  
  54.    IF INSTR(COMMAND$, "/300") THEN             ' if /300 switch used...
  55.       Baud$ = "300"                            ' ...speed is 300 bps
  56.    ELSEIF INSTR(COMMAND$, "/1200") THEN        ' if /1200 switch used...
  57.       Baud$ = "1200"                           ' ...speed is 1200 bps
  58.    ELSE
  59.       Baud$ = "2400"                           ' ...else speed is 2400 bps
  60.    END IF
  61.    TCSpeed VAL(Baud$)                          ' set speed
  62.    TCParms "N", 8, 1                           ' no parity, 8 bit words, 1 stop
  63.  
  64.    Music = (INSTR(COMMAND$, "/QUIET") = 0)     ' handle "ANSI" music setting
  65.  
  66.    Change = -1                                 ' set screen update flag
  67.    DO
  68.       IF Change THEN                           ' if something changed...
  69.          WUpdate                               ' ...update the display
  70.          Change = 0                            ' ...clear screen update flag
  71.       END IF
  72.       IF TCInStat% THEN                        ' if we've received something...
  73.          St$ = ""
  74.          DO                                    ' ...get and "display" it
  75.             St$ = St$ + TCInkey$
  76.          LOOP WHILE TCInStat%
  77.          GOSUB ANSIprint
  78.          Change = -1                           ' ...set screen update flag
  79.       END IF
  80.       DO                                       ' if a key was pressed...
  81.          ky$ = INKEY$                          ' ...get it
  82.          IF LEN(ky$) = 1 THEN TCWrite ky$      ' ...send it to the comm port
  83.       LOOP WHILE LEN(ky$) = 1
  84.       IF ky$ = CHR$(0) + CHR$(73) THEN         ' if PgUp...
  85.          GOSUB SendFile                        ' ...send a file
  86.       ELSEIF ky$ = CHR$(0) + CHR$(81) THEN     ' if PgDn...
  87.          GOSUB RecvFile                        ' ...receive a file
  88.       END IF
  89.    LOOP UNTIL ky$ = CHR$(0) + CHR$(45)         ' repeat until Alt-X
  90.    TCDTR 0                                     ' drop the DTR (hang up)
  91.    TCDone                                      ' terminate comm handler
  92.    WDone                                       ' terminate window handler
  93.    END                                         ' terminate program
  94.  
  95.  
  96.  
  97. SendFile:
  98.    Change = -1
  99.    WOpen 6, 77, 5, 20, 8, 30, SendWin, ErrCode
  100.    WTitle SendWin, "Send File", 7, 0
  101.    WFrame SendWin, 2, 7, 0
  102.    WWriteLn SendWin, " Protocol?"
  103.    WWriteLn SendWin, ""
  104.    WWriteLn SendWin, " Xmodem"
  105.    WWrite SendWin, " 1k-Xmodem"
  106.    WUpdate
  107.    DO
  108.       ky$ = UCASE$(INKEY$)
  109.    LOOP UNTIL ky$ = "X" OR ky$ = "1" OR ky$ = CHR$(27)
  110.    SELECT CASE ky$
  111.       CASE "X"
  112.          Protocol$ = "Xmodem"
  113.          RecLen = 128
  114.       CASE "1"
  115.          Protocol$ = "Xmodem-1K"
  116.          RecLen = 1024
  117.       CASE ELSE
  118.          WClose SendWin
  119.          RETURN
  120.    END SELECT
  121.    WPlace SendWin, 5, 10
  122.    WSize SendWin, 2, 60
  123.    WClear SendWin
  124.    WLocate SendWin, 1, 1
  125.    File$ = ""
  126.    WWriteLn SendWin, "File to send:"
  127.    WCursor SendWin, 2
  128.    WInput SendWin, "", CHR$(13) + CHR$(27), "", 80, File$, ExitKey$
  129.    WCursor SendWin, 0
  130.    File$ = UCASE$(LTRIM$(RTRIM$(File$)))
  131.    IF LEN(File$) = 0 OR ExitKey$ = CHR$(27) THEN
  132.       WClose SendWin
  133.       RETURN
  134.    END IF
  135.    FOpen File$, "R", 1024, Handle, ErrCode
  136.    IF ErrCode THEN
  137.       WWriteLn MainWin, "--- Unable to open file " + File$
  138.       WClose SendWin
  139.       RETURN
  140.    END IF
  141.    T = INSTR(File$, ":")
  142.    IF T THEN
  143.       Path$ = LEFT$(File$, T)
  144.       File$ = MID$(File$, T + 1)
  145.    ELSE
  146.       Path$ = ""
  147.    END IF
  148.    DO
  149.       T = INSTR(File$, "\")
  150.       IF T THEN
  151.          Path$ = Path$ + LEFT$(File$, T)
  152.          File$ = MID$(File$, T + 1)
  153.       END IF
  154.    LOOP WHILE T
  155.    WPlace SendWin, 5, 20
  156.    WSize SendWin, 6, 40
  157.    WClear SendWin
  158.    WLocate SendWin, 1, 1
  159.    WTitle SendWin, Protocol$ + " Give", 7, 0
  160.    WWriteLn SendWin, "File Path  : " + Path$
  161.    WWriteLn SendWin, "File Name  : " + File$
  162.    WWriteLn SendWin, "Xfer time  :"
  163.    WWriteLn SendWin, "File Size  :" + STR$(FGetSize&(Handle))
  164.    WWriteLn SendWin, "Bytes Sent : 0"
  165.    WWrite SendWin, "Status Msg : Waiting for NAK"
  166.    WUpdate
  167.    StartXmodemSend Handle, Protocol$, Baud$, MaxRec, Record, EstTime$, ErrCode
  168.    IF ErrCode THEN
  169.       WWriteLn MainWin, "--- No response from other computer."
  170.       FClose Handle
  171.       WClose SendWin
  172.       RETURN
  173.    END IF
  174.    WTitle SendWin, Protocol$ + " Give", 7, 0
  175.    WLocate SendWin, 3, 14
  176.    WWrite SendWin, EstTime$
  177.    WLocate SendWin, 6, 14
  178.    WWrite SendWin, SPACE$(30)
  179.    WUpdate
  180.    DO
  181.       XmodemSend Handle, Protocol$, MaxRec, Record, ErrCount, ErrCode
  182.       SELECT CASE ErrCode
  183.          CASE -11
  184.             WWriteLn MainWin, "--- Transfer aborted"
  185.          CASE -10
  186.             WWriteLn MainWin, "--- Transfer done"
  187.          CASE -6
  188.             WWriteLn MainWin, "--- Too many errors.  Aborted."
  189.          CASE -5 TO -1
  190.             WLocate SendWin, 6, 14
  191.             WWrite SendWin, "Error in block.  Retrying."
  192.          CASE 0
  193.             WLocate SendWin, 5, 13
  194.             WWrite SendWin, STR$((Record - 1) * RecLen)
  195.             WLocate SendWin, 6, 14
  196.             WWrite SendWin, SPACE$(30)
  197.          CASE IS > 0
  198.             WWriteLn MainWin, "--- Error reading file"
  199.          CASE ELSE
  200.             WWriteLn MainWin, "--- Unknown error, code = " + STR$(ErrCode)
  201.       END SELECT
  202.       WUpdate
  203.    LOOP UNTIL ErrCode <= -6 OR ErrCode > 0
  204.    FClose Handle
  205.    WClose SendWin
  206.    RETURN
  207.  
  208.  
  209.  
  210. RecvFile:
  211.    Change = -1
  212.    WWriteLn MainWin, "*** File receive is not yet implemented ***"
  213.    RETURN
  214.  
  215.  
  216.  
  217.    REM $INCLUDE: 'ansi.bas'
  218.