Shareware Supreme Volume 6 #1/swsii.zip/swsii/102/QBS-0102.ZIP/QBS102-3.DOC

Text File | 1993-03-24 | 46KB | 1,298 lines

════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #8647
 Date:    02-09-93 16:56 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: EMS Array Code        1/
────────────────────────────────────────────────────────────────────────────────
' Here is some code I posted a while back.  Thought it might give the
' echo a bit of a code boost...

DECLARE FUNCTION IsAllASCII (Txt$) AS INTEGER
' JackMack SuperArray Management Kit v1.0
' Released into the public domain on 24 December 1992
' in the interest of mutually beneficial programming practices.
' Rereleased February 1993
' Written by Quinn Tyler Jackson of
' JackMack Consulting & Development
' "Specializing in Custom DOS-based GUI applications and on-line
'  documentation."

' This array management tool is programmed for VBDOS 1.0, but may
' be fully compatible with BASIC PDS 7.x.  It uses advanced features
' not found in QuickBASIC 4.5, but these features MAY be worked out
' by enterprising programmers.  Words to look for in the source code
' include: PRESERVE.

' Features of this application:

' INTEGER and LONG numeric arrays can be stored in EMS memory, leaving
' space free for bigger and better things.  Arrays are referenced not by
' obscure numbers and handles, but by user assigned names that may include
' ANY character.  That means that an array COULD conceivably be called
' "This is my array."

' STRING arrays are stored to a to virtual memory file, and are variable
' length.  Only their pointers are stored in RAM, and even these are stored
' safely out of the way in EMS.  In short, as long as disk space allows,
' one could have a 300,000 element string array, each element being between
' one and 32000 some odd characters long, and it wouldn't take up any more
' of DGROUP or far string space than any other STRING JmArray.
' Also note that STRING arrays are compressed onto the virtual disk file
' if they do not contain high-ASCII characters, to conserve disk space.

' Some academic points illustrated by this program:

'   1) Pointer referencing,
'   2) End user modifiable array names,
'   3) "Handle-based" arrays,
'   4) Virtual memory.

' NOTE: To allow for INTEGER and LONG values to be passed back from the
'       same function that returns STRING values, all values are passed
'       back as STRING.  They must be converted thus:
'
'       ErrorCode = JmSET ("My array", 10, "100")
'       IntegerValue = VAL(JmGet ("My array",10)
'
'       This is unfortunate, but allows one function to return ALL types
'       of data, not just one per function.


' These seven routines are from Hanlin's PBCLONE 1.9 library.  Earlier
' versions of PBCLONE might work, too.

DECLARE FUNCTION IsASCII% (Ch$)
DECLARE FUNCTION StrSqu$ (St$)
DECLARE FUNCTION StrUnSq$ (St$)
DECLARE SUB EMSClose (BYVAL ArrayHandle%)
DECLARE SUB EMSOpen (Elements&, ElementType%, ArrayHandle%, ErrCode%)
DECLARE SUB EMSGet (BYVAL ArrayHandle%, ElementNr&, Value AS ANY)
DECLARE SUB EMSPut (BYVAL ArrayHandle%, ElementNr&, Value AS ANY)

' These routines are local to this particular program.
DECLARE FUNCTION JmGET$ (ArrayName$, Element AS LONG, ErrCode AS INTEGER)
DECLARE FUNCTION JmDIM% (ArrayName$, Elements AS LONG, ArrayType%)
DECLARE FUNCTION JmWORD (InExpression$, Index%) AS STRING
DECLARE FUNCTION JmSET% (ArrayName$, Element AS LONG, Vlue AS STRING)
DECLARE FUNCTION JmERASE% (ArrayName$)

OPTION BASE 1 ' I prefer things to start at one.  Humans tend to count that
              ' way, don't you agree?

'Some system constants.
CONST BUFFER_MAX = 10           ' How many previously read strings to buffer.
CONST VirtualFile = "JMVSA.$$$" ' Virtual string memory file.
CONST StartSize = 10

'Ye olde tradional Boolean logic constants
CONST TRUE = (1 = 1)            ' I prefer (1=1) since it is compiler
                                ' independent, whereas -1 is specific to
                                ' MS BASICS.
CONST FALSE = NOT TRUE

' Array Types
CONST Array_Integer = 1
CONST Array_Long = 2
CONST Array_String = 3

' Errors that might happen
CONST Err_EMS_Allocation = -1
CONST Err_Bad_Subscript = -2
CONST Err_Array_Not_Dimensioned = -3
CONST Err_Overflow = -4
CONST Err_DOS_Error = -5

' PointerType for the array cross-reference table.
TYPE PointerType
    Elements AS LONG                ' How many array elements array has.

    Handle AS INTEGER               ' EMS handle of either data or ptr table
                                    ' (String arrays use an EMS ptr table).

    ArrayType AS INTEGER            ' What type of array we're dealing with.


    Accesses AS LONG                ' How many times this array is accessed.
END TYPE

DEFINT A-Z
'$DYNAMIC arrays are going to be used so they can be redimensioned.

' PtrArray changes size and must be preserved when it does so.  Therefore,
' QuickBASIC users might have to rethink the logic I have used throughout.
DIM SHARED PtrArray(StartSize) AS PointerType

REDIM SHARED AName$(StartSize)          ' Names of arrays.
DIM SHARED VirtualHandle AS INTEGER     ' Handle of virtual memory file.

' The simple sample application to show syntax follows here.  Normally, your
' program would go here....


CLS
' A 300,000 element string array!  Requires lots of EMS for pointers!  A
' one million element array would require 4 Megs of free EMS, but wouldn't
' take up any more DGROUP or conventional memory than a two element array!

INPUT "This array can have any name you'd like: ", Array$
' Arrays can be named at the end-user level.  This is good for database
' applications and is a powerful feature.  The user is not forced to refer
' to his specific data by any contrived name other than the one he or she
' assigns!

