|
DataMuseum.dkPresents historical artifacts from the history of: Ohio Scientific Inc. |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Ohio Scientific Inc. Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 5104 (0x13f0)
Notes: OS65UFile, OSU65U-BASIC
Names: »REMOVE«
└─⟦2f57871a3⟧ Bits:30009355 Ohio Scientific OS-OMS Nucleus, delvist oversat til dansk
└─⟦this⟧ »REMOVE«
00001 PRINT"** PROGRAM NOT EXECUTABLE FROM THE CONSOLE **":RUN"DBMSYS","PASS" 00002 CLOSE:CLEAR:REM 1/79 RECORD DELETE & REPACK (REMOVE) 00003 REM 00004 REM LINES 1-200 SET FLGS,POKES,VARIABLES,ETC. 00005 K0=0:K1=1:K2=2:K3=3:K4=4:K5=5:K6=6:K7=7:K8=8:K9=9:KW=10:KZ=32 00006 FORX=K1TOKZ:PRINT:NEXT:FLAG11:FLAG9:REM FLG11-SPACE SUPP FLG9-50,000 00007 DIML$(100),FL(100),FP(100),D$(100) 00010 REM PEEK FOR CURRENT DEVICE 00011 DV(K1)=PEEK(9832):IFDV(K1)>127THENDV(K1)=DV(K1)-128+K4 00012 DV$(K1)=CHR$(DV(K1)+65) 00020 PRINT:PRINT"OS-DMS RECORD DELETE & REPACK":PRINT"-----------------------------":PRINT 00197 REM 00198 REM *************** MASTER FILE VERIFICATION *************** 00199 REM 00200 INPUT"DEVICE MASTER FILE IS STORED ON ";DV$(K2):PRINT 00205 IF DV$(K2)="" THEN DV$(K2)=DV$(K1): GOTO 300 00210 IFLEN(DV$(K2))>K1THENPRINT:PRINT"WHAT!":GOTO200 00215 IFDV$(K2)<"A"ORDV$(K2)>"E"THENPRINT:PRINT"WHAT!":GOTO200 00297 REM 00298 REM *************** PICKUP FILENAME & PASSWORD *************** 00299 REM 00300 INPUT"MASTER FILE NAME,PASSWORD ";M$,P$:PRINT 00305 IFM$=""ORP$=""THENPRINT:PRINT"WHAT!":GOTO300 00310 IFLEN(M$)<K5THENM$=M$+" ":GOTO310 00315 IFLEN(M$)=K6ANDRIGHT$(M$,K1)="0"GOTO330 00320 IFLEN(M$)>=6THENPRINT:PRINT"IMPROPER FILENAME":GOTO300 00325 IFLEN(M$)<K6THENM$=M$+"0":REM XXXXX0 00330 IFP$="."ORP$="."THENP$="ANAN" 00335 IFLEN(P$)<>K4THENPRINT:PRINT"IMPROPER PASSWORD":GOTO300 00340 DEVDV$(K2):REM SELECT NEW DEVICE 00345 OPENM$,P$,K1:REM OPEN FILE 00350 PRINT:PRINT"PLEASE WAIT":PRINT 00397 REM 00398 REM *************** VERIFY FILE NAME IN HEADER *************** 00399 REM 00400 INDEX<K1>=K0:INPUT%K1,N$:IFN$=LEFT$(M$,K5)GOTO410 00405 ERR$="FILE HEADER MISMATCH":GOTO40000:REM ERROR HANDLER 00410 INDEX<K1>=K6:INPUT%K1,TY:REM VERIFY MASTER FILE TYPE 00415 IFTY<>KWTHENERR$="NOT A MASTER FILE TYPE":GOTO40000 00420 INDEX<K1>=K9:INPUT%K1,EODF:REM GET END OF DATA INDEX 00425 INDEX<K1>=20:INPUT%K1,BODF:REM GET START OF DATA INDEX 00430 REM CHK IF DATA EXIST IN FILE 00435 IFEODF<=BODFTHENERR$="FILE EMPTY":GOTO40000 00440 INDEX<K1>=31:INPUT%K1,RL:REM GET RECORD LENGTH 00445 INDEX<K1>=42:INPUT%K1,NR:REM GET # OF RECORDS 00450 REM DOUBLE CHK FOR DATA IN THE FILE 00455 IFNR<K1THENERR$="FILE EMPTY":GOTO40000 00460 REM EVERYTHING IN THE FILE SEEMS 'OK' 00465 REM GET FIELD NAMES,LENGTHS & OFFSETS 00470 REM L$(N)=NAME FL(N)=LENGHT FP(N)=OFFSET 00475 TT=K0:TF=K1:A1=480:INDEX<K1>=53:REM TT=OFFSET TF=# OF FIELDS 00480 INPUT%K1,L$(TF):INPUT%K1,FL(TF):FP(TF)=TT 00485 T=TT+FL(TF):IFINDEX(K1)<BODFTHENTF=TF+K1:GOTOA1 00490 IFINDEX(K1)>BODFTHENERR$="FILE HEADER ERROR":GOTO40000 00495 REM ALL FIELD NAMES,LENGHTS & OFFSETS ARE ENTERED & SET 00497 REM 00498 REM *************** INPUT DELETE SPECIFICATIONS *************** 00499 REM 00500 INPUT"DELETE BLANK RECORDS STARTING AT RECORD # ";A$:A=VAL(A$) 00505 IFA<>INT(A)THENPRINT:PRINT"WHAT!":GOTO500 00507 IF A>=1 GOTO 510 00508 A=1: PRINT: INPUT"WILL START WITH RECORD NUMBER ONE (OK) ";QA$ 00509 IF LEFT$(QA$,1)="N" THEN PRINT: GOTO 500 00510 JZ=INT((EODF-BODF)/RL):IFA<=JZGOTO520 00515 PRINT"* LAST RECORD IN FILE IS RECORD #";JZ;"*":PRINT:GOTO500 00520 FORX=K1TOKZ:PRINT:NEXT:PRINT"PLEASE WAIT" 00525 IF LEN(S1$)<71 THEN S1$=S1$+" ": GOTO 525 00597 REM 00598 REM *************** DELETE & REPACK ROUTINE *************** 00599 REM 00600 EN=INT((EODF-BODF)/RL): WR=A-K1: RE=WR: REM READ/WRITE START 00610 FOR X=K1 TO TF: FL(X)=FL(X)-K1: NEXT: REM LEN NOW PRIMED 00620 TB=K0: A1=630: A3=700: A4=760: A6=720 00630 IF RE>=EN GOTO A6: REM AT END SO BYE BYE ! 00640 INDEX<K1>=BODF+(RE*RL): INPUT %K1,D$(K1): REM GET 1ST FIELD 00650 IF D$(K1)="^P" THEN RE=RE+K1: TB=TB+K1: GOTO A1: REM KILL IT 00660 IF D$(K1)<>"0" AND RE=WR THEN RE=RE+K1: WR=WR+K1: GOTO A1 00670 INDEX<K1>=BODF+(RE*RL): B=K0: FOR X=K1 TO TF: INPUT %K1,D$(X) 00680 IF D$(X)<>"0" AND RE=WR THEN RE=RE+K1: WR=WR+K1: GOTO A1 00685 IF D$(X)<>"0" THEN B=B+K1: REM F NOT EMPTY 00690 NEXT: IF B>K0 GOTO A3: REM MOVE THIS RECORD 00695 RE=RE+K1: TB=TB+K1: GOTO A1: REM KILL THIS ONE 00700 INDEX<K1>=BODF+(WR*RL): FOR X=K1 TO TF 00710 PRINT %K1,RIGHT$(S1$+D$(X),FL(X)): NEXT: RE=RE+K1: WR=WR+K1: GOTO A1 00720 IF TB=K0 GOTO A4: REM IF NO BLANKS NOTHING TO DO 00730 EODF=EODF-(TB*RL): INDEX<K1>=EODF: FOR X=K1 TO TB 00740 FOR Y=K1 TO TF: PRINT %K1,RIGHT$(S1$,FL(Y)): NEXT: NEXT X 00750 INDEX<K1>=K9: PRINT %K1,EODF: REM UPDATE NEW EODF 00760 GOTO 51100: REM BYE BYE 00897 REM 00898 REM *************** ERROR HANDLER IN LINE 40,000 ON *************** 00899 REM 40000 REM ERROR EXPANSION GOES HERE 40010 PRINT:PRINTERR$:PRINT:CLOSE:GOTO51000:REM COMMON EXIT PATH 50000 REM LINE 50,000 ERROR HANDLER 50010 ER=PEEK(10226):EL=PEEK(11774)+PEEK(11775)*256 50015 REM CHK FOR 'NON-EXISTANT ENTRY ERROR' 50020 IFER=128THENERR$="INVALID FILENAME":GOTO51050 50025 REM CHK FOR 'END OF FILE HIT' ERROR 50030 IFER=132THENERR$="END OF FILE ERROR":GOTO51000 50035 REM CHK FOR ACCESS RIGHTS VIOLATION 50040 IFER=130THENERR$="ACCESS RIGHTS VIOLATION":GOTO51000 50045 REM MAYBE A SYSTEM ERROR I.E. CHANNEL NOT OPEN ERROR 50050 IFER=129THENERR$="CANNOT ACCESS FILE":GOTO51050 50055 REM OTHER ERRORS ARE HARD ERRORS 50060 ERR$="DISC ERROR CODE "+STR$(ER)+" IN LINE "+STR$(EL) 50065 REM PICKUP DISC ADDR. WHERE ERROR OCCURED 50070 EA=K0: FORI=K1TOK1STEP-K1:EA=EA*256+PEEK(9889+I):NEXT 50080 DV(K4)=PEEK(9832):IFDV(K4)>127THENDV(K4)=DV(K4)-128+K4 50090 PRINT"ERROR ON DEVICE "+CHR$(DV(K4)+65)+" AT DISC ADDRESS";EA 51000 REM ERROR MESSAGE PRINT CODE ENTRY AT '51000' CLOSES FILE 51020 CLOSE 51040 REM ENTRY ST '51050' DOES NOT CLOSE THE CHANNEL 51050 PRINT:PRINT:PRINT"***** ERROR *****":PRINT:PRINT 51051 XC=XC+1:IFXC<2GOTO51060 51052 PRINT"** CHECK TO SEE IF THE DISKETTE(S) ARE IN THE PROPER DRIVE **" 51060 PRINT ERR$: ERR$="" 51100 REM COMMON EXIT PATH 51101 IFER<1THENFORX=1TO32:PRINT:NEXT 51105 IFER<1THENPRINT"*** END OF DELETE & REPACK ***" 51106 PRINT:INPUT"ENTER A C TO CONTINUE ";QS$:FORX=1TO32:PRINT:NEXT 51110 DEVCHR$(DV(K1)+65):REM SELECT ORIGINAL DEVICE 51120 POKE2972,58:POKE2976,44:REM DISABLE :,& IN DATA FIELD 51130 FLAG12:REM DISABLE SPACE SUPP 51150 CLOSE:RUN"DBMSYS","PASS"