DataMuseum.dk

top - metrics - download

    Length: 9200 (0x23f0)
    Notes: OS65UFile, OSU65U-BASIC
    Names: »SEEDLD«

└─⟦2f57871a3⟧ Bits:30009355 Ohio Scientific OS-OMS Nucleus, delvist oversat til dansk
    └─⟦this⟧ »SEEDLD« 

BASIC

00002 REM
00010 REM     OS-65U DATA BASE MANAGEMENT SYSTEM
00020 REM       7/78  EDIT MASTER FILE
00030 REM
00099 CLOSE
00100 FLAG 1 :REM DISABLE CLOSE ON ERROR FEATURE
00101 POKE 2976,13:POKE 2972,13:REM ALLOW (,) & (:) IN FILES
00110 FLAG 11
00120 FLAG 9 :REM WE CHECK & DECODE DISC ERRORS
00130 NE$="*":NC$="":EE$="/"
00196 POKE 2888,0
00197 REM
00198 REM
00250 FOR I=1 TO 25:PRINT:NEXT I
00260 PRINT"MASTER FILE SEED LOADER"
00270 PRINT"-----------------------"
00294 REM GET CURRENT DEVICE NUMBER
00295 DV(2)=PEEK(9832):IF DV(2)>127 THEN DV(2)=DV(2)-128+4
00296 DV$(2)=CHR$(DV(2)+65)
00297 REM
00298 REM 
00299 REM     GET DEV/FILENAME/PASSWORD
00300 INPUT"DEVICE MASTER FILE STORED ON ";DV$(1)
00310 DV$(1)=LEFT$(DV$(1),1)
00311 IF DV$(1)>="A" AND DV$(1)<="E" GOTO 320
00312 PRINT:PRINT" ENTER MASS STORAGE DEVICE"
00313 PRINT"  A,B,C,D  FLOPPY DISK"
00314 PRINT"  E        HARD DISK":PRINT:GOTO 300
00320 INPUT"FILE NAME ";F$(1)
00321 IF LEN(F$(1))>5 THEN PRINT"** FIVE CHARACTER MAXIMUM **":GOTO 320
00322 IF LEN(F$(1))=0 GOTO 320
00325 IF LEN(F$(1))<5THENFOR I=0TO(4-LEN(F$(1))):F$(1)=F$(1)+" ":NEXT I
00330 F$(1)=LEFT$(F$(1),5) : F$(2)=F$(1)+"0"
00340 INPUT"PASSWORD ";PW$
00345 IF PW$="." THEN PW$="ANAN"
00347 IF LEN(PW$)<4 THEN PRINT"** INVALID PASSWORD **":GOTO 340
00350 IF LEN(PW$)>4 THEN PRINT"*** INVALID PASSWORD FORMAT ***":GOTO 340
00360 POKE 2888,27
00397 REM
00398 REM
00399 REM     GET MASTER HEADER INFO
00400 DEV DV$(1) : OPEN F$(2),PW$,1
00410 INPUT%1,T$: IF T$<> F$(1) THEN ERR=1: GOTO 30000
00420 INDEX<1>=6: INPUT%1,TY: IF TY<>10 THEN ERR=2: GOTO 30000
00430 INDEX<1>=9: INPUT%1,EODF
00440 INDEX<1>=20:INPUT%1,BODF
00450 INDEX<1>=31:INPUT%1,RL
00460 INDEX<1>=42:INPUT%1,RN
00470 INDEX<1>=53:N=1: REM  DETERMINE NUMBER OF FIELDS
00480 INPUT%1,T$: INPUT%1,T
00490 IF INDEX(1)<BODF THEN N=N+1: GOTO 480
00500 INDEX<1>=53:DIM FDLB$(N),FL(N),FC$(N),C$(N)
00510 FOR I=1 TO N:INPUT%1,FDLB$(I):INPUT%1,FL(I): FL(I)=FL(I)-1:NEXT I
00528 REM
00529 REM
00530 FOR I=1 TO 24:PRINT:NEXT I: REM CLEAR SCREEN
00547 GOTO 564
00548 REM
00549 REM     OUTPUT CONTROL CHARACTER LEGEND
00550 PRINT"CHARACTER   CONTROL FUNCTION"
00551 PRINT
00552 PRINT"    *         ERASES CURRENT FIELD CONTENTS"
00553 PRINT"    /         RETURNS TO PREVIOUS QUESTION"
00554 PRINT"   (CR)       UNLESS OTHER WISE STATED A CARRIDGE RETURN"
00555 PRINT"               WITH NO ENTRY WILL MEAN: YES CONTINUE"
00560 PRINT:PRINT
00561 FOR I=1 TO 5: PRINT: NEXT I
00562 POKE 2888,0:INPUT"TO CONTINUE INPUT C ";J$:POKE 2888,27
00564 FOR I=1 TO 26:PRINT:NEXT I
00578 REM
00579 REM     MAKE CURSOR STRINGS
00580 FOR I=1 TO N:C$(I)=""
00582 FOR J=1 TO FL(I):C$(I)=C$(I)+"-":NEXT J
00584 NEXT I
00597 REM
00598 REM
00599 REM     OUTPUT SAMPLE RECORD
00600 FOR I=1 TO N:REM FILL SAMPLE RECORD WITH DASHES
00610 FC$(I)=C$(I)
00620 NEXT I
00640 PRINT"FILE: ";F$(1)
00680 GOSUB 10120: REM GO PRINT SAMPLE RECORD
00685 FOR I=1 TO N:FC$(I)="":NEXT I
00690 RPTR=1:FPTR=1:GOTO 20000
00697 REM
00698 REM
00699 REM     DETERMINE RECORD NUMBER
00700 PRINT:PRINT"RECORD SELECTION TECHNIQUES":PRINT
00701 X=RPTR
00711 PRINT"(#) RECORD NUMBER ((A) FOR APPENEND)"
00712 PRINT"(L)  LABEL/CONTENTS SEARCH"
00713 PRINT"(K)  KEYFILE CONTENTS SEARCH"
00714 PRINT"(S)  SEARCH MASTER FOR MATCH"
00715 PRINT"(E)  EXIT                     ";
00720 POKE 2888,0:INPUT SM$: POKE 2888,27
00722 IF SM$=NC$ THEN X=X+1: GOTO 820
00724 IF SM$=NE$ GOTO 790
00726 IF SM$=EE$ THEN SM$="E":GOTO 765
00730 IF SM$="#" THEN PRINT"ENTER RECORD NUMBER ":GOTO 720
00740 IF SM$="L" GOTO 5000: REM GOTO LABEL/CONTENT SEARCH
00750 IF SM$="K" THEN PRINT"SORRY NOT AVAIABLE-TRY S":GOTO 720
00755 IF SM$="A" GOTO 3000: REM GO FIND EODF RECORD+1
00760 IF SM$="S" GOTO 2000
00765 IF SM$="E" GOTO 50080: REM GOTO COMMON EXIT
00770 X=ASC(LEFT$(SM$,1))
00780 IF X>47 AND X<58 THEN X=VAL(SM$): GOTO 800
00790 PRINT"*** INVALID ENTRY ***": GOTO 700
00800 IF X=INT(X) GOTO 807
00802 PRINT"*** ENTER INTEGER NUMBERS ONLY ***":GOTO 700
00807 IF X>0 AND X<=RN GOTO 820
00810 PRINT"*** INVALID RECORD NUMBER ***":SM$="#":GOTO 730
00820 RPTR=X: REM COMMON EXIT FROM DETERMINE RECORD
00897 FOR I=1 TO 25:PRINT:NEXT I
00898 REM
00899 REM     OUTPUT CURRENT RECORD
00900 GOSUB 10000:REM  GO GET CURRENT RECORD CONTENTS
00905 GOSUB 10100:REM  GO PRINT CURRENT RECORD CONTENTS
00906 REM
00908 REM
00909 REM     INPUT AND DECODE FIELD NAME/NUMBER
00910 POKE 2888,0:INPUT"FIELD LABEL OR NUMBER ";W$: POKE 2888,27
00911 IF W$=NC$ THEN W$="1":IF W$=NE$ GOTO 910
00912 IF W$=EE$ AND LEN(W$)=1 THEN PRINT:PRINT:PRINT: FPTR=1: GOTO 700
00913 X=ASC(LEFT$(W$,1))
00914 IF X>47 AND X<58 THEN W=VAL(W$):GOTO 930
00916 FOR I=1 TO N:IF FDLB$(I)=W$ THEN W=I:GOTO 930
00918 NEXT I
00920 PRINT"*** FIELD ";W$;" NOT FOUND IN FILE ";F$(1);" ***":GOTO 910
00930 IF W>=1 AND W<=N THEN FPTR=W:GOTO 950
00931 PRINT"*** FIELD NUMBER ";W;" NOT FOUND IN FILE ";F$(1):GOTO 910
00950 GOSUB 10000:REM GET CURRENT FILE
00997 REM
00998 REM
00999 REM     EDIT AND SAVE RECORD
01000 FOS=0:FOR I=1 TO (FPTR-1):FOS=FOS+FL(I)+1:NEXT I
01010 INDEX<1>=BODF+((RPTR-1)*RL)+FOS
01020 IF INDEX(1)>=EODF THEN FC$(FPTR)="** FIELD EMPTY **"
01040 PRINT
01050 PRINT"FIELD: ";FDLB$(FPTR)
01060 PRINT TAB(5);FC$(FPTR)
01070 PRINT TAB(5);C$(FPTR)
01120 PRINT TAB(3);
01140 POKE 2888,0:INPUT S$:POKE 2888,27
01142 IF S$=NC$ GOTO 1240
01144 IF S$=EE$ AND LEN(S$)=1 THEN FPTR=1:GOTO 910
01145 IF S$<>NE$ GOTO 1160
01146 S$="":FOR I=1 TO (FL(FPTR)-1):S$=S$+"":NEXT I
01147 S$=S$+"0"
01160 IF LEN(S$)<=FL(FPTR) GOTO 1195
01180 PRINT:PRINT"*** SEED TOO LONG FOR FIELD ***"
01181 PRINT"OVERRUN OCCURRED AT RECORD: ";RPTR;" FIELD: ";FPTR
01182 PRINT:PRINT:PRINT:GOTO 50080
01190 GOTO 1070
01195 IF LEN(S$)=FL(FPTR) GOTO 1205
01200 FOR I=1 TO (FL(FPTR)-LEN(S$)): S$=" "+S$:NEXT I
01205 IF FPTR=1 THEN FOS=0 : GOTO 1220
01210 FOS=0:FOR I=1 TO(FPTR-1):FOS=FOS+FL(I)+1:NEXT I
01220 INDEX<1>=BODF+FOS+((RPTR-1)*RL):PRINT%1,S$
01225 IF INDEX(1)>EODFTHENEODF=BODF+(RPTR*RL):INDEX<1>=9:PRINT%1,EODF
01240 FPTR=FPTR+1
01260 IF FPTR<=N THEN J=J+1:GOTO 20050
01265 GOTO 25000
01280 GOSUB 10000:GOSUB 10100
01281 POKE 2888,0
01282 INPUT"IS THIS CORRECT ";A$
01283 POKE 2888,27: IF A$=NC$ THEN A$="Y"
01284 IF LEFT$(A$,1)="Y" THEN FOR H=1 TO 25:PRINT:NEXT H: GOTO 1290
01286 IF LEFT$(A$,1)="N" GOTO 910
01288 PRINT"*** YES (Y) OR NO (N) ***": GOTO 1281
01290 RPTR=RPTR+1: FOR I=1 TO N: FC$(I)="": NEXT I
01291 FOR I=1 TO N: FC$(I)="":NEXT I
01300 IF RPTR<=RN THEN FPTR=1:GOSUB 10000:GOSUB 10100:GOTO 1000
01320 PRINT"** END OF FILE **"
01360 GOTO 50080: REM GOTO COMMON EXIT
01998 REM
01999 REM     SIMPLE SEARCH ROUTINE
02000 POKE 2888,0:PRINT"SEARCH STRING (MAXIMUM OF 32 CAHRACTERS)"
02001 INPUT ST$:POKE 2888,27
02002 IF LEN(ST$)=0 GOTO 2000
02010 INDEX<1>=BODF
02020 FIND ST$,1
02030 IF INDEX(1)>=1E9 THEN MS=1: GOTO 2100
02040 SPTR=0:M=1:SPTR=BODF
02050 SPTR=SPTR+RL
02060 IF SPTR>INDEX(1) THEN X=M: GOSUB 4000: GOTO 820: REM RECORD FOUND
02070 IF SPTR>=EODF THEN MS=2:GOTO 2100
02080 M=M+1: IF M>RN THEN MS=3: GOTO 2100
02090 GOTO 2050
02100 IF MS=1 THEN PRINT ST$;" NOT FOUND I FILE ";F$(1): GOTO 700
02110 IF MS=2 THEN PRINT ST$;" NOT FOUND BEFORE CURRENT END OF FILE"
02115 IF MS=2 GOTO 700
02120 IF MS=3 THEN MS=1: GOTO 2100
02998 REM
02999 REM     FIND RPTR FOR APPENEND MODE
03000 R=0
03010 IF R=RN+1 THEN PRINT"*** FILE FULL ***": GOTO 700
03020 IF BODF+(R*RL)=EODF THEN X=R+1: GOTO 820: REM GO GET RECORD
03030 R=R+1: GOTO 3010
03998 REM
03999 REM     SUB TO CONTINUE SEARCH
04000 RPTR=X:GOSUB 10000: GOSUB 10100: REM OUTPUT RECORD
04010 PRINT:POKE 2888,0:INPUT"IS THIS THE CORRECT RECORD ";Z$
04015 POKE 2888,27:IF LEN(Z$)=0 THEN Z$="Y"
04020 IF LEFT$(Z$,1)="Y" THEN RETURN
04030 IF LEFT$(Z$,1)<>"N" THEN PRINT"**** YES OR NO ****": GOTO 4010
04040 INDEX<1>=INDEX(1)+LEN(ST$)
04050 GOTO 2020 : REM CONTINUE SEARCH
04998 REM
04999 REM    LABEL/CONTENT SEARCH
05000 PRINT
05010 PRINT"FIELD LABELS"
05020 FOR I=1 TO N: PRINT TAB(3);FDLB$(I): NEXT I
05030 PRINT
05040 POKE 2888,0:POKE 2976,44:POKE 2972,58:G$="":H$=""
05041 INPUT"LABEL,CONTENTS ";G$,H$:POKE 2976,13:POKE 2972,13
05042 POKE 2888,27: IF G$="" OR H$="" GOTO 5000
05043 REM
05044 REM
05045 REM
05046 REM
05047 REM
05050 FOR I=1 TO N:IF G$=FDLB$(I) GOTO 5070
05055 NEXT I
05060 PRINT"**** ";G$;" NOT A VALID FIELD LABEL ****":GOTO 5000
05070 G=I
05080 INDEX<1>=BODF
05090 FIND H$,1
05100 IF INDEX(1)>=1E9 THEN MS=1: GOTO 5200
05110 SPTR=BODF:M=1
05120 SPTR=SPTR+RL
05130 IF SPTR>INDEX(1) THEN X=M:GOTO 5300
05140 IF SPTR>=EODF THEN MS=2:GOTO 5200
05150 M=M+1:IF M>RN THEN MS=3:GOTO 5200
05160 GOTO 5120
05198 REM
05199 REM
05200 PRINT
05210 IF MS=1 THEN PRINT H$;" NOT FOUND IN FILE": GOTO 700
05220 IF MS=2 THEN PRINT H$;" NOT FOUND BEFORE END OF FILE MARKER"
05230 IF MS=2 GOTO 700
05240 IF MS=3 THEN MS=1:GOTO 5210
05298 REM
05299 REM     CHECK LABEL/CONTENTS
05300 RPTR=X:GOSUB 10000: REM   GO GET RECORD CONTENTS
05310 IF H$=FC$(G) GOTO 5330
05320 GOTO 5400: REM NO MATCH TRRY AGAIN
05330 IF G$<>FDLB$(G) GOTO 5400
05340 GOSUB 10100: REM OUTPUT RECORD
05350 POKE 2888,0:INPUT"IS THIS THE CORRECT RECORD ";U$:POKE 2888,27
05360 IF LEFT$(U$,1)="Y" GOTO 820
05370 IF LEFT$(U$,1)<>"N" THEN PRINT"*** YES OR NO ***": GOTO 5350
05400 INDEX<1>=INDEX(1)+LEN(H$)
05410 GOTO 5090
09994 REM
09995 REM
09996 REM
09997 REM     SUBROUTINES
09998 REM
09999 REM     SUB 1  GET CURRENT RECORD CONTENTS
10000 INDEX<1>=((RPTR-1)*RL)+BODF
10020 FOR I=1 TO N: FC$(I)=""
10032 INPUT%1,FC$(I)
10035 FOS=0:FOR K=1 TO N:FOS=FOS+FL(K)+1:NEXT K
10080 NEXT I:RETURN
10098 REM
10099 REM     SUB 1.2  PRINT CURRENT RECORD CONTENTS
10100 PRINT
10110 PRINT"RECORD: ";RPTR
10120 PRINT
10130 PRINT"FIELD";TAB(36);"CONTENTS"
10140 PRINT"*****";TAB(36);"********"
10150 PRINT
10160 FOR I=1 TO N
10170 PRINT I;FDLB$(I);TAB(35);FC$(I):NEXT I
10180 PRINT: RETURN
19997 REM
19998 REM
19999 REM     SEED PATCH IN
20000 FOR I=1 TO N
20005 PRINT TAB(12);FL(I)
20010 PRINT"SEED: ";I;
20020 INPUT SEED$(I)
20040 NEXT I
20041 J=1:PRINT:PRINT"PLEASE WAIT"
20050 A$=STR$(FPTR):B$=STR$(RPTR)
20055 A$=RIGHT$(A$,LEN(A$)-1):B$=RIGHT$(B$,LEN(B$)-1)
20060 S$=A$+SEED$(J)+B$
20070 GOTO 1142
25000 RPTR=RPTR+1:FPTR=1:J=1
25005 PRINT"NOW WORKING ON RECORD ";RPTR
25010 IF RPTR<=RN GOTO 20050
25020 PRINT"   FILE LOADED WITH SEEDS"
25030 GOTO 50080
30000 IF ERR=1 THEN PRINT"*** FILE NAME MISMATCH ***":GOTO 30100
30010 IF ERR=2 THEN PRINT"*** FILE TYPE MISMATCH ***":GOTO 30100
30020 GOTO 50080
30100 PRINT"*** LOCATED FILE MISMATCH BEFORE CONTINUING":GOTO 50080
50000 DE=PEEK(10226): REM GET DISC ERR #
50002 DL=PEEK(11774)+PEEK(11775)*256:REM LINE NUMBER
50003 IF DE=128 AND DL=400 THEN PRINT"*** FILE NOT FOUND ***":GOTO 294
50005 IF DE=128 THEN PRINT"*** FILE NOT FOUND ***":GOTO 52000
50020 IF DE=129 THEN PRINT"*** CHANNEL NOT OPEN ***":GOTO 52000
50030 IF DE=130 THEN PRINT"*** ACCESS RIGHT VIOLATION ***":GOTO 52000
50040 IF DE=131 THEN PRINT"*** EXECUTABILITY VIOLATION ***":GOTO 52000
50050 IF DE=132 THEN PRINT"*** END OF FILE ***":GOTO 52000
50060 IF DE=133 THEN PRINT"*** CHANNEL ALREADY OPEN ***":GOTO 52000
50070 PRINT"*** DISC ERROR ";DE;" LINE ";DL;" ***"
50080 CLOSE: DEV DV$(2):FLAG 2:FLAG 12:FLAG 10
50085 POKE 2976,44:POKE 2972,58
50090 RUN"DBMSYS","PASS"
52000 PRINT "*** LINE ";DL;" ***" :GOTO 50080