DataMuseum.dk

top - download

    Length: 13440 (0x3480)
    Types: TextFile
    Names: »RECREATE.BAS«

└─⟦57f0389e8⟧ Bits:30005761 SW1611 Access Manager v. 1.0
    └─ ⟦this⟧ »RECREATE.BAS« 

TextFile

REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM	RECREATE PROGRAM  VERSION 1.02  03/03/83
REM	ASSUMES AM86BUF IS AT LEAST 4844 BYTES
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::

%INCLUDE AM86EXTR.BAS

DIM DRN%(1),DEL.PTR%(1),NO.DEL%(1),UTL%(1)

YES% = 1 : NO% = 0 : CLEAR.LINE$ = "                    "
END.DATA.FILE% = 53
INVALID.RECORD% = 52
END.INDEX.FILE% = 23
CORRUPT.DATA% = 70
CORRUPT.INDEX% = 40
DELETE.FLAG$ = CHR$(255)

REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM	RECREATE CAPACITIES
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::

DIM INDEX.NAME$(9),KEY.LEN%(9,5),KEY.TYPE%(9),NO.KEY.PARTS%(9)
DIM AUTO.SUFFIX%(9),KEY.POS%(9,5),BLANK.KEY.TO.NULL$(9)
MAX.NO.KEY.PARTS% = 5
MAX.NO.KEYS% = 9

REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM	LOCK VALUES
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::

NLOCK% = 0	REM NO LOCK REQUEST
XFILE% = 4	REM EXCLUSIVE FILE LOCK REQUEST

REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM	RECREATE UTILITIES
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DEF SPACE(FLDLEN)
	STRING SPACE
	INTEGER FLDLEN

REM	               123456789012345678901234567890123456789012345678	
	SPACE = LEFT$("                                                ", Ø
		FLDLEN)
	RETURN
FEND

DEF ABANDON
	PRINT "Rebuild Aborted!"
	CLOSE 1
	STOP
FEND

DEF EXTRACT.KEY(KEY%)
	STRING EXTRACT.KEY,TEMP$

	TEMP$ = ""
	FOR PART% = 1 TO NO.KEY.PARTS%(KEY%)
		TEMP$ = TEMP$ + MID$(INPBUF$,KEY.POS%(KEY%,PART%), Ø
			KEY.LEN%(KEY%,PART%))
	NEXT PART%

	IF BLANK.KEY.TO.NULL$(KEY%) = "Y" AND TEMP$ = SPACE(LEN(TEMP$)) Ø
		THEN EXTRACT.KEY = "" Ø
	ELSE Ø
		EXTRACT.KEY = TEMP$

	RETURN

FEND

REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::
REM
REM	PRE-INDEX SORT ROUTINES (buffer input / speed indexing)
REM
REM :::::::::::::::::::::::::::::::::::::::::::::::::::::::::

DIM KEYVAL$(1500),DRN1%(1500),DRN2%(1500),LINK%(1500)
SORT.FLAG% = NO%
NO.SORT% = 0
MAX.SORT% = 1500

DEF ENTRY.ERROR(DR1%,DR2%)

		PRINT " Error:  #";ERRCOD;" (rec# ";DR1%;DR2%;")"
		PRINT "during index rebuild."
		DUMMY% = CLSDAT(FILE.NO%)
		DUMMY% = ERAIDX(KEY.NO%)
		CALL ABANDON
FEND

DEF SORT.SETUP(KEY%)

	IF SORT.FLAG% = NO% THEN Ø
		SORT.FLAG% = YES% Ø
	ELSE Ø
		FOR TEMP% = 1 TO NO.SORT% :Ø
			KEYVAL$(TEMP%) = "" :Ø
		NEXT TEMP%

	IF FRE < 0 THEN Ø
		SORT.FRE = FRE + 65536. Ø
	ELSE Ø
		SORT.FRE = FRE
	IF MFRE < 0 THEN Ø
		SORT.MFRE = MFRE + 65536. Ø
	ELSE Ø
		SORT.MFRE = MFRE

	G.SORT = INT(SORT.MFRE / (KEY.LEN%(KEY%,0) + 4 ))
	M.SORT = INT(SORT.FRE  / (KEY.LEN%(KEY%,0) + 4 ))
	NO.SORT% = (G.SORT + 3. * M.SORT) / 4.
	IF NO.SORT% > MAX.SORT% THEN NO.SORT% = MAX.SORT%

	RETURN

FEND

