home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / b / baswiz19.zip / TERM.BAS < prev    next >
BASIC Source File  |  1993-01-29  |  10KB  |  259 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |         BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   |                       The BASIC Wizard's Library                     |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE FUNCTION FGetSize& (BYVAL Handle%)
  10.    DECLARE FUNCTION TCInkey$ ()
  11.    DECLARE FUNCTION TCInStat% ()
  12.    DECLARE FUNCTION WMenuPopUp% (Handle%, PickList$(), HiFore%, LoFore%)
  13.    DECLARE SUB FClose (Handle%)
  14.    DECLARE SUB FOpen (File$, FMode$, BufferLen%, Handle%, ErrCode%)
  15.    DECLARE SUB GetDisplay (Adapter%, Mono%)
  16.    DECLARE SUB StartXmodemSend (Handle%, Protocol$, Baud$, MaxRec%, Record%, EstTime$, ErrCode%)
  17.    DECLARE SUB TCDone ()
  18.    DECLARE SUB TCDTR (BYVAL State%)
  19.    DECLARE SUB TCInit (Port%, InSize%, OutSize%, ErrCode%)
  20.    DECLARE SUB TCParms (Parity$, WordLength%, StopBits%)
  21.    DECLARE SUB TCSpeed (Bps&)
  22.    DECLARE SUB TCWrite (St$)
  23.    DECLARE SUB WClear (BYVAL Handle%)
  24.    DECLARE SUB WClose (BYVAL Handle%)
  25.    DECLARE SUB WColor (BYVAL Handle%, BYVAL Fore%, BYVAL Back%)
  26.    DECLARE SUB WCursor (BYVAL Handle%, BYVAL CSize%)
  27.    DECLARE SUB WDone ()
  28.    DECLARE SUB WFixColor (BYVAL Convert%)
  29.    DECLARE SUB WFrame (BYVAL Handle%, BYVAL Frame%, BYVAL Fore%, BYVAL Back%)
  30.    DECLARE SUB WGetColor (BYVAL Handle%, Fore%, Back%)
  31.    DECLARE SUB WGetLocate (BYVAL Handle%, Row%, Column%)
  32.    DECLARE SUB WInit (Rows%, Columns%, ErrCode%)
  33.    DECLARE SUB WInput (Handle%, Valid$, ExitCode$, ExtExitCode$, MaxLength%, St$, ExitKey$)
  34.    DECLARE SUB WLocate (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
  35.    DECLARE SUB WOpen (Rows%, Columns%, SRow1%, SCol1%, SRow2%, SCol2%, Handle%, ErrCode%)
  36.    DECLARE SUB WPlace (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
  37.    DECLARE SUB WSize (BYVAL Handle%, BYVAL Rows%, BYVAL Columns%)
  38.    DECLARE SUB WTitle (BYVAL Handle%, Title$, BYVAL Fore%, BYVAL Back%)
  39.    DECLARE SUB WUpdate ()
  40.    DECLARE SUB WWrite (BYVAL Handle%, St$)
  41.    DECLARE SUB WWriteLn (BYVAL Handle%, St$)
  42.    DECLARE SUB XmodemSend (Handle%, Protocol$, MaxRec%, Record%, ErrCount%, ErrCode%)
  43.  
  44.    DEFINT A-Z
  45.  
  46.    Rows = 25: Columns = 80                     ' assume 25x80
  47.    GetDisplay Adapter, Mono                    ' get display type
  48.    IF INSTR(COMMAND$, "/43") THEN              ' if /43 switch used...
  49.       IF Adapter = 4 OR Adapter = 6 THEN       ' ...and EGA or VGA...
  50.          WIDTH , 43                            ' ...set 43x80 mode
  51.          Rows = 43
  52.       END IF
  53.    END IF
  54.    IF INSTR(COMMAND$, "/B") THEN Mono = -1
  55.    WFixColor Mono                              ' colors --> mono (if need be)
  56.  
  57.    WInit Rows, Columns, ErrCode                ' initialize window handler
  58.    IF ErrCode THEN
  59.       PRINT "Error: insufficient memory"
  60.       END
  61.    END IF
  62.    MainWin = 0                                 ' background window handle
  63.    Win = MainWin                               ' same, for ANSIprint routine
  64.    WColor MainWin, 7, 0
  65.    WClear MainWin
  66.    WWriteLn MainWin, "BASWIZ tiny terminal program.  Use Alt-X to exit."
  67.    WWriteLn MainWin, "PgUp to send a file, PgDn to receive one."
  68.    WWriteLn MainWin, ""
  69.    WCursor MainWin, 2                          ' turn on the cursor
  70.  
  71.    IF INSTR(COMMAND$, "/COM4") THEN            ' if /COM4 switch used...
  72.       CommPort = 4                             ' ...set to COM4
  73.    ELSEIF INSTR(COMMAND$, "/COM3") THEN        ' if /COM3 switch used...
  74.       CommPort = 3                             ' ...set to COM3
  75.    ELSEIF INSTR(COMMAND$, "/COM2") THEN        ' if /COM2 switch used...
  76.       CommPort = 2                             ' ...set to COM2
  77.    ELSE
  78.       CommPort = 1                             ' ...otherwise assume COM1
  79.    END IF
  80.    TCInit CommPort, 1024, 128, ErrCode         ' initialize comm handler
  81.    IF ErrCode THEN
  82.       PRINT "Error: insufficient memory"
  83.       TCDone
  84.       WDone
  85.       END
  86.    END IF
  87.  
  88.    IF INSTR(COMMAND$, "/300") THEN             ' if /300 switch used...
  89.       Baud$ = "300"                            ' ...speed is 300 bps
  90.    ELSEIF INSTR(COMMAND$, "/1200") THEN        ' if /1200 switch used...
  91.       Baud$ = "1200"                           ' ...speed is 1200 bps
  92.    ELSEIF INSTR(COMMAND$, "/9600") THEN        ' if /9600 switch used...
  93.       Baud$ = "9600"                           ' ...speed is 9600 bps
  94.    ELSEIF INSTR(COMMAND$, "/14400") THEN        ' if /14400 switch used...
  95.       Baud$ = "14400"                           ' ...speed is 14400 bps
  96.    ELSEIF INSTR(COMMAND$, "/38400") THEN        ' if /38400 switch used...
  97.       Baud$ = "38400"                           ' ...speed is 38400 bps
  98.    ELSEIF INSTR(COMMAND$, "/57600") THEN        ' if /57600 switch used...
  99.       Baud$ = "57600"                           ' ...speed is 57600 bps
  100.    ELSE
  101.       Baud$ = "2400"                           ' ...else speed is 2400 bps
  102.    END IF
  103.    TCSpeed CLNG(VAL(Baud$))                    ' set speed
  104.    TCParms "N", 8, 1                           ' no parity, 8 bit words, 1 stop
  105.  
  106.    Music = (INSTR(COMMAND$, "/QUIET") = 0)     ' handle "ANSI" music setting
  107.  
  108.    Change = -1                                 ' set screen update flag
  109.    DO
  110.       IF Change THEN                           ' if something changed...
  111.          WUpdate                               ' ...update the display
  112.          Change = 0                            ' ...clear screen update flag
  113.       END IF
  114.       IF TCInStat% THEN                        ' if we've received something...
  115.          St$ = ""
  116.          DO                                    ' ...get and "display" it
  117.             St$ = St$ + TCInkey$
  118.          LOOP WHILE TCInStat%
  119.          GOSUB ANSIprint
  120.          Change = -1                           ' ...set screen update flag
  121.       END IF
  122.       DO                                       ' if a key was pressed...
  123.          ky$ = INKEY$                          ' ...get it
  124.          IF LEN(ky$) = 1 THEN TCWrite ky$      ' ...send it to the comm port
  125.       LOOP WHILE LEN(ky$) = 1
  126.       IF LEN(ky$) = 2 THEN                     ' handle Alt keys
  127.          SELECT CASE ASC(RIGHT$(ky$, 1))       '
  128.             CASE 73: GOSUB SendFile            ' PgUp   (send file)
  129.             CASE 81: GOSUB RecvFile            ' PgDn   (receive file)
  130.             CASE 45: TermDone = -1             ' Alt-X  (exit the program)
  131.             CASE ELSE                          '
  132.          END SELECT                            '
  133.       END IF                                   '
  134.    LOOP UNTIL TermDone
  135.  
  136.    TCDTR 0                                     ' drop the DTR (hang up)
  137.    TCDone                                      ' terminate comm handler
  138.    WDone                                       ' terminate window handler
  139.    END                                         ' terminate program
  140.  
  141.  
  142.  
  143. SendFile:
  144.    Change = -1
  145.    WOpen 6, 77, 5, 20, 6, 30, SendWin, ErrCode
  146.    WTitle SendWin, "Send File", 7, 0
  147.    WFrame SendWin, 2, 7, 0
  148.    REDIM Pick$(1 TO 2)
  149.    Pick$(1) = " Xmodem"
  150.    Pick$(2) = " Xmodem 1K"
  151.    SELECT CASE WMenuPopUp(SendWin, Pick$(), 0, 7)
  152.       CASE 1
  153.          Protocol$ = "Xmodem"
  154.          RecLen = 128
  155.       CASE 2
  156.          Protocol$ = "Xmodem-1K"
  157.          RecLen = 1024
  158.       CASE ELSE
  159.          WClose SendWin
  160.          RETURN
  161.    END SELECT
  162.    WPlace SendWin, 5, 10
  163.    WSize SendWin, 2, 60
  164.    WClear SendWin
  165.    WLocate SendWin, 1, 1
  166.    File$ = ""
  167.    WWriteLn SendWin, "File to send:"
  168.    WCursor SendWin, 2
  169.    WInput SendWin, "", CHR$(13) + CHR$(27), "", 80, File$, ExitKey$
  170.    WCursor SendWin, 0
  171.    File$ = UCASE$(LTRIM$(RTRIM$(File$)))
  172.    IF LEN(File$) = 0 OR ExitKey$ = CHR$(27) THEN
  173.       WClose SendWin
  174.       RETURN
  175.    END IF
  176.    FOpen File$, "R", 1024, Handle, ErrCode
  177.    IF ErrCode THEN
  178.       WWriteLn MainWin, "--- Unable to open file " + File$
  179.       WClose SendWin
  180.       RETURN
  181.    END IF
  182.    T = INSTR(File$, ":")
  183.    IF T THEN
  184.       Path$ = LEFT$(File$, T)
  185.       File$ = MID$(File$, T + 1)
  186.    ELSE
  187.       Path$ = ""
  188.    END IF
  189.    DO
  190.       T = INSTR(File$, "\")
  191.       IF T THEN
  192.          Path$ = Path$ + LEFT$(File$, T)
  193.          File$ = MID$(File$, T + 1)
  194.       END IF
  195.    LOOP WHILE T
  196.    WPlace SendWin, 5, 20
  197.    WSize SendWin, 6, 40
  198.    WClear SendWin
  199.    WLocate SendWin, 1, 1
  200.    WTitle SendWin, Protocol$ + " Send", 7, 0
  201.    WWriteLn SendWin, "File Path  : " + Path$
  202.    WWriteLn SendWin, "File Name  : " + File$
  203.    WWriteLn SendWin, "Xfer time  :"
  204.    WWriteLn SendWin, "File Size  :" + STR$(FGetSize&(Handle))
  205.    WWriteLn SendWin, "Bytes Sent : 0"
  206.    WWrite SendWin, "Status Msg : Waiting for NAK"
  207.    WUpdate
  208.    StartXmodemSend Handle, Protocol$, Baud$, MaxRec, Record, EstTime$, ErrCode
  209.    IF ErrCode THEN
  210.       WWriteLn MainWin, "--- No response from other computer."
  211.       FClose Handle
  212.       WClose SendWin
  213.       RETURN
  214.    END IF
  215.    WTitle SendWin, Protocol$ + " Send", 7, 0
  216.    WLocate SendWin, 3, 14
  217.    WWrite SendWin, EstTime$
  218.    WLocate SendWin, 6, 14
  219.    WWrite SendWin, SPACE$(30)
  220.    WUpdate
  221.    DO
  222.       XmodemSend Handle, Protocol$, MaxRec, Record, ErrCount, ErrCode
  223.       SELECT CASE ErrCode
  224.          CASE -11
  225.             WWriteLn MainWin, "--- Transfer aborted"
  226.          CASE -10
  227.             WWriteLn MainWin, "--- Transfer done"
  228.          CASE -6
  229.             WWriteLn MainWin, "--- Too many errors.  Aborted."
  230.          CASE -5 TO -1
  231.             WLocate SendWin, 6, 14
  232.             WWrite SendWin, "Error in block.  Retrying."
  233.          CASE 0
  234.             WLocate SendWin, 5, 13
  235.             WWrite SendWin, STR$((Record - 1) * RecLen)
  236.             WLocate SendWin, 6, 14
  237.             WWrite SendWin, SPACE$(30)
  238.          CASE IS > 0
  239.             WWriteLn MainWin, "--- Error reading file"
  240.          CASE ELSE
  241.             WWriteLn MainWin, "--- Unknown error, code = " + STR$(ErrCode)
  242.       END SELECT
  243.       WUpdate
  244.    LOOP UNTIL ErrCode <= -6 OR ErrCode > 0
  245.    FClose Handle
  246.    WClose SendWin
  247.    RETURN
  248.  
  249.  
  250.  
  251. RecvFile:
  252.    Change = -1
  253.    WWriteLn MainWin, "*** File receive is not yet implemented ***"
  254.    RETURN
  255.  
  256.  
  257.  
  258.    REM $INCLUDE: 'ansi.bas'
  259.