home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 17
/
CD_ASCQ_17_101194.iso
/
vrac
/
sampdb1.zip
/
SAMPLEDB.BAS
< prev
next >
Wrap
BASIC Source File
|
1994-08-30
|
20KB
|
708 lines
'written By Bill Slamer
DEFLNG A-Z
DECLARE SUB CLOSEALL ()
DECLARE SUB BINARYSEARCH ()
DECLARE SUB READFILE ()
DECLARE SUB CLEARRECORD ()
DECLARE SUB UPDATEINDEX ()
DECLARE SUB LOADDATAFIELDS ()
DECLARE SUB PRINTRECORDS ()
DECLARE SUB SHOWMENU ()
DECLARE SUB LOADEDITFIELD ()
DECLARE SUB UPDATEREC ()
DECLARE SUB EDITCUSTOMER ()
DECLARE SUB OPENFILES ()
DECLARE SUB SORTINDEX ()
DECLARE SUB SHOWCUSTOMERS ()
DECLARE SUB DELETERECORD ()
DECLARE SUB CHECKFORDUPS ()
$INCLUDE "Arrowkey.Inc"
COLOR 15, 1: CLS
DIM Fielddesc$(10), Fieldlen(10), Deleted(50)
DIM Editfield$(10), Menu$(10)
DIM Index$(2000), Index(2000)
SHARED Fielddesc$(), Fieldlen(), Deleted()
SHARED Editfield$(), Menu$(),Index$(),Index()
SHARED Mrow, Currec, Y$, Deleted, D$, Dup,Lof1,Lof2
SHARED Maxrows, Row, Currtop, Extnd, Arraylocation
SHARED Add, Set
CLS
Type Customerrecord
F1Name AS String * 15
Lname AS String * 15
Address AS String * 30
City AS String * 20
State AS String * 2
Zip AS String * 5
Date AS String * 10
END Type
DIM Custrec AS Customerrecord
Type Indexrecord
Newrec AS String * 30
Recno AS Long
END Type
DIM Ir AS Indexrecord
SHARED Ir,Custrec
'*** load Menu Selections
DATA View all customers, Edit a customer record
DATA Add a customer record,Print all customer records,Read data from file,Quit
FOR X = 1 TO 6
READ Menu$(X)
Menu$(X) = LEFT$(" " + Menu$(X) + SPACE$(50), 50)
NEXT
'*** load Array With Record Fields
FOR X = 1 TO 7: READ Fielddesc$(X), Fieldlen(X): NEXT
DATA First Name,15,Last Name,15,Address,30,City,20,State,2,Zip,5,Date,10
Openfiles 'open Any Files That Need To Be Opened
Showmenu 'display Menu
'------------------------------------------------------------------------------
SUB BINARYSEARCH
SHARED N$,Lof2,Dup,Mid,Ir
Low = 1: High = Lof2
DO
Mid = INT((Low + High) / 2)
IF Low > High THEN
LOCATE 15, 35: PRINT "Saved"
Dup = 0
EXIT DO
END IF
GET #2, Mid, Ir
IF Ir.Newrec = LEFT$(N$,30) THEN
LOCATE 15, 26: PRINT "Duplicate First & Last name"
Dup = 1
EXIT DO
END IF
IF Ir.Newrec < N$ THEN Low = Mid + 1 ELSE High = Mid - 1
LOOP
END SUB
'------------------------------------------------------------------------------
SUB BINARYSEARCH1
SHARED N$,Lof2,Dup,Mid,Ir,Nf
Low = 1: High = Lof2
DO
COLOR 15,1:CLS
Mid = INT((Low + High) / 2)
IF Low > High THEN
LOCATE 15, 15: PRINT "No records starting with the letter ";N$
X$=INPUT$(1)
Nf=1
EXIT DO
END IF
GET #2, Mid, Ir
IF LEFT$(Ir.Newrec,1) = N$ THEN
EXIT DO
END IF
IF Ir.Newrec < N$ THEN Low = Mid + 1 ELSE High = Mid - 1
LOOP
END SUB
'------------------------------------------------------------------------------
SUB CHECKFORDUPS
SHARED Dup, Index$(), Maxrows, Editfield$()
Binarysearch
END SUB
'------------------------------------------------------------------------------
SUB CLEARRECORD
SHARED Fielddesc(),Editfield
FOR X = 1 TO 7
COLOR 15, 1: LOCATE X + 4, 11: PRINT Fielddesc$(X)
Editfield$(X) = SPACE$(Fieldlen(X))
Editfield$(7) = DATE$
COLOR , 0: LOCATE X + 4, 22: PRINT Editfield$(X)
NEXT
END SUB
'------------------------------------------------------------------------------
SUB CLOSEALL
Close
OPEN "deleted" FOR OUTPUT AS 3
FOR X = 1 TO Deleted
PRINT #3, Deleted(X)
NEXT
CLOSE#3
END SUB
'------------------------------------------------------------------------------
SUB DELETERECORD
SHARED Deleted(), Deleted, D$, Mid,Ir,N1$,N$
N$=N1$ '=Index$(Row+Extnd)
BinarySearch
COLOR 15, 4
R=0
LOCATE 16, 14: PRINT "Are you sure you want to delete this record (Y or N)";
D$ = INPUT$(1): D$ = UCASE$(D$)
COLOR 15, 1
IF D$ = "N" THEN
LOCATE 16, 14: PRINT SPACE$(55);
EXIT SUB
END IF
LOCATE 16, 14: PRINT SPACE$(55);
COLOR 31,1:LOCATE 16, 14: PRINT "Updating Index":COLOR 15,1
OPEN "TEMP.ndx" FOR RANDOM AS 3 LEN = LEN(Ir)
Lof2 = LOF(2) / LEN(Ir)
FOR X = 1 TO Lof2
Get#2,X,Ir
if x<>MID then
incr R
PUT#3,R,Ir
End If
NEXT
Deleted = Deleted + 1
Deleted(Deleted) = MID
CloseAll
kill"Names.ndx"
name"Temp.ndx" as "Names.ndx"
OpenFiles
END SUB
'------------------------------------------------------------------------------
SUB EDITCUSTOMER
'this Routine Is Used For Editing And Adding Records
SHARED Maxrows, Currec, Index(), Index$(), Deleted(), Deleted, D$, Dup, Mrow
SHARED Add,N$
COLOR 15, 1: CLS
Lof1 = LOF(1) / LEN(Custrec)
Lof2 = LOF(2) / LEN(Ir)
Add = 0: Dup = 0
LOCATE 1, 60: PRINT "] Insert OFF ["
FOR X = 1 TO 10
COLOR 15, 1: LOCATE X + 4, 11: PRINT Fielddesc$(X)
IF Mrow = 3 THEN
Editfield$(X) = SPACE$(Fieldlen(X))
END IF
IF Mrow = 3 THEN Editfield$(7) = DATE$
COLOR , 0: LOCATE X + 4, 22: PRINT Editfield$(X)
NEXT
IF Mrow = 2 THEN
LOCATE 18, 13: PRINT CHR$(24) + CHR$(25) + " " + CHR$(26) + CHR$(27) + " <Alt U>pdate <ESC> quit <Ins> <Alt D>elete"
ELSE
LOCATE 18, 20: PRINT CHR$(24) + CHR$(25) + " " + CHR$(26) + CHR$(27) + " <Alt S>ave <ESC> quit <Ins>"
END IF
Row = 1: Col = 1: Nooffields = 7
DO
COLOR 0, 7: LOCATE Row + 4, Col + 21
PRINT MID$(Editfield$(Row), Col, 1)
X$ = "": WHILE X$ = "": X$ = Inkey$: Wend: X$ = UCASE$(X$)
COLOR 15, 0: LOCATE Row + 4, Col + 21
PRINT MID$(Editfield$(Row), Col, 1)
SELECT CASE X$
CASE CHR$(0) + CHR$(32)
Deleterecord
IF D$ = "Y" THEN
EXIT SUB
END IF
CASE Esc$
IF Added = 1 THEN
Added = 0
COLOR 31, 1
LOCATE 15, 25: PRINT "Updating index"
COLOR 15, 1
Sortindex
Lof2 = Lof2 + 1
Updateindex
Row = 1: Col = 1
GOSUB LOADINDEX
END IF
COLOR 15, 1: CLS
EXIT SUB
CASE CHR$(0) + CHR$(22) 'alt U (update Record)
IF Mrow = 2 THEN 'make Sure Programe Is In Edit Mode
COLOR 15, 1: CLS 'before Allowing Update.
Loaddatafields
Updaterec
EXIT SUB
END IF
CASE CHR$(0) + CHR$(31) 'alt S (save New Record)
'*** everything Entered Is Stored In Editfield$() array.
IF Mrow = 3 THEN 'make Sure Program Is In Add Mode
N$=Editfield$(2)+", "+EditField$(1) 'before allowing SAVE.
Checkfordups
IF Dup = 0 THEN
COLOR 15, 1: CLS
Lof1 = Lof1 + 1
Added = 1
Loaddatafields
Add = Add + 1
IF Deleted > 0 THEN
Currec = Deleted(Deleted)
Deleted = Deleted - 1
ELSE
Currec = Lof1
END IF
Index$(Add) = Custrec.Lname + ", " + Custrec.F1Name
Index(Add) = Currec
Updaterec
Clearrecord
Row = 1: Col = 1
END IF
END IF
CASE Uparrow$
Col = 1: Row = Row - 1: IF Row < 1 THEN Row = Nooffields
CASE Dnarrow$, Enter$
Col = 1: Row = Row + 1: IF Row > Nooffields THEN Row = 1
CASE Larrow$
Col = Col - 1: IF Col < 1 THEN Col = Fieldlen(Row)
CASE Rarrow$
Col = Col + 1: IF Col > Fieldlen(Row) THEN Col = 1
CASE Pgup$
Col = 1: Row = 1
CASE Pgdn$
Col = 1: Row = Nooffields
CASE Ins$
COLOR , 1
IF Inc = 1 THEN
Inc = 0: LOCATE 1, 60: PRINT "] Insert OFF ["
ELSE
Inc = 1: LOCATE 1, 60: PRINT "] Insert ON ["
END IF
COLOR , 0
CASE Del$
F$ = MID$(Editfield$(Row), Col + 1, Fieldlen(Row))
F1$ = LEFT$(Editfield$(Row), Col - 1) + F$ + " "
Editfield$(Row) = F1$
LOCATE Row + 4, 22: PRINT Editfield$(Row)
CASE Homek$
Col = 1: IF Row = 5 OR Row = 6 THEN Col = 2
CASE Endk$
Col = Fieldlen(Row)
CASE Bs$
IF Col > 1 THEN
F$ = MID$(Editfield$(Row), Col, Fieldlen(Row))
F1$ = LEFT$(Editfield$(Row), Col - 2) + F$ + " "
Editfield$(Row) = F1$
Col = Col - 1: IF Col < 1 THEN Col = 1
LOCATE Row + 4, 22: PRINT Editfield$(Row)
END IF
CASE > CHR$(31)
IF X$ < CHR$(126) THEN
IF Inc = 1 THEN
F$ = MID$(Editfield$(Row), Col, Fieldlen(Row))
F1$ = LEFT$(LEFT$(Editfield$(Row), Col - 1) + X$ + F$, Fieldlen(Row))
Editfield$(Row) = F1$
Col = Col + 1: IF Col > Fieldlen(Row) THEN Col = 1
LOCATE Row + 4, 22: PRINT Editfield$(Row)
ELSE
MID$(Editfield$(Row), Col) = X$
LOCATE Row + 4, 22: PRINT Editfield$(Row)
Col = Col + 1: IF Col > Fieldlen(Row) THEN Col = 1
END IF
END IF
END SELECT
LOOP
LOADINDEX:
Maxrows=0
Lof2 = LOF(2) / LEN(Ir)
FOR X = 1 TO Lof2
GET #2, X, Ir
Maxrows = Maxrows + 1
Index$(Maxrows) = Ir.Newrec
Index(Maxrows) = Ir.Recno
IF X = 2000 THEN EXIT FOR
NEXT
RETURN
END SUB
'------------------------------------------------------------------------------
SUB GETFIRSTLETTER
SHARED F1$,N$,Mid,Nf,C
LOCATE 5,10:INPUT"Enter FIRST letter of names to view ",N$
N$=UCASE$(N$)
C=0
Binarysearch1
IF Nf=1 THEN EXIT SUB
DO
Get#2,Mid-1,Ir
IF LEFT$(Ir.Newrec,1)<>N$ THEN EXIT DO
Mid=Mid-1
LOOP
DO
Get#2,Mid,Ir
IF LEFT$(Ir.Newrec,1)<>N$ THEN EXIT DO
INCR C
Index$(C)=Ir.Newrec
Index(C)=Ir.Recno
INCR Mid
LOOP
END SUB
'------------------------------------------------------------------------------
SUB LOADDATAFIELDS
SHARED Editfield$(),Custrec,Ir
Custrec.F1Name = Editfield$(1)
Custrec.Lname = Editfield$(2)
Custrec.Address = Editfield$(3)
Custrec.City = Editfield$(4)
Custrec.State = Editfield$(5)
Custrec.Zip = Editfield$(6)
Custrec.Date = Editfield$(7)
END SUB
'------------------------------------------------------------------------------
SUB LOADEDITFIELD
SHARED Maxrows, Currec, Index(), Index$(), N1$
Currec = Index(Row + Extnd)
N1$=Index$(Row+Extnd)
GET #1, Currec, Custrec
Editfield$(1) = Custrec.F1Name
Editfield$(2) = Custrec.Lname
Editfield$(3) = Custrec.Address
Editfield$(4) = Custrec.City
Editfield$(5) = Custrec.State
Editfield$(6) = Custrec.Zip
Editfield$(7) = Custrec.Date
END SUB
'------------------------------------------------------------------------------
SUB OPENFILES
ON LOCAL ERROR GOTO FILENOTFOUND
SHARED Maxrows, Currec, Index(), Index$(), Deleted(), Deleted,Ir, CustRec
'kill"Names.Db" '*** used For Testing Only
'kill"Names.Ndx" '*** used For Testing Only
OPEN "Names.db" FOR RANDOM AS 1 LEN = LEN(Custrec)
Lof1 = LOF(1) / LEN(Custrec)
OPEN "Names.ndx" FOR RANDOM AS 2 LEN = LEN(Ir)
Lof2 = LOF(2) / LEN(Ir)
MaxRows=LOF(2)/LEN(Ir)
OPEN "Deleted" FOR INPUT AS 3
WHILE NOT EOF(3)
Deleted = Deleted + 1
INPUT #3, Deleted(Deleted)
WEND
CLOSE #3
EXIT SUB
FILENOTFOUND:
IF ERR = 53 THEN RESUME NEXT
PRINT "Error #"; ERR; "just occured": CLOSE : END
END SUB
'------------------------------------------------------------------------------
SUB PRINTRECORDS
SHARED Maxrows, Currec, Index(), Index$()
COLOR 31, 1
LOCATE 12, 25: PRINT "Printing Records"
F$ = "\ \ \ \ \ \ \ \ \\ \ \"
LPRINT CHR$(15);
WIDTH "lpt1:", 132
FOR X = 1 TO LOF(1) / LEN(Custrec)
GET #1, X, Custrec
LPRINT USING F$; Custrec.F1Name; Custrec.Lname; Custrec.Address; Custrec.City; Custrec.State; Custrec.Zip
NEXT
COLOR 15, 1
END SUB
'------------------------------------------------------------------------------
SUB READFILE
SHARED Currec,Add,Lof1,Index$(),Index(),Lof2,Maxrows
COLOR 15, 1: CLS
Add = 0: Set = 0: Lof1 = LOF(1) / LEN(Custrec)
Currec = LOF(1) / LEN(Custrec)
LOCATE 5, 5: INPUT "Enter name of file to read data from ", Rf$
CLS
IF Rf$ = "" THEN EXIT SUB
LOCATE 12, 20: PRINT "Processing INPUT record #"
LOCATE 14, 25: PRINT "Sorting set "
LOCATE 15, 23: PRINT "Records in Database"
Df = FREEFILE
OPEN Rf$ FOR INPUT AS Df
WHILE NOT EOF(Df)
INPUT #df, Editfield$(1), Editfield$(2), Editfield$(3), Editfield$(4), Editfield$(5), Editfield$(6)
Editfield$(7) = DATE$
Loaddatafields
Lof1 = Lof1 + 1
LOCATE 15, 43: PRINT Lof1
PUT #1, Lof1, Custrec
Add = Add + 1
Index$(Add) = Custrec.Lname + ", " + Custrec.F1Name
Index(Add) = Lof1
LOCATE 12, 46: PRINT Add
IF Add = 2000 OR EOF(Df) THEN
Set = Set + 1
LOCATE 14, 37: PRINT "Set "; Set
Sortindex
Lof2 = LOF(2) / LEN(Ir)
Updateindex
Add = 0
END IF
WEND
Lof2 = LOF(2) / LEN(Ir)
FOR X = 1 TO Lof2
GET #2, X, Ir
Index$(X) = Ir.Newrec
Index(X) = Ir.Recno
IF X = 2000 THEN EXIT FOR
NEXT
Maxrows = LOF(2) / LEN(Ir)
CLS
END SUB
'------------------------------------------------------------------------------
SUB SHOWCUSTOMERS
SHARED Maxrows, Currec, Index(), Index$(), Loaded,C
COLOR 15, 1: CLS
IF LOF(2) / LEN(Ir) = 0 THEN EXIT SUB
COLOR 15, 2
LOCATE 4, 3: PRINT CHR$(201) + STRING$(72, CHR$(205)) + CHR$(187)
FOR X = 1 TO 8
LOCATE X + 4, 3: PRINT CHR$(186) + SPACE$(72) + CHR$(186)
NEXT
LOCATE 12, 3: PRINT CHR$(200) + STRING$(72, CHR$(205)) + CHR$(188)
LOCATE 6, 10: PRINT "The text in the box below will show the"
LOCATE 7, 10: PRINT "customers you have. You can scroll through"
LOCATE 8, 10: PRINT "them by using the ARROW keys."
IF Mrow = 2 THEN
LOCATE 10, 10: PRINT "<RETURN> selects record for editing."
END IF
COLOR , 4
LOCATE 14, 3: PRINT CHR$(201) + STRING$(72, CHR$(205)) + CHR$(187)
FOR X = 1 TO 10
LOCATE X + 14, 3: PRINT CHR$(186) + SPACE$(72) + CHR$(186);
NEXT
LOCATE 24, 3: PRINT CHR$(200) + STRING$(72, CHR$(205)) + CHR$(188);
FOR X = 1 TO 9
COLOR 15, 4: LOCATE X + 14, 5: PRINT LEFT$(Index$(X) + SPACE$(70), 70);
IF X=C THEN EXIT FOR
NEXT
COLOR 14, 4
LOCATE 24, 22: PRINT "{ " + CHR$(24) + CHR$(25) + " <RETURN> Choose <ESC> menu" + "}";
COLOR 15, 1
Row = 1: Extnd = 0: Currtop = 1:Loaded=9
DO
COLOR 0, 7: LOCATE Row + 14, 5
PRINT LEFT$(Index$(Row + Extnd) + SPACE$(70), 70);
Y$ = "": WHILE Y$ = "": Y$ = Inkey$: Wend: Y$ = UCASE$(Y$)
COLOR 15, 4: LOCATE Row + 14, 5
PRINT LEFT$(Index$(Row + Extnd) + SPACE$(70), 70);
SELECT CASE Y$
CASE Esc$
COLOR 15, 1
CLS
EXIT SUB
CASE Enter$
COLOR 15, 1
IF Mrow = 2 THEN Loadeditfield
CLS : EXIT SUB
CASE Pgup$
FOR Y = 1 TO 8
IF Row - 1 >= 1 THEN
Row = Row - 1
ELSE
IF Row = 1 AND Extnd > 0 THEN
Currtop = Currtop - 1
Extnd = Extnd - 1
GOSUB SCROLLONELINEDOWN
END IF
END IF
NEXT
CASE Uparrow$
IF Row - 1 >= 1 THEN
Row = Row - 1
ELSE
IF Row = 1 AND Extnd > 0 THEN
Currtop = Currtop - 1
Extnd = Extnd - 1
GOSUB SCROLLONELINEDOWN
END IF
END IF
CASE Pgdn$
IF Row+Extnd+8<=C THEN
FOR Y = 1 TO 8
IF Row + 1 + Extnd <= C THEN
Row = Row + 1
IF Row > 9 THEN
Currtop = Currtop + 1
Row = 9: Extnd = Extnd + 1
GOSUB SCROLLONELINEUP
END IF
END IF
NEXT
END IF
CASE Dnarrow$
IF Row + 1 + Extnd <= C THEN
Row = Row + 1
IF Row > 9 THEN
Currtop = Currtop + 1
Row = 9: Extnd = Extnd + 1
GOSUB SCROLLONELINEUP
END IF
END IF
END SELECT
LOOP
EXIT SUB
SCROLLONELINEUP:
Srow = 15
FOR X = Currtop TO Currtop + 7
LOCATE Srow, 5: PRINT LEFT$(Index$(X) + SPACE$(70), 70)
Srow = Srow + 1
NEXT
RETURN
SCROLLONELINEDOWN:
Srow = 22
FOR X = Currtop + 7 TO Currtop STEP -1
LOCATE Srow, 5: PRINT LEFT$(Index$(X) + SPACE$(70), 70);
Srow = Srow - 1
NEXT
RETURN
END SUB
'------------------------------------------------------------------------------
SUB SHOWMENU
'*** make Menu Box
SHARED Menu$(),Mrow,Nf
MAKEMENU:
DO
CLS
COLOR 15, 4
LOCATE 4, 15: PRINT CHR$(201) + STRING$(50, CHR$(205)) + CHR$(187)
LOCATE 4, 30: PRINT "[ Ziggy's Main Menu ]"
FOR X = 1 TO 8
LOCATE X + 4, 15: PRINT CHR$(186) + SPACE$(50) + CHR$(186)
NEXT
'*** print Menu Selections
LOCATE 12, 15: PRINT CHR$(200) + STRING$(50, CHR$(205)) + CHR$(188)
FOR X = 1 TO 6: LOCATE X + 5, 16: PRINT Menu$(X): NEXT
Mrow = 1: Noofselections = 6
DO
COLOR 0, 7: LOCATE Mrow + 5, 16: PRINT Menu$(Mrow)
X$ = "": WHILE X$ = "": X$ = Inkey$: Wend: X$ = UCASE$(X$)
COLOR 15, 4: LOCATE Mrow + 5, 16: PRINT Menu$(Mrow)
SELECT CASE X$
CASE Esc$
COLOR 7, 0
CLS : END
CASE Enter$
SELECT CASE Mrow
CASE 1 'view All Customers
CLS
Getfirstletter
IF Nf=0 THEN
Showcustomers
END IF
Nf=0
EXIT DO
CASE 2 'edit A Customer Record
CLS
Getfirstletter
IF Nf=0 THEN
Showcustomers
IF Y$ <> Esc$ AND MaxRows <> 0 THEN
Editcustomer
END IF
END IF
Nf=0
EXIT DO
CASE 3 'add A Customer Record
CLS
Editcustomer
EXIT DO
CASE 4 'print All Customer Records
CLS
Printrecords
EXIT DO
CASE 5 'read Records From A File
CLS
Readfile
EXIT DO
CASE 6 'quit
COLOR 7, 0
CLOSE : CLS : END
END SELECT
CASE Uparrow$
Mrow = Mrow - 1
IF Mrow < 1 THEN Mrow = Noofselections
CASE Dnarrow$
Mrow = Mrow + 1
IF Mrow > Noofselections THEN Mrow = 1
END SELECT
LOOP
LOOP
END SUB
'------------------------------------------------------------------------------
SUB SORTINDEX
SHARED Index$(),Index()
IF Add = 0 THEN EXIT SUB
Maxstrarray% = Add
REDIM Stackl%(Maxstrarray%), Stackr%(Maxstrarray%)
Sx% = 1: Stackl%(1) = 1: Stackr%(1) = Maxstrarray%
WHILE Sx% <> 0
Lx% = Stackl%(Sx%): Rx% = Stackr%(Sx%): Sx% = Sx% - 1
WHILE Lx% < Rx%
Ix% = Lx%: Jx% = Rx%: X$ = Index$((Lx% + Rx%) \ 2)
WHILE Ix% <= Jx%
WHILE Index$(Ix%) < X$: Ix% = Ix% + 1: WEND
WHILE Index$(Jx%) > X$: Jx% = Jx% - 1: WEND
X0% = 0
WHILE (Ix% <= Jx% AND X0% = 0)
X0% = 1: SWAP Index$(Ix%), Index$(Jx%)
SWAP Index(Ix%), Index(Jx%)
Ix% = Ix% + 1: Jx% = Jx% - 1
WEND
WEND
X0% = 0
WHILE (Ix% <= Rx% AND X0% = 0)
X0% = 1: Sx% = Sx% + 1
Stackl%(Sx%) = Ix%: Stackr%(Sx%) = Rx%
WEND
Rx% = Jx%
WEND
WEND
ERASE Stackl%, Stackr%
END SUB
'------------------------------------------------------------------------------
SUB UPDATEINDEX
SHARED Lof2,Mid,Add,Index$(),Index()
Low = 1: High = Lof2
DO
Mid = INT((Low + High) / 2)
IF Low > High THEN
IF Lof2 > 0 THEN
FOR X = Lof2 TO Mid + 1 STEP -1
GET #2, X, Ir
PUT #2, X + Add, Ir
NEXT
END IF
Ir.Newrec = Index$(Add)
Ir.Recno = Index(Add)
PUT #2, X + Add, Ir
Add = Add - 1
IF Add < 1 THEN EXIT SUB
IF X = 0 THEN
FOR X = 1 TO Add
Ir.Newrec = Index$(X)
Ir.Recno = Index(X)
PUT #2, X, Ir
NEXT
EXIT SUB
END IF
DO
GET #2, X, Ir
IF LEFT$(Ir.Newrec, LEN(Index$(Add))) > Index$(Add) THEN
PUT #2, X + Add, Ir
X = X - 1
ELSE
Ir.Newrec = Index$(Add)
Ir.Recno = Index(Add)
PUT #2, X + Add, Ir
Add = Add - 1
END IF
LOOP WHILE Add > 0 AND X > 0
EXIT SUB
END IF
GET #2, Mid, Ir
IF LEFT$(Ir.Newrec, LEN(Index$(Add))) < Index$(Add) THEN Low = Mid + 1 ELSE High = Mid - 1
LOOP
END SUB
'------------------------------------------------------------------------------
SUB UPDATEREC
SHARED Maxrows, Currec, Index(), Index$()
PUT #1, Currec, Custrec
END SUB