DEF SORT.KEYVAL(NO.READ%)


	LINK%(0) = NO.READ%
	LINK%(NO.READ%) = 0

	IF NO.READ% < 2 THEN Ø
		RETURN

	FOR J% = NO.READ% - 1 TO 1 STEP -1
		P% = LINK%(0)
		Q% = 0
		KEY.VALUE$ = KEYVAL$(J%)
L3:
		IF KEY.VALUE$ <= KEYVAL$(P%) THEN GOTO L5
L4:
		Q% = P%
		P% = LINK%(Q%)
		IF P% > 0 THEN GOTO L3
L5:
		LINK%(Q%) = J%
		LINK%(J%) = P%
	NEXT J%

	RETURN
FEND			

DEF SORT.INDEX(KEY%,KEY.NO%,NO.READ%)

	IF NO.READ% = 0 THEN RETURN

	CALL SORT.KEYVAL(NO.READ%)

	I% = LINK%(0)

INDEX.LOOP:

	IF I% = 0 THEN RETURN

	CALL SETDAT(DRN2%(I%))
	RET.CODE% = ADDKEY(KEY.NO%,FILE.NO%,NLOCK%,KEYVAL$(I%),DRN1%(I%))
	IF ERRCOD <> 0 THEN Ø
		PRINT "Could not enter key value in ";INDEX.NAME$(KEY%); :Ø
		CALL ENTRY.ERROR(DRN1%(I%),DRN2%(I%))
	IF RET.CODE% <> 1 THEN Ø
		PRINT "WARNING...ADDKEY Return Code: ";RET.CODE% :Ø
		PRINT TAB(10);"while processing record # "; Ø
			DRN1%(I%);DRN2%(I%);" for ";INDEX.NAME$(KEY%)

PRINT INDEX.NAME$(KEY%);DRN1%(I%);DRN2%(I%);CHR$(13);

	I% = LINK%(I%)
	GOTO INDEX.LOOP

FEND

DEF SORT.READ(KEY%,KEY.NO%)

		DRN%(0) = BEG.REC%
		DRN%(1) = 0
		END.FILE% = NO%

PRINT CLEAR.LINE$;CHR$(13);

SORT.LOOP:
		IF END.FILE% = YES% THEN Ø
			PRINT :Ø
			PRINT INDEX.NAME$(KEY%);" is rebuilt." :Ø
			RETURN

		NO.READ% = 0

DATA.LOOP:

		CALL SETDAT(DRN%(1))
		TEMP% = READAT(FILE.NO%,DRN%(0),INPBUF.PTR%)

		IF TEMP% = END.DATA.FILE% OR TEMP% = INVALID.RECORD% THEN  Ø
			END.FILE% = YES% :Ø
			GOTO BUILD.INDEX
		IF TEMP% <> 0 THEN Ø
			PRINT "Could not read ";FILE.NAME$; :Ø
			CALL ENTRY.ERROR(DRN%(0),DRN%(1))

		IF LEFT$(INPBUF$,1) = DELETE.FLAG$ THEN GOTO SKIP.RECORD

PRINT FILE.NAME$;DRN%(0);DRN%(1);CHR$(13);

		NO.READ% = NO.READ% + 1
		KEYVAL$(NO.READ%) = EXTRACT.KEY(KEY%)
		DRN1%(NO.READ%) = DRN%(0)
		DRN2%(NO.READ%) = DRN%(1)

SKIP.RECORD:
		DRN%(0) = DRN%(0) + 1
		IF DRN%(0) = 0 THEN Ø
			DRN%(1) = DRN%(1) + 1
		IF NO.READ% < NO.SORT% THEN Ø
			GOTO DATA.LOOP

BUILD.INDEX:

PRINT CLEAR.LINE$;CHR$(13);

		CALL SORT.INDEX(KEY%,KEY.NO%,NO.READ%)
		GOTO SORT.LOOP

FEND		

DEF CONV.INT(DRN)
REM
REM THIS VERSION IS LIMITED TO TWO-BYTE INTEGERS
REM
	STRING CONV.INT
	INTEGER DRN,MSB,LSB

	MSB = INT%(DRN/256)
	LSB = DRN - MSB * 256
	IF LSB < 0 THEN MSB = MSB - 1

REM
REM NOTE THAT THE MSB AND LSB COULD BE COMBINED IN EITHER
REM ORDER. THE MOST IMPORTANT FACTOR IS TO ADOPT A CONVENTION
REM ON THE ORDER AND STICK WITH IT. (NUMERIC KEYS MUST HAVE LSB FIRST.)
REM

	CONV.INT = CHR$(LSB) + CHR$(MSB)
	RETURN
FEND

