EMS Array Code 3/

 BBS: Inland Empire Archive
Date: 02-09-93 (16:56)             Number: 329
From: QUINN TYLER JACKSON          Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: EMS Array Code        3/       Conf: (2) Quik_Bas

>>> 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)