|
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: 5056 (0x13c0)
Types: TextFile
Notes: Mikados_K
Names: »KNUDELBO.K«
└─⟦206949bb3⟧ Bits:30004653 Kunderegister P1 til messe (MIKADOS)
└─⟦this⟧ »KNUDELBO.K«
PROGRAM KNUDELBO;
(*$IISFHEAD*)
KPOST=RECORD
A:AR;
NR:ARRAY(1..23) OF INTEGER;
NAVN:ARRAY (1..3) OF PACKED ARRAY (1..30) OF CHAR;
LANDSBY:PACKED ARRAY (1..20) OF CHAR;
POSTNR:PACKED ARRAY (1..25) OF CHAR;
TLF:PACKED ARRAY (1..10) OF CHAR;
SALDOKØB:ARRAY (1..9) OF REAL
END;
ZONE= RECORD
H:ISFHEAD;
T:ARRAY(1..918) OF INTEGER
END;
LANDFILE=FILE OF PACKED ARRAY(1..30) OF CHAR;
VAR F:ISF;
KZ:ZONE;
LANDFIL:LANDFILE;
QUQ:^INTEGER;
FILNAVN2:STRING(20);
J,IER,I:INTEGER;
KUNDE:KPOST;
T:TEXT;
NAME:PACKED ARRAY (1..26) OF CHAR;
FIRST,LAST:PACKED ARRAY (1..4) OF CHAR;
STRENG:STRING(4);
PNR,FINIS:BOOLEAN;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IIOPEN*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IICLOSE*)
(*$INEXTREC*)
(*$R+*)
(*$L+*)
PROCEDURE ERROR;
BEGIN
WRITELN('FEJL I KUNDEREG ',IER);
ICLOSE(KZ.H,F);
WRITELN('ICLOSE ',IER);
I:=I DIV 0
END;
PROCEDURE OFEJL;
BEGIN
GOTOXY(1,20);
WRITELN('REGISTERFEJL ',IER,' . SITUATIONEN ER FORSØGT REDDET.');
WRITELN('TAST 0, HVIS DER SKAL FORTSÆTTES');
REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;
IF I<>0 THEN ERROR;
CLEARSCREEN
END;
FUNCTION CHECK:BOOLEAN;
VAR P:PACKED ARRAY (1..4) OF CHAR;
K:INTEGER;
BEGIN
FOR K:=1 TO 4 DO P(K):=KUNDE.POSTNR(K);
IF (P>=FIRST) AND (P<=LAST) THEN CHECK:=TRUE ELSE CHECK:=FALSE
END;
PROCEDURE PRKUNOPL(O:INTEGER);
BEGIN
WITH KUNDE DO
BEGIN
J:=0;
REPEAT J:=J+1
UNTIL (J=4) OR (NAVN(1,J)<>' ');
IF NAVN(1,J)=' ' THEN
BEGIN
MOVELEFT(NAVN(1,5),NAME,26);
WRITELN(T,' ':6,NAME)
END
ELSE
WRITELN(T,' ':6,NAVN(1));
WRITELN(T,' ':6,NAVN(2));
WRITELN(T,' ':6,NAVN(3));
WRITELN(T,' ':6,LANDSBY);
WRITELN(T,' ':6,POSTNR);
WRITELN(T,' ')
END
END;
BEGIN
CLEARSCREEN;
WRITELN('KUNDELABELS');
FILNAVN2:='KLABELS:P1:30:K';
REWRITE(T,FILNAVN2);
FILNAVN2:='KUNDERG:P2:1338:I';
RESET(F,FILNAVN2);
IOPEN(KZ.H,F,LÆS);
IF IER<>0 THEN OFEJL;
REPEAT
GOTOXY(1,22);
WRITELN('I POSTNR-INTERVALLER (1), ET INTERVAL (2), KNR-ORDEN (3)');
GOTOXY(60,22);
READLN;READ(J)
UNTIL (IORESULT=0) AND (J>0) AND (J<4);
IF J=1 THEN BEGIN FINIS:=FALSE;PNR:=TRUE END;
IF J=2 THEN BEGIN FINIS:=TRUE;PNR:=TRUE END;
IF J=3 THEN BEGIN FINIS:=TRUE;PNR:=FALSE END;
IF J=2 THEN
BEGIN
REPEAT
CLEARSCREEN;
REPEAT
GOTOXY(1,22);
WRITELN('START');
GOTOXY(10,22);
READLN;READ(STRENG)
UNTIL LENGTH(STRENG)=4;
FOR I:=1 TO 4 DO FIRST(I):=STRENG(I);
REPEAT
GOTOXY(20,22);
WRITELN('SLUT');
GOTOXY(30,22);
READLN;READ(STRENG)
UNTIL LENGTH(STRENG)=4;
FOR I:=1 TO 4 DO LAST(I):=STRENG(I);
UNTIL LAST>=FIRST;
END
ELSE
BEGIN
FIRST:='1000';
LAST:='1999'
END;
I:=0;
WITH KUNDE DO
REPEAT
NR(1):=0;NR(2):=0;
NEXTREC(KZ.H,F,A);
IF IER<>-1 THEN ERROR;
REPEAT
IF (PNR=FALSE) OR (CHECK=TRUE) THEN
BEGIN
PRKUNOPL(-1);
WRITELN(T,' ':6,'afs. H.S.Møller Trommesalen 5 1614 V.');
WRITELN(T,' ');
WRITELN(T,' ');
I:=I+1;
END;
NEXTREC(KZ.H,F,A)
UNTIL IER<>0;
IF IER<>-2 THEN ERROR;
IF LAST='9999' THEN FINIS:=TRUE;
LAST(1):=CHR(ORD(LAST(1))+1);
FIRST(1):=CHR(ORD(FIRST(1))+1);
UNTIL FINIS;
ICLOSE(KZ.H,F);
CLEARSCREEN;
WRITELN('ICLOSE ',IER,I:7);
CHAIN('INTRE *1','LISTKNUD:P1',QUQ)
END.
0x0000…0013 Line {l1=0x11, l2=»PROGRAM KNUDELBO;«, l3=0x11}
0x0013…0022 Line {l1=0x0d, l2=»(*$IISFHEAD*)«, l3=0x0d}
0x0022…0030 Line {l1=0x0c, l2=»KPOST=RECORD«, l3=0x0c}
0x0030…003e Line {l1=0x0c, l2=» A:AR;«, l3=0x0c}
0x003e…0062 Line {l1=0x22, l2=» NR:ARRAY(1..23) OF INTEGER;«, l3=0x22}
0x0062…009d Line {l1=0x39, l2=» NAVN:ARRAY (1..3) OF PACKED ARRAY (1..30) OF CHAR;«, l3=0x39}
0x009d…00cb Line {l1=0x2c, l2=» LANDSBY:PACKED ARRAY (1..20) OF CHAR;«, l3=0x2c}
0x00cb…00f8 Line {l1=0x2b, l2=» POSTNR:PACKED ARRAY (1..25) OF CHAR;«, l3=0x2b}
0x00f8…0122 Line {l1=0x28, l2=» TLF:PACKED ARRAY (1..10) OF CHAR;«, l3=0x28}
0x0122…0148 Line {l1=0x24, l2=» SALDOKØB:ARRAY (1..9) OF REAL«, l3=0x24}
0x0148…014e Line {l1=0x04, l2=»END;«, l3=0x04}
0x014e…015c Line {l1=0x0c, l2=»ZONE= RECORD«, l3=0x0c}
0x015c…016f Line {l1=0x11, l2=» H:ISFHEAD;«, l3=0x11}
0x016f…0192 Line {l1=0x21, l2=» T:ARRAY(1..918) OF INTEGER«, l3=0x21}
0x0192…0199 Line {l1=0x05, l2=» END;«, l3=0x05}
0x0199…01c8 Line {l1=0x2d, l2=»LANDFILE=FILE OF PACKED ARRAY(1..30) OF CHAR;«, l3=0x2d}
0x01c8…01d7 Line {l1=0x0d, l2=»VAR F:ISF;«, l3=0x0d}
0x01d7…01e8 Line {l1=0x0f, l2=» KZ:ZONE;«, l3=0x0f}
0x01e8…0202 Line {l1=0x18, l2=» LANDFIL:LANDFILE;«, l3=0x18}
0x0202…0218 Line {l1=0x14, l2=» QUQ:^INTEGER;«, l3=0x14}
0x0218…0235 Line {l1=0x1b, l2=» FILNAVN2:STRING(20);«, l3=0x1b}
0x0235…024b Line {l1=0x14, l2=» J,IER,I:INTEGER;«, l3=0x14}
0x024b…025f Line {l1=0x12, l2=» KUNDE:KPOST;«, l3=0x12}
0x025f…026e Line {l1=0x0d, l2=» T:TEXT;«, l3=0x0d}
0x026e…0299 Line {l1=0x29, l2=» NAME:PACKED ARRAY (1..26) OF CHAR;«, l3=0x29}
0x0299…02c9 Line {l1=0x2e, l2=» FIRST,LAST:PACKED ARRAY (1..4) OF CHAR;«, l3=0x2e}
0x02c9…02e3 Line {l1=0x18, l2=» STRENG:STRING(4);«, l3=0x18}
0x02e3…02fa Line {l1=0x15, l2=» PNR,FINIS:BOOLEAN;«, l3=0x15}
0x02fa…02fd Line {l1=0x01, l2=» «, l3=0x01}
0x02fd…0306 Line {l1=0x07, l2=»(*$L-*)«, l3=0x07}
0x0306…0319 Line {l1=0x11, l2=»(*$R-,IEXCOMCOP*)«, l3=0x11}
0x0319…0326 Line {l1=0x0b, l2=»(*$IIOPEN*)«, l3=0x0b}
0x0326…0336 Line {l1=0x0e, l2=»(*$IREADPROC*)«, l3=0x0e}
0x0336…0346 Line {l1=0x0e, l2=»(*$IFINDPOST*)«, l3=0x0e}
0x0346…0354 Line {l1=0x0c, l2=»(*$IICLOSE*)«, l3=0x0c}
0x0354…0363 Line {l1=0x0d, l2=»(*$INEXTREC*)«, l3=0x0d}
0x0363…036c Line {l1=0x07, l2=»(*$R+*)«, l3=0x07}
0x036c…0375 Line {l1=0x07, l2=»(*$L+*)«, l3=0x07}
0x0375…0387 Line {l1=0x10, l2=»PROCEDURE ERROR;«, l3=0x10}
0x0387…038e Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x038e…03b2 Line {l1=0x22, l2=» WRITELN('FEJL I KUNDEREG ',IER);«, l3=0x22}
0x03b2…03c5 Line {l1=0x11, l2=» ICLOSE(KZ.H,F);«, l3=0x11}
0x03c5…03e0 Line {l1=0x19, l2=» WRITELN('ICLOSE ',IER);«, l3=0x19}
0x03e0…03ee Line {l1=0x0c, l2=» I:=I DIV 0«, l3=0x0c}
0x03ee…03f4 Line {l1=0x04, l2=»END;«, l3=0x04}
0x03f4…0406 Line {l1=0x10, l2=»PROCEDURE OFEJL;«, l3=0x10}
0x0406…040d Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x040d…041e Line {l1=0x0f, l2=» GOTOXY(1,20);«, l3=0x0f}
0x041e…0463 Line {l1=0x43, l2=» WRITELN('REGISTERFEJL ',IER,' . SITUATIONEN ER FORSØGT REDDET.');«, l3=0x43}
0x0463…0493 Line {l1=0x2e, l2=» WRITELN('TAST 0, HVIS DER SKAL FORTSÆTTES');«, l3=0x2e}
0x0493…04cc Line {l1=0x37, l2=» REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;«, l3=0x37}
0x04cc…04e3 Line {l1=0x15, l2=» IF I<>0 THEN ERROR;«, l3=0x15}
0x04e3…04f2 Line {l1=0x0d, l2=» CLEARSCREEN«, l3=0x0d}
0x04f2…04f8 Line {l1=0x04, l2=»END;«, l3=0x04}
0x04f8…0511 Line {l1=0x17, l2=»FUNCTION CHECK:BOOLEAN;«, l3=0x17}
0x0511…0535 Line {l1=0x22, l2=»VAR P:PACKED ARRAY (1..4) OF CHAR;«, l3=0x22}
0x0535…0545 Line {l1=0x0e, l2=» K:INTEGER;«, l3=0x0e}
0x0545…054c Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x054c…0577 Line {l1=0x29, l2=» FOR K:=1 TO 4 DO P(K):=KUNDE.POSTNR(K);«, l3=0x29}
0x0577…05b9 Line {l1=0x40, l2=» IF (P>=FIRST) AND (P<=LAST) THEN CHECK:=TRUE ELSE CHECK:=FALSE«, l3=0x40}
0x05b9…05bf Line {l1=0x04, l2=»END;«, l3=0x04}
0x05bf…05df Line {l1=0x1e, l2=»PROCEDURE PRKUNOPL(O:INTEGER);«, l3=0x1e}
0x05df…05e6 Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x05e6…05f7 Line {l1=0x0f, l2=» WITH KUNDE DO«, l3=0x0f}
0x05f7…0600 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0x0600…060e Line {l1=0x0c, l2=» J:=0;«, l3=0x0c}
0x060e…0624 Line {l1=0x14, l2=» REPEAT J:=J+1«, l3=0x14}
0x0624…064d Line {l1=0x27, l2=» UNTIL (J=4) OR (NAVN(1,J)<>' ');«, l3=0x27}
0x064d…066b Line {l1=0x1c, l2=» IF NAVN(1,J)=' ' THEN«, l3=0x1c}
0x066b…0679 Line {l1=0x0c, l2=» BEGIN«, l3=0x0c}
0x0679…06a0 Line {l1=0x25, l2=» MOVELEFT(NAVN(1,5),NAME,26);«, l3=0x25}
0x06a0…06c0 Line {l1=0x1e, l2=» WRITELN(T,' ':6,NAME)«, l3=0x1e}
0x06c0…06cc Line {l1=0x0a, l2=» END«, l3=0x0a}
0x06cc…06d9 Line {l1=0x0b, l2=» ELSE«, l3=0x0b}
0x06d9…06f8 Line {l1=0x1d, l2=» WRITELN(T,' ':6,NAVN(1));«, l3=0x1d}
0x06f8…0717 Line {l1=0x1d, l2=» WRITELN(T,' ':6,NAVN(2));«, l3=0x1d}
0x0717…0736 Line {l1=0x1d, l2=» WRITELN(T,' ':6,NAVN(3));«, l3=0x1d}
0x0736…0755 Line {l1=0x1d, l2=» WRITELN(T,' ':6,LANDSBY);«, l3=0x1d}
0x0755…0773 Line {l1=0x1c, l2=» WRITELN(T,' ':6,POSTNR);«, l3=0x1c}
0x0773…078a Line {l1=0x15, l2=» WRITELN(T,' ')«, l3=0x15}
0x078a…0791 Line {l1=0x05, l2=» END«, l3=0x05}
0x0791…0797 Line {l1=0x04, l2=»END;«, l3=0x04}
0x0797…079e Line {l1=0x05, l2=»BEGIN«, l3=0x05}
0x079e…07ae Line {l1=0x0e, l2=» CLEARSCREEN;«, l3=0x0e}
0x07ae…07c9 Line {l1=0x19, l2=» WRITELN('KUNDELABELS');«, l3=0x19}
0x07c9…07e9 Line {l1=0x1e, l2=» FILNAVN2:='KLABELS:P1:30:K';«, l3=0x1e}
0x07e9…0801 Line {l1=0x16, l2=» REWRITE(T,FILNAVN2);«, l3=0x16}
0x0801…0823 Line {l1=0x20, l2=» FILNAVN2:='KUNDERG:P2:1338:I';«, l3=0x20}
0x0823…0839 Line {l1=0x14, l2=» RESET(F,FILNAVN2);«, l3=0x14}
0x0839…084f Line {l1=0x14, l2=» IOPEN(KZ.H,F,LÆS);«, l3=0x14}
0x084f…0868 Line {l1=0x17, l2=» IF IER<>0 THEN OFEJL;«, l3=0x17}
0x0868…0872 Line {l1=0x08, l2=» REPEAT«, l3=0x08}
0x0872…0885 Line {l1=0x11, l2=» GOTOXY(1,22);«, l3=0x11}
0x0885…08cd Line {l1=0x46, l2=» WRITELN('I POSTNR-INTERVALLER (1), ET INTERVAL (2), KNR-ORDEN (3)');«, l3=0x46}
0x08cd…08df Line {l1=0x10, l2=» GOTOXY(60,22);«, l3=0x10}
0x08df…08f1 Line {l1=0x10, l2=» READLN;READ(J)«, l3=0x10}
0x08f1…091c Line {l1=0x29, l2=» UNTIL (IORESULT=0) AND (J>0) AND (J<4);«, l3=0x29}
0x091c…094d Line {l1=0x2f, l2=» IF J=1 THEN BEGIN FINIS:=FALSE;PNR:=TRUE END;«, l3=0x2f}
0x094d…097d Line {l1=0x2e, l2=» IF J=2 THEN BEGIN FINIS:=TRUE;PNR:=TRUE END;«, l3=0x2e}
0x097d…09ae Line {l1=0x2f, l2=» IF J=3 THEN BEGIN FINIS:=TRUE;PNR:=FALSE END;«, l3=0x2f}
0x09ae…09bd Line {l1=0x0d, l2=» IF J=2 THEN«, l3=0x0d}
0x09bd…09c6 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0x09c6…09d2 Line {l1=0x0a, l2=» REPEAT«, l3=0x0a}
0x09d2…09e7 Line {l1=0x13, l2=» CLEARSCREEN;«, l3=0x13}
0x09e7…09f3 Line {l1=0x0a, l2=» REPEAT«, l3=0x0a}
0x09f3…0a09 Line {l1=0x14, l2=» GOTOXY(1,22);«, l3=0x14}
0x0a09…0a23 Line {l1=0x18, l2=» WRITELN('START');«, l3=0x18}
0x0a23…0a3a Line {l1=0x15, l2=» GOTOXY(10,22);«, l3=0x15}
0x0a3a…0a56 Line {l1=0x1a, l2=» READLN;READ(STRENG)«, l3=0x1a}
0x0a56…0a73 Line {l1=0x1b, l2=» UNTIL LENGTH(STRENG)=4;«, l3=0x1b}
0x0a73…0a9e Line {l1=0x29, l2=» FOR I:=1 TO 4 DO FIRST(I):=STRENG(I);«, l3=0x29}
0x0a9e…0aaa Line {l1=0x0a, l2=» REPEAT«, l3=0x0a}
0x0aaa…0ac1 Line {l1=0x15, l2=» GOTOXY(20,22);«, l3=0x15}
0x0ac1…0ada Line {l1=0x17, l2=» WRITELN('SLUT');«, l3=0x17}
0x0ada…0af1 Line {l1=0x15, l2=» GOTOXY(30,22);«, l3=0x15}
0x0af1…0b0d Line {l1=0x1a, l2=» READLN;READ(STRENG)«, l3=0x1a}
0x0b0d…0b2a Line {l1=0x1b, l2=» UNTIL LENGTH(STRENG)=4;«, l3=0x1b}
0x0b2a…0b54 Line {l1=0x28, l2=» FOR I:=1 TO 4 DO LAST(I):=STRENG(I);«, l3=0x28}
0x0b54…0b6c Line {l1=0x16, l2=» UNTIL LAST>=FIRST;«, l3=0x16}
0x0b6c…0b73 Line {l1=0x05, l2=» END«, l3=0x05}
0x0b73…0b7b Line {l1=0x06, l2=» ELSE«, l3=0x06}
0x0b7b…0b84 Line {l1=0x07, l2=» BEGIN«, l3=0x07}
0x0b84…0b98 Line {l1=0x12, l2=» FIRST:='1000';«, l3=0x12}
0x0b98…0baa Line {l1=0x10, l2=» LAST:='1999'«, l3=0x10}
0x0baa…0bb2 Line {l1=0x06, l2=» END;«, l3=0x06}
0x0bb2…0bbb Line {l1=0x07, l2=» I:=0;«, l3=0x07}
0x0bbb…0bcc Line {l1=0x0f, l2=» WITH KUNDE DO«, l3=0x0f}
0x0bcc…0bd6 Line {l1=0x08, l2=» REPEAT«, l3=0x08}
0x0bd6…0bee Line {l1=0x16, l2=» NR(1):=0;NR(2):=0;«, l3=0x16}
0x0bee…0c06 Line {l1=0x16, l2=» NEXTREC(KZ.H,F,A);«, l3=0x16}
0x0c06…0c22 Line {l1=0x1a, l2=» IF IER<>-1 THEN ERROR;«, l3=0x1a}
0x0c22…0c2e Line {l1=0x0a, l2=» REPEAT«, l3=0x0a}
0x0c2e…0c5a Line {l1=0x2a, l2=» IF (PNR=FALSE) OR (CHECK=TRUE) THEN«, l3=0x2a}
0x0c5a…0c68 Line {l1=0x0c, l2=» BEGIN«, l3=0x0c}
0x0c68…0c7e Line {l1=0x14, l2=» PRKUNOPL(-1);«, l3=0x14}
0x0c7e…0cc0 Line {l1=0x40, l2=» WRITELN(T,' ':6,'afs. H.S.Møller Trommesalen 5 1614 V.');«, l3=0x40}
0x0cc0…0cd8 Line {l1=0x16, l2=» WRITELN(T,' ');«, l3=0x16}
[…0x1…]
0x0cf0…0d00 Line {l1=0x0e, l2=» I:=I+1;«, l3=0x0e}
0x0d00…0d0d Line {l1=0x0b, l2=» END;«, l3=0x0b}
0x0d0d…0d27 Line {l1=0x18, l2=» NEXTREC(KZ.H,F,A)«, l3=0x18}
0x0d27…0d3a Line {l1=0x11, l2=» UNTIL IER<>0;«, l3=0x11}
0x0d3a…0d54 Line {l1=0x18, l2=» IF IER<>-2 THEN ERROR;«, l3=0x18}
0x0d54…0d78 Line {l1=0x22, l2=» IF LAST='9999' THEN FINIS:=TRUE;«, l3=0x22}
0x0d78…0d99 Line {l1=0x1f, l2=» LAST(1):=CHR(ORD(LAST(1))+1);«, l3=0x1f}
0x0d99…0dbc Line {l1=0x21, l2=» FIRST(1):=CHR(ORD(FIRST(1))+1);«, l3=0x21}
0x0dbc…0dcc Line {l1=0x0e, l2=» UNTIL FINIS;«, l3=0x0e}
0x0dcc…0ddf Line {l1=0x11, l2=» ICLOSE(KZ.H,F);«, l3=0x11}
0x0ddf…0def Line {l1=0x0e, l2=» CLEARSCREEN;«, l3=0x0e}
0x0def…0e0e Line {l1=0x1d, l2=» WRITELN('ICLOSE ',IER,I:7);«, l3=0x1d}
0x0e0e…0e37 Line {l1=0x27, l2=» CHAIN('INTRE *1','LISTKNUD:P1',QUQ)«, l3=0x27}
0x0e37…0e3d Line {l1=0x04, l2=»END.«, l3=0x04}
0x0e3d…0e40 00 00 00 ┆ ┆
0x0e40…0e60 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 ┆ ┆
[…0x2a…]
0x13a0…13c0 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 63 ┆ c┆