nul = JmDIM(Array$, 1000, Array_String)
IF nul < 0 THEN PRINT "ERROR": END
PRINT nul
PRINT "Getting data from array '" + Array$ + "'."
nul = JmSET(Array$, 1000, "This is a test.  The test seems to have worked.")

PRINT JmGET(Array$, 1000, ErrCode)

nul = JmERASE("*") 'Be sure to do this to free EMS handles and memory!
>>> Continued to next message

 * SLMR 2.1a *

--- Maximus 2.01wb
 * Origin: VKUG/VPCC QuickBasic Echo - Richmond, BC (1:153/151)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #8648
 Date:    02-09-93 16:56 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: EMS Array Code        2/
────────────────────────────────────────────────────────────────────────────────
>>> Continued from previous message
REM $STATIC
FUNCTION IsAllASCII (Txt$) AS INTEGER
FOR scan = 1 TO LEN(Txt$)
    IF NOT IsASCII(MID$(Txt$, scan, 1)) THEN
        IsAllASCII = FALSE
        EXIT FUNCTION
    END IF
NEXT
IsAllASCII = TRUE
END FUNCTION

FUNCTION JmDIM (ArrayName$, Elements AS LONG, ArrayType) AS INTEGER
STATIC ArrayPtr AS INTEGER

' Get First Available spot in list.
FOR scan = 1 TO UBOUND(PtrArray)
    IF AName$(scan) = "" THEN
        ArrayPtr = scan
        Flag = TRUE
        EXIT FOR
    END IF
NEXT scan

IF NOT Flag THEN ' We have to make room for a new array, since no spots left.
    ArrayPtr = UBOUND(PtrArray) + 1
    REDIM PRESERVE PtrArray(ArrayPtr) AS PointerType
    REDIM PRESERVE AName$(ArrayPtr)
END IF


SELECT CASE ArrayType
    CASE Array_Integer, Array_Long
        AName$(ArrayPtr) = ArrayName$
        PtrArray(ArrayPtr).Elements = Elements
        PtrArray(ArrayPtr).ArrayType = ArrayType
        EMSOpen Elements, Array_Type, Handle, ErrCode
        PtrArray(ArrayPtr).Handle = Handle
        IF ErrCode THEN
            JmDIM = -1
            EXIT FUNCTION
        ELSE
            JmDIM = Handle
            EXIT FUNCTION
        END IF

    CASE Array_String, Array_Compressed
        AName$(ArrayPtr) = ArrayName$
        PtrArray(ArrayPtr).Elements = Elements
        PtrArray(ArrayPtr).ArrayType = ArrayType
        IF NOT VirtualHandle THEN 'we haven't opened the virtual file yet.
            VirtualHandle = FREEFILE
            OPEN VirtualFile FOR BINARY AS VirtualHandle

        END IF
        ' This EMS array is an array of POINTERS to file offsets.
        EMSOpen Elements, Array_Long, Handle, ErrCode
        PtrArray(ArrayPtr).Handle = Handle
        IF ErrCode THEN
            JmDIM = -1
            EXIT FUNCTION
        ELSE
            JmDIM = Handle
            EXIT FUNCTION
        END IF
END SELECT

END FUNCTION

FUNCTION JmERASE (ArrayName$)

IF ArrayName$ <> "*" THEN ' The asterix is intended to erase ALL JmArrays!!
    FOR scan = 1 TO UBOUND(PtrArray)
        IF ArrayName$ = AName$(scan) THEN
                'Release EMS being used by array.
                EMSClose PtrArray(scan).Handle
                'Show the name as blank so that it is freed for future use.
                AName$(scan) = ""
                Flag = TRUE
                EXIT FOR
        END IF
    NEXT scan
    IF NOT Flag THEN
        ' We tried to ERASE an array that didn't exist.  Names ARE
        ' case sensitive, so "Quinn" and "quinn" are different.
        JmERASE = Err_Array_Not_Dimensioned
        EXIT FUNCTION
    END IF
ELSE
    CLOSE VirtualHandle ' Close the virtual string file and
'    KILL VirtualFile    ' get rid of it.

    FOR scan = 1 TO UBOUND(PtrArray)
        IF AName$(scan) <> "" THEN
            'Release EMS used by array.
            EMSClose PtrArray(scan).Handle
        END IF
    NEXT scan
    REDIM PtrArray(1) AS PointerType
    REDIM AName$(1)
    VirtualHandle = 0
END IF
END FUNCTION

FUNCTION JmGET (ArrayName$, Element AS LONG, ErrCode AS INTEGER) AS STRING
STATIC BufferPtr


FOR scan = 1 TO UBOUND(PtrArray)
    IF ArrayName$ = AName$(scan) THEN
        IF Element > PtrArray(scan).Elements THEN
            ErrCode = Err_Bad_Subscript
            EXIT FUNCTION
        END IF
        SELECT CASE PtrArray(scan).ArrayType
            CASE Array_Integer
                EMSGet PtrArray(scan).Handle, Element, TempInt%
                JmGET = STR$(TempInt%)
                Flag = TRUE
                EXIT FOR

            CASE Array_Long
                EMSGet PtrArray(scan).Handle, Element, TempLong&
                JmGET = STR$(TempLong&)
                Flag = TRUE
                EXIT FOR

            CASE Array_String
                EMSGet PtrArray(scan).Handle, Element, EndPtr&

                ON LOCAL ERROR GOTO DOSErrorGet
                    ' First find the right spot in virtual file.
                    SEEK VirtualHandle, EndPtr&
                    ' Then find out how much data to read from file.
                    GET VirtualHandle, , Leng%
                    ' Then prepare an adequate buffer.
                    Buffer$ = SPACE$(ABS(Leng%))
                    ' And finally suck it in through the straw.
                    GET VirtualHandle, , Buffer$
                ON LOCAL ERROR GOTO 0
