DataMuseum.dk

top - download

    Length: 7584 (0x1da0)
    Notes: Mikados TextFile, Mikados_K
    Names: »DISKCOPY«

└─⟦f1b095e24⟧ Bits:30005320 Katalogisering af disketter
    └─ ⟦this⟧ »DISKCOPY« 

Text

PROGRAM DISKCOPY;
 
(* BR-18.03.85 *)
 
TYPE BLOCK    = PACKED ARRAY (0..255) OF CHAR;
     BINÆRTRÆ = ^KNUDE;
     NAVNTYPE = STRING(8);
     KNUDE    = RECORD
                  NAVN : NAVNTYPE; 
                  VENSTRE, HØJRE : BINÆRTRÆ;
                END;
 
VAR DISCBUFFER          : BLOCK;
    DISC, ERRORCODE     : INTEGER;
    ROD, FIL            : BINÆRTRÆ;
    TRÆ2, TRÆ3          : ARRAY('0'..'Å') OF BINÆRTRÆ;
    FILTYPE             : CHAR;
    FUNDET              : BOOLEAN;
    DISKCAT3, MONIFP    : TEXT;
    MONIF32, MONIF23    : TEXT;
    NYTNAVN             : NAVNTYPE;
    TAL                 : INTEGER;
    
PROCEDURE PSCIU(VAR DISCBUFFER: BLOCK; DISC, TRACK, SECTOR,
                IOCODE: INTEGER; VAR ERRORCODE: INTEGER); EXTERNAL;
 
(********************************************************************)
 
PROCEDURE RANDOMIZE;
 
BEGIN
  TAL:=ROUND(1+TIME/100);
END; (*RANDOMIZE*)
 
(********************************************************************)
 
PROCEDURE INITIALISER;
 
BEGIN
  FOR FILTYPE:='0' TO 'Å' DO TRÆ2(FILTYPE):=NIL;
  FOR FILTYPE:='0' TO 'Å' DO TRÆ3(FILTYPE) :=NIL;
  ERRORCODE:=1;
  TAL:=1;
  RANDOMIZE;
  REWRITE(DISKCAT3,'DISKCAT3:P2:10');
  REWRITE(MONIF32,'MONIF32:P2:10');
  WRITELN(MONIF32,'>FCOPY,R');
  REWRITE(MONIF23,'MONIF23:P2:10');
  WRITELN(MONIF23,'>FCOPY,R');
  REWRITE(MONIFP,'MONIFP:P2:10');
  WRITELN(MONIFP,'>FPURG');
  CLEARSCREEN;
  WRITELN('KOPIERING AF DISKETTER FRA P3 TIL P2 OG RETUR':50);
  WRITELN('*********************************************':50);
  WRITELN;
END; (*INITIALISER*)
 
(********************************************************************)
 
PROCEDURE AFSLUT;
 
BEGIN
  CLOSE(DISKCAT3);
  CLEARSCREEN;
  WRITELN('MIKADOS VERSION 01.11.1984');
END; (*AFSLUT*)
 
(********************************************************************)
 
PROCEDURE TRÆINDSÆT(VAR ROD:BINÆRTRÆ; FIL:BINÆRTRÆ);
 
BEGIN
  IF ROD=NIL THEN
    ROD:=FIL
  ELSE
    IF FIL^.NAVN<ROD^.NAVN THEN
      TRÆINDSÆT(ROD^.VENSTRE,FIL) 
    ELSE
      TRÆINDSÆT(ROD^.HØJRE,FIL);
END; (*TRÆINDSÆT*)
 
(********************************************************************)
 
PROCEDURE FINDFIL(ROD:BINÆRTRÆ; FILNAVN:NAVNTYPE; VAR FUNDET:BOOLEAN);
 
BEGIN
  IF ROD=NIL THEN
    FUNDET:=FALSE 
  ELSE
    IF ROD^.NAVN=FILNAVN THEN
      FUNDET:=TRUE
    ELSE
      IF ROD^.NAVN>FILNAVN THEN
        FINDFIL(ROD^.VENSTRE,FILNAVN,FUNDET) 
      ELSE
        FINDFIL(ROD^.HØJRE,FILNAVN,FUNDET);
END; (*FINDFIL*)
 
(********************************************************************)
 
PROCEDURE RANDOMNAVN(VAR NAVN:NAVNTYPE);
 
VAR I, NUMMER  : INTEGER;
 
(*******************)
 
FUNCTION RND(VAR INT:INTEGER): REAL;
BEGIN
  INT:=253*INT+1;
  RND:=0.5+INT/65536.0;
END;
 
(*******************)
 
BEGIN
  FOR I:=1 TO LENGTH(NAVN) DO 
    NAVN(I):=CHR(ORD('A')+TRUNC(RND(TAL)*(ORD('Å')-ORD('A'))));
END; (*RANDOMNAVN*)
 
(********************************************************************)
 
PROCEDURE TRÆGENNEMLØB(ROD:BINÆRTRÆ; FILTYPE:CHAR);
 
BEGIN
  IF ROD<>NIL THEN
  BEGIN
    TRÆGENNEMLØB(ROD^.VENSTRE,FILTYPE);
