DataMuseum.dk

top - metrics - download

    Length: 8192 (0x2000)
    Types: TextFile
    Names: »DSIMTLSP.PAS«

└─⟦da1b76629⟧ Bits:30008866 Indeholder bla. RCKAT
    └─⟦this⟧ »DSIMTLSP.PAS« 

TextFile

OVERLAY PROCEDURE LAES(FILN: STRING14);
BEGIN
   ASSIGN(FIL,FILN);
   RESET(FIL);
   IF IORES<>0 THEN WRITELN(CHR(07),
   '  Fejl, Kan ikke finde "',FILN,'" !!') ELSE
   BEGIN
      BUFPEG:=BUFMAXÆ1Å;
      PAKCHR:=CHR(0);
      BUFPOSÆ2,1Å:=BUFPEG;
      J:=BUFPEG;  L:=1;
      I:=-1;
      WHILE (POSITION(FIL)<LENGTH(FIL)) AND 
            (BUFPEG<SIZE(BUFFER)) AND
            (I<>MAXINT) DO
      BEGIN
         BLOCKREAD(FIL,IOBUFÆ1Å,1);
         I:=0;
         WHILE I<128 DO
         BEGIN
            I:=SUCC(I);
            IF DEF.BFTYPE<4 THEN IOBUFÆIÅ:=CHR(ORD(IOBUFÆIÅ) AND $7F);
            IF (IOBUFÆIÅ=CHR(26)) AND (NOT DUPR) THEN  I:=MAXINT  ELSE
            BEGIN
               IF PUTBUF(IOBUFÆIÅ) THEN ;
               IF CRLF_SW THEN
               BEGIN
                  L:=SUCC(L);
                  J:=BUFPEG;
                  IF (PRED(L) MOD 20)=0 THEN
                  BUFPOSÆ2,SUCC(PRED(L) DIV 20)Å:=BUFPEG;
               END;
            END;
         END;
      END;
     
      IF (BUFPEG>=SIZE(BUFFER)) OR (I<0) THEN
      BEGIN
         IF I<0 THEN WRITELN('  Indlæsning ok, men filen er tom !!') ELSE
                     WRITELN(CHR(07),'  Ikke nok plads i fil-bufferen !!');
         BUF_CLR(2);
      END ELSE
      BEGIN 
         BUFELINÆ2Å:=L;
         FNAV:=FILN;
         BUFMINÆ2Å:=SIZE(BUFFER)-(BUFPEG-BUFMAXÆ1Å);
         BUF_RES(2);
         MOVE(BUFFERÆSUCC(BUFMAXÆ1Å)Å,BUFFERÆSUCC(BUFMINÆ2Å)Å,
              BUFPEG-BUFMAXÆ1Å);
         FOR I:=1 TO (SUCC(PRED(L) DIV 20)) DO 
         BUFPOSÆ2,IÅ:=BUFPOSÆ2,IÅ+BUFMINÆ2Å-BUFMAXÆ1Å;
         BUFMAXÆ2Å:=SIZE(BUFFER);
         WRITELN('  Indlæsning ok.');
      END;
   END;
   CLOSE(FIL);
END;

OVERLAY PROCEDURE SKRIV(FRA,TIL: INTEGER; FILN: STRING14);
LABEL SLUT;
BEGIN
   NYDISK;
   ASSIGN(FIL,FILN);
   RESET(FIL);
   I:=IORES;
   CLOSE(FIL);
   IF I=0 THEN
   BEGIN
      WRITE('  Filen findes i forvejen.  Overskriv? (J/N): ');
      REPEAT UNTIL GETCON(CH) AND ((CH='J') OR (CH='N'));
      IF CH='N' THEN
      BEGIN
         WRITELN('N');
         WRITELN('  Intet skrevet, filen uændret!!');
         GOTO SLUT;
      END;
      WRITELN('J');
   END;
   ASSIGN(FIL,FILN);
   REWRITE(FIL);
   IF IORES<>0 THEN
   BEGIN
      CLOSE(FIL);
      WRITELN('  Kan ikke åbne "',FILN,'"');
      GOTO SLUT;
   END;
   FIND(SUCC(TIL));   I:=BUFPEG;
   FIND(FRA);
   SETBUF(BUFPEG);
   IF DUPR THEN I:=PRED(I) ELSE
   BEGIN
      CH:=BUFFERÆSUCC(I)Å;
      BUFFERÆSUCC(I)Å:=CHR(26);
   END;
   J:=0;
   WHILE (BUFPEG<SUCC(I)) OR (PAKCNT<>0) DO
   BEGIN
      GETBUF(CH2);
      OK_SW:=CRTL;
      IF NOT CRTL THEN
      CASE CH OF
         @10,@13,@26,@32..@127: OK_SW:=TRUE;
      END;
      IF OK_SW THEN
      BEGIN
         J:=SUCC(J);
         IOBUFÆJÅ:=CH2;
         IF EKKO THEN IF CH2<>CHR(26) THEN PUTCON(CH2);
      END;
      IF (J=128) OR ((BUFPEG>=SUCC(I)) AND (PAKCNT=0)) THEN
      BEGIN
         BLOCKWRITE(FIL,IOBUFÆ1Å,1);
         J:=0;
      END;
   END;
   IF (NOT DUPR) THEN BUFFERÆSUCC(I)Å:=CH;
   J:=IORES;
   CLOSE(FIL);
   IF EKKO THEN WRITELN;
   CASE J OF
      0:  WRITELN('  Udskrivning ok.');
      13: WRITELN('  Fejl i udskrivning, disk fuld !!');
   OTHERWISE
      WRITELN('  Fejl i udskrivning, I/O error ',J);
   END;
   
   SLUT:
END;

OVERLAY PROCEDURE PRINT(FRA,TIL: INTEGER);
LABEL UD;
BEGIN
   FIND(SUCC(TIL));   I:=BUFPEG;
   FIND(FRA);
   SETBUF(BUFPEG);
   WHILE (BUFPEG<I) OR (PAKCNT<>0) DO
   BEGIN
      IF GETCON(CH) THEN
      BEGIN
         IF EKKO THEN
         BEGIN
            WRITELN;  WRITELN;
         END;
         WRITE(CHR(07),'  Afbrydelse !!  ',SUCC(I-BUFPEG):5,
         ' Bytes tilbage i bufferen.  Stop? (J/N): ');
         REPEAT UNTIL GETCON(CH) AND (CH IN Æ'J','N'Å);
         WRITELN(CH);  
         IF CH = 'J' THEN
         BEGIN
            WRITELN('  Print stoppet.');
            GOTO UD;
         END;
         IF EKKO THEN WRITELN;
      END;
      GETBUF(CH);
      OK_SW:=CRTL;
      IF NOT CRTL THEN
      CASE CH OF
         @10,@13,@26,@32..@127: OK_SW:=TRUE;
      END;
      IF OK_SW THEN
      BEGIN
         WRITE(LST,CH);
         IF EKKO THEN PUTCON(CH);
      END ELSE 
      BEGIN
         WRITELN(LST,'<',CRTLTABÆORD(CH)Å,'>');
         IF EKKO THEN WRITELN('<',CRTLTABÆORD(CH)Å,'>');
      END;
   END;
   UD:
   WRITELN(LST);
END;

OVERLAY PROCEDURE DUMP(FRA,TIL: INTEGER);
LABEL UD;
VAR
  DLIN: INTEGER;
  S0: STRINGÆ10Å;
  S1: STRINGÆ50Å;
  S2: STRINGÆ16Å;
  HX: ARRAYÆ0..15Å OF CHAR;
  SW: BOOLEAN;
  
PROCEDURE SKR;
BEGIN
   IF DLIN>0 THEN
   BEGIN
      STR(DLIN+10000:5,S0);
      S0:=CONCAT(COPY(S0,2,4),'  ');
   END ELSE S0:='      ';
   S0:=CONCAT(S0,HXÆ(O DIV 4096) MOD 16Å,HXÆ(O DIV 256) MOD 16Å,
                 HXÆ(O DIV 16) MOD 16Å,HXÆO MOD 16Å);
   WHILE LEN(S1)<48 DO S1:=CONCAT(S1,' ');
   WHILE LEN(S2)<16 DO S2:=CONCAT(S2,' ');
   IF DUPR THEN WRITELN(LST,S0,'  ',S1,' >',S2,'<');
   IF (NOT DUPR) OR EKKO THEN WRITELN(S0,'  ',S1,' >',S2,'<');
   O:=O+16;   W:=SUCC(W);
   DLIN:=-1;  SW:=FALSE;
   S1:='';   S2:='';
END;

BEGIN
   HX:='0123456789ABCDEF';  S1:='';  S2:='';
   FIND(SUCC(TIL));   I:=BUFPEG;
   FIND(FRA);
   SETBUF(BUFPEG);
   LIN:=FRA;  O:=0;  W:=0;  DLIN:=FRA;  SW:=FALSE;
   WHILE (BUFPEG<I) OR (PAKCNT<>0) DO
   BEGIN
      IF GETCON(CH) AND DUPR THEN
      BEGIN
         WRITE(CHR(07),'  Afbrydelse !!  ',SUCC(I-BUFPEG):5,
         ' Bytes tilbage i bufferen.  Stop? (J/N): ');
         REPEAT UNTIL GETCON(CH) AND (CH IN Æ'J','N'Å);
         WRITELN(CH);  
         IF CH = 'J' THEN
         BEGIN
            WRITELN('  Dump stoppet.');
            WRITELN(LST);
            GOTO UD;
         END;
      END;
      
      IF SW AND (DLIN<0) THEN DLIN:=LIN;
      
      GETBUF(CH);
      S1:=CONCAT(S1,HXÆORD(CH) DIV 16Å,HXÆORD(CH) MOD 16Å,' ');
      CASE CH OF
         @32..@127:  S2:=CONCAT(S2,CH);
      OTHERWISE
         S2:=CONCAT(S2,'.');
      END;
      IF LEN(S2)=16 THEN
      BEGIN
         SKR;
         IF ((W MOD 20)=0) AND (NOT DUPR) THEN
         BEGIN
            WRITE('Tryk RETURN for at fortsætte eller ESC for stop...');
            REPEAT UNTIL GETCON(CH) AND (CH IN Æ@13,@27Å);
            IF CH=CHR(27) THEN 
            BEGIN
               WRITELN;
               WRITE('Dump stoppet.');
               GOTO UD;
            END;
            WRITE(CHR(13));
         END;
      END;
      IF CH=CHR(10) THEN 
      BEGIN
         LIN:=SUCC(LIN);
         SW:=TRUE;
      END;
   END;
   IF LEN(S2)<>0 THEN  SKR;

   UD:
   WRITELN;
END;
«eof»