DataMuseum.dk

top - download

    Length: 2496 (0x9c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »VARFIX.K«

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

Mikados K File

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*)
(*$IPUTGET*)
(*$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:0000: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 (VARE.VARENR1<=1859) AND (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;
  VARE.VARENR1:=1911;
  GETREC(VZ.H,F,VARE.A);
  IF IER<>0 THEN ERROR;
  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.