>>> Continued to next message

 * SLMR 2.1a *

--- Maximus 2.01wb
 * Origin: VKUG/VPCC QuickBasic Echo - Richmond, BC (1:153/151)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #8649
 Date:    02-09-93 16:56 (Public)
 From:    QUINN TYLER JACKSON
 To:      ALL
 Subject: EMS Array Code        3/
────────────────────────────────────────────────────────────────────────────────
>>> Continued from previous message
                ' Negative lengths indicate previous compression.
                IF Leng% < 0 THEN Buffer$ = StrUnSq(Buffer$)
                JmGET = Buffer$
                Flag = TRUE
                EXIT FOR
        END SELECT
    END IF
NEXT scan

IF NOT Flag THEN
    ErrCode = Err_Array_Not_Dimensioned
    EXIT FUNCTION
END IF

EXIT FUNCTION

DOSErrorGet:
' Something happened that had to be trapped.
ErrCode = Err_DOS_Error
EXIT FUNCTION

END FUNCTION

FUNCTION JmSET (ArrayName$, Element AS LONG, Vlue AS STRING)
FOR scan = 1 TO UBOUND(PtrArray)
    IF ArrayName$ = AName$(scan) THEN
        IF Element > PtrArray(scan).Elements THEN
            JmSET = Err_Bad_Subscript
            EXIT FUNCTION
        END IF
        SELECT CASE PtrArray(scan).ArrayType

            CASE Array_Integer
                TempInt& = VAL(Vlue)
                IF TempInt& > 32768 OR TempInt& < -32768 THEN
                    ' Someone forgot his BASIC basics.
                    JmSET = Err_Overflow
                    EXIT FUNCTION
                END IF
                TempInt% = TempInt&
                ' Stuff it up there in EMS land.
                EMSPut PtrArray(scan).Handle, Element, TempInt%
                Flag = TRUE
                EXIT FOR

            CASE Array_Long
                TempLong& = VAL(Vlue)
                EMSPut PtrArray(scan).Handle, Element, TempLong&
                Flag = TRUE
                EXIT FOR

            CASE Array_String


                ' New string assignments added to end of virtual file.
                EndPtr& = LOF(VirtualHandle) + 1
                EMSPut PtrArray(scan).Handle, Element, EndPtr&
                ON LOCAL ERROR GOTO DOSErrorSet
                    SEEK VirtualHandle, EndPtr&
                    ' Add the string length to the string for later use.
                    SELECT CASE IsAllASCII(Vlue)
                        CASE TRUE
                            'Compress string.
                            Vlue = StrSqu(Vlue)
                            ' Make it < 0 if compressed.
                            Vlue = MKI$(-LEN(Vlue)) + Vlue
                        CASE ELSE
                            Vlue = MKI$(LEN(Vlue)) + Vlue
                    END SELECT
                    PUT VirtualHandle, , Vlue
                ON LOCAL ERROR GOTO 0
                Flag = TRUE
                EXIT FOR

        END SELECT
    END IF
NEXT scan

IF NOT Flag THEN
    JmSET = Err_Bad_Array_Name
    EXIT FUNCTION
END IF

EXIT FUNCTION
DOSErrorSet:
    JmSET = Err_DOS_Error
    EXIT FUNCTION

END FUNCTION


 * SLMR 2.1a *

--- Maximus 2.01wb
 * Origin: VKUG/VPCC QuickBasic Echo - Richmond, BC (1:153/151)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #9372
 Date:    02-08-93 17:35 (Public)
 From:    VICTOR YIU
 To:      ERIC MAYS
 Subject: GETINPUT    1/2
────────────────────────────────────────────────────────────────────────────────
Here's what you're looking for!

-!!!!!!!!!!!!!!!!!!!!!!!!!!-8<-!!!!!-8<-!-  snip here

' released into public domain
' +-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!-+
' |  GetInput.bas                               by Victor Yiu |
' |  ~~~~~~~~~~~~                                             |
' |    A full functioned replacement for INPUT.  Includes     |
' |  full line editing:  insert, typeover, delete, home/end,  |
' |  and next/previous word.  Also lets you specify maximum   |
' |  line length, or let use input until end of line.         |
' |    The code is specially written for clarity and ease of  |
' |  understanding.  All of the code is optimized to the max  |
' |  that I know how.                                         |
' |    In essence, it is just a full line editor.             |
' |                                                           |
' |  Syntax:                                                  |
' |     In$ = GetInput$(Prompt$, MaxLen%)                     |
' |                                                           |
' |  Prompt$ is the prompt that you want to be displayed when |
' |             user is inputting data, like "Your name? "    |
' |  MaxLen  is the maximum length that you will allow the    |
' |             user to type in.  Use "0" or "-1" to input it |
' |             to the end of the screen                      |
' +-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!-+

'  Declarations
DECLARE SUB Init ()
DECLARE SUB Alarm ()
DECLARE FUNCTION GetInput$ (Prompt$, MaxLen%)

DEFINT A-Z      ' use integers by default for speed
COMMON SHARED Null$           ' set up some initial keys:
COMMON SHARED LeftK$, RightK$ ' it is faster and clearer to use variables
COMMON SHARED Home$, End$     ' (A$, B$) instead of constants ("d",
COMMON SHARED Insert$, Delete$' "xyz", CHR$(3))
COMMON SHARED CLeft$, CRight$ ' --> MY BENCHMARKS CONFIRM IT <--
COMMON SHARED SpaceBar$