DEF INC.NO.DEL
	NO.DEL%(0) = NO.DEL%(0) + 1
	IF NO.DEL%(0) = 0 THEN Ø
		NO.DEL%(1) = NO.DEL%(1) + 1
	DEL.PTR%(0) = DRN%(0)
	DEL.PTR%(1) = DRN%(1)
	RETURN
FEND

DEF INC.DRN
	DRN%(0)= DRN%(0) + 1
	IF DRN%(0) = 0 THEN Ø
		DRN%(1) = DRN%(1) + 1
	RETURN
FEND

DEF WRITE.DELETE.LINK
	LNKBUF$ = DELETE.FLAG$ + CONV.INT(DEL.PTR%(0)) + Ø
		CONV.INT(DEL.PTR%(1)) + "DELETED"
	LNKBUF.PTR% = SADD(LNKBUF$) + 2
	CALL SETDAT(DRN%(1))
	IF WRTDAT(FILE.NO%,DRN%(0),LNKBUF.PTR%) <> 0 THEN Ø
		PRINT "Could not rewrite deleted record." :Ø
		PRINT "Data file ";FILE.NAME$;" (";DRN%(0);DRN%(1);")." :Ø
		CALL ABANDON
	RETURN
FEND

DEF OUTHDR(LSW%,MSW%)
	STRING TEMP

	TEMP = CONV.INT(LSW%)
	PUT 2,ASC(TEMP)
	PUT 2,ASC(RIGHT$(TEMP,1))
	TEMP = CONV.INT(MSW%)
	PUT 2,ASC(TEMP)
	PUT 2,ASC(RIGHT$(TEMP,1))
	RETURN
	FEND

DEF RECREATE.HEADER

	OPEN FILE.NAME$ RECL 128 AS 2
REM
REM DRN% SET TO FILE SIZE
REM
	DRN%(0) = DRN%(0) - 1
	IF DRN%(0) = -1 THEN Ø
		DRN%(1) = DRN%(1) - 1
REM
REM UTL% set to file utilzation
REM
	IF NO.DEL%(0) < 0 THEN Ø
		TEMP = NO.DEL%(0) + 65536. Ø
	ELSE Ø
		TEMP = NO.DEL%(0)
	TEMP = TEMP + 65536. * NO.DEL%(1)
	TEMP = TEMP + BEG.REC% - 1	REM ADJ FOR HEADER
	TEMP = - TEMP
	IF DRN%(0) < 0 THEN Ø
		TEMP = TEMP + DRN%(0) + 65536. Ø
	ELSE Ø
		TEMP = TEMP + DRN%(0)
	TEMP = TEMP + 65536. * DRN%(1)		rem temp = size - unsued
	IF TEMP < 0 THEN Ø
		PRINT "Illegal value for file utilization:";TEMP :Ø
		CLOSE 2 :Ø
		CALL ABANDON
	UTL%(1) = INT%(TEMP / 65536.)
	UTL%(0) = TEMP - 65536. * UTL%(1)
REM
REM OUTPUT HEADER: DELPTR,UTL,SIZE,INTEGRITY FLAG
REM
	CALL OUTHDR(DEL.PTR%(0),DEL.PTR%(1))
	CALL OUTHDR(UTL%(0),UTL%(1))
	CALL OUTHDR(DRN%(0),DRN%(1))
	PUT 2,0
	FOR TEMP% = 1 TO 115
		PUT 2,32		REM FILL HEADER WITH SPACES
	NEXT TEMP%
	CLOSE 2
	RETURN
FEND	
	
DEF REBUILD.DATA
	INTEGER REBUILD.DATA
REM
REM REBUILD.DATA RETURN VALUES
REM		0 - data file uncorrupted, no action needed
REM		1 - data file corrupted, was rebuilt
REM		2 - could not get exclusive lock, no action taken
REM		3 - no header record / apparently empty data file, no action
REM	      < 0 - unresolved error on open (ERRCOD = - return value),
REM			no action taken
REM
	STATUS% = 0
	FILE.NO% = OPNDAT(-1,XFILE%,FILE.NAME$,REC.LEN%)

	IF ERRCOD = END.DATA.FILE% THEN Ø
		REBUILD.DATA% = 3 :Ø
		DUMMY% = CLSDAT(FILE.NO%) :Ø
		RETURN

	IF ERRCOD = CORRUPT.DATA% THEN Ø
		STATUS% = 1 :Ø
		FILE.NO% = OPRDAT(-1,XFILE%,FILE.NAME$,REC.LEN%)

	IF STATUS% = 0 AND ERRCOD <> 0 THEN Ø
		REBUILD.DATA = -ERRCOD :Ø
		DUMMY% = CLSDAT(FILE.NO%) :Ø
		RETURN

	IF LOKCOD <> 0 THEN Ø
		REBUILD.DATA = 2 :Ø
		DUMMY% = CLSDAT(FILE.NO%) :Ø
		RETURN

	IF BEG.REC% = 0 THEN Ø
		BEG.REC% = INT%((128 + REC.LEN% - 1) / REC.LEN%) + 1
	TMPBUF$ = "0123456789abcdef0123456789abcdef"
	INPBUF$ = ""
	NO.SEG% = INT% ((REC.LEN% + 31) / 32)
	FOR TEMP% = 1 TO NO.SEG%
		INPBUF$ = INPBUF$ + TMPBUF$
	NEXT TEMP%
	INPBUF.PTR% = SADD(INPBUF$) + 2


	IF STATUS% = 0 THEN Ø
		REBUILD.DATA = STATUS% :Ø
		PRINT "No need to modify ";FILE.NAME$ :Ø
		DUMMY% = CLSDAT(FILE.NO%) :Ø
		RETURN

