Category : BASIC Source Code
Archive   : QBIF200E.ZIP
Filename : QBIFKNUM.BAS

 
Output of file : QBIFKNUM.BAS contained in archive : QBIF200E.ZIP

' Stradivarious Software B-Tree Indexing Demo and Test Module for
' QuickBASIC 4.5 or BASIC 7.1 PDS
' Written in Microsoft (TM) QuickBASIC 4.5/BASIC 7.1 PDS
' Copyright (C) 1990, 1991, 1992 by Stradivarious Software
'
' Last updated: 01NOV92 Library manager: LIB.EXE 3.14/3.17
' Library: QBIF45/QBIF71 BC Compiler: BC.EXE 4.5/7.1
' Library index: - C Compiler: Microsoft C 5.1
' Used in: QBIFKNUM.EXE Assembler: MASM 5.1
' Program version: 2.00 Linker: LINK.EXE 3.69/5.10
'
' Purpose of program: Find number of keys in any QBIF index file.
' Author: Stradivarious Software, PO Box 157, High Wycombe,
' Buckinghamshire HP10 9HF, United Kingdom.
' Program name: QBIFKNUM.EXE
'
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ NOTICE! ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ The shareware version of QBIF includes ³
' ³ support for only 1 index file and the ³

' ³ stand-alone libraries display a shareware ³
' ³ advice message at the termination of any ³
' ³ program you write. The shareware version ³
' ³ is fully functional and has no time limit ³
' ³ or other arbitrary restrictions. You are ³
' ³ encouraged to register so that you obtain ³
' ³ full benefit from the QBIF package. ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'
' Note: See additional comments in QBIFDEMO.BAS.
'
' If you would like to rebuild QBIFKNUM, use the following syntax:
' BC QBIFKNUM /O /E;
' LINK /EX /NOE QBIFKNUM QBIF451,,,QBIF45; (for QuickBASIC 4.5)
' LINK /EX /NOE QBIFKNUM QBIF711N,,,QBIF71; (for BASIC 7.1 PDS near strings)
'
' Changes:
' 01AUG91 Minor change to internal find_ix routine.
' 16JUN92 Changes to incorporate BASIC 7.1 PDS near/far strings.
' 01NOV92 Version 2.00 release finalised.

' $INCLUDE: 'QBIF.BI' ' Must include this file in any program.

DECLARE FUNCTION IsFileThere% (filespec$) ' Check whether file exists.

CONST yes = 1,_ ' Note line continuation character _ is not
no = 0,_ ' permitted in the environment, but is
null = "",_ ' stripped out automatically.
true = -1,_
false = 0

' File access methods for opening index file(s)
' (May be OR'd together - see MS-DOS Programmer's Reference)

CONST accessReadOnly = &H0000,_
accessWriteOnly = &H0001,_
accessReadWrite = &H0002,_
accessShareCompatibility = &H0000,_
accessShareDenyReadWrite = &H0010,_
accessShareDenyWrite = &H0020,_
accessShareDenyRead = &H0030,_
accessShareDenyNone = &H0040


' ******************************* Important! *********************************
SUB BasicError (errnum%) ' You must include this procedure in the
ERROR errnum% ' main module of any program using QBIF,
END SUB ' even if you do not use error trapping (see
' documentation). However, you can place it
' anywhere in the main module.
' ****************************************************************************

ON ERROR GOTO ErrorHandler ' It is not essential to use error trapping;
' See QBIF documentation.

MCinit ' Do this before any other QBIF command.

accessmethod% = accessReadOnly

CLS
PRINT " Stradivarious Software Data Indexing"
PRINT " for QuickBASIC 4.5 or BASIC 7 near or far strings"
PRINT " Find Number of Keys 2.00 (01 NOV 92)"
PRINT

PRINT "This program reads any QBIF index file and outputs the number of keys."
PRINT

DO
LINE INPUT "Enter index filename: ",idxname$
IF idxname$ = null THEN EXIT DO
IF IsFileThere%(idxname$) THEN
dup% = yes
IF MCopenix1%(idxname$, dup%, accessmethod%) = 0 THEN
PRINT "Error opening index file"
EXIT DO
END IF
ixopen% = true
ELSE PRINT "File not found";
EXIT DO
END IF

count% = 0
PRINT "Working..."

DO WHILE MCnextkey1&(found$)
count% = count% + 1
LOOP

PRINT
PRINT

PRINT count%; " Key(s) in index file"

EXIT DO

LOOP

PRINT

CloseDown:
IF ixopen% THEN MCcloseix1
END

' **************************************************************************
' *** One way of checking whether a file exists ***
' **************************************************************************

FUNCTION IsFileThere%(filespec$)
handle% = FREEFILE
OPEN "R",handle%,filespec$
x& = LOF(handle%)
CLOSE handle%
IF x& = 0 THEN
IsFileThere% = false
KILL filespec$ ' Because the OPEN creates it anyway.
ELSE IsFileThere% = true
END IF
END FUNCTION


' *********************** Trapping runtime errors ************************
' (See comments in QBIFDEMO.BAS)

ErrorHandler:
errnum% = ERR
SELECT CASE errnum%
CASE 250
tx$ = "QBIF critical write error"
CASE 249
tx$ = "QBIF write error"
CASE 248
tx$ = "QBIF critical read error"
CASE 247
tx$ = "QBIF read error"
CASE 246
tx$ = "QBIF critical create error"
CASE 245
tx$ = "QBIF create error"
CASE 244
tx$ = "QBIF critical open error"
CASE 243
tx$ = "QBIF open error"
CASE 242
tx$ = "QBIF close error"
CASE ELSE
tx$ = "Standard BASIC error"
END SELECT

PRINT
PRINT "Error ";errnum%;" has occurred: ";tx$
PRINT "Press any key to terminate program"

WHILE a$ > null ' Flush keyboard buffer to stop
a$ = INKEY$ ' cascaded keypresses aborting program.
WEND

a$ = INPUT$(1)

RESUME CloseDown