CONST False = 0, True = NOT False   ' set up boolean constants

    Null$ = CHR$(0)             ' define initial keys
    SpaceBar$ = " "
    Insert$ = Null$ + "R"
    Delete$ = Null$ + "S"

    LeftK$ = Null$ + "K": RightK$ = Null$ + "M"
    Home$ = Null$ + "G": End$ = Null$ + "O"
    CLeft$ = Null$ + "s": CRight$ = Null$ + "t"
CLS             ' clear screen
COLOR 7, 0      ' use white on black


In$ = GetInput$("Enter a string: ", -1)   ' input a string

PRINT
PRINT "You typed ["; In$; "]"

' +-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!-+
' |  Alarm                                      by Victor Yiu |
' |  ~~~~~                                                    |
' |    Plays a tune                                           |
' +-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!-+
SUB Alarm

    SOUND 1000, .1

END SUB

FUNCTION GetInput$ (Prompt$, MaxLen)

    IF MaxLen < 1 THEN MaxLen = 80 - LEN(Prompt$) - POS(0)
    ' 0 or -1 means all that will fit on the row
    ' Adjusts MaxLen to max. len to the end of the line if user
    ' passes in < 1
    PRINT Prompt$;      ' print prompt
    StartX = POS(0)     ' save cursor column, to use later as base
    Cursor = 1          ' init. cursor
    Insert = True       ' default mode: insert

    DO    ' start main loop
        IF Update THEN      ' True if something changed in input
            LOCATE , StartX, 0      ' locate at base
            PRINT Out$; SpaceBar$;        ' print input plus a space
            Update = False          ' reset flag
        END IF

        LOCATE , Cursor + StartX - 1, 1, (NOT Insert) * -7, 16
            ' locate cursor at end of text, with cursor on.
            ' cursor shape is dependent on insertion mode
        DO: I$ = INKEY$         ' wait for input
        LOOP UNTIL LEN(I$)      ' --> NOTE:
                                    ' using LEN(I$) is _MUCH_ faster than
                                    ' using I$ <> ""

>>>>> Continued on next message...

--- Blue Wave/RA v2.10 [NR]
 * Origin: Hard Disc Cafe / Houston Texas / [phone] / (1:106/30.0)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #9373
 Date:    02-08-93 17:35 (Public)
 From:    VICTOR YIU
 To:      ERIC MAYS
 Subject: GETINPUT    2/2
────────────────────────────────────────────────────────────────────────────────
>>>>>> Continued from last message...

        IF LEN(I$) = 1 THEN     ' branch according to len. of input
            Update = True       ' set flag to update

            SELECT CASE ASC(I$)
                CASE IS >= 32   ' a normal char: just add it to string
               IF (NOT Insert) OR (LEN(Out$) < MaxLen) THEN  ' within limits?
                    ' able to add anymore?
                        IF Cursor > 0 THEN    ' has user typed anything?
'                 Out$ = LEFT$(Out$, Cursor - 1) + I$ + MID$(Out$, Cursor)
'                 Out$ = LEFT$(Out$, Cursor - 1) + I$ + MID$(Out$, Cursor + 1)
   Out$ = LEFT$(Out$, Cursor - 1) + I$ + MID$(Out$, Cursor - (NOT Insert))
                        ELSE
                            Out$ = I$    ' create new string
                        END IF
                        Cursor = Cursor + 1     ' advance cursor position
                    ELSE
                        Alarm           ' can't add, so beep at them
                        Update = False  ' don't update
                    END IF
                CASE 8          ' backspace
                    IF LEN(Out$) AND (Cursor > 1) THEN 'can we backspace?
                        Out$ = LEFT$(Out$, Cursor - 2) + MID$(Out$, Cursor)
                        'remove 1 char. before cursor
                        Cursor = Cursor - 1     ' adjust cursor
                    ELSE
                        Alarm
                        Update = False
                    END IF
                CASE 13     ' enter
                    EXIT DO
                CASE 27     ' escape
                    IF LEN(Out$) > 0 THEN     ' has user typed anything?
                        LOCATE , StartX, 0    ' yes, so clear the string
                        PRINT SPACE$(LEN(Out$) + 1);

                        Out$ = ""
                        Cursor = 1      ' resetting cursor position
                        Update = False  ' don't update:  no reason to
                    ELSE
                        EXIT DO         ' if nothing, just exit
                    END IF
            END SELECT
        ELSE    ' extended ASCII code
            SELECT CASE I$
                CASE LeftK$
                    IF Cursor > 1 THEN
                        Cursor = Cursor - 1     ' move cursor left
                    ELSE
                        Alarm
                    END IF
                CASE RightK$

                    IF Cursor < LEN(Out$) + 1 THEN
                        Cursor = Cursor + 1     ' move cursor right
                    ELSE
                        Alarm
                    END IF
                CASE Delete$
                    IF LEN(Out$) > 0 AND (Cursor < LEN(Out$)) THEN
                        Out$ = LEFT$(Out$, Cursor - 1) + MID$(Out$, Cursor +
1)
                        Update = True
                    ELSE
                        Alarm
                    END IF

                CASE CLeft$     ' move to previous word
                    IF Cursor > 2 THEN
                        Temp = Cursor - 1     ' assume starting position
                        DO                      ' start loop
                            Temp = Temp - 1     ' adjust pointer
                            IF ASC(MID$(Out$, Temp)) = 32 THEN  ' space?
                                Temp = Temp + 1  ' yes, so move cursor to
                                EXIT DO          ' next word & exit
                            END IF
                        LOOP UNTIL Temp = 1  ' just in case for no spaces
                        Cursor = Temp           'adjust cursor
                    ELSE
                        Cursor = 1
                    END IF
                CASE CRight$
                    IF Cursor <= LEN(Out$) THEN 'only if not end of line
                        Temp = INSTR(Cursor, Out$, SpaceBar$) ' find next
