00887: Program to shrink MKEYED files by rewriting keys in non-sequential loop iteration.

Title:

Program to shrink MKEYED files by rewriting keys in non-sequential loop iteration.

Description:

The following program can be used to shrink MKEYED files by writing records in a non-sequential loop. 

0010 REM Program to write MKEYED keys in non-sequential order 
0020 REM Will shrink MKEYED files by re-writing them in a 5-pass loop 
0030 REM You can set the number of passes at line 70 (CYCLES=5). 
0040 REM 
0050 IF TCB(13)=0 THEN BEGIN ; IF TCB(15)<255 THEN START 255,PGM(-1) 
0060 LET F1N$=FIN(0),CUR_WDW=DEC(F1N$(9,2)); PRINT ‘GOTO'(0),’PUSH’,’CS’, 
0070 LET F1N$=FIN(0),XM=ASC(F1N$(7)),YM=ASC(F1N$(8)),LN=29,CYCLES=5 
0080 LET TXT$=”Shrink MKEYED files in a “+STR(CYCLES)+”-pass rewrite” 
0090 GOSUB CENTER; PRINT @(X,0),TXT$,’CE’,’GS’,@(0,1),FILL(XM,”0″),’GE’, 
0100 LET DIR$=DIR(“”); SETERR GET_DIR; ENTER DIR$; GOTO TST_DIR 
0110 GET_DIR: LET Y=INT((YM-3)/2)-1,TXT$=”Directory to examine : “+FILL(LN) 
0120 GOSUB CENTER; PRINT @(X,Y),’SB’,TXT$,’CE’,; LET TXT$=TXT$(1,LEN(TXT$)-LN) 
0130 INPUTE (0,ERR=GET_DIR)X+LEN(TXT$),Y,LN,”_”,DIR$:(“”=QUIT,LEN=0,LN) 
0140 TST_DIR: SETERR 0; IF DIR$(LEN(DIR$),1)<>”/” THEN LET DIR$=DIR$+”/” 
0150 LET Z=X,CHAN=UNT; OPEN (CHAN,ERR=OOPS_0)DIR$; GOTO CHECK 
0160 OOPS_0: LET TXT$=”Error “+STR(ERR)+” during ‘OPEN’ of “+DIR$ 
0170 OOPS_1: GOSUB CENTER; PRINT @(X,YM-2),’SF’,’BR’,TXT$,’ER’, 
0180 INPUT (0,ERR=GET_DIR,SIZ=1)’CI’,*; GOTO GET_DIR 
0190 OOPS_2: LET TXT$=”Error “+STR(ERR)+” during ‘OPEN’ …” 
0200 GOSUB CENTER; GOSUB WAIT; GOTO READ 
0210 OOPS_3: LET TXT$=”‘LOCK’ on this file not possible at the time !!!” 
0220 GOSUB CENTER; GOSUB WAIT; CLOSE (CHECK); GOTO READ 
0230 OOPS_4: LET TXT$=”‘”+PATH$+”‘ => NO read/write permission” 
0240 GOSUB CENTER; GOSUB WAIT; GOTO EOD 
0250 OOPS_5: LET TXT$=”Error “+STR(ERR)+” during creation ‘”+TMP$+”‘” 
0260 GOSUB CENTER; GOSUB WAIT; CLOSE (CHECK); GOTO READ 
0270 CHECK: LET F1D$=FID(CHAN); IF ASC(F1D$)=5 THEN GOTO GET_SUB 
0280 LET TXT$=”‘”+DIR$+”‘ is NOT a directory !!!”; GOTO OOPS_1 
0290 GET_SUB: LET TXT$=”Examine subdirectories of “+DIR$+” too : ” 
0300 PRINT @(Z,Y+1),’SB’,TXT$,’CE’, 
0310 INPUTE (0,ERR=GET_SUB)Z+LEN(TXT$),Y+1,”A”,”_”,SUB$:(“”=GET_DIR,LEN=0,1) 
0320 ON POS(SUB$=”NJY”) GOTO GET_SUB,GO 
0330 GO: CLOSE (CHAN); DIM NO[19]; LET PATH$=””,NAME$=DIR$,CNT=-1,NO[0]=CHAN
0340 GET: LET CNT=CNT+1,PATH$=PATH$+NAME$ 
0350 PRINT @(Z,Y+2),’SB’,”Directory : “,’CE’,PATH$,@(Z,Y+3),’SB’,”File : “, 
0360 IF NO[CNT]=0 THEN LET NO[CNT]=UNT FI; OPEN (NO[CNT],ERR=OOPS_4)PATH$ 
0370 READ: READ RECORD(NO[CNT],ERR=EOD)NAME$; PRINT @(Z+7,Y+3),’CL’,NAME$,
0380 IF POS(NAME$=”..”) THEN GOTO READ 
0390 IF NAME$(LEN(NAME$))<>”/” THEN GOTO GOT_FILE 
0400 IF POS(SUB$=”YJ”) THEN GOSUB GET; GOTO READ ELSE GOTO READ 
0410 GOT_FILE: LET CHECK=UNT; OPEN (CHECK,ERR=OOPS_2)PATH$+NAME$ 
0420 LET F1D$=FID(CHECK),F1N$=FIN(CHECK) 
0430 IF ASC(F1D$)<>6 OR ASC(F1D$(2))<>0 THEN CLOSE (CHECK); GOTO READ 
0440 IF DEC(F1N$(77,4))<CYCLES+1 THEN CLOSE (CHECK); GOTO READ 
0450 IF POS($00$<>F1N$(86))=0 THEN CLOSE (CHECK); GOTO READ 
0460 LOCK (CHECK,ERR=OOPS_3); LET COPY=UNT 
0470 LET TMP$=PATH$+”TMP”+HTA(INFO(3,0))+”.”+FID(0),F1D$=F1D$(1,8)+TMP$ 
0480 PRINT @(Z,Y+4),’SB’,”Rewrite : “,’CE’,TMP$, 
0490 ERASE: LET X=Z+LEN(TMP$)+10; ERASE TMP$,ERR=COPY; GOTO ERASE 
0500 COPY: LET NR=DEC($00$+F1N$(77,4)); FILE F1D$,F1N$(86),ERR=OOPS_5 
0510 OPEN (COPY)TMP$; LOCK (COPY) 
0520 FOR PASS=1 TO CYCLES; CLOSE (CHECK); PREFIX PFX 
0530 OPEN (CHECK)PATH$+NAME$; LOCK (CHECK); LET TIMES=PASS-1 
0540 WHILE TIMES; READ RECORD(CHECK,END=EOF0); GOTO EOW0 
0550 EOF0: LET TIMES=1 
0560 EOW0: LET TIMES=TIMES-1; WEND 
0570 GET_REC: READ RECORD(CHECK,END=EOF2,DIR=CYCLES)D$; LET NR=NR-1 
0580 WRITE RECORD(COPY,ERR=EOF2,DOM=EOF2)D$; PRINT @(X,Y+4),NR,PASS,” “, 
0590 GOTO GET_REC 
0600 EOF2: NEXT PASS; LET D$=””,NEWFIN$=FIN(COPY) 
0610 IF NR=0 AND F1N$(77,4)=NEWFIN$(77,4) THEN GOTO RENAME 
0620 LET TXT$=”‘”+NAME$+”‘ => Possible KEY-POINTER problem …” 
0630 GOSUB CENTER; GOSUB WAIT; CLOSE (CHECK); CLOSE (COPY); PREFIX PFX 
0640 ERASE TMP$; GOTO READ 
0650 RENAME: CLOSE (CHECK); CLOSE (COPY); PREFIX PFX 
0660 ERASE PATH$+NAME$,ERR=OOPS_6; GOTO RENAME_1 
0670 OOPS_6: LET TXT$=”Error “+STR(ERR)+” during erase ‘”+PATH$+NAME$+”‘” 
0680 GOSUB CENTER; GOSUB WAIT; GOTO READ 
0690 RENAME_1: PREFIX PFX; RENAME TMP$ TO PATH$+NAME$ 
0700 PRINT @(0,Y+4),’CE’,; GOTO READ 
0710 EOD: CLOSE (NO[CNT]); LET CNT=CNT-1 
0720 LET PATH$=PATH$(1,POS(“/”=PATH$(1,LEN(PATH$)-1),-1)) 
0730 PRINT @(Z,Y+2),’SB’,”Directory : “,’CL’,PATH$, 
0740 IF PATH$>=DIR$ THEN RETURN 
0750 LET TXT$=”End of re-write, hit <CR>”; GOSUB CENTER; GOSUB WAIT 
0760 GOTO QUIT 
5000 REM ^5000 
5010 QUIT: PRINT ‘POP’,’GOTO'(CUR_WDW),; RESET 
5020 IF TCB(13) THEN EXIT ELSE STOP 
5030 CENTER: LET X=INT((XM-LEN(TXT$))/2); IF X<0 THEN LET X=0 FI; RETURN 
5040 WAIT: PRINT @(X,YM-2),’CE’,’BR’,TXT$,’ER’,’RB’, 
5050 INPUT (0,ERR=TIMEOUT,SIZ=1,TIM=10)’CI’,* 
5060 TIMEOUT: PRINT @(0,YM-2),’CE’,; RETURN 
5070 END 

Last Modified: 02/23/2004 Product: PRO/5 Operating System: All platforms

BASIS structures five components of their technology into the BBx Generations.