ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/QBNWS201.ZIP/Z.BAS

BASIC Source File | 1991-01-08 | 18.5 KB | 342 lines

REM Z.BAS Copyright 1990
REM by Charles Graham, POB 58634, St. Louis, MO 63158
'
'Z.BAS is an elementary communications program written in
'Microsoft QuickBASIC 4.5.  It opens the computer's console
'(CON) as a file and funnels all screen writes through CON.
'If a user has ANSI.SYS installed properly, this technique
'makes Z.BAS compatible with Bulletin Board Systems that use
'ANSI escape sequences to produce color and animation on their
'user's screens.
'
'There are only a few requirements for running Z.BAS:
'   1)  use an IBM-compatible computer with at least
'       128K of available RAM
'   2)  use a Hayes-compatible modem
'   3)  use a color monitor and video board
'   4)  call a BBS using modem parameters of N,8,1 (no
'       parity, 8 data bits, 1 stop bit) unless you want
'       to change the code in SUB getparms
'   5)  install ANSI.SYS if not already installed.
'
DECLARE SUB bottomline ()                   'Prints line 25
DECLARE SUB delay ()                        'Wastes time
DECLARE SUB getparms ()                     'You need these
DECLARE SUB hangup ()                       'Byebye, BBS
DECLARE SUB initialize ()                   'Foreplay
DECLARE SUB makeacall ()                    'Reach out & touch
DECLARE SUB opencomport ()                  'Open Sesame
DECLARE SUB outtahere ()                    'I quit!
                                            '