space
                        IF Temp = 0 THEN            ' any spaces at all?
                            Cursor = LEN(Out$) + 1  ' no, so just put at
                                                    ' end of line
                        ELSE
                            Cursor = Temp + 1    ' yes, put after space
                        END IF
                    ELSE
                        Cursor = LEN(Out$) + 1
                    END IF
                CASE Home$
                    Cursor = 1
                CASE End$
                    Cursor = LEN(Out$) + 1
                CASE Insert$
                    Insert = NOT Insert     ' if user pressed the insert
                                            ' key, just toggle flag
            END SELECT
        END IF
    LOOP

    LOCATE , , 0, 0, 16     ' restore cursor to invisible big block

    PRINT                   ' go to next line

    GetInput$ = Out$        ' assign function to value
END FUNCTION                ' exit

-!!!!!!!!!-8<-!!!!!!!!!!!!-8<-!!!!- that's it!

Hope it helps!
Victor

P.S.  Watch out for word-wrapped lines...

... My spelling?  Oh, it's just line noise.

--- Blue Wave/RA v2.10 [NR]
 * Origin: Hard Disc Cafe / Houston Texas / [phone] / (1:106/30.0)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #9376
 Date:    02-08-93 18:04 (Public)
 From:    VICTOR YIU
 To:      ALL
 Subject: MSGSPLIT ---->> 1/2
────────────────────────────────────────────────────────────────────────────────
Almost all of the active participants in this echo will find this program
extremely useful!!!

8<------8<--------8<-------8<----  Snip begins here: MSGSPLIT.BAS

' ==============================================================
' MsgSplit v1.0 ■ (C) Copyright Victor Yiu, 1993. ■ Feb. 8, 1993
' ==============================================================
' A great message processor for posting source files.  Converts
' your source files into messages that can be posted in FidoNet
' echos efficiently.  NO MORE PULLING YOUR HAIR OUT when you
' want to post a file!!!

' Significant features:
' ~~~~~~~~~~~~~~~~~~~~~
' o  Expands "tabs" (CHR$(9)s) into -REAL- spaces
' o  Removes unnecessary white space at end of lines
'      (QB has a VERY nasty tendency to do that if you're not careful...)
' o  Warns poster and reader of lines of over 80 characters.  Helps prevent
'      reader from dealing with much word-wrap problems.  First tries to
'      trim spaces, to see if the line will be then <80 char.
' o  Ability to specify message length
' o  Ability to reserve lines on 1st message
' o  Can directly post to preset BlueWave numbers -- saves me a lot of time!
' o  Great code to study and find out how it works!  (Don't I say that about
'      all my creations?!  <G>)  This program was written/produced/debugged
'      in only 45 minutes!!
'
' ===================== Comments are GREATLY welcomed! =====================

DEFINT A-Z

CONST True = -1, False = 0
Tab$ = CHR$(9): TabSub$ = SPACE$(4)

CLS
PRINT "MsgSplit v1.0 ■ (C) Copyright Victor Yiu, 1993."
PRINT

INPUT "What is the filename to split [.BAS]"; FileName$
IF LEN(FileName$) = 0 THEN END

INPUT "Name according to BlueWave conventions [y/N]"; BW$
BW = UCASE$(LEFT$(BW$, 1)) = "Y"

IF BW THEN
    INPUT "What echo # to post in"; OutN
    OutN$ = LTRIM$(STR$(OutN))
    INPUT "What message # to start posting in [1]"; FileOutNum
    IF FileOutNum <= 0 THEN FileOutNum = 1
ELSE
    FileOutNum = 1
END IF


Chop = INSTR(FileName$, ".")
IF Chop = 0 THEN
    IF NOT BW THEN OutN$ = FileName$
    FileName$ = UCASE$(FileName$ + ".BAS")
ELSE
    IF NOT BW THEN OutN$ = LEFT$(FileName$, Chop - 1)
    FileName$ = UCASE$(FileName$)
END IF

INPUT "How many lines per message [90]"; LPP
IF LPP <= 10 THEN LPP = 90

INPUT "Reserve how many lines for first message [5]"; Reserve$
IF LEN(Reserve$) THEN
    Reserve = VAL(Reserve$)
ELSE
    Reserve = 5
END IF
PRINT

OPEN FileName$ FOR INPUT AS #1
LinesOut = Reserve + 1
OnMsgNumber = 1
LPP = LPP - 4   ' lines per page

DO
    Temp$ = LTRIM$(STR$(FileOutNum))
    IF BW THEN
        Ext$ = "000": MID$(Ext$, 4 - LEN(Temp$)) = Temp$
    ELSE
        Ext$ = Temp$
    END IF

>>>>>>> Continued on next message >>>>>>>

--- Blue Wave/RA v2.10 [NR]
 * Origin: Hard Disc Cafe / Houston Texas / [phone] / (1:106/30.0)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #9377
 Date:    02-08-93 18:04 (Public)
 From:    VICTOR YIU
 To:      ALL
 Subject: MSGSPLIT ---->> 2/2
────────────────────────────────────────────────────────────────────────────────
Msg#: 2 >>>>>> Continued from last message: MSGSPLIT.BAS >>>>>>>

    OPEN OutN$ + "." + Ext$ FOR OUTPUT AS #2

    IF OnMsgNumber > 1 THEN
        PRINT #2, "Msg#:"; OnMsgNumber; ">>>>>> ";
        PRINT #2, "Continued from last message: "; FileName$; " >>>>>>>"
        PRINT #2,
    ELSE
   PRINT #2, "8<------8<--------8<-------8<----  Snip begins here: ";
