DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦6b00f2d7b⟧ TextFile

    Length: 3328 (0xd00)
    Types: TextFile
    Names: »CPR.PAS«

Derivation

└─⟦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« 
└─⟦f983c2ef3⟧ Bits:30004681 Pascal opgaver (Butler)
    └─ ⟦this⟧ »CPR.PAS« 

TextFile

      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»