REM
REM CORRUPTED FILE. MUST RECREATE DELETED LINKS AND HEADER RECORD
REM

	PRINT "Rebuilding data file ";FILE.NAME$
	PRINT

	DRN%(0) = BEG.REC%
	DRN%(1) = 0
	

	DEL.PTR%(0) = 0
	DEL.PTR%(1) = 0
	NO.DEL%(0) = 0
	NO.DEL%(1) = 0

READ.LOOP:

	CALL SETDAT(DRN%(1))
	IF READAT(FILE.NO%,DRN%(0),INPBUF.PTR%) = END.DATA.FILE% THEN Ø
		GOTO END.OF.FILE
	IF ERRCOD <> 0 THEN Ø
		REBUILD.DATA = -ERRCOD :Ø
		DUMMY% = CLSDAT(FILE.NO%) :Ø
		RETURN

PRINT FILE.NAME$;DRN%(0);DRN%(1);CHR$(13);

	IF LEFT$(INPBUF$,1) = DELETE.FLAG$ THEN Ø
		CALL WRITE.DELETE.LINK :Ø
		CALL INC.NO.DEL
	CALL INC.DRN
	GOTO READ.LOOP

END.OF.FILE:

	PRINT
	PRINT FILE.NAME$;" is reorganized. Now rebuild index files."
	
	IF CLSDAT(FILE.NO%) <> 0 THEN Ø
		PRINT "Could not close data file (to recreate header)"; Ø
			FILE.NAME$ :Ø
		CALL ABANDON

	CALL RECREATE.HEADER
	REBUILD.DATA = 1
	RETURN

FEND

DEF REBUILD.INDICES(REDO.DATA%)

	IF NO.KEYS% < 1 THEN RETURN

	FILE.NO% = OPNDAT(-1,XFILE%,FILE.NAME$,REC.LEN%)
	IF ERRCOD <> 0 OR LOKCOD <> 0 THEN Ø
		PRINT "Could not attempt index rebuild." :Ø
		PRINT "Error/Lock Codes...";ERRCOD,LOKCOD :Ø
		DUMMY% = CLSDAT(FILE.NO%) :Ø
		RETURN

	FOR KEY% = 1 TO NO.KEYS%
		KEY.NO% = OPNIDX(-1,INDEX.NAME$(KEY%),KEY.LEN%(KEY%,0), Ø
			KEY.TYPE%(KEY%),AUTO.SUFFIX%(KEY%))

		IF ERRCOD = 0 AND REDO.DATA% = 0 THEN Ø
			TEMP% = NOKEYS(KEY.NO%) :Ø
			IF TEMP% <> 0 OR DATVAL <> 0 THEN Ø
				PRINT INDEX.NAME$(KEY%);" is OK as is."; Ø
					" No rebuild performed." :Ø
				GOTO SKIP.INDEX

		IF ERRCOD <> 0 AND ERRCOD <> CORRUPT.INDEX% AND Ø
		    ERRCOD <> END.INDEX.FILE% THEN Ø
			PRINT "Unanticipated Error with "; :Ø
			GOTO KEY.ERROR

		IF ERRCOD = CORRUPT.INDEX% THEN Ø
			KEY.NO% = OPRIDX(-1,INDEX.NAME$(KEY%), Ø
			KEY.LEN%(KEY%,0),KEY.TYPE%(KEY%),AUTO.SUFFIX%(KEY%))

		IF ERAIDX(KEY.NO%) <> 0 THEN Ø
			PRINT "Could not erase old "; :Ø
			GOTO KEY.ERROR

		KEY.NO% = OPNIDX(-1,INDEX.NAME$(KEY%),KEY.LEN%(KEY%,0), Ø
			KEY.TYPE%(KEY%),AUTO.SUFFIX%(KEY%))
		IF ERRCOD <> 0 THEN Ø
			PRINT "Could not re-open "; :Ø
			GOTO KEY.ERROR			

		CALL SORT.SETUP(KEY%)		
		CALL SORT.READ(KEY%,KEY.NO%)

