|
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: 3328 (0xd00) Types: TextFile Names: »CPR.PAS«
└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer └─ ⟦this⟧ »CPR.PAS«
PROGRAM cpr; CONST maxtegn = 10; TYPE cifre = 0 .. 9; cprcifre = ARRAY(.1 .. maxtegn.) OF cifre; cprstreng = STRING(.maxtegn.); VAR i, position : INTEGER; cprst : cprstreng; ciffer : cprcifre; ch : CHAR; slut : BOOLEAN; FUNCTION cpr_ok(nummer : cprcifre) : BOOLEAN; VAR sum, dag, maaned, aar, i : INTEGER; test : BOOLEAN; BEGIN (* cpr_ok *) sum := 0; test := TRUE; FOR i := 1 TO 7 DO sum := sum + nummer(.11 - i.) * i; FOR i := 2 TO 4 DO sum := sum + nummer(.5 - i.) * i; IF sum MOD 11 <> 0 THEN test := FALSE; dag := nummer(.1.) * 10+ nummer(.2.); maaned := nummer(.3.) * 10 + nummer(.4.); aar := nummer(.5.) * 10 + nummer(.6.); IF (dag = 0) OR (dag > 31) OR (maaned = 0) OR (maaned > 12) THEN test := FALSE; IF ((maaned = 4) OR (maaned = 6) OR (maaned = 9) OR (maaned = 11)) AND (dag = 31) THEN test := FALSE; IF (maaned = 2) AND (dag= 29) AND ((aar MOD 4 <>0) OR (aar = 0)) THEN test := false; cpr_ok := test; END; (* cpr_ok *) BEGIN (* cpr *) REPEAT REPEAT WRITE(CLRHOM); slut := FALSE; GOTOXY(10, 3); WRITE('Programmet afbrydes ved at taste 0'); GOTOXY(10, 5); WRITE('Et CPR-nummer angives på formen ddmmaaxxxx'); GOTOXY(10, 7); WRITE('Tast CPR-nummer: < >'); BUFLEN := maxtegn; GOTOXY(28, 7); READLN(cprst); IF cprst = '0' THEN slut := TRUE; IF NOT slut THEN BEGIN position := 0; FOR i := LEN(cprst) TO maxtegn DO cprst := cprst + ' '; FOR i := maxtegn DOWNTO 1 DO IF (cprst(.i.) < '0') OR (cprst(.i.) > '9') THEN position := i; IF position > 0 (* Fejlagtigt tegn fundet *) THEN BEGIN GOTOXY(27 + position, 8); WRITE('▶92◀ Fejlagtigt tegn - Tast <RETURN>'); READLN(ch); END; END; UNTIL (position = 0) OR slut; IF NOT slut THEN BEGIN FOR i := 1 TO maxtegn DO ciffer(.i.) := ORD(cprst(.i.)) - ORD('0'); GOTOXY(10, 11); WRITE(cprst); IF cpr_ok(ciffer) THEN WRITE(' er OK.') ELSE WRITE(' er ikke i orden.'); WRITE(' Tast <RETURN>: '); READLN(ch); END; UNTIL slut; END. (* cpr *) «eof»