FileName$
    PRINT #2,
    END IF

    TooLong = False
    FOR Trans = LinesOut TO LPP
        IF NOT EOF(1) THEN
            IF Trans = LinesOut THEN
                DO: LINE INPUT #1, Buf$
                LOOP WHILE LEN(Buf$) = 0
            ELSE
                LINE INPUT #1, Buf$
                Buf$ = RTRIM$(Buf$)
            END IF

            Tb = INSTR(Buf$, Tab$)  'remove those dang chr$(8)s (tabs)
            IF Tb THEN
                DO
                    Buf$ = LEFT$(Buf$, Tb - 1) + TabSub$ + MID$(Buf$, Tb + 1)
                    Tb = INSTR(Tb, Buf$, Tab$)
                LOOP WHILE Tb
            END IF

            IF LEN(Buf$) > 80 THEN
                T$ = LTRIM$(Buf$)
                IF LEN(T$) > 80 THEN
                    IF NOT TooLong THEN
                        TooLong = True
                        Trans = Trans + 1
                    END IF
                ELSE
                    Buf$ = T$
                    T$ = ""
                END IF
            END IF
            IF NOT ((Trans = LPP) AND LEN(Buf$) = 0) THEN
                PRINT #2, Buf$
            END IF
        END IF
    NEXT
    IF NOT EOF(1) THEN
        PRINT #2,
        PRINT #2, ">>>>>>> Continued on next message >>>>>>>"

    ELSE
        PRINT #2,
        PRINT #2, "8<------8<--------8<-------8<----  Snip ends!"
        PRINT #2, "Message polishing/splitting was done by MSGSPLIT 1.0, ";
        PRINT #2, "a Victor Yiu creation."
        PRINT #2,
    END IF
    IF TooLong THEN
        PRINT #2, "Warning -- some lines may be word wrapped in this message!"
        PRINT "Warning: Message number"; OnMsgNumber; "has obese lines!"
    END IF

    CLOSE #2
    IF NOT EOF(1) THEN
        OnMsgNumber = OnMsgNumber + 1
        FileOutNum = FileOutNum + 1
        LinesOut = 1
    END IF
LOOP UNTIL EOF(1)

CLOSE
PRINT "Complete!"
END


8<------8<--------8<-------8<----  Snip ends!
Message polishing/splitting was done by MSGSPLIT 1.0, a Victor Yiu creation.

... 1) Open mouth.   2) Insert shoe store.
--- Blue Wave/RA v2.10 [NR]
 * Origin: Hard Disc Cafe / Houston Texas / [phone] / (1:106/30.0)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #10056
 Date:    02-10-93 11:19 (Public)
 From:    FRANCOIS ROY
 To:      TRENT SHIRLEY
 Subject: CD-ROM Recognition
────────────────────────────────────────────────────────────────────────────────
You can use CALL INTERRUPT to read the ISO-9660 sectors via MSCDEX.  The VTOC
(Volume Table of Contents) is accessible as shown below; I don't have its
structure so can't tell you what the fields mean, but I can betcha no two are
alike... the VTOC is a 2048-byte string; I defined my buffer in CDVTOC with a
length of 4096 because for some reason 2048 gives me String Space Corrupt
errors... the demo routine below prints the first 800 bytes of the VTOC but
you may want to store the whole 2048 bytes as the CD's "fingerprint".

The code snippet below is for QB; QBX far strings need a small alteration.

DECLARE SUB CDVTOC (D$, V$)
DECLARE SUB CDDRIVE (DR$)
   TYPE REGTYPE  ' For CALL INTERRUPT
     AX AS INTEGER
     BX AS INTEGER
     CX AS INTEGER
     DX AS INTEGER
     BP AS INTEGER
     SI AS INTEGER
     DI AS INTEGER
     FL AS INTEGER
     DS AS INTEGER
     ES AS INTEGER
   END TYPE
   DIM SHARED INR AS REGTYPE, OUR AS REGTYPE
   CALL CDDRIVE(D$)
   PRINT "Drive:"; D$
   CALL CDVTOC(D$, V$)
   PRINT LEFT$(V$, 800)
   END

SUB CDDRIVE (DR$) STATIC
    DR$ = STRING$(32, 0)
    INR.AX = &H150D
    INR.BX = SADD(DR$)
    INR.ES = SSEG(DR$)
    CALL InterruptX(&H2F, INR, OUR)
    IF ASC(DR$) = 0 THEN DR$ = "" ELSE DR$ = CHR$(ASC(DR$) + 65) + ":"
END SUB

SUB CDVTOC (D$, V$) STATIC
REM Reads VTOC
    DR$ = STRING$(4096, 0)
    INR.AX = &H1505
    INR.BX = SADD(DR$)
    INR.CX = INSTR("ABCDEFGHIJKLMNOP", LEFT$(D$, 1)) - 1
    INR.DX = 0  ' 1st volume descriptor
    INR.ES = SSEG(DR$)
    CALL InterruptX(&H2F, INR, OUR)
REM AX=1 is normal and indicates a standard vol. descr.
REM AX=15 is 'Invalid Drive' and 21 is 'Not Ready'. 255 means no vol. desc.
    IF OUR.AX > 1 THEN V$ = "Error" + STR$(OUR.AX) ELSE V$ = DR$
END SUB


--- ME2_1104
 * Origin: Out of String Space - the Final Frontier (Fidonet 1:163/506.2)



════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #10145
 Date:    02-10-93 12:35 (Public)
 From:    QUINN TYLER JACKSON
 To:      JEFF JOHNSTON
 Subject: Detecting video...
────────────────────────────────────────────────────────────────────────────────
JJ>     Is there maybe a
JJ>     ASM program that would return the video being used so that the
JJ>     program would just branch to another sub or use a different set of
JJ>     variables for that particular video?

Try this'un.  I use it in all my programs, since they need to know
if the program can handle EGA/VGA alternate text fonts.  Thanks go to
Ethan Winer and his great book _BASIC Techniques and Utilities_. This
function returns a value that tells you what monitor you're contending
with. It's commented, so you should be able to figure what monitor
yields what return value.  It doesn't bloat code with error trapping,
either....  It also returns the video segment.