(*  WRITELN(LIST,ROD^.NAVN,' ',FILTYPE);  *)
(*  WRITELN(DISKCAT3,ROD^.NAVN,' ',FILTYPE);*)
    NYTNAVN:=ROD^.NAVN;
    FINDFIL(TRÆ2(FILTYPE),ROD^.NAVN,FUNDET);
    IF FUNDET THEN      
      REPEAT
        WRITE(NYTNAVN,' ',FILTYPE,' FINDES      PÅ P2');
        RANDOMNAVN(NYTNAVN);
        WRITELN('    NYT NAVN : ',NYTNAVN);
        FINDFIL(TRÆ2(FILTYPE),NYTNAVN,FUNDET);
      UNTIL NOT FUNDET 
    ELSE
      WRITELN(ROD^.NAVN,' ',FILTYPE,' FINDES IKKE PÅ P2');
    WRITELN(MONIF32,ROD^.NAVN);
    WRITELN(MONIF32,NYTNAVN);
    WRITELN(MONIF23,NYTNAVN);
    WRITELN(MONIF23,ROD^.NAVN);
    WRITELN(MONIFP,NYTNAVN);
    WRITELN(MONIFP,FILTYPE);
    WRITELN(MONIFP,'2');
    TRÆGENNEMLØB(ROD^.HØJRE,FILTYPE);
  END;
END; (*TRÆGENNEMLØB*)
 
(********************************************************************)
 
PROCEDURE LÆSFILCAT(DISC:INTEGER);
 
CONST CAT2  = 256; (*ANTAL SEKTORER I KATALOGEN FOR P1/P2*)
      CAT3   = 64;  (*ANTAL SEKTORER I KATALOGEN FOR P3*)
      SPS2  = 32;  (*ANTAL SEKTORER PR. SPOR FOR P1/P2*)
      SPS3   = 16;  (*ANTAL SEKTORER PR. SPOR FOR P3*)
 
VAR CATSIZE, SEKTMAX, N : INTEGER;
    TRACK, SECTOR, IOCODE, J, L, CIFFER :INTEGER;
    FILNAVN : STRING(9);
 
BEGIN
  CASE DISC OF
  1,2: BEGIN
         CATSIZE:=CAT2;
         SEKTMAX:=SPS2;
       END;
  3  : BEGIN
         CATSIZE:=CAT3;
         SEKTMAX:=SPS3;
       END;
  END;
 
  FOR N:=1 TO CATSIZE DO
  BEGIN
    TRACK := N DIV SEKTMAX;
    SECTOR:= N MOD SEKTMAX;
    ERRORCODE:=0;
    IOCODE := 1;
    PSCIU(DISCBUFFER,DISC,TRACK,SECTOR,IOCODE,ERRORCODE);
    IF ERRORCODE <> 0 THEN EXIT(LÆSFILCAT);
 
    J:=0;
    REPEAT
      FILNAVN:='*********';
      FOR L := J TO J+8 DO
      BEGIN
        CIFFER := ORD(DISCBUFFER(L)) MOD 128;
        IF (CIFFER <= 126) AND (CIFFER>=32) THEN FILNAVN(L-J+1):=CHR(CIFFER);
      END;
      FILTYPE:=FILNAVN(9);
      FILNAVN:=COPY(FILNAVN,1,8);
      IF (SCAN(8,='*',FILNAVN(1))=8) AND (FILTYPE IN (.'0'..'Å'.)) THEN
      BEGIN
        NEW(FIL);
        FIL^.NAVN:=FILNAVN;
        FIL^.VENSTRE:=NIL;
        FIL^.HØJRE:=NIL;
        CASE DISC OF 
        1,2: TRÆINDSÆT(TRÆ2(FILTYPE),FIL);
        3  : TRÆINDSÆT(TRÆ3(FILTYPE),FIL);
        END;
(*      WRITELN(LIST,TRACK:3,'  ',SECTOR:2,'  ',FILNAVN,' ',FILTYPE);*)
      END;
      J:=J+13;
    UNTIL (FILNAVN='********') OR (J>=242);
  END; (*FOR N:=....*)
END; (*LÆSFILCAT*)
 
(**********************************************************************)
 
PROCEDURE MAIN;
 
VAR FILNAVN             : NAVNTYPE;
    FTYPE               : STRING(1);
    PCB1, PCB2, PCB3    : ^INTEGER;
    
BEGIN
  INITIALISER;
 
  FOR DISC:=3 DOWNTO 2 DO BEGIN
    WRITELN('Katalogen på disk P',DISC,' læses. VENT !');
    LÆSFILCAT(DISC);
    WRITELN;
  END;
 
  FOR FILTYPE:='0' TO 'Å' DO
    IF TRÆ3(FILTYPE)<>NIL THEN BEGIN
      WRITELN(MONIF32,'3');
      WRITELN(MONIF32,'2');
      WRITELN(MONIF32,FILTYPE);
      WRITELN(MONIF23,'2');
      WRITELN(MONIF23,'3');
      WRITELN(MONIF23,FILTYPE);
      TRÆGENNEMLØB(TRÆ3(FILTYPE),FILTYPE);
      WRITELN(MONIF32,' ');
      WRITELN(MONIF23,' ');
    END;
  WRITELN(MONIF32,'><');
  WRITELN(MONIF23,'><');
  WRITELN(MONIFP,'><');
  CLOSE(MONIF32);
  CLOSE(MONIF23);
  CLOSE(MONIFP);
  WRITELN;
(*WRITE('Fortryder du så tryk på <ESC>, ellers tryk på <RETURN> ');*)
(*READLN;*)
(*IF NOT EOF THEN BEGIN*)
(*  CHAIN('MONITOR *1','MONIF32:P2 ',PCB1);  *)
(*  WRITE('INDSÆT NY DISKETTE OG TRYK PÅ <RETURN> ');*)
(*  READLN;*)
(*  CHAIN('MONITOR *1','MONIF23:P2 ',PCB2);*)
(*  CHAIN('MONITOR *1','MONIFP:P2 ',PCB3);*)
(*END;*)
END; (*MAIN*)
 
(**********************************************************************)
 
BEGIN
  MAIN;
  IF ERRORCODE <> 0 THEN WRITELN ('ERRORCODE:', ERRORCODE:4);
  AFSLUT;
END.