|
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: 11264 (0x2c00)
Types: TextFile
Names: »BASETEST«
└─⟦eca9022c5⟧ Bits:30002661 Datalære sådan - løsningsdiskette
└─ ⟦this⟧ »BASETEST«
0010 // dette er et program, der aftester databasesystemet 0015 DIM svar$ OF 1,søge$ OF 20,søgefelt$ OF 8 0016 n:= 0 0020 EXEC omgivelser 0025 REPEAT 0030 CLEAR 0040 PRINT "vælg opgave" 0050 PRINT " 1. valg af register" 0060 PRINT " 2. indlæsnig af poster" 0070 PRINT " 3. udskrivning af hele registeret" 0080 PRINT " 4. søgning en bestemt post" 0090 PRINT " 5. søgning et ebestemt felt" 0100 PRINT " 6. rette en post" 0110 PRINT " 7. slette en post" 0120 PRINT " 8. slette register" 0130 PRINT 0140 INPUT "tast opgave:": nr 0150 IF nr=1 THEN 0160 INPUT "reg-navn: ": filnavn$ 0170 INPUT "Nyt/Gammelt": svar$ 0180 IF svar$ IN "Nn" THEN EXEC opret(filnavn$) 0190 EXEC brug(filnavn$) 0200 ENDIF 0210 // 0220 IF nr=2 THEN 0230 CLEAR 0240 svar$:= "J" 0250 REPEAT 0260 EXEC indlæspost 0270 INPUT "flere poster (J/N):": svar$ 0280 UNTIL svar$ IN "Nn" 0290 ENDIF 0300 // 0310 IF nr=3 THEN 0320 CLEAR 0330 EXEC brugskærm 0340 EXEC skrivud(1,antalposter) 0350 ENDIF 0360 // 0370 IF nr=4 THEN 0380 CLEAR 0390 INPUT "tast søgenøgle: ": søge$ 0400 EXEC findipost(søge$) 0410 ENDIF 0420 // 0430 IF nr=5 THEN 0440 CLEAR 0450 INPUT "tast søgefeltets navn: ": søgefelt$ 0460 INPUT "tast søgenøglen: ": søge$ 0470 EXEC findifelt(søgefelt$,søge$) 0480 ENDIF 0490 // 0500 IF nr=6 THEN 0510 CLEAR 0520 INPUT "hvad skal rettes: ": søge$ 0530 fra:= 1 0540 REPEAT 0550 lokaliser(søge$,fra,antalposter,n) 0560 IF n>0 THEN 0570 EXEC vispost(n) 0580 INPUT "-skal den rettes:": svar$ 0590 IF svar$ IN "Jj" THEN EXEC retpost(n) 0600 ENDIF 0610 fra:= n+1 0620 UNTIL n<0 0630 ENDIF 0640 // 0650 IF nr=7 THEN 0660 CLEAR 0670 INPUT "hvad skal slettes: ": søge$ 0680 fra:= 1 0690 REPEAT 0700 lokaliser(søge$,fra,antalposter,n) 0710 IF n>0 THEN 0720 EXEC vispost(n) 0730 INPUT "-skal den slettes: ": svar$ 0740 IF svar$ IN "Jj" THEN EXEC sletpost(n) 0750 ENDIF 0760 fra:= n+1 0770 UNTIL n<0 0780 ENDIF 0790 // 0800 UNTIL nr<=0 0810 //------------------------------------------------------------ 1000 PROC omgivelser 1010 DIM filnavn$ OF 8,feltnavne$(10) OF 8,felt$ OF 8 1020 antalfelter:= 0 1030 postlængde:= 0 1040 antalposter:= 0 1050 skærmpå:= TRUE 1060 ENDPROC omgivelser 1070 // 1080 // 1500 PROC opret(filnavn$) CLOSED 1510 CLOSE // lukker eventuelt fejlagtigt åbne filer 1520 IMPORT antalfelter,postlængde,antalposter,feltnavne$ 1530 CLEAR 1540 INPUT "hvor mange felter i en post: ": antalfelter 1550 postlængde:= 25*antalfelter 1560 DIM postindhold$(antalfelter) OF 25,post$ OF postlængde 1570 DIM felter$ OF 8*antalfelter 1580 felter$:= "" 1590 post$:= "" 1600 FOR i:= 1 TO antalfelter DO 1610 PRINT "navn på felt nr ";i;" (max 8 tegn)"; 1620 INPUT ":": feltnavne$(i) 1630 t:= LEN(feltnavne$(i))+1 1640 FOR l:= t TO 8 DO feltnavne$(i)(l:l):= " " 1650 felter$:= felter$+feltnavne$(i) 1660 postindhold$(i):= " " 1670 post$:= post$+postindhold$(i) 1680 NEXT i 1690 CREATE filnavn$+".RAN",(postlængde*101) DIV 1024+1 1700 CREATE filnavn$+".def",1 1710 OPEN FILE 1,filnavn$+".RAN", RANDOM postlængde+2 1720 OPEN FILE 2,filnavn$+".DEF", RANDOM 90 1730 WRITE FILE 2,1: antalfelter,felter$ 1740 FOR i:= 1 TO 100 DO 1750 WRITE FILE 1,i: post$ 1760 NEXT i 1770 WRITE FILE 1,101: antalposter 1780 CLOSE 1790 ENDPROC opret 2000 PROC brug(filnavn$) CLOSED 2005 CLOSE // lukker evt fejlagtigt åbne filer 2010 IMPORT antalfelter,postlængde,antalposter,feltnavne$ 2015 DIM felter$ OF 80 2020 OPEN FILE 2,filnavn$+".DEF", RANDOM 90 2030 READ FILE 2,1: antalfelter,felter$ 2040 CLOSE FILE 2 2041 FOR i:= 1 TO antalfelter DO feltnavne$(i):= felter$((i-1)*8+1:i*8) 2050 postlængde:= antalfelter*25 2060 OPEN FILE 1,filnavn$+".RAN", RANDOM postlængde+2 2070 READ FILE 1,101: antalposter 2080 ENDPROC brug 2090 // 2100 // 2500 PROC indlæspost CLOSED 2510 IMPORT antalfelter,antalposter,feltnavne$,postlængde 2520 DIM svar$ OF 1,postindhold$(antalfelter) OF 25 2525 DIM post$ OF postlængde 2526 post$:= "" 2530 nr:= antalposter+1 2540 CLEAR 2550 FOR i:= 1 TO antalfelter DO 2560 PRINT AT(1,i),"felt nr ";i;" ";feltnavne$(i); 2570 PRINT " <" 2580 INPUT AT(21,i),":": postindhold$(i) 2590 NEXT i 2600 INPUT AT(10,12),"- kan posten godkendes (J/N): ": svar$ 2610 IF svar$ IN "Nn" THEN 2620 REPEAT 2630 INPUT AT(10,14),"Hvilket feltnr skal rettes (0 stopper rettelse)?": i 2640 IF 0<i AND i<11 THEN 2650 PRINT AT(21,i)," <" 2660 INPUT AT(21,i),":": postindhold$(i) 2670 ENDIF 2680 PRINT AT(10,14)," "; 2690 PRINT " " 2700 UNTIL i<=0 2710 ENDIF 2711 FOR i:= 1 TO antalfelter DO 2712 FOR j:= LEN(postindhold$(i))+1 TO 25 DO postindhold$(i)(j:j):= " " 2713 post$:= post$+postindhold$(i) 2714 NEXT i 2720 WRITE FILE 1,nr: post$ 2730 antalposter:= antalposter+1 2740 WRITE FILE 1,101: antalposter 2750 ENDPROC indlæspost 3000 PROC retpost(nr) CLOSED 3010 IMPORT antalfelter,feltnavne$,antalposter,postlængde 3020 DIM svar$ OF 1,postindhold$(antalfelter) OF 25,post$ OF postlængde 3030 IF 0<nr AND nr<=antalposter THEN 3040 READ FILE 1,nr: post$ 3050 FOR f:= 1 TO antalfelter DO postindhold$(f):= post$((f-1)*25+1:f*25) 3060 CLEAR 3070 FOR i:= 1 TO antalfelter DO 3080 PRINT AT(1,i+1),"felt nr ";i;" ";feltnavne$(i); 3090 PRINT " <" 3100 PRINT AT(21,i+1),":";postindhold$(i) 3110 NEXT i 3120 REPEAT 3130 INPUT AT(10,14),"Hvilket feltnr skal rettes (0 stopper rettelse)?": i 3140 IF 0<i AND i<11 THEN 3150 PRINT AT(21,i+1)," <" 3160 INPUT AT(21,i+1),":": postindhold$(i) 3170 ENDIF 3180 PRINT AT(10,14)," "; 3190 PRINT " " 3200 UNTIL i<=0 3210 post$:= "" 3220 FOR i:= 1 TO antalfelter DO 3230 FOR j:= LEN(postindhold$(i))+1 TO 25 DO postindhold$(i)(j:j):= " " 3240 post$:= post$+postindhold$(i) 3250 NEXT i 3260 WRITE FILE 1,nr: post$ 3270 ENDIF 3280 ENDPROC retpost 3500 PROC findifelt(felt$,søgenøgle$) CLOSED 3510 IMPORT antalfelter,feltnavne$,antalposter,postlængde,skærmpå 3520 DIM svar$ OF 1,postindhold$(antalfelter) OF 25,post$ OF postlængde 3530 feltnr:= 0 3540 FOR i:= 1 TO antalfelter DO 3550 IF felt$=feltnavne$(i) THEN feltnr:= i 3560 NEXT i 3570 IF feltnr=0 THEN 3580 PRINT "feltnavn findes ikke i denne fil" 3590 STOP 3600 ELSE 3610 READ FILE 1,101: antalposter 3620 FOR nr:= 1 TO antalposter DO 3630 READ FILE 1,nr: post$ 3640 FOR f:= 1 TO antalfelter DO postindhold$(f):= post$((f-1)*25+1:f*25) 3650 IF søgenøgle$ IN postindhold$(feltnr) THEN 3660 CLEAR 3670 PRINT "en mulighed er:" 3680 FOR i:= 1 TO antalfelter DO 3690 PRINT AT(1,i),"felt nr ";i;" ";feltnavne$(i); 3700 PRINT " <" 3710 INPUT AT(21,i),":": postindhold$(i) 3720 NEXT i 3730 PRINT 3740 IF skærmpå THEN 3750 INPUT AT(60,22),"-tast return:": svar$ 3760 CLEAR 3770 ENDIF 3780 ENDIF 3790 NEXT nr 3800 ENDIF 3810 ENDPROC findifelt 4000 PROC findipost(søgenøgle$) CLOSED 4010 IMPORT antalfelter,feltnavne$,antalposter,postlængde,skærmpå 4020 DIM svar$ OF 1,postindhold$(antalfelter) OF 25,post$ OF postlængde 4030 READ FILE 1,101: antalposter 4040 FOR nr:= 1 TO antalposter DO 4050 READ FILE 1,nr: post$ 4060 FOR f:= 1 TO antalfelter DO postindhold$(f):= post$((f-1)*25+1:f*25) 4070 IF søgenøgle$ IN post$ THEN 4080 CLEAR 4090 PRINT "en mulighed er:" 4100 FOR i:= 1 TO antalfelter DO 4110 PRINT AT(1,i),"felt nr ";i;" ";feltnavne$(i); 4120 PRINT " <" 4130 PRINT AT(21,i),":";postindhold$(i) 4140 NEXT i 4150 PRINT 4160 IF skærmpå THEN 4170 INPUT AT(60,22),"-tast return:": svar$ 4180 CLEAR 4190 ENDIF 4200 ENDIF 4210 NEXT nr 4220 ENDPROC findipost 4500 PROC sletpost(nr) CLOSED 4510 IMPORT antalfelter,feltnavne$,antalposter,postlængde 4520 DIM svar$ OF 1,postindhold$(antalfelter) OF 25,post$ OF postlængde 4530 IF 0<nr AND nr<=antalposter THEN 4540 READ FILE 1,antalposter: post$ 4550 WRITE FILE 1,nr: post$ 4560 post$:= " " 4570 WRITE FILE 1,antalposter: post$ 4580 antalposter:= antalposter-1 4590 WRITE FILE 1,101: antalposter 4600 ENDIF 4610 ENDPROC sletpost 5000 PROC skrivud(fra,til) CLOSED 5010 IMPORT antalfelter,antalposter,feltnavne$,skærmpå,postlængde 5020 DIM post$ OF postlængde 5030 DIM postindhold$(antalfelter) OF 25,svar$ OF 1 5040 CLEAR 5050 IF til>antalposter THEN til:= antalposter 5060 IF fra<1 THEN fra:= 1 5070 FOR nr:= fra TO til DO 5080 READ FILE 1,nr: post$ 5090 FOR f:= 1 TO antalfelter DO postindhold$(f):= post$((f-1)*25+1:f*25) 5100 PRINT USING "post nr ###:": nr 5110 FOR i:= 1 TO antalfelter DO 5120 PRINT feltnavne$(i);": ";postindhold$(i) 5130 NEXT i 5140 PRINT 5150 PRINT 5160 IF skærmpå THEN 5170 INPUT AT(60,22),"-tast return:": svar$ 5180 CLEAR 5190 ENDIF 5200 NEXT nr 5210 ENDPROC skrivud 5500 PROC vispost(nr) CLOSED 5510 IMPORT antalfelter,feltnavne$,antalposter,postlængde,skærmpå 5520 DIM svar$ OF 1,postindhold$(antalfelter) OF 25,post$ OF postlængde 5530 IF 0<nr AND nr<=antalposter THEN 5540 READ FILE 1,nr: post$ 5550 FOR f:= 1 TO antalfelter DO postindhold$(f):= post$((f-1)*25+1:f*25) 5560 CLEAR 5570 FOR i:= 1 TO antalfelter DO 5580 PRINT AT(1,i),"felt nr ";i;" ";feltnavne$(i); 5590 PRINT " <" 5600 PRINT AT(21,i),":";postindhold$(i) 5610 NEXT i 5620 ENDIF 5630 ENDPROC vispost 6000 PROC brugskærm CLOSED 6010 SELECT OUTPUT "console" 6020 skærmpå:= TRUE 6030 ENDPROC brugskærm 7000 PROC lokaliser(søgenøgle$,fra,til,REF fundetnr) CLOSED 7010 IMPORT antalfelter,feltnavne$,antalposter,postlængde 7020 DIM svar$ OF 1,postindhold$(antalfelter) OF 25,post$ OF postlængde 7030 fundetnr:= -1 7040 READ FILE 1,101: antalposter 7050 IF fra<1 THEN fra:= 1 7060 IF til>antalposter THEN til:= antalposter 7070 nr:= fra-1 7080 REPEAT 7090 nr:= nr+1 7100 READ FILE 1,nr: post$ 7110 IF søgenøgle$ IN post$ THEN fundetnr:= nr 7120 UNTIL fundetnr>0 OR nr>=til 7130 ENDPROC lokaliser «eof»