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

BASIC Source File | 1991-01-26 | 7.2 KB | 326 lines

    REM $TITLE: 'SMALLEXE'

    ' How to create a SMALL QB EXEcutable
    ' T. G. Muench January 1991

    REM $INCLUDE: 'C:\QBASIC\QB.BI'

    DEFINT A-Z

    ' Constants

    CONST FALSE = 0
    CONST TRUE = NOT FALSE

    ' Global variables

    COMMON SHARED INPREG AS REGTYPE
    COMMON SHARED OUTREG AS REGTYPE
    COMMON SHARED CR$, LF$, CRLF$

    ' Functions and subprograms

    DECLARE FUNCTION FileExist (FILE$)
    DECLARE FUNCTION ReadData$ (DATA$)
    DECLARE FUNCTION ReadTimer& ()
    DECLARE FUNCTION StrToInt& (NUMSTR$)

    DECLARE SUB GetInput (PROMPT$, ENTRY$)
    DECLARE SUB InputLine (IOCHAN, BUFSIZE, STATUS, TEXT$)

Initialization:

    ' Sample string data

    DATA$ = "1,2,3,4,5,6,7,8,9,10"
    DATA$ = DATA$ + ",Now,is,the,time,for,all,good,persons,to,come"

    ' I/O channel

    CHAN = 1

    ' Miscellaneous

    CR$ = CHR$(13)
    LF$ = CHR$(10)
    CRLF$ = CR$ + LF$

    REM $PAGE

StartProgram:

    PRINT : PRINT "Integers"
    START& = ReadTimer&
    FOR I = 1 TO 10
        PRINT I, StrToInt&(ReadData$(DATA$))
    NEXT I
    PRINT "Ticks = "; ReadTimer& - START&
    CALL GetInput("Press Enter to continue: ", ENTRY$)

    PRINT : PRINT "Strings"
    START& = ReadTimer&
    FOR I = 11 TO 20
        PRINT I, ReadData$(DATA$)
    NEXT I
    PRINT "Ticks = "; ReadTimer& - START&
    CALL GetInput("Press Enter to continue: ", ENTRY$)

    PRINT : PRINT "Read ASCII file:"
    CALL GetInput("File to read? ", FILE$)
    IF FILE$ = "" THEN
        BEEP : PRINT "No file specified"
    ELSEIF NOT FileExist(FILE$) THEN
        BEEP : PRINT "File not found"
    ELSE
        CALL GetInput("Display lines (Y,N)? ", ENTRY$)
        IF UCASE$(ENTRY$) = "Y" THEN
        DISPLAY = TRUE
        ELSE
        DISPLAY = FALSE
        END IF
        START& = ReadTimer&
        OPEN FILE$ FOR BINARY AS #CHAN
        MAXSIZE = 4 * 1024
        FILESTAT = 1
        DO UNTIL FILESTAT = -1
        CALL InputLine(CHAN, MAXSIZE, FILESTAT, LINE$)
        COUNT = COUNT + 1
        IF DISPLAY THEN
            PRINT LINE$
        END IF
        LOOP
        CLOSE #CHAN
        PRINT : PRINT "Read"; COUNT; "lines"
        PRINT "Ticks = "; ReadTimer& - START&
    END IF