SKIP.INDEX:
		DUMMY% = CLSIDX(KEY.NO%)
	NEXT KEY%

	DUMMY% = CLSDAT(FILE.NO%)
	RETURN

KEY.ERROR:
		PRINT INDEX.NAME$(KEY%);" Error:  #";ERRCOD
		PRINT "Index not rebuilt."
		GOTO SKIP.INDEX

FEND

DEF REBUILD

	READ #1;FILE.NAME$,REC.LEN%,NO.KEYS%,BEG.REC%

	IF NO.KEYS% > MAX.NO.KEYS% THEN Ø
		PRINT "Error in ";REC.PAR;" for data file ";FILE.NAME$ :Ø
		PRINT "More than ";MAX.NO.KEYS%;" key files requested.":Ø
		CLOSE 1 :Ø
		STOP
		
	IF NO.KEYS% <= 0 THEN GOTO SKIP.KEY.DESCRIPTION

	FOR KEY% = 1 TO NO.KEYS%
		READ #1;INDEX.NAME$(KEY%),KEY.LEN%(KEY%,0), Ø
			KEY.TYPE%(KEY%),AUTO.SUFFIX%(KEY%), Ø
			NO.KEY.PARTS%(KEY%),BLANK.KEY.TO.NULL$(KEY%)
		BLANK.KEY.TO.NULL$(KEY%) = UCASE$(BLANK.KEY.TO.NULL$(KEY%))
		IF NO.KEY.PARTS%(KEY%) < 1 OR NO.KEY.PARTS%(KEY%) > Ø
			MAX.NO.KEY.PARTS% THEN GOTO KEY.ERROR
		FOR PART% = 1 TO NO.KEY.PARTS%(KEY%)
			READ #1;KEY.POS%(KEY%,PART%),KEY.LEN%(KEY%,PART%)
		NEXT PART%
	NEXT KEY%

SKIP.KEY.DESCRIPTION:

	REDO.DATA% = REBUILD.DATA

	IF REDO.DATA% = 2 THEN Ø
		PRINT "Data file ";FILE.NAME;" could not be locked."

	IF REDO.DATA% = 3 THEN Ø
		PRINT "Data file ";FILE.NAME$;" apparently empty."

	IF REDO.DATA% < 0 THEN Ø
		PRINT "Unanticipated AM86 Error #";-REDO.DATA%; Ø
			" while processing ";FILE.NAME$

	IF REDO.DATA% < 0 OR REDO.DATA% > 1 THEN Ø
		PRINT "No rebuild performed." :Ø
		RETURN

	CALL REBUILD.INDICES(REDO.DATA%)

	PRINT
	PRINT "Rebuild for ";FILE.NAME$;" completed."

	RETURN

KEY.ERROR:

	PRINT "Error in ";REC.PAR$;" for data file ";FILE.NAME$; Ø
		" with key file ";INDEX.NAME$(KEY%)
	PRINT "Number of key parts must satisfy -"
	PRINT
	PRINT TAB(10);"1  <=  # PARTS  <=  ";MAX.NO.KEY.PARTS%
	PRINT
	CLOSE 1
	STOP
FEND	

REM +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

INPUT "Enter recreate parameter file name:";REC.PAR$

OPEN REC.PAR$ AS 1

READ #1;NO.DATA.FILES%,NODE.SECTORS%

TERMINAL% = INTUSR(-1,YES%,2)
IF ERRCOD <> 0 THEN Ø
	PRINT "Could not initialize user." :Ø
	STOP

BUFFER.SPACE% = 4844 - 70 - 198	REM assumes that only one key file and one 
				REM data file will be open at the same time.
NO.BUFFERS% = INT%(BUFFER.SPACE% / (NODE.SECTORS% * 128 + 60))
IF NO.BUFFERS% > 254 THEN NO.BUFFERS% = 254

IF SETUP(NO.BUFFERS%,1,NODE.SECTORS%,1) <> 0 THEN Ø
	PRINT "Illegal SETUP parameters." :Ø
	CALL ABANDON

FOR DFILE% = 1 TO NO.DATA.FILES%
	CALL REBUILD
	PRINT
NEXT DFILE%

PRINT
PRINT "Normal Termination."
CLOSE 1
STOP
«eof»