Stars of Shareware: Programmierung/SOURCE.mdf/programm/msdos/basic/qbwnet/chat.bas

BASIC Source File | 1993-06-24 | 5.4 KB | 197 lines

'
'
'  CHAT.BAS - Sample Chat program written using Network Datagram Services
'
'    This program uses QBWARE/Net, the Network Communications Library for
'    Basic and Quickbasic from AJM Software.  It is a simple chat program
'    that demonstrates the basic concepts of peer-to-peer communications.
'
'    Copyright (C) - AJM SOftware, 1993
'
'
'
'
'    NETWORK.BI contains FUNCTION prototypes and TYPE declarations needed by
'        the library.
'
        REM $INCLUDE: 'network.bi'

'
'    Misc TYPE statement for scrolling a portion of the screen
'
        TYPE RegType
             ax    AS INTEGER
             bx    AS INTEGER
             cx    AS INTEGER
             dx    AS INTEGER
             si    AS INTEGER
             di    AS INTEGER
             flags AS INTEGER
        END TYPE

'
'    These TYPE's are found in NETWORK.BI
'
        DIM MyStation AS NetStation
        DIM YourStation AS NetStation
        DIM MsgOut AS NetMsg
        DIM MsgIn AS NetMsg

'
'    These values define the window used to display incoming messages.
'
        Tr = 5: Lc = 1: Br = 25: Rc = 80
        SFg = 7 : SBg = 0

'
'    These values are used by the ***VERY*** basic keyboard handler.
'
        BkSpace$ = CHR$(8)
        Enter$ = CHR$(13)
        Esc$ = CHR$(27)

'
'    Program startup
'
        CLS
        LOCATE 1, 30
        PRINT "Network Chat Utility"

        LOCATE 4, 1
        WHILE LEN(MyName$) = 0 OR LEN(MyName$) > 8
                INPUT ;"Enter your Name (8 chars max): ", MyName$
        WEND
        MyName$ = LEFT$(LTRIM$(RTRIM$(MyName$)) + ":" + SPACE$(8), 10)

        LOCATE 4, 1
        PRINT SPACE$(79);

'
'    Initialize the Network Communications Library
'
        GOSUB NetWorkStartUp

'
'    Send a message indicating that I'm signing on.
'
        MsgOut.Text = MyName$ + "Logging In........." + DATE$ + SPACE$(2) + TIME$
        Rc = NetBroadcast(NetHandle&, MsgOut)

        LOCATE 3, 1
        PRINT "Msg:"
        InKy$ = ""

'
'    This is the mainline loop.   It polls the keyboard as well as the Network
'        Communication buffers looking for leyboard input or Network traffic.
'
        WHILE InKy$ <> Esc$        'loop until [Esc] is pressed
                InKy$ = INKEY$
                IF InKy$ <> "" THEN GOSUB ProcessInp
                Rc = NetReceive(YourStation, MsgIn)
                IF Rc = 0 THEN GOSUB ProcessMsgIn
                LOCATE 1,69: PRINT DATE$;
                LOCATE 2,69: PRINT TIME$;
        WEND

        MsgOut.Text = MyName$ + "Logging Out......... " + DATE$ + SPACE$(2) + TIME$
        Rc = NetBroadcast(NetHandle&, MsgOut)
        END


'
'    This procedure allocates storage needed by the communication library and
'        initializes all network control blocks.  If the Network software
'        is not loaded, the startup routines return a -1 and this program
'        is terminated.
'
NetWorkStartUp:

        Rc = NetStart(MyStation)
        IF Rc <> 0 THEN
                CLS
                PRINT "Network not detected .........."
                PRINT "Program Ending .........."
        END IF
'
'    Issue 5 listen requests for incoming messages.  This allows you to
'        receive up to 5 messages at the same instant.
'
        NetHandle& = NetListen&
        NetHandle& = NetListen&
        NetHandle& = NetListen&
        NetHandle& = NetListen&
        NetHandle& = NetListen&
        RETURN

'
'    This is a short routine to handle the keyboard and display the
'        appropriate letter on screen.  Please note that BackSpace is
'        the only edit key.  [Escape] terminates the program.
'
ProcessInp:

        SELECT CASE InKy$

                CASE Esc$               'Shut down program
                        RETURN

                CASE BkSpace$           'backup
                        IF Len(Text$) > 1 THEN Text$ = LEFT$(Text$, LEN(Text$) - 1)

                CASE Enter$             'Send the message
                        GOSUB SendText

                CASE ELSE               'filter out extended (i.e. F1-F12)
                        IF LEN(InKy$) = 1 THEN Text$ = Text$ + InKy$
        END SELECT

        LOCATE 3, 6
        PRINT LEFT$(Text$ + SPACE$(69), 69);
        IF LEN(Text$) > 69 THEN GOSUB SendText  'Automatically Send Msg
        RETURN

'
'    This routine sends a message to all stations using the Network Datagram
'        services.
'
SendText:

        MsgOut.Text = MyName$ + Text$
        Rc = NetBroadcast(NetHandle&, MsgOut)
        MsgIn.Text = MsgOut.Text
        GOSUB ProcessMsgIn
        Text$ = ""
        RETURN

'
'    This routine scrolls the CHAT window and places the new message on the
'        bottom of the screen.  Note that we assume the new message will
'        fit on one line.  If the doesn't, the entire screen will scroll
'        in a very unprofessional manner.
'
ProcessMsgIn:

        Tr = 5: Lc = 1: Br = 25: Rc = 80
        SFg = 7 : SBg = 0
        CALL WScroll (Tr, Br, Lc, Rc, SFg, SBg)
        TextIn$ = RTRIM$(MsgIn.Text)
        LOCATE 25,1
        PRINT TextIn$;
        RETURN



SUB WScroll (Tr, Br, Lc, Rc, SFg, SBg)

'    This is a short routine to scroll a portion of the screen.
'
    DIM regs AS RegType

        regs.ax = &H601
        regs.bx = SBg
        regs.cx = ((Tr - 1) * 256) + (Lc - 1)
        regs.dx = ((Br - 1) * 256) + (Rc - 1)
        CALL ExecInt(&H10, SEG regs)
END SUB