EndProgram:

    END

    REM $PAGE

    '[]=============================================================[]
    '[]      Checks to see if a file exists so that it may be     []
    '[]             opened by BASIC            []
    '[]=============================================================[]

    FUNCTION FileExist (FILE$) STATIC

    NAME$ = FILE$ + CHR$(0)

    INPREG.AX = &H3D00
    INPREG.DX = SADD(NAME$)

    CALL INTERRUPT(&H21, INPREG, OUTREG)

    IF (OUTREG.FLAGS AND 1) THEN
        FileExist = FALSE
    ELSE
        FileExist = TRUE
        '
        ' Close the file handle
        '
        INPREG.AX = &H3E00
        INPREG.BX = OUTREG.AX
        CALL INTERRUPT(&H21, INPREG, OUTREG)
    END IF

    END FUNCTION

    '[]=============================================================[]
    '[]            Gets user input from the keyboard        []
    '[]=============================================================[]

    SUB GetInput (PROMPT$, ENTRY$) STATIC

    IF PROMPT$ <> "" THEN
        PRINT PROMPT$;
    END IF

    COL = POS(0)

    ENTRY$ = ""
    DO WHILE TRUE
        LOCATE CSRLIN, COL, 1
        CHAR$ = INPUT$(1)
        SELECT CASE CHAR$
        CASE CHR$(13)
            PRINT
            EXIT DO
        CASE CHR$(8)
            IF LEN(ENTRY$) > 0 THEN
            ENTRY$ = LEFT$(ENTRY$, LEN(ENTRY$) - 1)
            COL = COL - 1
            LOCATE CSRLIN, COL, 1
            PRINT " ";
            END IF
        CASE ELSE
            ENTRY$ = ENTRY$ + CHAR$
            PRINT CHAR$;
            COL = COL + 1
        END SELECT
    LOOP

    END SUB

    '[]=============================================================[]
    '[]       Inputs a line of text from the specified file    []
    '[]=============================================================[]

    SUB InputLine (IOCHAN, BUFSIZE, STATUS, TEXT$) STATIC

    STATIC TOTBYTES&    ' Total #bytes in file
    STATIC BYTES&        ' #Bytes read so far
    STATIC SEEKPOS&        ' Seek position in file
    STATIC SPOS        ' Start of line in buffer

    ' Initialize if this is the first call

    IF STATUS = 1 THEN
        STATUS = 0
        TOTBYTES& = LOF(IOCHAN)
        BYTES& = 0
        SEEKPOS& = 1
        BUFFER$ = STRING$(BUFSIZE, 0)
        SPOS = 1
    END IF

    EPOS = INSTR(SPOS, BUFFER$, CRLF$)
    IF EPOS <> 0 THEN
        '
        ' Easy - have a full line
        '
        TEXT$ = MID$(BUFFER$, SPOS, EPOS - SPOS)
    ELSE
        ' Partial line - read the next block
        '  and assemble the full line
        '
        IF LEFT$(BUFFER$, 1) = CHR$(0) THEN
        TEXT$ = ""
        ELSE
        TEXT$ = MID$(BUFFER$, SPOS, BUFSIZE - SPOS + 1)
        END IF
        IF (SEEKPOS& + BUFSIZE) > TOTBYTES& THEN
        BUFSIZE = TOTBYTES& - SEEKPOS& + 1
        BUFFER$ = STRING$(BUFSIZE, 0)
        END IF
        GET #IOCHAN, SEEKPOS&, BUFFER$
        BYTES& = BYTES& + BUFSIZE
        SEEKPOS& = SEEKPOS& + BUFSIZE
        IF BYTES& = TOTBYTES& THEN
        '
        ' Last block needs ending CRLF
        '
        IF RIGHT$(BUFFER$, 2) <> CRLF$ THEN
            BUFFER$ = BUFFER$ + CRLF$
            BUFSIZE = BUFSIZE + 2
        END IF
        END IF
        IF RIGHT$(TEXT$, 1) = CR$ THEN
        '
        ' Special case - CR at end of previous block
        '
        TEXT$ = LEFT$(TEXT$, LEN(TEXT$) - 1)
        EPOS = 0
        ELSE
        EPOS = INSTR(1, BUFFER$, CRLF$)
        TEXT$ = TEXT$ + MID$(BUFFER$, 1, EPOS - 1)
        END IF
    END IF

    ' Point to start of next line

    SPOS = EPOS + 2

    ' All done? If so set status and deallocate buffer

    IF (BYTES& = TOTBYTES& AND EPOS = (BUFSIZE - 1)) THEN
        BUFFER$ = "" ' This doesn't ERASE
        STATUS = -1
    END IF

    END SUB

    '[]=============================================================[]
    '[]          Returns the next string element from the         []
    '[]            passed data string            []
    '[]=============================================================[]

    FUNCTION ReadData$ (DATA$) STATIC

    STATIC COUNT    ' Number of times called
    STATIC SPOS     ' Starting pos in string

    COUNT = COUNT + 1
    IF COUNT = 1 THEN
        SPOS = 1
    END IF

    EPOS = INSTR(SPOS, DATA$, ",")
    IF EPOS = 0 THEN
        '
        ' Assume at end of string
        '
        EPOS = LEN(DATA$) + 1
    END IF

    ReadData$ = MID$(DATA$, SPOS, EPOS - SPOS)

    SPOS = EPOS + 1

    END FUNCTION

    FUNCTION ReadTimer& STATIC

    '[]=============================================================[]
    '[]     Returns the number of clock ticks since midnight    []
    '[]=============================================================[]

    INPREG.AX = &H0000
    CALL INTERRUPT(&H1A, INPREG, OUTREG)

    IF OUTREG.DX < 0 THEN
        LO& = 65536 + OUTREG.DX     ' Adjust for signed word
    ELSE
        LO& = OUTREG.DX
    END IF

    ReadTimer& = (65536 * OUTREG.CX) + LO&

    END FUNCTION

    '[]=============================================================[]
    '[]   Returns the long integer equivalent of a numeric string    []
    '[]=============================================================[]

    FUNCTION StrToInt& (NUMSTR$) STATIC

    IF LEFT$(NUMSTR$, 1) = "-" THEN
        NEGATIVE = TRUE
        WORK$ = RIGHT$(NUMSTR$, LEN(NUMSTR$) - 1)
    ELSE
        NEGATIVE = FALSE
        WORK$ = NUMSTR$
    END IF

    VALUE& = 0 : POWER& = 1

    FOR INDX = LEN(WORK$) TO 1 STEP -1
        BYTE$ = MID$(WORK$, INDX, 1)
        IF (BYTE$ < "0" OR BYTE$ > "9") THEN
        EXIT FOR
        ELSE
        VALUE& = VALUE& + (POWER& * (ASC(BYTE$) - 48))
        POWER& = 10 * POWER&
        END IF
    NEXT INDX

    IF NEGATIVE THEN
        StrToInt& = -VALUE&
    ELSE
        StrToInt& = VALUE&
    END IF

    END FUNCTION