EMS Array Code 2/

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

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