home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / BASWIZ15.ZIP / TERM.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-03-31  |  9.6 KB  |  251 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |         BASWIZ  Copyright (c) 1990-1991  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.    ELSE
  93.       Baud$ = "2400"                           ' ...else speed is 2400 bps
  94.    END IF
  95.    TCSpeed VAL(Baud$)                          ' set speed
  96.    TCParms "N", 8, 1                           ' no parity, 8 bit words, 1 stop
  97.  
  98.    Music = (INSTR(COMMAND$, "/QUIET") = 0)     ' handle "ANSI" music setting
  99.  
  100.    Change = -1                                 ' set screen update flag
  101.    DO
  102.       IF Change THEN                           ' if something changed...
  103.          WUpdate                               ' ...update the display
  104.          Change = 0                            ' ...clear screen update flag
  105.       END IF
  106.       IF TCInStat% THEN                        ' if we've received something...
  107.          St$ = ""
  108.          DO                                    ' ...get and "display" it
  109.             St$ = St$ + TCInkey$
  110.          LOOP WHILE TCInStat%
  111.          GOSUB ANSIprint
  112.          Change = -1                           ' ...set screen update flag
  113.       END IF
  114.       DO                                       ' if a key was pressed...
  115.          ky$ = INKEY$                          ' ...get it
  116.          IF LEN(ky$) = 1 THEN TCWrite ky$      ' ...send it to the comm port
  117.       LOOP WHILE LEN(ky$) = 1
  118.       IF LEN(ky$) = 2 THEN                     ' handle Alt keys
  119.          SELECT CASE ASC(RIGHT$(ky$, 1))       '
  120.             CASE 73: GOSUB SendFile            ' PgUp   (send file)
  121.             CASE 81: GOSUB RecvFile            ' PgDn   (receive file)
  122.             CASE 45: TermDone = -1             ' Alt-X  (exit the program)
  123.             CASE ELSE                          '
  124.          END SELECT                            '
  125.       END IF                                   '
  126.    LOOP UNTIL TermDone
  127.  
  128.    TCDTR 0                                     ' drop the DTR (hang up)
  129.    TCDone                                      ' terminate comm handler
  130.    WDone                                       ' terminate window handler
  131.    END                                         ' terminate program
  132.  
  133.  
  134.  
  135. SendFile:
  136.    Change = -1
  137.    WOpen 6, 77, 5, 20, 6, 30, SendWin, ErrCode
  138.    WTitle SendWin, "Send File", 7, 0
  139.    WFrame SendWin, 2, 7, 0
  140.    REDIM Pick$(1 TO 2)
  141.    Pick$(1) = " Xmodem"
  142.    Pick$(2) = " Xmodem 1K"
  143.    SELECT CASE WMenuPopUp(SendWin, Pick$(), 0, 7)
  144.       CASE 1
  145.          Protocol$ = "Xmodem"
  146.          RecLen = 128
  147.       CASE 2
  148.          Protocol$ = "Xmodem-1K"
  149.          RecLen = 1024
  150.       CASE ELSE
  151.          WClose SendWin
  152.          RETURN
  153.    END SELECT
  154.    WPlace SendWin, 5, 10
  155.    WSize SendWin, 2, 60
  156.    WClear SendWin
  157.    WLocate SendWin, 1, 1
  158.    File$ = ""
  159.    WWriteLn SendWin, "File to send:"
  160.    WCursor SendWin, 2
  161.    WInput SendWin, "", CHR$(13) + CHR$(27), "", 80, File$, ExitKey$
  162.    WCursor SendWin, 0
  163.    File$ = UCASE$(LTRIM$(RTRIM$(File$)))
  164.    IF LEN(File$) = 0 OR ExitKey$ = CHR$(27) THEN
  165.       WClose SendWin
  166.       RETURN
  167.    END IF
  168.    FOpen File$, "R", 1024, Handle, ErrCode
  169.    IF ErrCode THEN
  170.       WWriteLn MainWin, "--- Unable to open file " + File$
  171.       WClose SendWin
  172.       RETURN
  173.    END IF
  174.    T = INSTR(File$, ":")
  175.    IF T THEN
  176.       Path$ = LEFT$(File$, T)
  177.       File$ = MID$(File$, T + 1)
  178.    ELSE
  179.       Path$ = ""
  180.    END IF
  181.    DO
  182.       T = INSTR(File$, "\")
  183.       IF T THEN
  184.          Path$ = Path$ + LEFT$(File$, T)
  185.          File$ = MID$(File$, T + 1)
  186.       END IF
  187.    LOOP WHILE T
  188.    WPlace SendWin, 5, 20
  189.    WSize SendWin, 6, 40
  190.    WClear SendWin
  191.    WLocate SendWin, 1, 1
  192.    WTitle SendWin, Protocol$ + " Send", 7, 0
  193.    WWriteLn SendWin, "File Path  : " + Path$
  194.    WWriteLn SendWin, "File Name  : " + File$
  195.    WWriteLn SendWin, "Xfer time  :"
  196.    WWriteLn SendWin, "File Size  :" + STR$(FGetSize&(Handle))
  197.    WWriteLn SendWin, "Bytes Sent : 0"
  198.    WWrite SendWin, "Status Msg : Waiting for NAK"
  199.    WUpdate
  200.    StartXmodemSend Handle, Protocol$, Baud$, MaxRec, Record, EstTime$, ErrCode
  201.    IF ErrCode THEN
  202.       WWriteLn MainWin, "--- No response from other computer."
  203.       FClose Handle
  204.       WClose SendWin
  205.       RETURN
  206.    END IF
  207.    WTitle SendWin, Protocol$ + " Send", 7, 0
  208.    WLocate SendWin, 3, 14
  209.    WWrite SendWin, EstTime$
  210.    WLocate SendWin, 6, 14
  211.    WWrite SendWin, SPACE$(30)
  212.    WUpdate
  213.    DO
  214.       XmodemSend Handle, Protocol$, MaxRec, Record, ErrCount, ErrCode
  215.       SELECT CASE ErrCode
  216.          CASE -11
  217.             WWriteLn MainWin, "--- Transfer aborted"
  218.          CASE -10
  219.             WWriteLn MainWin, "--- Transfer done"
  220.          CASE -6
  221.             WWriteLn MainWin, "--- Too many errors.  Aborted."
  222.          CASE -5 TO -1
  223.             WLocate SendWin, 6, 14
  224.             WWrite SendWin, "Error in block.  Retrying."
  225.          CASE 0
  226.             WLocate SendWin, 5, 13
  227.             WWrite SendWin, STR$((Record - 1) * RecLen)
  228.             WLocate SendWin, 6, 14
  229.             WWrite SendWin, SPACE$(30)
  230.          CASE IS > 0
  231.             WWriteLn MainWin, "--- Error reading file"
  232.          CASE ELSE
  233.             WWriteLn MainWin, "--- Unknown error, code = " + STR$(ErrCode)
  234.       END SELECT
  235.       WUpdate
  236.    LOOP UNTIL ErrCode <= -6 OR ErrCode > 0
  237.    FClose Handle
  238.    WClose SendWin
  239.    RETURN
  240.  
  241.  
  242.  
  243. RecvFile:
  244.    Change = -1
  245.    WWriteLn MainWin, "*** File receive is not yet implemented ***"
  246.    RETURN
  247.  
  248.  
  249.  
  250.    REM $INCLUDE: 'ansi.bas'
  251.