DataMuseum.dk

top - download

    Length: 16224 (0x3f60)
    Types: TextFile
    Notes: Mikados_K
    Names: »ALFAKUND.K«

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

Mikados K File

PROGRAM ALFAKUND;
(*$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;
APOST=RECORD
       NR1,NR2:INTEGER;
       FNAVN:PACKED ARRAY (1..4) OF CHAR;
       ENAVN:PACKED ARRAY (1..26) OF CHAR;
       UNAVN:PACKED ARRAY (1..30) OF CHAR;
       ADR: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
END;
ZONE= RECORD
       H:ISFHEAD;
       T:ARRAY(1..918) OF INTEGER
 END;
PROCSTAT=RECORD
       NP,NROSTART:INTEGER
END;
NPFILE=FILE OF PROCSTAT;
VAR    F:ISF;
       NRPF,CF:NPFILE;
       KZ:ZONE;
       FILNAVN2:STRING(20);
    J,IER,I:INTEGER;
       QUQ:^INTEGER;
      KUNDE:KPOST;
      T:FILE OF APOST;
       NAME:PACKED ARRAY (1..26) OF CHAR;
 
(*$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;
PROCEDURE PRKUNOPL;
BEGIN
  WITH KUNDE DO
  BEGIN
    T^.NR1:=NR(1);T^.NR2:=NR(2);
         MOVELEFT(NAVN(1,1),T^.FNAVN,4);
    MOVELEFT(NAVN(1,5),T^.ENAVN,26);
T^.UNAVN:=NAVN(2);
T^.ADR:=NAVN(3);
T^.LANDSBY:=LANDSBY;
T^.POSTNR:=POSTNR;
T^.TLF:=TLF;
  PUT(T);
  END
END;
BEGIN
  CLEARSCREEN;
  REPEAT
    GOTOXY(1,20);
    WRITELN('Sæt plade 4 i drev 1 og tryk RETURN');
    READLN;
(*$C-*)
    REWRITE(CF,'C4:P1:0:J');
    SEEK(CF,1)
(*$C+*)
  UNTIL IORESULT=0;
  CLOSE(CF);
  WRITELN('ALFAKUNDE');
  FILNAVN2:='ALISTE:P1:30:K';
  REWRITE(T,FILNAVN2);
  FILNAVN2:='KUNDERG:P2:1338:I';
  REWRITE(F,FILNAVN2);
  IOPEN(KZ.H,F,LÆS);
  IF IER<>0 THEN OFEJL;
  WITH KUNDE DO
  BEGIN
    NR(1):=0;NR(2):=0;
    I:=0;
    NEXTREC(KZ.H,F,A);
    IF IER<>-1 THEN ERROR;
    REPEAT
       PRKUNOPL;
       I:=I+1;
       NEXTREC(KZ.H,F,A)
    UNTIL IER<>0;
  END;
  IF IER<>-2 THEN ERROR;
FILLCHAR(T^.ENAVN(1),26,CHR(126));
T^.NR1:=0;T^.NR2:=0;
FILLCHAR(T^.FNAVN(1),4,CHR(126));
FILLCHAR(T^.UNAVN(1),30,CHR(126));
FILLCHAR(T^.ADR(1),30,CHR(126));
FILLCHAR(T^.LANDSBY(1),20,CHR(126));
FILLCHAR(T^.POSTNR(1),25,CHR(126));
FILLCHAR(T^.TLF(1),10,CHR(126));
PUT(T);
  CLOSE(T);
  ICLOSE(KZ.H,F);
  CLEARSCREEN;
  WRITELN('ICLOSE ',IER,I:7);
   CHAIN('INTRE   *1','SORTKUND:P1',QUQ)
END.