DataMuseum.dk

top - metrics - download

    Length: 4096 (0x1000)
    Types: TextFile
    Names: »DSIMTCPM.PAS«

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

TextFile

OVERLAY PROCEDURE CPM(FUN: CHAR; FILN: STRING14);
LABEL TEM;
TYPE
   FCB_TYP = RECORD
               DRIVE: BYTE;
               FNAME: ARRAYÆ1..8Å OF CHAR;
               FTYPE: ARRAYÆ1..3Å OF CHAR;
               XXXXX: ARRAYÆ1..21Å OF CHAR;
               RECNO: INTEGER;
            END;
   DMA_TYP = RECORD
               DRIVE: BYTE;
               FNAME: ARRAYÆ1..8Å OF CHAR;
               FTYPE: ARRAYÆ1..3Å OF CHAR;
               XXXXX: ARRAYÆ1..20Å OF CHAR;
            END;
            
VAR
  FCB: FCB_TYP;
  DMA: ARRAYÆ0..3Å OF DMA_TYP;
  GEM: ARRAYÆ1..100Å OF STRINGÆ11Å;  (* AT $1E00; *)
  NAVN: STRINGÆ14Å;
  
BEGIN
   NYDISK;
   BDOS(26,ADDR(DMA));
   NAVN:=FILN;
   WHILE (NAVN<>'') AND (NAVNÆ1Å=' ') DO DELETE(NAVN,1,1);
   IF POS(':',NAVN)<=1 THEN  FCB.DRIVE:=SUCC(MEMÆ$0004Å)  ELSE
   IF (NAVNÆ1Å='A') OR (NAVNÆ1Å='B') THEN  FCB.DRIVE:=ORD(NAVNÆ1Å)-64 ELSE
   BEGIN
      WRITELN('  Fejl i kommando!!');
      GOTO TEM;
   END;
   DELETE(NAVN,1,POS(':',NAVN));
   IF NAVN='' THEN NAVN:=CONCAT(NAVN,'*.*') ELSE
   IF POS('.',NAVN) = 0 THEN  NAVN:=CONCAT(NAVN,'.*');
   I:=0;
   WHILE (I<PRED(POS('.',NAVN))) AND (I<8) DO
   BEGIN
      I:=SUCC(I);
      IF NAVNÆIÅ<>'*' THEN  FCB.FNAMEÆIÅ:=NAVNÆIÅ  ELSE
      BEGIN
         REPEAT
            FCB.FNAMEÆIÅ:='?';
            I:=SUCC(I);
         UNTIL I>8;
      END;
   END;
   WHILE I<8 DO
   BEGIN
      I:=SUCC(I);
      FCB.FNAMEÆIÅ:=' ';
   END;
   DELETE(NAVN,1,POS('.',NAVN));
   I:=0;
   WHILE (I<LEN(NAVN)) AND (I<3) DO
   BEGIN
      I:=SUCC(I);
      IF NAVNÆIÅ<>'*' THEN  FCB.FTYPEÆIÅ:=NAVNÆIÅ  ELSE
      BEGIN
         REPEAT
            FCB.FTYPEÆIÅ:='?';
            I:=SUCC(I);
         UNTIL I>3;
      END;
   END;
   WHILE I<3 DO
   BEGIN
      I:=SUCC(I);
      FCB.FTYPEÆIÅ:=' ';
   END;
   FILL(FCB.XXXXX,21,CHR(0));
   I:=BDOSB(17,ADDR(FCB));
   L:=0;
   WHILE I<>255 DO
   BEGIN
      L:=SUCC(L);
      GEMÆLÅÆ0Å:=CHR(11);
      MOVE(DMAÆIÅ.FNAME,GEMÆLÅÆ1Å,11);
      I:=BDOSB(18);
   END;
   FOR I:=1 TO L DO
   FOR J:=SUCC(I) TO L DO
   IF GEMÆIÅ>GEMÆJÅ THEN
   BEGIN
      GEMÆ100Å:=GEMÆIÅ;  GEMÆIÅ:=GEMÆJÅ;  GEMÆJÅ:=GEMÆ100Å;
   END;
   J:=0;
   IF L=0 THEN WRITELN('  Ingen filer fundet!!') ELSE
   BEGIN
      FOR I:=1 TO L DO
      BEGIN
         IF COPY(GEMÆIÅ,9,3) = '   ' THEN CH:=' ' ELSE CH:='.';
         WRITE('  ',CHR(FCB.DRIVE+64),':',
         COPY(GEMÆIÅ,1,8),CH,COPY(GEMÆIÅ,9,3));
         CASE FUN OF
            'X': BEGIN
                    MOVE(GEMÆIÅÆ1Å,FCB.FNAME,11);
                    BDOS(35,ADDR(FCB));
                    J:=J+((FCB.RECNO+7) DIV 8);
                    WRITE(((FCB.RECNO+7) DIV 8):6,'k');
                 END;
            'Z': BEGIN
                    IF L>1 THEN
                    BEGIN
                       WRITE('  ? (J/N): ');
                       REPEAT UNTIL GETCON(CH) AND (CH IN Æ'J','N'Å);
                       WRITE(CH);
                    END;
                    IF (L=1) OR (CH='J') THEN
                    BEGIN
                       MOVE(GEMÆIÅÆ1Å,FCB.FNAME,11);
                       BDOS(19,ADDR(FCB));
                       WRITE('  Slettet!!');
                    END;
                 END;
         END;
         WRITELN;
         IF GETCON(CH) THEN REPEAT UNTIL GETCON(CH);
      END;
      IF FUN='X' THEN
      BEGIN
         WRITELN('  --------------   ----');
         WRITELN('  TOTAL         ',J:6,'k');
      END;
   END;
   
   TEM:
END;
«eof»