home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
qbnewsl
/
qbnws201
/
smallexe
/
smallexe.bas
< prev
next >
Wrap
BASIC Source File
|
1991-01-26
|
7KB
|
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