|
|
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 - metrics - download
Length: 3328 (0xd00)
Types: TextFile
Names: »CPR.PAS«
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
└─⟦this⟧ »CPR.PAS«
└─⟦3702e543b⟧ Bits:30003064 Demoprogrammer A-J til Pascal bog
└─⟦this⟧ »CPR.PAS«
└─⟦692ac107c⟧ Bits:30005923 PolyPascal-80 V3.10 arbejdsdiskette 1
└─⟦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('^ 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»