PROGRAM FILETEST;        (***************************************************)       (*                                                 *)       (*   OPRETTELSE OG AJOURF\RING AF PERSONKARTOTEK   *)       (*                                                 *)       (* DEMONSTRATION AF DIREKTE FILER OG ANVENDELSE AF *)       (* EDIT PROCEDUREN I MIKADOS PASCAL                *)       (***************************************************)  TYPE STATUS = ( GIFT, ENKE, FRASKILT, UNGKARL );     ALFA = STRING(30);     TEKST = STRING(18);     DATO = RECORD DAG: 1..31;                   M]NED: 1..12;                   ]R: INTEGER            END;     PERSON = RECORD                NAVN: RECORD                        FORNAVN, EFTERNAVN: ALFA                      END;                K\N: (MAND, KVINDE, UKENDT);                F\DSELSDATO: DATO;                CASE [GTESKABELIGSTATUS: STATUS OF                  GIFT, ENKE: (GIFTEDATO: DATO);                  FRASKILT:   (SKILSMISSEDATO: DATO;                               ANTALSKILSMISSER: INTEGER);                  UNGKARL:    (UAFH[NGIG: BOOLEAN)              END (*PERSON*); VAR  REGISTER: FILE OF PERSON;     [STATUS, KODE: ALFA;     FINISHED, OK: BOOLEAN;     OPKODE, SVAR : CHAR;     POSTNUMMER: INTEGER;     IOVAL: INTEGER;         (***************************************************)       (* GENERELT ANVENDELIG PROCEDURE SOM ILLUSTRERER   *)       (* HVORLEDES EDIT PROCEDUREN KAN ANVENDES TIL      *)       (* REDIGERING AF HELTAL.                           *)       (* HVIS OPKODE<>'R' INDTASTES NYT HELTAL           *)       (* HVIS OPKODE ='R' PR[SENTERES DET NUV[RENDE      *)       (*      INDHOLD AF HELTAL P] SK[RMEN MED HENBLIK   *)       (*      P] REDIGERING                              *)       (***************************************************) PROCEDURE ENTERINTEGER( LEDETEKST: TEKST;                        VAR HELTAL: INTEGER );  VAR ST\RRELSESORDEN,INDEX: INTEGER;      INTSTRING: STRING(6);      SIGN, CH: CHAR;      DIGITS, FINISHED: BOOLEAN;BEGIN  INDEX := 18;  WHILE LEDETEKST(INDEX)=' ' DO INDEX:=INDEX-1;  WRITE( LEDETEKST:INDEX, ' ' );  INTSTRING := '      ';  IF OPKODE='R' THEN    BEGIN    INDEX:=0;    IF HELTAL<0 THEN      BEGIN      HELTAL:=-HELTAL;      INDEX:=1;      INTSTRING(1):='-'      END;    ST\RRELSESORDEN:=10000;    WHILE HELTAL<ST\RRELSESORDEN DO      ST\RRELSESORDEN := ST\RRELSESORDEN DIV 10;    REPEAT      BEGIN      INDEX:=INDEX+1;      INTSTRING(INDEX):= CHR( HELTAL DIV ST\RRELSESORDEN + ORD('0'));      HELTAL := HELTAL MOD ST\RRELSESORDEN;      ST\RRELSESORDEN := ST\RRELSESORDEN DIV 10;      END;    UNTIL ST\RRELSESORDEN=0;    END;  EDIT( INTSTRING:6 );  INDEX := 1;  FINISHED := FALSE;  DIGITS := FALSE;  SIGN := ' ';  HELTAL := 0;  REPEAT    BEGIN    CH := INTSTRING(INDEX);    IF CH IN (.'+','-'.) THEN      IF DIGITS OR (SIGN<>' ') THEN FINISHED:=TRUE      ELSE SIGN:= CH    ELSE      IF CH IN (.'0'..'9'.) THEN        BEGIN        HELTAL := HELTAL*10 + ORD(CH) - ORD('0');        DIGITS := TRUE        END      ELSE FINISHED:=TRUE;    INDEX := INDEX + 1;    END;  UNTIL FINISHED OR (INDEX>6);  IF SIGN='-' THEN HELTAL:=-HELTAL;END  (*ENTERINTEGER*); PROCEDURE ENTERSTRING( LEDETEKST: TEKST;                       VAR EDITSTRING: ALFA;                       L[NGDE: INTEGER );  VAR INDEX: INTEGER;BEGIN  INDEX:=18;  WHILE LEDETEKST(INDEX)=' ' DO INDEX:=INDEX-1;  WRITE( LEDETEKST:INDEX, ' ' );  IF OPKODE='O' THEN    BEGIN    FILLCHAR( EDITSTRING(1), L[NGDE, ' ' );    (*$R-*)  EDITSTRING(0) := CHR(L[NGDE);  (*$R+*)    END;  EDIT( EDITSTRING:L[NGDE )END (*ENTERSTRING*); PROCEDURE ENTERDATO( LEDETEKST: TEKST;                     VAR EDITDATO: DATO );  VAR INDEX: INTEGER;BEGIN  INDEX:= 18;  WHILE LEDETEKST(INDEX)=' ' DO INDEX:=INDEX-1;  WRITE( LEDETEKST:INDEX, ' ' );  WITH EDITDATO DO    BEGIN    ENTERINTEGER( 'DAG               ', DAG );    ENTERINTEGER( 'M]NED             ', M]NED );    ENTERINTEGER( ']R                ', ]R );    END;END  (*ENTERDATO*); PROCEDURE ENTERCOMMAND;BEGIN  REPEAT    BEGIN    WRITE( 'OPERATIONSKODE (O-OPRET, R-RET, A-AFSLUT) ' );    WHILE EOLN DO READLN;    READ( OPKODE );    END;  UNTIL OPKODE IN (.'O','R','A'.);END; PROCEDURE ENTERSTATUS;BEGIN  IF OPKODE='R' THEN    CASE REGISTER^.[GTESKABELIGSTATUS OF      GIFT:     [STATUS := 'GIFT    ';      ENKE:     [STATUS := 'ENKE    ';      FRASKILT: [STATUS := 'FRASKILT';      UNGKARL:  [STATUS := 'UNGKARL';    END  ELSE [STATUS := '    ';  REPEAT    BEGIN    WRITE( 'INDTAST [GTESKABELIG STATUS (G/F/E/U) ' );    EDIT( [STATUS );    END;  UNTIL [STATUS(1) IN (.'G','F','E','U'.);END;  BEGINREWRITE( REGISTER, 'PERSDATA:P2:10' );FINISHED := FALSE;REPEAT  BEGIN  CLEARSCREEN;  OK := TRUE;  ENTERCOMMAND;  IF OPKODE<>'A' THEN    BEGIN    WRITELN;    WRITE( 'INDTAST POSTNUMMER ' );    READ( POSTNUMMER );    SEEK( REGISTER, POSTNUMMER );    IF IORESULT<>0 THEN      BEGIN      IOVAL:=IORESULT;      WRITE( 'FEJL ', IOVAL, ' VED OPSLAG I FIL' );      WRITE(' - TAST RETURN:');      READLN;      OK := FALSE      END;    IF OK AND (OPKODE='R') THEN      BEGIN      GET( REGISTER );      IF IORESULT<>0 THEN        BEGIN        WRITELN( 'FEJL ', IORESULT, ' VED INDL[SNING AF POST');        OK := FALSE        END      ELSE SEEK( REGISTER, POSTNUMMER );      END;    IF OK THEN      BEGIN      WITH REGISTER^,NAVN DO        BEGIN        ENTERSTRING('FORNAVN           ', FORNAVN, 30 );        ENTERSTRING('EFTERNAVN         ', EFTERNAVN, 30 );        KODE := ' ';        REPEAT          BEGIN          IF OPKODE='R' THEN            CASE K\N OF              MAND:   KODE := 'M';              KVINDE: KODE := 'K';              UKENDT: KODE := 'U';            END;          ENTERSTRING('K\N (M/K/U)       ', KODE, 1 );          END;        UNTIL KODE(1) IN (.'M','K','U'.);        CASE KODE(1) OF          'M': K\N := MAND;          'K': K\N := KVINDE;          'U': K\N := UKENDT;        END;        ENTERDATO( 'F\DSELSDATO       ', F\DSELSDATO );        ENTERSTATUS;        CASE [STATUS(1) OF          'G','E': BEGIN                 IF [STATUS(1)='G' THEN [GTESKABELIGSTATUS:=GIFT                                ELSE [GTESKABELIGSTATUS:=ENKE;                 WRITE( 'DATO FOR [GTESKABETS ');                 ENTERDATO('INDG]ELSE         ',GIFTEDATO);               END;          'F': BEGIN                 [GTESKABELIGSTATUS:=FRASKILT;                 ENTERDATO('SKILSMISSEDATO    ', SKILSMISSEDATO );                 ENTERINTEGER('ANTAL SKILSMISSER ',ANTALSKILSMISSER);               END;          'U': BEGIN                 [GTESKABELIGSTATUS:=UNGKARL;                 REPEAT                   BEGIN                   WRITE('UAFH[NGIG (J/N) ');                   WHILE EOLN DO READLN;                   READ( SVAR )                   END;                 UNTIL SVAR IN (.'J','N'.);                 UAFH[NGIG := SVAR = 'J';               END;        END (*CASE [GTESKABELIGSTATUS*);        END (*WITH REGISTER^*);      PUT( REGISTER );      END  (*IF OK*);    END (*OPKODE<>'A'*);  END (*REPEATS[TNING*);UNTIL OPKODE='A';WRITELN('FILETEST SLUT')END (*FILETEST*).