|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
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«
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.
0x0000…0013 Line {l1=0x11, l2=»PROGRAM OPRETBTA;«, l3=0x11}
0x0013…0022 Line {l1=0x0d, l2=»(*$IISFHEAD*)«, l3=0x0d}
0x0022…0038 Line {l1=0x14, l2=»INFILE=FILE OF CHAR;«, l3=0x14}
0x0038…0049 Line {l1=0x0f, l2=»BETAPOST=RECORD«, l3=0x0f}
0x0049…0057 Line {l1=0x0c, l2=» A:AR;«, l3=0x0c}
0x0057…007b Line {l1=0x22, l2=» NR:ARRAY (1..3) OF INTEGER;«, l3=0x22}
0x007b…0096 Line {l1=0x19, l2=» (*KNR1,KNR2,LAND*)«, l3=0x19}
0x0096…00d1 Line {l1=0x39, l2=» NAVN:ARRAY (1..3) OF PACKED ARRAY (1..30) OF CHAR;«, l3=0x39}
0x00d1…00ee Line {l1=0x1b, l2=» (*NAVN,UDVNAVN,ADR*)«, l3=0x1b}
0x00ee…011c Line {l1=0x2c, l2=» LANDSBY:PACKED ARRAY (1..20) OF CHAR;«, l3=0x2c}
0x011c…0149 Line {l1=0x2b, l2=» POSTNR:PACKED ARRAY (1..25) OF CHAR;«, l3=0x2b}
0x0149…0172 Line {l1=0x27, l2=» TLF:PACKED ARRAY (1..10) OF CHAR«, l3=0x27}
0x0172…0178 Line {l1=0x04, l2=»END;«, l3=0x04}
0x0178…0189 Line {l1=0x0f, l2=»BETAZONE=RECORD«, l3=0x0f}
0x0189…019c Line {l1=0x11, l2=» H:ISFHEAD;«, l3=0x11}
0x019c…01bf Line {l1=0x21, l2=» T:ARRAY(1..374) OF INTEGER«, l3=0x21}
0x01bf…01c5 Line {l1=0x04, l2=»END;«, l3=0x04}
0x01c5…01d4 Line {l1=0x0d, l2=»VAR F:ISF;«, l3=0x0d}
0x01d4…01e9 Line {l1=0x13, l2=» BZ:BETAZONE;«, l3=0x13}
0x01e9…0200 Line {l1=0x15, l2=» INDFIL:INFILE;«, l3=0x15}
0x0200…021c Line {l1=0x1a, l2=» INDPOST:STRING(76);«, l3=0x1a}
0x021c…0242 Line {l1=0x24, l2=» FILNAVN1,FILNAVN2:STRING(20);«, l3=0x24}
0x0242…0258 Line {l1=0x14, l2=» AV,IER,I:INTEGER;«, l3=0x14}
0x0258…0268 Line {l1=0x0e, l2=» R:REAL;«, l3=0x0e}
0x0268…027f Line {l1=0x15, l2=» BETA:BETAPOST;«, l3=0x15}
0x027f…0292 Line {l1=0x11, l2=»(*$R-,IEXCOMCOP*)«, l3=0x11}
0x0292…029f Line {l1=0x0b, l2=»(*$IIOPEN*)«, l3=0x0b}
0x029f…02af Line {l1=0x0e, l2=»(*$IINITIATE*)«, l3=0x0e}
0x02af…02bc Line {l1=0x0b, l2=»(*$ISÆTØG*)«, l3=0x0b}
0x02bc…02cc Line {l1=0x0e, l2=»(*$IREADPROC*)«, l3=0x0e}
0x02cc…02dc Line {l1=0x0e, l2=»(*$IFINDPOST*)«, l3=0x0e}
0x02dc…02eb Line {l1=0x0d, l2=»(*$IFORSKYD*)«, l3=0x0d}
0x02eb…02f9 Line {l1=0x0c, l2=»(*$IICLOSE*)«, l3=0x0c}
0x02f9…0307 Line {l1=0x0c, l2=»(*$IPUTGET*)«, l3=0x0c}
0x0307…0315 Line {l1=0x0c, l2=»(*$IINSERT*)«, l3=0x0c}
0x0315…0324 Line {l1=0x0d, l2=»(*$INEXTREC*)«, l3=0x0d}
0x0324…0332 Line {l1=0x0c, l2=»(*$IDELETE*)«, l3=0x0c}
0x0332…0340 Line {l1=0x0c, l2=»(*$IREPORT*)«, l3=0x0c}
0x0340…0349 Line {l1=0x07, l2=»(*$R+*)«, l3=0x07}
0x0349…0352 Line {l1=0x07, l2=»(*$L+*)«, l3=0x07}
0x0352…0380 Line {l1=0x2c, l2=»FUNCTION UNPACK(FBYTE1,FBYTE2:INTEGER):REAL;«, l3=0x2c}
0x0380…038f Line {l1=0x0d, l2=»VAR RES:REAL;«, l3=0x0d}
0x038f…0396 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x0396…03a1 Line {l1=0x09, l2=» RES:=0;«, l3=0x09}
0x03a1…03ab Line {l1=0x08, l2=» REPEAT«, l3=0x08}
0x03ab…03d6 Line {l1=0x29, l2=» RES:=RES*100+ORD(INDPOST(FBYTE1))-32;«, l3=0x29}
0x03d6…03ec Line {l1=0x14, l2=» FBYTE1:=FBYTE1+1«, l3=0x14}
0x03ec…0404 Line {l1=0x16, l2=» UNTIL FBYTE1>FBYTE2;«, l3=0x16}
0x0404…0413 Line {l1=0x0d, l2=» UNPACK:=RES«, l3=0x0d}
0x0413…0419 Line {l1=0x04, l2=»END;«, l3=0x04}
0x0419…042a Line {l1=0x0f, l2=»PROCEDURE STOP;«, l3=0x0f}
0x042a…043a Line {l1=0x0e, l2=»VAR I:INTEGER;«, l3=0x0e}
0x043a…0451 Line {l1=0x15, l2=»BEGIN I:=I DIV 0 END;«, l3=0x15}
0x0451…0458 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x0458…0474 Line {l1=0x1a, l2=» FILNAVN1:='BTAW0001:P1';«, l3=0x1a}
0x0474…0496 Line {l1=0x20, l2=» FILNAVN2:='BETAREG:P2:0000:I';«, l3=0x20}
0x0496…04b1 Line {l1=0x19, l2=» RESET(INDFIL,FILNAVN1);«, l3=0x19}
0x04b1…04c4 Line {l1=0x11, l2=» READLN(INDFIL);«, l3=0x11}
0x04c4…04dc Line {l1=0x16, l2=» REWRITE(F,FILNAVN2);«, l3=0x16}
0x04dc…04ec Line {l1=0x0e, l2=» I:=IORESULT;«, l3=0x0e}
0x04ec…0520 Line {l1=0x32, l2=»IF I<>0 THEN BEGIN WRITELN('REWRITE ',I);STOP END;«, l3=0x32}
0x0520…0538 Line {l1=0x16, l2=» IOPEN(BZ.H,F,SKRIV);«, l3=0x16}
0x0538…057e Line {l1=0x44, l2=»IF IER<>0 THEN BEGIN WRITE('IOPEN ',IER); IF IER<>-19 THEN STOP END;«, l3=0x44}
0x057e…05cb Line {l1=0x4b, l2=»INITIATE(BZ.H,F,161); IF IER<>0 THEN BEGIN WRITE('INITIATE ',IER);STOP END;«, l3=0x4b}
0x05cb…05db Line {l1=0x0e, l2=» WITH BETA DO«, l3=0x0e}
0x05db…05e4 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0x05e4…05ff Line {l1=0x19, l2=» READLN(INDFIL,INDPOST);«, l3=0x19}
0x05ff…0609 Line {l1=0x08, l2=» AV:=0;«, l3=0x08}
0x0609…0613 Line {l1=0x08, l2=» REPEAT«, l3=0x08}
0x0613…062b Line {l1=0x16, l2=» R:=UNPACK(1,3);«, l3=0x16}
0x062b…064a Line {l1=0x1d, l2=» NR(1):=TRUNC(R/10000);«, l3=0x1d}
0x064a…0671 Line {l1=0x25, l2=» NR(2):=TRUNC(R-NR(1)*10000.0);«, l3=0x25}
0x0671…06a4 Line {l1=0x31, l2=» FOR I:=1 TO 30 DO NAVN(1,I):=INDPOST(3+I);«, l3=0x31}
0x06a4…06d8 Line {l1=0x32, l2=» FOR I:=1 TO 30 DO NAVN(2,I):=INDPOST(33+I);«, l3=0x32}
0x06d8…070c Line {l1=0x32, l2=» FOR I:=1 TO 13 DO NAVN(3,I):=INDPOST(63+I);«, l3=0x32}
0x070c…072c Line {l1=0x1e, l2=» READLN(INDFIL,INDPOST);«, l3=0x1e}
0x072c…0761 Line {l1=0x33, l2=» FOR I:=14 TO 30 DO NAVN(3,I):=INDPOST(I-13);«, l3=0x33}
0x0761…0796 Line {l1=0x33, l2=» FOR I:=1 TO 20 DO LANDSBY(I):=INDPOST(17+I);«, l3=0x33}
0x0796…07ca Line {l1=0x32, l2=» FOR I:=1 TO 25 DO POSTNR(I):=INDPOST(37+I);«, l3=0x32}
0x07ca…0808 Line {l1=0x3c, l2=» FOR I:=1 TO 9 DO TLF(I):=INDPOST(63+I);TLF(10):=' ';«, l3=0x3c}
0x0808…082d Line {l1=0x23, l2=» NR(3):=TRUNC(UNPACK(63,63));«, l3=0x23}
0x082d…083b Line {l1=0x0c, l2=» AV:=AV+1;«, l3=0x0c}
0x083b…0868 Line {l1=0x2b, l2=» WRITELN(NR(1)*10000.0+NR(2):10:-2,AV:6);«, l3=0x2b}
0x0868…08af Line {l1=0x45, l2=» INSERT(BZ.H,F,BETA.A); IF IER<>0 THEN BEGIN WRITE('INSERT',IER:5);«, l3=0x45}
0x08af…08f3 Line {l1=0x42, l2=» STOP END;«, l3=0x42}
0x08f3…090f Line {l1=0x1a, l2=» READLN(INDFIL,INDPOST);«, l3=0x1a}
0x090f…0924 Line {l1=0x13, l2=» UNTIL EOF(INDFIL)«, l3=0x13}
0x0924…092c Line {l1=0x06, l2=» END;«, l3=0x06}
0x092c…0944 Line {l1=0x16, l2=» ICLOSE(BZ.H,F);«, l3=0x16}
0x0944…097e Line {l1=0x38, l2=» WRITE(LIST,'ICLOSE ',IER:5,AV:6,BETA.NR(1),BETA.NR(2))«, l3=0x38}
0x097e…0984 Line {l1=0x04, l2=»END.«, l3=0x04}
0x0984…09a0 00 00 50 41 43 4b 28 35 2a 49 2b 34 2c 35 2a 49 2b 36 29 3b 43 37 20 20 20 20 20 20 ┆ PACK(5*I+4,5*I+6);C7 ┆
0x09a0…09c0 20 53 41 4c 44 4f 4b 5c 42 28 38 29 3a 3d 55 4e 50 41 43 4b 28 33 37 2c 33 38 29 2a 28 31 45 2b ┆ SALDOKØB(8):=UNPACK(37,38)*(1E+┆
0x09c0…09e0 36 29 2b 55 4e 50 41 43 4b 28 33 39 2c 34 31 29 3b 37 37 20 20 20 20 20 20 20 53 41 4c 44 4f 4b ┆6)+UNPACK(39,41);77 SALDOK┆
0x09e0…0a00 5c 42 28 37 29 3a 3d 55 4e 50 41 43 4b 28 34 32 2c 34 33 29 2a 28 31 45 2b 36 29 2b 55 4e 50 41 ┆ØB(7):=UNPACK(42,43)*(1E+6)+UNPA┆
0x0a00…0a20 43 4b 28 34 34 2c 34 36 29 3b 37 37 20 20 20 20 20 20 20 53 41 4c 44 4f 4b 5c 42 28 39 29 3a 3d ┆CK(44,46);77 SALDOKØB(9):=┆
0x0a20…0a40 55 4e 50 41 43 4b 28 34 37 2c 34 38 29 2a 28 31 45 2b 36 29 2b 55 4e 50 41 43 4b 28 34 39 2c 35 ┆UNPACK(47,48)*(1E+6)+UNPACK(49,5┆
0x0a40…0a60 31 29 3b 37 24 20 20 20 20 20 20 20 4e 52 28 31 31 29 3a 3d 54 52 55 4e 43 28 55 4e 50 41 43 4b ┆1);7$ NR(11):=TRUNC(UNPACK┆
0x0a60…0a80 28 35 32 2c 35 33 29 29 3b 24 24 20 20 20 20 20 20 20 4e 52 28 31 32 29 3a 3d 54 52 55 4e 43 28 ┆(52,53));$$ NR(12):=TRUNC(┆
0x0a80…0aa0 55 4e 50 41 43 4b 28 35 34 2c 35 35 29 29 3b 24 18 20 20 20 20 20 20 20 52 3a 3d 55 4e 50 41 43 ┆UNPACK(54,55));$ R:=UNPAC┆
0x0aa0…0ac0 4b 28 35 36 2c 35 38 29 3b 18 1e 20 20 20 20 20 20 20 4e 52 28 31 33 29 3a 3d 54 52 55 4e 43 28 ┆K(56,58); NR(13):=TRUNC(┆
0x0ac0…0ae0 52 2f 31 30 30 30 30 29 3b 1e 27 20 20 20 20 20 20 20 4e 52 28 31 34 29 3a 3d 54 52 55 4e 43 28 ┆R/10000); ' NR(14):=TRUNC(┆
0x0ae0…0b00 52 2d 4e 52 28 31 33 29 2a 31 30 30 30 30 2e 30 29 3b 27 18 20 20 20 20 20 20 20 52 3a 3d 55 4e ┆R-NR(13)*10000.0);' R:=UN┆
0x0b00…0b20 50 41 43 4b 28 35 39 2c 36 31 29 3b 18 1d 20 20 20 20 20 20 20 4e 52 28 34 29 3a 3d 54 52 55 4e ┆PACK(59,61); NR(4):=TRUN┆
0x0b20…0b40 43 28 52 2f 31 30 30 30 30 29 3b 1d 25 20 20 20 20 20 20 20 4e 52 28 35 29 3a 3d 54 52 55 4e 43 ┆C(R/10000); % NR(5):=TRUNC┆
0x0b40…0b60 28 52 2d 4e 52 28 34 29 2a 31 30 30 30 30 2e 30 29 3b 25 23 20 20 20 20 20 20 20 4e 52 28 37 29 ┆(R-NR(4)*10000.0);%# NR(7)┆
0x0b60…0b80 3a 3d 54 52 55 4e 43 28 55 4e 50 41 43 4b 28 36 32 2c 36 33 29 29 3b 23 23 20 20 20 20 20 20 20 ┆:=TRUNC(UNPACK(62,63));## ┆
0x0b80…0ba0 46 4f 52 20 49 3a 3d 31 39 20 54 4f 20 32 32 20 44 4f 20 4e 52 28 49 29 3a 3d 30 3b 23 0c 20 20 ┆FOR I:=19 TO 22 DO NR(I):=0;# ┆
0x0ba0…0bc0 20 41 56 3a 3d 41 56 2b 31 3b 0c 2b 20 20 20 57 52 49 54 45 4c 4e 28 4e 52 28 31 29 2a 31 30 30 ┆ AV:=AV+1; + WRITELN(NR(1)*100┆
0x0bc0…0be0 30 30 2e 30 2b 4e 52 28 32 29 3a 31 30 3a 2d 32 2c 41 56 3a 36 29 3b 2b 46 20 20 20 49 4e 53 45 ┆00.0+NR(2):10:-2,AV:6);+F INSE┆
0x0be0…0c00 52 54 28 56 5a 2e 48 2c 46 2c 4b 55 4e 44 45 2e 41 29 3b 20 49 46 20 49 45 52 3c 3e 30 20 54 48 ┆RT(VZ.H,F,KUNDE.A); IF IER<>0 TH┆
0x0c00…0c20 45 4e 20 42 45 47 49 4e 20 57 52 49 54 45 28 27 49 4e 53 45 52 54 27 2c 49 45 52 3a 35 29 3b 46 ┆EN BEGIN WRITE('INSERT',IER:5);F┆
0x0c20…0c40 42 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ┆B ┆
0x0c40…0c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 53 54 4f 50 20 45 ┆ STOP E┆
0x0c60…0c80 4e 44 3b 42 1a 20 20 20 52 45 41 44 4c 4e 28 49 4e 44 46 49 4c 2c 49 4e 44 50 4f 53 54 29 3b 1a ┆ND;B READLN(INDFIL,INDPOST); ┆
0x0c80…0ca0 13 20 20 55 4e 54 49 4c 20 45 4f 46 28 49 4e 44 46 49 4c 29 13 06 20 20 45 4e 44 3b 06 16 20 20 ┆ UNTIL EOF(INDFIL) END; ┆
0x0ca0…0cc0 20 20 20 20 20 49 43 4c 4f 53 45 28 56 5a 2e 48 2c 46 29 3b 16 3a 20 20 57 52 49 54 45 28 4c 49 ┆ ICLOSE(VZ.H,F); : WRITE(LI┆
0x0cc0…0ce0 53 54 2c 27 49 43 4c 4f 53 45 20 27 2c 49 45 52 3a 35 2c 41 56 3a 36 2c 4b 55 4e 44 45 2e 4e 52 ┆ST,'ICLOSE ',IER:5,AV:6,KUNDE.NR┆
0x0ce0…0d00 28 31 29 2c 4b 55 4e 44 45 2e 4e 52 28 32 29 29 3a 04 45 4e 44 2e 04 00 00 00 00 00 00 00 00 00 ┆(1),KUNDE.NR(2)): END. ┆
0x0d00…0d20 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ┆ ┆
[…0x86…]