|
|
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: 2528 (0x9e0)
Types: TextFile
Notes: Mikados_K
Names: »VREORGIE.K«
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
└─⟦this⟧ »VREORGIE.K«
PROGRAM VAREREOR;
(*$IISFHEAD*)
VPOST=RECORD
A:AR;
VARENR1,LVRNDØR,OPRLAND,PAKENHED,
FORVLEVU,DATSBES1,DATSBES2,DATSORD1,DATSORD2,
DÆKGRASÅ,ANAFTILG:INTEGER;
NAVN:ARRAY(1..2) OF PACKED ARRAY (1..30) OF CHAR;
PRIS,KOSTPRIS,TOLDPNR,FYSLAGER,PRIMOLAG,MINLAGER,RESAFLAG,IORDRE,
RAIORDRE,STASBEST,ASOLGTIÅ,ASOLGTSÅ,OMSIÅR,OMSSÅR,DÆKBIDTD:REAL
END;
ZONE= RECORD
H:ISFHEAD;
T:ARRAY(1..451) OF INTEGER
END;
VAR F1,F:ISF;
VZ1,VZ:ZONE;
FILNAVN1,FILNAVN2:STRING(20);
IER,I:INTEGER;
VARE:VPOST;
R:REAL;
(*$L-*)
(*$R-,IEXCOMCOP*)
(*$IINITIATE*)
(*$IIOPEN*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IICLOSE*)
(*$IINSERT*)
(*$INEXTREC*)
(*$R+*)
(*$L+*)
PROCEDURE STOP;
VAR I:INTEGER;
BEGIN I:=I DIV 0 END;
PROCEDURE ERROR;
BEGIN
WRITELN('FEJL I VAREREG ',IER);
ICLOSE(VZ.H,F);
WRITELN('ICLOSE ',IER);
STOP
END;
BEGIN
FILNAVN1:='REGVARE:P1:0000:I';
REWRITE(F1,FILNAVN1);
IOPEN(VZ1.H,F1,SKRIV);IF IER<>0 THEN ERROR;
FILNAVN2:='REGVARE:P2:1137:I';
REWRITE(F,FILNAVN2);
IOPEN(VZ.H,F,LÆS);
IF IER<>0 THEN ERROR;
INITIATE(VZ1.H,F1,VZ.H.RECINUSE);
IF IER<>0 THEN ERROR;
I:=0;
VARE.VARENR1:=0;
NEXTREC(VZ.H,F,VARE.A);
IF IER<>-1 THEN ERROR;
IER:=0;
WHILE IER=0 DO
BEGIN
INSERT(VZ1.H,F1,VARE.A);
IF IER<>0 THEN ERROR;
NEXTREC(VZ.H,F,VARE.A);
I:=I+1
END;
IF IER<>-2 THEN ERROR;
WRITELN('INDPOSTER,UDPOSTER',VZ.H.RECINUSE:6,I:6);
ICLOSE(VZ.H,F);
ICLOSE(VZ1.H,F1);
WRITELN('ICLOSE ',IER)
END.