Cheers,

Quinn

___->8  CUT HERE  8<-------

DEFINT A-Z
' $INCLUDE: 'qb.bi'

DECLARE FUNCTION Monitor% (Segment)
DIM SHARED InRegs AS RegType, OutRegs AS RegType


FUNCTION Monitor% (Segment) STATIC
DEF SEG = 0              'first see if it's color or mono
Segment = &HB800         'assume color

IF PEEK(&H463) = &HB4 THEN

  Segment = &HB000       'assign the monochrome segment
  Status = INP(&H3BA)    'get the current video status
  FOR X = 1 TO 30000     'test for a Hercules 30000 times
    IF INP(&H3BA) <> Status THEN
      Monitor% = 2       'the port changed, it's a Herc
      EXIT FUNCTION      'all done
    END IF
  NEXT
  Monitor% = 1           'it's a plain monochrome

ELSE                     'it's some sort of color monitor

  InRegs.AX = &H1A00     'first test for VGA
  CALL INTERRUPT(&H10, InRegs, OutRegs)
  IF (OutRegs.AX AND &HFF) = &H1A THEN
    Monitor% = 5         'it's a VGA
    EXIT FUNCTION        'all done
  END IF

  InRegs.AX = &H1200     'now test for EGA

  InRegs.BX = &H10
  CALL INTERRUPT(&H10, InRegs, OutRegs)
  IF (OutRegs.BX AND &HFF) = &H10 THEN
    Monitor% = 3         'if BL is still &H10 it's a CGA
  ELSE
    Monitor% = 4         'otherwise it's an EGA
  END IF

END IF

END FUNCTION


 * SLMR 2.1a *

--- Maximus 2.01wb
 * Origin: VKUG/VPCC QuickBasic Echo - Richmond, BC (1:153/151)


════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #10334
 Date:    02-10-93 02:12 (Public)
 From:    ROB MCKEE
 To:      CALVIN FRENCH
 Subject: Communications through t
────────────────────────────────────────────────────────────────────────────────
Hello Calvin!
   You wrote in a message to Joe Negron:

 JN>   > PRINT #1,"+++"
 CF>
 CF> "+++" doesn't always work. To do it properly, you need to
 CF> read   the modem register [just a second let me get my
 CF> manual] "S2" and   see what it is. It's 043 normally, and
 CF> that's ASCII "+++".   Although I diddn't read the messages,
 CF> I picked up on this. This   can cause some _very_ annoying
 CF> bugs in some cases, I imagine.   Hope that helps out,

If it is set to >128 then the Escape Character is disabled on 90% of modems

The proper way to do it is:
 During program Start up.. Psuedo code follows

 IF NOT CD% then
    Print #ComPort,"ATS2?"
    GetLine Comport, Theline$
    If TheLine$= "ATS2?" then
        GetLine Comport, Theline$
        If TheLine$= "" then
            GetLine Comport, Theline$
        End if
    endif
    ModemEscape$=chr$(val(TheLine$))
    if ModemEscape$< chr$(128) then
        ModemEscape$= True
    else
        ModemEscape$= Else
    endif
    Connection%= False
 Else
    ' Assume "+" since modem is talking to somebody
    ' and the connection is hot
    ModemEscape$="+"
    ModemEscape$= True
    Connection%= True
 Endif

 Then to Issue the Escape String

 delay!=.55
 d!=(Timer + Delay!) mod 86400&
 If D!<timer then Do: loop until Int(Timer=0)
 Do: Loop until Timer=>d!
 ? #ComPort, ModemEscape$+ModemEscape$+ModemEscape$;
 d!=(Timer + Delay!) mod 86400&
 If D!<timer then Do: loop until Fix(Timer)=0
 Do: Loop until Timer=>d!
 WaitFor ComPort,"OK"
 ' do what ever you need to do.....


 You also have to be aware of modems that use the TIES escape which is
"+++AT" and doesn't use the Hayes Time guard before or after the Escape
sequence.  To further Explain here is a Healthy quote from the HAYES
WhitePaper on TIES which is available from the HAYES BBS:
 Hayes Microcomputer.......... GA 1-404-446-6336 96V

As part of his intensive research in the development of the original Hayes
Smartmodem, Dale Heatherington solved this inherent limitation by
surrounding the escape code, a sequence of characters, with guard times  on
both sides to alert the modem that the sequence is distinguished from  a
typical string of characters in a file transmission.  This escape  sequence

                <guard time>    <escape code>    <guard time>

virtually eliminates the limitation inherent in a data-dependent escape
sequence because of its use of time and because it does not depend on the
probability of character occurrence in a stream of data.  It is virtually
impossible for the Hayes escape sequence with guard time to appear in a  file
transfer and cause an unintentional escape using the common file  transfer
protocols.

Dale Heatherington's invention led to the issuance of United States  Patent
Number 4,549,302, the Modem With Improved Escape Sequence With  Guard Time
Mechanism, often called the Hayes '302 Patent, and  corresponding patents in
a number of countries.  The Hayes '302 Patent  ensures that modems escape or
change to the Command Mode of operation  reliably and without the possibility
that data alone could trigger the  escape.  In over eleven years of use of
the Hayes '302, Hayes has never  received a complaint about an unintentional
escape.  In addition, this  mechanism was copied by almost everyone in the
industry making it one of  the most widely adopted and enduring defacto
standards.


This "new" escape mechanism is called Time Independent Escape Sequence or
TIES.  The name appears to derive from the way in which the escape  sequence
works because it does not make use of time as the Hayes '302  does.  TIES
depends entirely upon the appearance of the escape sequence  in the stream of
data being received by the modem.  The TIES escape  mechanism is similar to
the escape mechanism in use at the time of the  invention of the Hayes '302
in that an escape can be triggered by the  data being sent as part of a file
transfer.

TIES - What Is It?

