DataMuseum.dk

top - download

    Length: 7648 (0x1de0)
    Types: TextFile
    Notes: Mikados_K
    Names: »ISFBETA.K«

└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
    └─⟦this⟧ »ISFBETA.K« 

Mikados K File

PROGRAM OPRETBTA;
(*$IISFHEAD*)
INFILE=FILE OF CHAR;
BETAPOST=RECORD
       A:AR;
       NR:ARRAY (1..3) OF INTEGER;
       (*KNR1,KNR2,LAND*)
       NAVN:ARRAY (1..3) OF PACKED ARRAY (1..30) OF CHAR;
       (*NAVN,UDVNAVN,ADR*)
       LANDSBY:PACKED ARRAY (1..20) OF CHAR;
       POSTNR:PACKED ARRAY (1..25) OF CHAR;
       TLF:PACKED ARRAY (1..10) OF CHAR
END;
BETAZONE=RECORD
       H:ISFHEAD;
       T:ARRAY(1..374) OF INTEGER
END;
VAR    F:ISF;
       BZ:BETAZONE;
       INDFIL:INFILE;
       INDPOST:STRING(76);
       FILNAVN1,FILNAVN2:STRING(20);
   AV,IER,I:INTEGER;
       R:REAL;
       BETA:BETAPOST;
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IINITIATE*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$IINSERT*)
(*$INEXTREC*)
(*$IDELETE*)
(*$IREPORT*)
(*$R+*)
(*$L+*)
FUNCTION UNPACK(FBYTE1,FBYTE2:INTEGER):REAL;
VAR RES:REAL;
BEGIN
  RES:=0;
  REPEAT
    RES:=RES*100+ORD(INDPOST(FBYTE1))-32;
    FBYTE1:=FBYTE1+1
  UNTIL FBYTE1>FBYTE2;
  UNPACK:=RES
END;
PROCEDURE STOP;
VAR I:INTEGER;
BEGIN I:=I DIV 0 END;
BEGIN
  FILNAVN1:='BTAW0001:P1';
  FILNAVN2:='BETAREG:P2:0000:I';
  RESET(INDFIL,FILNAVN1);
  READLN(INDFIL);
  REWRITE(F,FILNAVN2);
  I:=IORESULT;
IF I<>0 THEN BEGIN WRITELN('REWRITE ',I);STOP END;
  IOPEN(BZ.H,F,SKRIV);
IF IER<>0 THEN BEGIN WRITE('IOPEN ',IER); IF IER<>-19 THEN STOP END;
INITIATE(BZ.H,F,161); IF IER<>0 THEN BEGIN WRITE('INITIATE ',IER);STOP END;
  WITH BETA DO
  BEGIN
  READLN(INDFIL,INDPOST);
  AV:=0;
  REPEAT
       R:=UNPACK(1,3);
       NR(1):=TRUNC(R/10000);
       NR(2):=TRUNC(R-NR(1)*10000.0);
       FOR I:=1 TO 30 DO NAVN(1,I):=INDPOST(3+I);
       FOR I:=1 TO 30 DO NAVN(2,I):=INDPOST(33+I);
       FOR I:=1 TO 13 DO NAVN(3,I):=INDPOST(63+I);
       READLN(INDFIL,INDPOST);
       FOR I:=14 TO 30 DO NAVN(3,I):=INDPOST(I-13);
       FOR I:=1 TO 20 DO LANDSBY(I):=INDPOST(17+I);
       FOR I:=1 TO 25 DO POSTNR(I):=INDPOST(37+I);
       FOR I:=1 TO  9 DO TLF(I):=INDPOST(63+I);TLF(10):=' ';
       NR(3):=TRUNC(UNPACK(63,63));
   AV:=AV+1;
   WRITELN(NR(1)*10000.0+NR(2):10:-2,AV:6);
   INSERT(BZ.H,F,BETA.A); IF IER<>0 THEN BEGIN WRITE('INSERT',IER:5);
                                                         STOP END;
   READLN(INDFIL,INDPOST);
  UNTIL EOF(INDFIL)
  END;
       ICLOSE(BZ.H,F);
  WRITE(LIST,'ICLOSE ',IER:5,AV:6,BETA.NR(1),BETA.NR(2))
END.