(* 1---Module 05---1 *)

  FUNCTION sizedos_file(VAR a : sizearray) : real;

    BEGIN (* sizedos_file *)
    sizedos_file := a[1] + 256.0*(a[2] + 256.0*(a[3] + 256.0*a[4]));
    END; (* sizedos_file *)

  (* 1---------------1 *)

  PROCEDURE dirms_dos(short : boolean);

    VAR
      perline,
      errorcode,
      count, i       : integer;
      x              : real;
      filename       : str20;
      monthstring    : ARRAY[0..38] OF char;
      nbytes         : real;

    (* 2---------------2 *)

    PROCEDURE longformat;

      VAR
        i, n           : integer;

      (* 3---------------3 *)

      PROCEDURE leadingzero(n : integer);

        BEGIN (* leadingzero *)
        IF n < 10 THEN write('0');
        write(n);
        END; (* leadingzero *)

      (* 3---------------3 *)

      BEGIN (* longformat *)
      WITH dos_fcb^ DO BEGIN
        write('  '); n := attribute;
        IF volumename THEN write('<VolNam>')
        ELSE IF subdirname THEN write('<SubDir>')
        ELSE BEGIN
          FOR i := 1 TO 8 DO BEGIN
            write(chr(((n shr 7) AND 1) + $30));
            n := n shl 1; END;
          END;

        write(clusterno : 7); write('  ');

        n := 3 * ((date shr 5) AND $f);
        IF (n > 36) THEN n := 0;
        FOR i := n TO n+2 DO write(monthstring[i]);
        write(' '); n := date AND $1f;
        leadingzero(n);
        write(',', (date shr 9) + 1980);

        write('  '); n := (time shr 11);
        leadingzero(n); write(':');
        n := ((time shr 5) AND 63);
        leadingzero(n); write(':'); n := ((time AND $1f) * 2);
        leadingzero(n);
        write(sizedos_file(filesize) : 8 : 0);
        nbytes := nbytes + sizedos_file(filesize); END;
      END; (* longformat *)

    (* 2---------------2 *)

    BEGIN (* dirms_dos *)
    monthstring := '...JanFebMarAprMayJunJulAugSepOctNovDec';
    count := 0; identifyms_dos;
    IF NOT (identity = unidentified) THEN BEGIN
      IF short THEN BEGIN
        filename := ''; perline := 5; END
      ELSE BEGIN
        perline := 1; nbytes := 0.0;
        clrscr; writeln; write('Dir Mask: ');
        readln(filename); writeln;
        writeln('Name', 'Attributes' : 18, 'Clstr' : 7, 'Date' : 13,
                'Time' : 10, 'Size' : 8);
        FOR i := 1 TO 59 DO write('-'); END;
      searchfirst(filename, errorcode);
      REPEAT
        IF (errorcode = 0) THEN BEGIN
          IF count MOD perline <> 0 THEN write(' | ')
          ELSE BEGIN
            writeln;
            IF (count DIV perline MOD perscreen = 0) AND
               (count >= perline) THEN pause; END;
          count := succ(count);

          WITH dos_fcb^ DO BEGIN
            FOR i := 1 TO namesize DO write(name[i]);
            write('.');
            FOR i := 1 TO typesize DO write(extention[i]);
            IF NOT short THEN longformat; END;
          END;
        searchnext(filename, errorcode);
      UNTIL (errorcode = $ff) OR break;
      writeln;
      IF NOT short THEN BEGIN
        write(nbytes : 1 : 0, ' bytes in ', count : 1, ' files.  ');
        continue; END;
      END;
    END; (* dirms_dos *)

  (* 1---------------1 *)

  PROCEDURE readms_dos;

    VAR
      filename       : str20;
      i, err         : integer;
      stop           : boolean;

    (* 2---------------2 *)

    PROCEDURE copyfiles;

      VAR
        rcdspercluster : integer;
        i              : integer;
        cpmname        : str20;
        cpmfile        : FILE;
        skip           : boolean;
        ch             : char;

      (* 3---------------3 *)

      PROCEDURE copyone;

        VAR
          cl, i          : integer;
          size, sz       : real;

        BEGIN (* copyone *)
        rewrite(cpmfile);
        cl := dos_fcb^.clusterno;
        size := sizedos_file(dos_fcb^.filesize);
        WHILE (cl < $ff8) DO BEGIN
          readcluster(cl);
          FOR i := 1 TO rcdspercluster DO BEGIN
            sz := size; 
            WHILE (sz < 127.99) AND (sz > 0.01) DO BEGIN
              (* pad with CPM eof chars *)
              clusterbuffer[succ((pred(i) * 128) + round(sz))] := eofmk;
              sz := sz + 1.0; END;
            IF size > 0.01 THEN      (* Don't Compare Reals With Zero *)
              blockwrite(cpmfile, clusterbuffer[succ((pred(i) * 128))], 1);
            size := size - 128.0; END;
          cl := fatpointer(cl); (* Point to Next Cluster *) END;
        close(cpmfile);
        END; (* copyone *)

      (* 3---------------3 *)

      BEGIN (* copyfiles *)
      rcdspercluster := recordspersector * secspercluster;
      REPEAT
        cpmname := '';
        FOR i := 1 TO namesize DO
          IF NOT (dos_fcb^.name[i]=' ') THEN
            cpmname := cpmname + dos_fcb^.name[i];
        cpmname := cpmname + '.';
        FOR i := 1 TO typesize DO
          cpmname := cpmname + dos_fcb^.extention[i];
        cpmname := concat(cpm_drivech, ':', cpmname);
        writeln; write(cpmname);
        assign(cpmfile, cpmname);
        skip := exists(cpmfile);
        IF skip THEN BEGIN
          write(' exists, purge (y/N)?'); read(kbd, ch);
          ch := upcase(ch);
          IF ch = 'Y' THEN BEGIN
            write(' Yes, overwriting'); skip := false; END
          ELSE write(' No, not copied'); END;
        IF NOT skip THEN copyone;
        REPEAT
          searchnext(filename, err);
        UNTIL NOT (volumename OR subdirname);
        stop := break;
      UNTIL (err = eodirectory) OR stop;
      writeln;
      END; (* copyfiles *)

    (* 2---------------2 *)

    BEGIN (* readms_dos *)
    identifyms_dos;
    IF NOT (identity = unidentified) THEN BEGIN
      clrscr;
      write('File Transfer From MS-DOS to CP/M, MS-DOS directory');
      dirms_dos(true); writeln;
      write('File Name to Get From MS-DOS to CP/M : ');
      readln(filename); stop := false;
      IF filename = '' THEN stop := true
      ELSE BEGIN
        searchfirst(filename, err);
        WHILE volumename OR subdirname DO searchnext(filename, err);
        IF (err = eodirectory) THEN write('File Not Found, ')
        ELSE BEGIN
          write('Transfering -'); copyfiles; END;
        END;
      IF stop THEN write('Aborted, ');
      continue; END;
    END; (* readms_dos *)

  (* 1---------------1 *)

  PROCEDURE mapms_dos;

    VAR
      nused, f     : integer;
      bpercluster  : real;

    BEGIN (* mapms_dos *)
    identifyms_dos;
    IF NOT (identity = unidentified) THEN BEGIN
      bpercluster := sectorsize * secspercluster;
      clrscr; nused := 0; write(' ' : 10);
      FOR i := 2 TO nclusters + 1 DO BEGIN
        IF (i MOD 16) = 0 THEN writeln
        ELSE IF i > 2 THEN write(',');
        f := fatpointer(i);
        IF f = 4095 THEN write(' end')
        ELSE write(f : 4);
        IF f <> 0 THEN nused := succ(nused); END;
      writeln;
      write(bpercluster * (nclusters-nused) : 1 : 0,'/');
      write(bpercluster * nused : 1 : 0, ' Bytes free/allocated.  ');
      continue; END;
    END; (* mapms_dos *)

  (* 1-End Module 05-1 *)