DIM SHARED ao$                              'Lots of SUBs
DIM SHARED cs$                              ' need these so
DIM SHARED bp$                              ' SHARE
DIM SHARED comport$                         '
DIM SHARED comspec$                         '
DIM SHARED es$                              '
DIM SHARED dialmode$                        '
DIM SHARED firsttime$                       '
DIM SHARED init$                            '
DIM SHARED hc$                              '
ON ERROR GOTO errorroutine                  'Just in case
DEFINT A-Z                                  'Speeds things up
es$ = CHR$(27)                              'ESCape
ao$ = es$ + "[0m"                           'Attributes off
cs$ = es$ + "[2J"                           'Clear screen
f1$ = CHR$(0) + CHR$(59)                    'F1 key
f10$ = CHR$(0) + CHR$(68)                   'F10 key
ff$ = CHR$(12)                              'Form feed
hc$ = es$ + "[f"                            'Home cursor
OPEN "con" FOR OUTPUT AS 2                  'Console as file
CALL initialize                             'Foreplay
PRINT #2, ao$;                              'Attributes off
PRINT #2, cs$ + " " + hc$;                  'Home cursor
CALL getparms                               'You need these
CALL opencomport                            'Open Sesame
CALL bottomline                             'Print line 25
DO                                          'Begin endless loop
    a$ = INKEY$                             'Check keyboard
    IF a$ <> "" THEN                        'Key pressed?
        SELECT CASE a$                      'What do I do now?
            CASE es$                        'ESCape key?
                CALL hangup                 ' Byebye, BBS
            CASE f1$                        'F1 key?
                CALL makeacall              ' Reach out & touch
            CASE f10$                       'F10 key?
                CALL outtahere              ' I quit!
            CASE ELSE                       'Some other key?
                PRINT #1, a$;               ' Send it to modem
        END SELECT                          '
    END IF                                  '
    WHILE NOT EOF(1)                        'Characters arrived?
        b$ = INPUT$(LOC(1), #1)             'Receive characters
        WHILE INSTR(b$, ff$) <> 0           'If an ASCII form
            q = INSTR(b$, ff$)              ' feed is received
            b$ = LEFT$(b$, q - 1) + cs$ + MID$(b$, q + 1)
                                            ' change it to ANSI
        WEND                                '
        PRINT #2, b$;                       'Print characters
        a$ = INKEY$                         'Check keyboard
        IF a$ <> "" THEN                    'Key pressed?
            SELECT CASE a$                  'What do I do now?
                CASE es$                    'ESCape key?
                    CALL hangup             ' Byebye, BBS
                CASE f1$                    'F1 key?
                    CALL makeacall          ' Reach out & touch
                CASE f10$                   'F10 key?
                    CALL outtahere          ' I quit!
                CASE ELSE                   'Some other key?
                    PRINT #1, a$;           ' Send it to modem
            END SELECT                      '
        END IF                              '
    WEND                                    '
LOOP                                        'End endless loop
                                            '
errorroutine:                               'Who knows what evil
PRINT "Error type"; ERR; "occurred!"        'lurks within the
RESUME NEXT                                 'hearts of computers?

SUB bottomline                              'Prints line 25
PRINT #2, cs$;                              'Clear screen
PRINT #2, es$ + "[25;1f";                   'LOCATE 25, 1
PRINT #2, es$ + "[1;37;44m";                'Bright white on blue
PRINT #2, "Z QB Dialer  Copr. 1990 by Charles Graham   ";
PRINT #2, es$ + "[1;33m";                   'Yellow on blue
PRINT #2, "  ESC Hang Up    F1 Dial    F10 End";
PRINT #2, ao$;                              'Attributes off
PRINT #2, hc$ + " " + hc$;                  'Home cursor
END SUB                                     '

SUB delay                                   'Wastes time
now! = TIMER                                '"now!" needs to be
WHILE TIMER - now! < 1.5                    ' a SINGLE precision
WEND                                        ' variable
END SUB                                     '

SUB getparms                                'You need these
PRINT #2, cs$;                              'Clear screen
IF firsttime$ = "on" THEN                   'Skip this if it's
    firsttime$ = "off"                      ' your first call;
ELSE                                        ' otherwise:
    PRINT #2, es$ + "[1;36m";               'Light cyan
    PRINT #2, hc$;                          'Home cursor
    PRINT #2, "Modem speed ";               'Prompt for bps
    PRINT #2, es$ + "[1;33m";               'Yellow
    PRINT #2, "3";                          '
    PRINT #2, es$ + "[1;36m";               'Light cyan
    PRINT #2, "00 ";                        '
    PRINT #2, es$ + "[1;33m";               'Yellow
    PRINT #2, "1";                          '
    PRINT #2, es$ + "[1;36m";               'Light cyan
    PRINT #2, "200 ";                       '
    PRINT #2, es$ + "[1;33m";               'Yellow
    PRINT #2, "2";                          '
    PRINT #2, es$ + "[1;36m";               'Light cyan
    PRINT #2, "400 ";                       '
    PRINT #2, es$ + "[1;33m";               'Yellow
    PRINT #2, "9";                          '
    PRINT #2, es$ + "[1;36m";               'Light cyan
    PRINT #2, "600 [";                      '
    PRINT #2, es$ + "[1;33m";               'Yellow
    PRINT #2, "1";                          '
    PRINT #2, es$ + "[1;36m";               'Light cyan
    PRINT #2, "/";                          '
    PRINT #2, es$ + "[1;33m";               'Yellow
    PRINT #2, "2";                          '
    PRINT #2, es$ + "[1;36m";               'Light cyan
    PRINT #2, "/";                          '
    PRINT #2, es$ + "[1;33m";               'Yellow
    PRINT #2, "3";                          '
    PRINT #2, es$ + "[1;36m";               'Light cyan
    PRINT #2, "/";                          '
    PRINT #2, es$ + "[1;33m";               'Yellow
    PRINT #2, "9";                          '
    PRINT #2, es$ + "[1;36m";               'Light cyan
    PRINT #2, "]? ";                        '
    PRINT #2, es$ + "[1;33m";               'Yellow
    bp$ = ""                                'Initialize to null
    WHILE bp$ <> "1" AND bp$ <> "2" AND bp$ <> "3" AND bp$ <> "9"
        bp$ = INKEY$                        'Wait for 1, 2, 3
    WEND                                    ' or 9 to be pressed
    comspec$ = "COM" + comport$ + ":"       'Initialize comspec
    SELECT CASE bp$                         'Whadda we got?
        CASE "1"                            '1 pressed?
            PRINT #2, "1200 bps";           ' Tell user
            comspec$ = comspec$ + "1200"    ' Add 1200 to comspec
        CASE "2"                            '2 pressed?
            PRINT #2, "2400 bps";           ' Tell user
            comspec$ = comspec$ + "2400"    ' Add 2400 to comspec
        CASE "3"                            '3 pressed?
            PRINT #2, "300 bps";            ' Tell user
            comspec$ = comspec$ + "300"     ' Add 300 to comspec
        CASE "9"                            '9 pressed?
            PRINT #2, "9600 bps";           ' Tell user
            comspec$ = comspec$ + "9600"    ' Add 9600 to comspec
    END SELECT                              '
    comspec$ = comspec$ + ",N,8,1,DS"       'Complete comspec
END IF                                      '
END SUB                                     '

SUB hangup                                  'Byebye, BBS
PRINT #2, cs$;                              'Clear screen
PRINT #2, es$ + "[1;5;37;41m";              'Blink white on red
PRINT #2, es$ + "[25;39H";                  'LOCATE 25, 39
PRINT #2, "Wait";                           'Tell user
CALL delay                                  'Waste time
PRINT #1, "+++";                            'Wake up your modem
CALL delay                                  'Waste time
PRINT #1, "ATH0"                            'Tell modem to hangup
PRINT #2, ao$;                              'Attributes off
IF NOT EOF(1) THEN                          'Clear the com buffer
    b$ = INPUT$(LOC(1), #1)                 ' of any unprocessed
END IF                                      ' bytes
CALL bottomline                             'Print line 25
END SUB                                     '

SUB initialize                              'Foreplay
PRINT #2, ao$;                              'Attributes off
PRINT #2, cs$;                              'Clear screen
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "Modem initialization string? ";  'Prompt user
PRINT #2, es$ + "[1;33m";                   'Yellow
a$ = ""                                     'Initialize to null
WHILE a$ <> CHR$(13)                        'Until Return pressed
    a$ = INKEY$                             'Grab key pressed
    IF a$ = CHR$(8) AND LEN(init$) THEN     'Backspace?
        PRINT #2, es$ + "[1D";              ' Lop off the right-
        PRINT #2, " ";                      ' most character and
        PRINT #2, es$ + "[1D";              ' move cursor left
        IF LEN(init$) > 1 THEN              ' Truncate init$
            init$ = LEFT$(init$, LEN(init$) - 1)'by one character
        ELSE                                ' or
            init$ = ""                      '  make it null
        END IF                              '
    ELSE                                    '
        a$ = UCASE$(a$)                     'Make it upper case
        IF a$ > " " THEN                    'Reject strange chars
            init$ = init$ + a$              'Add char to init$
            PRINT #2, a$;                   'Print the character
        END IF                              '
    END IF                                  '
WEND                                        '
PRINT #2, cs$;                              'Clear screen
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "Comm Port [";                    'Prompt user
PRINT #2, es$ + "[1;33m";                   'Yellow
PRINT #2, "1";                              '
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "/";                              '
PRINT #2, es$ + "[1;33m";                   'Yellow
PRINT #2, "2";                              '
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "]? ";                            '
PRINT #2, es$ + "[1;33m";                   'Yellow
WHILE comport$ <> "1" AND comport$ <> "2"   'Wait for a 1 or 2
    comport$ = INKEY$                       ' to be pressed
WEND                                        '
PRINT #2, comport$;                         'Tell user
PRINT #2, cs$;                              'Clear screen
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "DIAL ";                          'Prompt user
PRINT #2, es$ + "[1;33m";                   'Yellow
PRINT #2, "P";                              '
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "ulse or ";                       '
PRINT #2, es$ + "[1;33m";                   'Yellow
PRINT #2, "T";                              '
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "one [";                          '
PRINT #2, es$ + "[1;33m";                   'Yellow
PRINT #2, "P";                              '
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "/";                              '
PRINT #2, es$ + "[1;33m";                   'Yellow
PRINT #2, "T";                              '
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "]? ";                            '
WHILE dialmode$ <> "P" AND dialmode$ <> "T" 'Wait for a P or T
    dialmode$ = INKEY$                      ' to be pressed
    dialmode$ = UCASE$(dialmode$)           'Make it upper case
WEND                                        '
PRINT #2, es$ + "[1;33m";                   'Yellow
IF dialmode$ = "P" THEN                     'P pressed?
    PRINT #2, "Pulse";                      ' Print Pulse
ELSE                                        'else
    PRINT #2, "Tone";                       ' Print Tone
END IF                                      '
END SUB                                     '

SUB makeacall                               'Reach out & touch
PRINT #2, cs$;                              'Clear screen
PRINT #2, es$ + "[1;5;37;41m";              'Blink white on red
PRINT #2, es$ + "[25;39H";                  'LOCATE 25, 39
PRINT #2, "Wait";                           'Tell user
CALL delay                                  'Waste time
PRINT #1, "+++";                            'Wake up your modem
CALL delay                                  'Waste time
PRINT #1, "ATH0"                            'Tell modem to hangup
PRINT #2, ao$;                              'Attributes off
IF NOT EOF(1) THEN                          'Clear the com buffer
    b$ = INPUT$(LOC(1), #1)                 ' of any unprocessed
END IF                                      ' bytes
CALL getparms                               'You need these
CALL opencomport                            'Open Sesame
PRINT #2, cs$;                              'Clear screen
PRINT #2, es$ + "[1;36m";                   'Light cyan
PRINT #2, "Phone number? ";                 'Prompt user
PRINT #2, es$ + "[1;33m";                   'Yellow
dial$ = ""                                  'Initialize to null
WHILE a$ <> CHR$(13)                        'Until Return pressed
    a$ = INKEY$                             'Grab key pressed
    IF a$ = CHR$(8) AND LEN(dial$) THEN     'Backspace?
        PRINT #2, es$ + "[1D";              ' Lop off the right-
        PRINT #2, " ";                      ' most character and
        PRINT #2, es$ + "[1D";              ' move cursor left
        IF LEN(dial$) > 1 THEN              ' Truncate dial$ by
            dial$ = LEFT$(dial$, LEN(dial$) - 1)'  one character
        ELSE                                ' or
            dial$ = ""                      '  make it null
        END IF                              '
    ELSE                                    '
        a$ = UCASE$(a$)                     'Make it upper case
        IF a$ > " " THEN                    'Reject strange chars
            dial$ = dial$ + a$              'Add char to dial$
            PRINT #2, a$;                   'Print the character
        END IF                              '
    END IF                                  '
WEND                                        '
PRINT #1, "ATD" + dialmode$ + dial$         'Tell modem to dial
PRINT #2, ao$;                              'Attributes off
PRINT #2, cs$ + " " + hc$;                  'Clear screen
END SUB                                     '

SUB opencomport                             'Open Sesame
CLOSE #1                                    'Close com port
OPEN comspec$ FOR RANDOM AS 1               'Open com port
IF firsttime$ = "" THEN                     'First time?
    PRINT #1, init$                         ' Send init$ to modem
    firsttime$ = "on"                       ' Remember you did so
END IF                                      '
END SUB                                     '

SUB outtahere                               'I quit!
PRINT #2, cs$;                              'Clear screen
PRINT #2, es$ + "[1;5;37;41m";              'Blink white on red
PRINT #2, es$ + "[25;39H";                  'LOCATE 25, 39
PRINT #2, "Wait";                           'Tell user
CALL delay                                  'Waste time
PRINT #1, "+++";                            'Wake up your modem
CALL delay                                  'Waste time
PRINT #1, "ATH0"                            'Tell modem to hangup
IF NOT EOF(1) THEN                          'Clear the com buffer
    b$ = INPUT$(LOC(1), #1)                 ' of any unprocessed
END IF                                      ' bytes
CLOSE #1                                    'Close com port
PRINT #2, ao$;                              'Attributes off
PRINT #2, cs$ + " " + hc$;                  'Clear screen
CLOSE #2                                    'Close "con"
b$ = ""                                     'Make b$ null
END                                         'T-T-That's All Folks
END SUB                                     '