The simplest escape sequence for TIES is "+++AT<CR>" where "+++" stands  for
any escape character and "<CR>" represents carriage return or any  character
assigned in the modem registers by the AT command set which  designates the
end of the command. When that series of characters appears  in the data
stream, the modem can "escape" or change from
Receive/Transmit Mode to Command Mode of operation.  In effect, what  happens
at that point in the transmission is that the flow of data stops.   The flow
of data would halt simply because the characters which make up  the escape

sequence would have appeared in the data being transmitted.


 Catcha Later , I'll see you on the flip side - Rob

--- timEd/B6
 * Origin: Another Quik_Bas Point in Richmond, CA (1:125/411)


════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #11847
 Date:    02-12-93 05:00 (Public)
 From:    ROB MCKEE
 To:      RUSTY GORDON
 Subject: LIMITING THE LENGTH OF IN
────────────────────────────────────────────────────────────────────────────────
Hello Rusty!
   You wrote in a message to All:

 RG> This may sound like a stupid question but I have 8
 RG> Quickbasic books and cannot find the answer.
 RG> I understand how to limit the size of a string using
 RG> DIM variable$ as string * 15 etc... but how do I put a limit
 RG> to the  number of characters the user can enter as in the
 RG> sample below:

 RG> Enter Feature Name ▒▒▒▒▒▒▒▒▒▒▒▒▒▒.

 -------------------------8<--------------------------------  DECLARE
FUNCTION GINPUT$ (MaxLen%,Fill%)
 ' ? GINPUT$(44,176) ' Example of Usage
 ' END

 FUNCTION GINPUT$ (MaxLen%, Fill%)
 Fill$= CHR$(Fill%)
 r = CSRLIN
 c = POS(0)
 PRINT STRING$(MaxLen%,Fill$);
 LOCATE r, c, 1, 6, 7
 DO
     PRINT "";
     DO
     'GOSUB UpdateStatusLine
     i$ = INKEY$
     LOOP WHILE i$ = ""
     SELECT CASE i$
     CASE " " TO "z"
         IF LEN(Worki$) < MaxLen% THEN
             Worki$ = Worki$ + i$
             PRINT i$;
         END IF
     CASE CHR$(8)
         IF LEN(Worki$) = 1 THEN
             Worki$ = ""
             LOCATE r, c, 0
             PRINT STRING$(MaxLen%,Fill$);
             LOCATE r, c, 1, 6, 7
         ELSEIF LEN(Worki$) > 1 THEN
             Worki$ = LEFT$(Worki$, LEN(Worki$) - 1)
             PRINT CHR$(29); Fill$; CHR$(29);
         END IF
    CASE CHR$(0) + "w"  ' Control-Home Erase Line
             Worki$ = ""
             LOCATE r, c, 0
             PRINT STRING$(MaxLen%,Fill$);
             LOCATE r, c, 1, 6, 7
    CASE CHR$(10), CHR$(13)  ' Line Feed or Return Exit with String
EXIT DO
    CASE CHR$(27)

         GBQuitAction = True   ' A Shared Variable for Exiting Program
  EXIT FUNCTION         ' You don't Have to use it (True=-1 and     END
SELECT                 ' is a CONST False = 0, True = NOT False)  LOOP
 GINPUT$ = Worki$
 END FUNCTION
 -------------------------8<--------------------------------

 Catcha Later , I'll see you on the flip side - Rob

--- timEd/B6
 * Origin: Another Quik_Bas Point in Richmond, CA (1:125/411)


════════════════════════════════════════════════════════════════════════════════
 Area:    QuickBasic
  Msg:    #12045
 Date:    02-11-93 18:10 (Public)
 From:    DICK DENNISON
 To:      VICTOR YIU
 Subject: CRC-16 and CRC-32
────────────────────────────────────────────────────────────────────────────────
VY>     Can anyone tell me how to modify Rich's QBCRC10 CRC-32 maker to ma
VY> 16-bit CRCs?  I already have the CRC-32 code, so reposting it is unnec
VY> Thanks!
  'From Donn Bly:

DECLARE FUNCTION Computecrc& (x$)
'OPEN "ccit.bas" FOR OUTPUT AS 1
CLS
FOR x = 0 TO 255
    crc& = Computecrc&(CHR$(x))
    PRINT HEX$(crc&),
NEXT

FUNCTION Computecrc& (x$)
' ComputeCRC - Copyright (C) 1989, Donn Bly, 1:236/7.0
'
' Standard Donn Bly Licencing Agreement:
'  This code may be used for anything that you want, except for profit.  I
f
'  you want to profit from my work you had better talk to me first.
'  NOTE: The CRC Polynomial was redone by Dick Dennison for CCIT16
STATIC InputByte AS INTEGER, CRCword AS LONG, c%, FeedBackBit AS INTEGER
'
' CRC Calculation Polynomial = X^16+X^12+X^5+X^0     (CCIT 16)
'
' X$ is the block on which to compute the CRC
'
CRCword = 0  'this line is Dick's
FOR c% = 1 TO LEN(x$)
   InputByte = ASC(MID$(x$, c%, 1))
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 128) =
128)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 64) = 6
4)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 32) = 3
2)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 16) = 1
6)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 8) = 8)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 4) = 4)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 2) = 2)

   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
   FeedBackBit = ((CRCword AND 32768) = 32768) XOR ((InputByte AND 1) = 1)
   CRCword = ((CRCword AND 32767&) * 2&)
   IF FeedBackBit THEN CRCword = CRCword XOR &H1021&
NEXT c%
Computecrc& = CRCword&
END FUNCTION
 'Sorry about the wrap.  This is for CCIT16 (the xmodem type).

--- VP [DOS] V4.09e
 * Origin: The MailMan  [phone] NY Quick Share Pt #7 *HST (1:272/34)