|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 24448 (0x5f80)
Types: TextFile
Names: »DATABASE.BAS«
└─⟦57f0389e8⟧ Bits:30005761 SW1611 Access Manager v. 1.0
└─ ⟦this⟧ »DATABASE.BAS«
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM DATABASE EXAMPLE VERSION 1.0 12/1/82 1656
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM INTERFACE TO AM86(tm)
REM
REM
REM AM86EXTR.BAS CONTAINS THE EXTERNAL DEFINITIONS OF THE
REM AM86 ROUTINES
REM
%INCLUDE AM86EXTR.BAS
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM SET-UP DATABASE FIELD & KEY DESCRIPTORS
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DIM FLD.NAME$(7),FLD.LEN%(7),NEW.FLD$(7),OLD.FLD$(7)
DIM FLD.PTR%(7)
MAX.FIELD% = 7:NO.FIELDS% = MAX.FIELD% + 1
YES% = 1 : NO% = 0
FLD.NAME$(0) = "Customer Number" :FLD.LEN%(0) = 4
FLD.NAME$(1) = "First Name" :FLD.LEN%(1) = 16
FLD.NAME$(2) = "Last Name" :FLD.LEN%(2) = 20
FLD.NAME$(3) = "Street Address" :FLD.LEN%(3) = 20
FLD.NAME$(4) = "City" :FLD.LEN%(4) = 20
FLD.NAME$(5) = "State" :FLD.LEN%(5) = 2
FLD.NAME$(6) = "Zipcode" :FLD.LEN%(6) = 9
FLD.NAME$(7) = "Customer Status" :FLD.LEN%(7) = 8
DIM KEY.NAME$(2),KEY.LEN%(2),KEY.MAP%(2),KEY.TYPE%(2),KEY.NUM%(2),KEY.DUP%(2)
MAX.KEY% = 2
KEY.LEN%(0)=10:KEY.TYPE%(0)=0:KEY.MAP%(0)=2 REM KEY 0 = LAST NAME
KEY.LEN%(1)=11:KEY.TYPE%(1)=0:KEY.MAP%(1)=6 REM KEY 1 = ZIPCODE
KEY.LEN%(2)=4 :KEY.TYPE%(2)=0:KEY.MAP%(2)=0 REM KEY 2 = CUST NUMBER
UNIQ.KEY% = 2 REM USED IN TEST OF UNIQUENESS
FOR KEY% = 0 TO MAX.KEY%
IF KEY% = UNIQ.KEY% THEN Ø
KEY.DUP%(KEY%) = NO% Ø
ELSE Ø
KEY.DUP%(KEY%) = YES%
KEY.NAME$(KEY%) = FLD.NAME$(KEY.MAP%(KEY%))
NEXT KEY%
DIM INDEX.NAME$(2)
INDEX.NAME$(0) = "NAME.IDX"
INDEX.NAME$(1) = "ZIPC.IDX"
INDEX.NAME$(2) = "NUMB.IDX"
NLOCK% = 0 REM IGNORE LOCKS
SLOCK% = 1 REM SHARED RECORD LOCK
XLOCK% = 2 REM EXCLUSIVE RECORD LOCK
SFILE% = 3 REM SHARED FILE LOCK
XFILE% = 4 REM EXCLUSIVE FILE LOCK
RLOCK% = 5 REM RELEASE SLOCK% OR XLOCK%
REM
REM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
REM
REM BEGINNING OF UTILITY FUNCTIONS
REM
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM CLEAR SCREEN ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF CLEAR.SCREEN%
FOR DUMMY% = 1 TO 24
PRINT
NEXT DUMMY%
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM MAIN MENU ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF MAIN.MENU%
PRINT TAB(21);" AM86(tm) DEMONSTRATION" :PRINT
PRINT TAB(20);"Customer Database Operations"
PRINT TAB(20);" Terminal ";TERMINAL%
PRINT TAB(20);"****************************":PRINT :PRINT
PRINT TAB(5);"1. Enter New Customers"
PRINT TAB(5);"2. Scan/Update/Delete Customer Records"
PRINT TAB(5);"3. List Customer Records"
PRINT TAB(5);"4. Database Statistics"
PRINT TAB(5);"5. Save All Files & Restart Operations"
PRINT TAB(5);"6. Terminate Operations":PRINT :PRINT
1000 INPUT "Enter desired operation number>>";OP%
IF OP%<1 OR OP%>6 THEN PRINT :PRINT :GOTO 1000
MAIN.MENU% = OP%
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM SELECT SEARCH KEY ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF SEARCH.KEY%
DUMMY% = CLEAR.SCREEN%
PRINT TAB(25);"Customer Database Search Keys":PRINT :PRINT
FOR KEY% = 0 TO MAX.KEY%
KEY.NO% = KEY% + 1
PRINT TAB(5);KEY.NO%;"- ";KEY.NAME$(KEY%)
NEXT KEY%
1040 PRINT :PRINT
INPUT "Enter desired key number>>";OP%
IF OP%<1 OR OP%>NO.KEYS% THEN 1040
SEARCH.KEY% = OP%-1
RETURN
FEND
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM ERROR HANDLING
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF ERROR.TYPE%(TYPE%)
PRINT
PRINT Ø
"User Error #";ERRCOD;" occurred while trying to ";
ON TYPE% GOTO 9210,9230,9250,9290,9300,9320,9330, Ø
9340,9350,9360,9370,9380,9390,9400,9410,9420
9210 PRINT "open ";INDEX.NAME$(KEY%) : GOTO 9700
9230 PRINT "search ";KEY.NAME$(KEY%);" Index File" : GOTO 9500
9250 PRINT "save ";INDEX.NAME$(KEY%) : GOTO 9600
9290 PRINT "remove old key from ";INDEX.NAME$(KEY%) : GOTO 9500
9300 PRINT "enter key into ";INDEX.NAME$(KEY%) :GOTO 9500
9320 PRINT "delete key from ";INDEX.NAME$(KEY%) :GOTO 9500
9330 PRINT "save ";FILE.NAME$ :KEY% = -1:GOTO 9600
9340 PRINT "get a new data record";" (";FILE.NO%;")" :GOTO 9700
9350 PRINT "delete data record #";DRN% :GOTO 9700
9360 PRINT "open ";FILE.NAME$;" (";FILE.NO%;")" :GOTO 9700
9370 PRINT "read data record #";DRN%:GOTO 9700
9380 PRINT "write data record.":GOTO 9700
9390 PRINT "release shared file lock on ";FILE.NAME$:GOTO 9700
9400 PRINT "initialize user.": STOP
9410 PRINT "close ";FILE.NAME$ :KEY% = -1:GOTO 9600
9420 PRINT "close ";INDEX.NAME$(KEY%) : GOTO 9600
9500 CALL CLSDAT(FILE.NO%)
FOR T.KEY% = 0 TO MAX.KEY%
IF T.KEY% <> KEY% THEN CALL CLSIDX(KEY.NUM%(T.KEY%))
NEXT T.KEY%
GOTO 9700 REM STOP ERROR MESSAGE
9600 T.KEY% = KEY% + 1
IF T.KEY%>MAX.KEY% THEN STOP
FOR KEY% = T.KEY% TO MAX.KEY%
CALL CLSIDX(KEY.NUM%(KEY%))
NEXT KEY%
9700 PRINT
PRINT "DEMONSTRATION TERMINATING WITH ERROR CODE #";ERRCOD
STOP
FEND
DEF LOCK.TYPE%(TYPE%)
PRINT "Lock Type: ";TYPE%;" Lock Code:";LOKCOD
CALL CLSDAT(FILE.NO%)
FOR T.KEY% = 0 TO MAX.KEY%
CALL CLSIDX(KEY.NUM%(T.KEY%))
NEXT T.KEY%
STOP
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM STRIP TRAILING BLANKS
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF STRIP.BLANKS$(OLD.VAL$,FLD%)
FOR TEST% = FLD.LEN%(FLD%) TO 1 STEP -1
IF MID$(OLD.VAL$,TEST%,1) <> " " THEN Ø
STRIP.BLANKS$ = LEFT$(OLD.VAL$,TEST%) :Ø
RETURN
NEXT TEST%
STRIP.BLANKS$ = ""
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM READ DATA RECORD ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF READ.CUST%(DRN%)
IF READAT(FILE.NO%,DRN%,INPBUF.PTR%) <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(11)
OFFSET% = 2 REM SKIP DELETE FLAG FIELD
FOR D.FLD% = 0 TO MAX.FIELD%
OLD.FLD.VAL$ = MID$(INPBUF$,OFFSET%,FLD.LEN%(D.FLD%))
OLD.FLD$(D.FLD%) = Ø
STRIP.BLANKS$(OLD.FLD.VAL$,D.FLD%)
OFFSET% = OFFSET% + FLD.LEN%(D.FLD%)
NEXT D.FLD%
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM LIST CUSTOMER RECORD ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF PRINT.CUST%
IF ROUTE$ = "Y" THEN Ø
LPRINTER
PRINT
PRINT TAB(5);OLD.FLD$(0);TAB(15);OLD.FLD$(7)
PRINT TAB(25);OLD.FLD$(1);" ";OLD.FLD$(2)
PRINT TAB(25);OLD.FLD$(3)
PRINT TAB(25);OLD.FLD$(4);", ";OLD.FLD$(5);" ";OLD.FLD$(6)
PRINT
CONSOLE
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM PAUSE ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF PAUSE%
PRINT
INPUT "Press 'RETURN' to continue ---";LINE PAUSE$
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM CONVERT TARGET VALUE TO KEY FORMAT ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF KEY.FORMAT$(KEY%,TARGET$)
IF UNIQ.KEY% = KEY% THEN Ø
KEY.FORMAT$ = TARGET$ :Ø
RETURN
KL% = KEY.LEN%(KEY%)
KEY.FORMAT$ = LEFT$(TARGET$ + SPACE$,KL%-2) + Ø
CHR$(0) + CHR$(0)
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM COMPARE INDEX.KEY & U.VALUE ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF COMPARE%
IF KEY% = UNIQ.KEY% THEN Ø
KL% = KEY.LEN%(KEY%) Ø
ELSE Ø
KL% = KEY.LEN%(KEY%)-2
C1$ = LEFT$(INDEX.KEY$ + SPACE$,KL%)
C2$ = LEFT$(U.VALUE$ + SPACE$,KL%)
IF C1$<C2$ THEN Ø
COMPARE% = -1 :Ø
RETURN
IF C1$>C2$ THEN Ø
COMPARE% = 1 Ø
ELSE Ø
COMPARE% = 0
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM CHECK LOCK ROUTINES
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF SKIP.LOCK%
WHILE DRN% <> 0 AND LOKCOD <> 0
L.VALUE$ = LEFT$(INDEX.KEY$,KEY.LEN%(KEY%))
INDEX.KEY$ = SET.LENGTH$
DRN% = AFTKEY(KEY.NUM%(KEY%),FILE.NO%,SLOCK%, Ø
L.VALUE$,INDEX.KEY$)
WEND
RETURN
FEND
DEF CHECK.LOCK%
PRINT
INPUT Ø
"Enter a 'W' if you wish to wait for locked record(s)>>"; Ø
LINE DUMMY$
IF UCASE$(DUMMY$) = "W" THEN Ø
CHECK.LOCK% = YES% :Ø
RETURN
WHILE DRN% <> 0 AND LOKCOD <> 0
CONV.TARGET$ = LEFT$(INDEX.KEY$,KEY.LEN%(KEY%))
INDEX.KEY$ = SET.LENGTH$
IF OLD.ACTION$ = "CONT" THEN Ø
DRN% = AFTKEY(KEY.NUM%(KEY%),FILE.NO%, Ø
SLOCK%, CONV.TARGET$,INDEX.KEY$) Ø
ELSE Ø
DRN% = BEFKEY(KEY.NUM%(KEY%),FILE.NO%, Ø
SLOCK%, CONV.TARGET$,INDEX.KEY$)
WEND
CHECK.LOCK% = NO%
RETURN
FEND
DEF SET.XLOCK$(OP$)
30010 IF SETLOK(FILE.NO%,XLOCK%,DRN%) <> 0 THEN Ø
PRINT : Ø
PRINT "Customer update on hold due to record lock" :Ø
INPUT Ø
"Enter 'W' if you wish to wait or press 'RET' to cancel update>>"; Ø
LINE DUMMY$:Ø
DUMMY$ = UCASE$(DUMMY$) Ø
ELSE Ø
DUMMY$ = "ok"
IF DUMMY$ = "W" THEN 30010
IF DUMMY$ = "ok" AND OP$ = "S" THEN Ø
SET.XLOCK$ = "SAVE"
IF DUMMY$ = "ok" AND OP$ = "D" THEN Ø
SET.XLOCK$ = "DELT"
IF DUMMY$ <> "ok" THEN Ø
SET.XLOCK$ = OLD.ACTION$
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM CUST # UNIQUENESS TEST ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF TEST.UNIQUENESS%
TEST$ = NEW.FLD$(KEY.MAP%(UNIQ.KEY%))
TEST% = GETKEY(UNIQ.KEY%,0,NLOCK%,TEST$)
IF LOKCOD <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(12)
IF TEST% = 0 THEN Ø
TEST.UNIQUENESS% = YES% Ø
ELSE Ø
TEST.UNIQUENESS% = NO% : Ø
PRINT : Ø
PRINT " *** Already Assigned ***" : Ø
PRINT
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM UPDATE DATA FIELD ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF UPDATE.FIELD%(FIELD.NO%)
FIELD.NO% = FIELD.NO%-1
1050 PRINT
PRINT "Input new ";FLD.NAME$(FIELD.NO%);
INPUT ">>";LINE NEW.FLD$(FIELD.NO%)
IF FIELD.NO% = KEY.MAP%(UNIQ.KEY%) THEN Ø
NEW.FLD$(FIELD.NO%) = RIGHT$("0000"+NEW.FLD$(FIELD.NO%), Ø
FLD.LEN%(FIELD.NO%)) Ø
ELSE Ø
NEW.FLD$(FIELD.NO%) = LEFT$(NEW.FLD$(FIELD.NO%), Ø
FLD.LEN%(FIELD.NO%))
IF FIELD.NO% <> 0 OR NEW.FLD$(FIELD.NO%) = Ø
OLD.FLD$(FIELD.NO%) THEN RETURN
UNIQUE% = TEST.UNIQUENESS%
IF NOT UNIQUE% THEN 1050
RETURN
FEND
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM WARNING MESSAGES
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF WARNING.TYPE%(TYPE%,RET.CODE%)
PRINT
PRINT "WARNING...Return Code #";RET.CODE%; Ø
" occurred while trying to ";
ON TYPE% GOTO 9930,9940,9950
9930 PRINT "remove old key from ";INDEX.NAME$(KEY%)
DUMMY% = PAUSE% :RETURN
9940 PRINT "enter key into ";INDEX.NAME$(KEY%)
DUMMY% = PAUSE% :RETURN
9950 PRINT "delete key from ";INDEX.NAME$(KEY%)
DUMMY% = PAUSE% :RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM ADD NEW KEY VALUE ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF ADD.KEY%(KEY%,DRN%)
K.FLD% = KEY.MAP%(KEY%)
OLD.KEY$ = OLD.FLD$(K.FLD%)
NEW.KEY$ = NEW.FLD$(K.FLD%)
REM
REM REMOVE OLD KEY VALUE
REM
RET.CODE% = DELKEY(KEY.NUM%(KEY%),FILE.NO%, Ø
XLOCK%,OLD.KEY$,DRN%)
IF ERRCOD <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(4)
IF LOKCOD <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(6)
IF RET.CODE% <> 1 THEN Ø
DUMMY% = WARNING.TYPE%(1,RET.CODE%)
REM
REM ADD NEW KEY VALUE
REM
RET.CODE% = ADDKEY(KEY.NUM%(KEY%),FILE.NO%, Ø
XLOCK%,NEW.KEY$,DRN%)
IF ERRCOD <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(5)
IF LOKCOD <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(7)
IF RET.CODE% <> 1 THEN Ø
DUMMY% = WARNING.TYPE%(2,RET.CODE%)
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM WRITE NEW DATA RECORD ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF WRITE.CUST%(DRN%)
OUTBUF$ = CHR$(0) REM CLEAR DELETE FLAG
FOR D.FLD% = 0 TO MAX.FIELD%
OUTBUF$ = OUTBUF$ + LEFT$(NEW.FLD$(D.FLD%) + Ø
FLD.SPC$, FLD.LEN%(D.FLD%))
NEXT D.FLD%
OUTBUF.PTR% = SADD(OUTBUF$) + 2
IF WRTDAT(FILE.NO%,DRN%,OUTBUF.PTR%) <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(12)
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM DELETE KEY VALUE FROM INDEX ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF DEL.KEY%(KEY%,DRN%)
K.FLD% = KEY.MAP%(KEY%)
OLD.KEY$ = OLD.FLD$(K.FLD%)
RET.CODE% = DELKEY(KEY.NUM%(KEY%),FILE.NO%, Ø
XLOCK%,OLD.KEY$,DRN%)
IF ERRCOD <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(6)
IF LOKCOD <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(10)
IF RET.CODE% <> 1 THEN Ø
DUMMY% = WARNING.TYPE%(3,RET.CODE%)
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM DATA ENTRY ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF ENTER.DATA$(ENTER.MODE$)
IF ENTER.MODE$ = "NEW" THEN Ø
FOR FLD% = 0 TO MAX.FIELD% : Ø
OLD.FLD$(FLD%) = "" : Ø
NEXT FLD%
IF ENTER.MODE$ = "OLD" THEN Ø
FOR FLD% = 0 TO MAX.FIELD% : Ø
NEW.FLD$(FLD%) = OLD.FLD$(FLD%) : Ø
NEXT FLD%
DUMMY% = CLEAR.SCREEN%
WHILE ENTER.MODE$ = "NEW"
PRINT TAB(20);"Enter New Customer Information"
PRINT TAB(20);" ******************************"
PRINT :PRINT
PRINT TAB(5); Ø
"ÆPress 'RETURN' for customer # to see main menu.Å"
PRINT
FOR FLD% = 0 TO MAX.FIELD%
FLD.NO% = FLD% + 1
1010 PRINT TAB(4);FLD.NO%;"- ";FLD.NAME$(FLD%); Ø
TAB(30);"(";FLD.LEN%(FLD%);")";TAB(38);
INPUT ">>";LINE NEW.FLD$(FLD%)
IF FLD% = 0 AND NEW.FLD$(FLD%) = "" THEN Ø
ENTER.DATA$ = "STOP" : Ø
RETURN
IF FLD% = KEY.MAP%(UNIQ.KEY%) THEN Ø
NEW.FLD$(FLD%) = RIGHT$("0000"+NEW.FLD$(FLD%),Ø
FLD.LEN%(FLD%)) :Ø
UNIQUE% = TEST.UNIQUENESS% Ø
ELSE Ø
NEW.FLD$(FLD%) = LEFT$(NEW.FLD$(FLD%), Ø
FLD.LEN%(FLD%)) :Ø
UNIQUE% = YES%
IF NOT UNIQUE% THEN GOTO 1010
NEXT FLD%
ENTER.MODE$ = "NEWMOD"
WEND
1015 PRINT :PRINT :PRINT
PRINT TAB(20);"Current customer information" : PRINT
FOR FLD% = 0 TO MAX.FIELD%
FLD.NO% = FLD% + 1
PRINT TAB(4);FLD.NO%;"- ";FLD.NAME$(FLD%);TAB(30); Ø
NEW.FLD$(FLD%)
NEXT FLD%
REM NEW DATA HAS FEWER OPTIONS
IF ENTER.MODE$ = "NEWMOD" THEN 1030
1020 PRINT :PRINT
PRINT Ø
"Press 'RETURN' to continue scan, enter Field # to change data,"
PRINT Ø
"S to save changes, D to delete data, B for back scan, or E"; Ø
" to end scan";
INPUT ">>";LINE OP$
OP$ = UCASE$(OP$)
IF OP$ = "" THEN ENTER.DATA$ = "CONT":RETURN
IF OP$ = "S" THEN ENTER.DATA$ = SET.XLOCK$(OP$):RETURN
IF OP$ = "D" THEN ENTER.DATA$ = SET.XLOCK$(OP$):RETURN
IF OP$ = "B" THEN ENTER.DATA$ = "BACK":RETURN
IF OP$ = "E" THEN ENTER.DATA$ = "STOP":RETURN
OP% = VAL(OP$)
IF OP%<1 OR OP%>NO.FIELDS% THEN 1020
DUMMY% = UPDATE.FIELD%(OP%)
GOTO 1015 REM DISPLAY INFO
1030 PRINT :PRINT
PRINT Ø
"Press 'RETURN' to save data, enter Field # to change data,"
INPUT "D to delete data, or E to end input>>";LINE OP$
OP$ = UCASE$(OP$)
IF OP$ = "" OR OP$ = "S" THEN ENTER.DATA$ = "SAVE":RETURN
IF OP$ = "D" THEN ENTER.DATA$ = "DELT":RETURN
IF OP$ = "E" THEN ENTER.DATA$ = "STOP":RETURN
OP% = VAL(OP$)
IF OP%<1 OR OP%>NO.FIELDS% THEN 1030
DUMMY% = UPDATE.FIELD%(OP%)
GOTO 1015
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM UPDATE INDICES & DATA FILE ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF UPDATE%(DATA.RECORD%)
IF DATA.RECORD% = 0 THEN Ø
DATA.RECORD% = NEWREC(FILE.NO%,XLOCK%)
UPDATE% = DATA.RECORD%
IF ERRCOD <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(8)
IF LOKCOD <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(3)
FOR KEY% = 0 TO MAX.KEY%
FLD% = KEY.MAP%(KEY%)
IF OLD.FLD$(FLD%) <> NEW.FLD$(FLD%) THEN Ø
DUMMY% = ADD.KEY%(KEY%,DATA.RECORD%)
NEXT KEY%
FOR FLD% = 0 TO MAX.FIELD%
IF OLD.FLD$(FLD%) <> NEW.FLD$(FLD%) THEN Ø
DUMMY% = WRITE.CUST%(DATA.RECORD%) :Ø
RETURN
NEXT FLD%
RETURN
FEND
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM DELETE INDEX & DATA FILE ENTRY ROUTINE
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF DELETE%(DATA.RECORD%)
FOR KEY% = 0 TO MAX.KEY%
FLD% = KEY.MAP%(KEY%)
IF OLD.FLD$(FLD%) <> "" THEN Ø
DUMMY% = DEL.KEY%(KEY%,DATA.RECORD%)
NEXT KEY%
IF RETREC(FILE.NO%,XLOCK%,DATA.RECORD%) <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(9)
IF LOKCOD <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(9)
RETURN
FEND
REM
REM END OF UTILITY FUNCTIONS
REM
REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM INITIALIZE INDEX FILES
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
2000
SET.LENGTH$ = "12345678901"
INDEX.KEY$ = SET.LENGTH$
SPACE$ = " "
REM
REM SET TERMINAL TO -1 FOR AUTOMATIC ASSIGNMENT BY AM86
REM
TERMINAL% = -1
TRAP.ERRORS% = YES%
TIME.OUT.TEST.DELAY% = 2 REM APPROXIMATELY 2 SECONDS
TERMINAL% = INTUSR(TERMINAL%,TRAP.ERRORS%,TIME.OUT.TEST.DELAY%)
IF ERRCOD <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(14)
NO.BUFFERS% = 5
NO.NODE.SECTORS% = 4
NO.DATA.FILES% = 1
NO.KEYS% = MAX.KEY% + 1
IF SETUP(NO.BUFFERS%,NO.KEYS%,NO.NODE.SECTORS%, Ø
NO.DATA.FILES%) <> 0 THEN Ø
PRINT "Illegal SETUP Parameters" :Ø
STOP
FOR KEY% = 0 TO MAX.KEY%
KEY.NUM%(KEY%) = OPNIDX(-1,INDEX.NAME$(KEY%), Ø
KEY.LEN%(KEY%), KEY.TYPE%(KEY%),KEY.DUP%(KEY%))
IF ERRCOD <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(1)
NEXT KEY%
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM INITIALIZE DATA FILE
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
FILE.NO% = -1
RECORD.LENGTH% = 100
FILE.NAME$ = "CUSTOMER.DAT"
FILE.NO% = OPNDAT(FILE.NO%,SFILE%,FILE.NAME$,RECORD.LENGTH%)
IF ERRCOD <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(10)
IF LOKCOD <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(1)
4990 REM INITIALIZE STRING UTILITIES
TMPBUF$ = "12345678901234567890123456789012345678901234567890"
INPBUF$ = TMPBUF$ + TMPBUF$
REM
REM INPBUF IS THE BUFFER AREA FOR THE READAT ROUTINE
REM
INPBUF.PTR% = SADD(INPBUF$) + 2
REM 123456789012345678901234567890123456
FLD.SPC$ = " "
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM BEGIN DATABASE OPERATION
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
5000 DUMMY% = CLEAR.SCREEN%
CHOICE% = MAIN.MENU%
ON CHOICE% GOTO 5100,5300,5500,5700,5900,6100
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM ENTER NEW CUSTOMERS
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
5100 ACTION$ = ENTER.DATA$("NEW")
LOCK.CODE% = 0
IF ACTION$ = "SAVE" THEN Ø
NDRN% = UPDATE%(0): Ø UPDATE INDICES & DATA FILE
LOCK.CODE% = FRELOK(FILE.NO%,XLOCK%,NDRN%)
IF LOCK.CODE% <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(8)
IF ACTION$ = "SAVE" THEN Ø
GOTO 5100 Ø
ELSE Ø
GOTO 5000 REM RETURN TO MENU
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM SCAN/UPDATE/DELETE CUSTOMERS
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
5300 KEY% = SEARCH.KEY% REM DETERMINE SEARCH KEY
PRINT
PRINT "Enter target value for ";KEY.NAME$(KEY%);","
INPUT " or press 'RETURN' to see main menu>>"; Ø
LINE TARGET$
IF TARGET$ = "" THEN 5000
CONV.TARGET$ = KEY.FORMAT$(KEY%,TARGET$)
5345 DRN% = SERKEY(KEY.NUM%(KEY%),FILE.NO%,SLOCK%, Ø
CONV.TARGET$,INDEX.KEY$)
IF ERRCOD <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(2)
IF LOKCOD <> 0 THEN Ø
STAYPUT% = CHECK.LOCK% Ø
ELSE Ø
STAYPUT% = NO%
IF STAYPUT% THEN 5345
OLD.ACTION$ = "CONT"
CONTINUE% = YES%
WHILE CONTINUE% AND DRN% <> 0
LDRN% = DRN% REM save drn for lock release
DUMMY% = READ.CUST%(DRN%)
ACTION$ = ENTER.DATA$("OLD")
SAVE.KEY% = KEY%
IF ACTION$ = "SAVE" THEN Ø
DUMMY% = UPDATE%(DRN%)
IF ACTION$ = "DELT" Ø
THEN DUMMY% = DELETE%(DRN%)
IF ACTION$ <> "DELT" AND FRELOK(FILE.NO%,RLOCK%,LDRN%) <> 0 Ø
THEN DUMMY% = LOCK.TYPE%(2)
IF ACTION$ = "SAVE" OR ACTION$ = "DELT" THEN Ø
KEY% = SAVE.KEY% : Ø RESET SEARCH KEY
ACTION$ = OLD.ACTION$ REM reset direction
OLD.ACTION$ = ACTION$
CONV.TARGET$ = LEFT$(INDEX.KEY$,KEY.LEN%(KEY%))
INDEX.KEY$ = SET.LENGTH$
LOCK.CODE% = 0
5390 IF ACTION$ = "CONT" THEN Ø
DRN% = AFTKEY(KEY.NUM%(KEY%),FILE.NO%, Ø
SLOCK%, CONV.TARGET$,INDEX.KEY$) :Ø
LOCK.CODE% = LOKCOD
IF ACTION$ = "BACK" THEN Ø
DRN% = BEFKEY(KEY.NUM%(KEY%),FILE.NO%, Ø
SLOCK%, CONV.TARGET$,INDEX.KEY$):Ø
LOCK.CODE% = LOKCOD
IF LOCK.CODE% <> 0 THEN Ø
STAYPUT% = CHECK.LOCK% Ø
ELSE Ø
STAYPUT% = NO%
IF STAYPUT% THEN 5390
IF ACTION$ = "STOP" THEN Ø
CONTINUE% = NO%
WEND
PRINT
PRINT "SCAN ENDED"
DUMMY% = PAUSE%
GOTO 5000 REM RETURN TO MAIN MENU
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM LIST CUSTOMERS
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
5500 KEY% = SEARCH.KEY%
PRINT
INPUT Ø
"Do you want listing routed to printer (Y/N)>>";LINE ROUTE$
ROUTE$ = UCASE$(ROUTE$)
PRINT
PRINT Ø
"Enter lower and upper limits for ";KEY.NAME$(KEY%);" listing;"
INPUT Ø
" separate values with a comma >>";L.VALUE$,U.VALUE$
L.VALUE$ = KEY.FORMAT$(KEY%,L.VALUE$)
U.VALUE$ = KEY.FORMAT$(KEY%,U.VALUE$)
DRN% = SERKEY(KEY.NUM%(KEY%),FILE.NO%,SLOCK%, Ø
L.VALUE$,INDEX.KEY$)
IF LOKCOD <> 0 THEN Ø
DUMMY% = SKIP.LOCK%
NO.LISTED% = 0
WHILE DRN% <> 0 AND COMPARE%< = 0
DUMMY% = READ.CUST%(DRN%)
DUMMY% = PRINT.CUST%
NO.LISTED% = NO.LISTED% + 1
IF FRELOK(FILE.NO%,SLOCK%,DRN%) <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(4)
L.VALUE$ = LEFT$(INDEX.KEY$,KEY.LEN%(KEY%))
INDEX.KEY$ = SET.LENGTH$
DRN% = AFTKEY(KEY.NUM%(KEY%),FILE.NO%,SLOCK%, Ø
L.VALUE$,INDEX.KEY$)
IF LOKCOD <> 0 THEN Ø
DUMMY% = SKIP.LOCK%
WEND
IF DRN% <> 0 THEN Ø
LOCK.CODE% = FRELOK(FILE.NO%,SLOCK%,DRN%) Ø
ELSE Ø
LOCK.CODE% = 0
IF LOCK.CODE% <> 0 THEN Ø
DUMMY% = LOCK.TYPE%(5)
PRINT
PRINT TAB(5);NO.LISTED%;" records listed."
DUMMY% = PAUSE%
GOTO 5000 REM RETURN TO MAIN MENU
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM DATABASE STATISTICS
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
5700 DUMMY% = CLEAR.SCREEN%
PRINT TAB(5);FILE.NAME$;" has ";GETDFS(FILE.NO%); Ø
" records; currently, ";
PRINT GETDFU(FILE.NO%);" of them are in use."
PRINT :PRINT :PRINT :PRINT
PRINT TAB(5);"INDEX";TAB(30);"ENTRIES"
PRINT TAB(5);"-----------------";TAB(30);"-------"
FOR KEY% = 0 TO MAX.KEY%
PRINT TAB(5);KEY.NAME$(KEY%);TAB(32);NOKEYS(KEY%)
NEXT KEY%
PRINT :PRINT :PRINT :PRINT
DUMMY% = PAUSE%
GOTO 5000 REM RETURN TO MAIN MENU
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM SAVE DATABASE UPDATES & RESTART
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
5900 IF SAVDAT(FILE.NO%) <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(7)
FOR KEY% = 0 TO MAX.KEY%
IF SAVIDX(KEY.NUM%(KEY%)) <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(3)
NEXT KEY%
GOTO 5000
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM SAVE DATABASE UPDATES & TERMINATE
REM
REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
6100 IF CLSDAT(FILE.NO%) <> 0 THEN Ø
DUMMY = ERROR.TYPE%(15)
FOR KEY% = 0 TO MAX.KEY%
IF CLSIDX(KEY.NUM%(KEY%)) <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(16)
NEXT KEY%
IF FRELOK(FILE.NO%,SFILE%,0) <> 0 THEN Ø
DUMMY% = ERROR.TYPE%(13)
PRINT
PRINT " *** SUCCESSFUL TERMINATION ***"
STOP
«eof»