Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FILECOPY.ZIP/FCOPY.PAS

Pascal/Delphi Source File | 1993-01-04 | 19.4 KB | 671 lines

{$C-}
{
reads a master DSDD disk into memory.
writes it to drives A and B in alternation without rereading the master.
requires 2 floppy drives (could be modified for a single one).
works for DSDD DOS 2.0+ 360K floppies only.
works for PC-DOS only.

written 7/28/86, Kim Kokkonen, TurboPower Software
Compuserve 72457,2131.

Altered by Bill Bliss to format disks, too (2/87).
Altered by Bill Bliss and Mark Solinski to handle 64K DMA boundary conditions
  that occur on some cheap IBM clones (4/20/87).

Released to the public domain.
}

program fcopy;
  { fast DSDD disk copier }

{ Demonstrates formatting a floppy disk from Turbo Pascal.
  This version only formats DSDD 9 sector floppies (360KB).
  Works with DOS 2.0 or 3.0 in either 360K or 1.2M drives.
  Does not support a /S option.

  If DoVerify is false, obtain a 2x speedup vs. DOS format.

  Requires Turbo version 3.0 to compile.

  Requires a cloning procedure after being compiled to a .COM file.
  The cloning procedure copies the boot sector of an already-formatted
  floppy into the program, where it can be used thereafter. To clone,
  call the program as follows:

  ProgramName @ <enter>

  Written 10/26/85. Kim Kokkonen, TurboPower Software.
  Compuserve 72457,2131.

  Altered slightly by Bill Bliss, The Whitewater Group,
  so that it could be used as an include file by FCOPY.PAS.
}

const
  ProgramName = 'FCOPY.COM';

  TYPE
    {holds sector data during sector setup after formatting}
    SectorBuffer = ARRAY[1..512] OF Char;
    {same size as sector buffer but easily initialized in code segment}
    FakeSectorBuffer = RECORD
                         l, h : STRING[255];
                       END;
    FormatRecord = RECORD
                     cyl, hed, rec, num : Byte;
                   END;
    FormatArray = ARRAY[1..18] OF FormatRecord;
    DiskBaseRec = RECORD
                    unk1, unk2, mtr, bps, eot, gpl,
                    dtl, glf, fbf, hst, mst : Byte;
                  END;
    DiskBasePtr = ^DiskBaseRec;
    registers = RECORD
                  CASE Integer OF
                    1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
                    2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
                END;
    FATtable = ARRAY[0..1023] OF Byte;

  CONST
    BootRecord : FakeSectorBuffer = {fill in with bootrecord}
    (l : ''; h : '');

  VAR
    reg : registers;
    SB : SectorBuffer;        {will fill in with dir sectors}
    BR : SectorBuffer ABSOLUTE BootRecord;
    VB : ARRAY[1..9] OF SectorBuffer; {will use for fast verify}
    FMT : FormatArray;
    FAT : FATtable;
    Drive, dType : Byte;
    ch : Char;
    BiosDiskBase : DiskBasePtr ABSOLUTE 0 : $78;
    OldDiskBase : DiskBasePtr;
    error : Integer;

  PROCEDURE BIOSreadSectors(funct, drive : Byte;
                            sector, track, head : Integer;
                            sects : Integer;
                            VAR buffer;
                            VAR error : Integer);
      { execute int 13 to read disk or verify via BIOS at low level}
    BEGIN
      reg.ax := (funct SHL 8) OR sects;
      reg.dl := drive;
      reg.dh := head;
      reg.ch := track AND 255;
      reg.cl := (sector AND 63) OR ((track SHR 8) SHL 6);
      reg.es := Seg(buffer);
      reg.bx := Ofs(buffer);
      Intr($13, reg);
      IF Odd(reg.flags AND 1) THEN
        error := reg.ax SHR 8
      ELSE
        error := 0;
    END {biosreadsectors} ;

  PROCEDURE BIOSwriteSectors(drive : Byte;
                             sector, track, head : Integer;
                             sects : Integer;
                             VAR buffer;
                             VAR error : Integer);
      { execute int 13 to write disk via BIOS at low level}
    BEGIN
      reg.ax := $300 OR sects;
      reg.dl := drive;
      reg.dh := head;
      reg.ch := track AND 255;
      reg.cl := (sector AND 63) OR ((track SHR 8) SHL 6);
      reg.es := Seg(buffer);
      reg.bx := Ofs(buffer);
      Intr($13, reg);
      IF Odd(reg.flags AND 1) THEN
        error := reg.ax SHR 8
      ELSE
        error := 0;
    END {BIOSWriteSectors} ;


  PROCEDURE InitBoot;
      { self-customize this program to hold the boot record}
    VAR
      ch : Char;
      error : Integer;
      f : FILE;
      tries : Byte;

    FUNCTION CodeSize : Integer;
        {thanks to Bob Tolz and Randy Forgaard for this function}
      VAR
        i : Byte;
      BEGIN
        i := 11;
        WHILE NOT((Mem[DSeg-2 : i+3] <> $00E9) AND (MemW[DSeg-2 : i+4] = $0000)) AND
        NOT((MemW[DSeg-2 : i+0] = $00E9) AND (MemW[DSeg-2 : i+2] = $E800)) DO
          i := i+1;
        CodeSize := ((((DSeg-2)-CSeg) SHL 4)+i+6)-$100
      END {CodeSize} ;

    BEGIN
      WriteLn('You will now clone a copy of the boot record into this program...');
      WriteLn('The completed version will be written to ',ProgramName,'.');
      Write('Place a DOS formatted disk in drive A: and press any key when ready.');
      repeat until keypressed;
      WriteLn;
      {read the boot record}
      tries := 0;
      REPEAT
        tries := Succ(tries);
        BIOSreadSectors(2, 0, 1, 0, 0, 1, BR, error);
      UNTIL (error = 0) OR (tries = 3);

      IF error <> 0 THEN BEGIN
        WriteLn('Could not read boot record.');
        Halt;
      END;
      {clone this program}
      Assign(f, ProgramName);
      Rewrite(f, 1);
      BlockWrite(f, Mem[CSeg : $100], CodeSize);
      Close(f);
      Halt;
    END {initboot} ;

  FUNCTION DOSversion : Byte;
      { return the major version number of DOS}
    BEGIN
      reg.ah := $30;
      MsDos(reg);
      DOSversion := reg.al;
    END {DOSversion} ;

  FUNCTION ATmachine : Boolean;
      { Return true if machine is AT class}
    VAR
      machtype : Byte ABSOLUTE $FFFF : $000E;
    BEGIN
      ATmachine := (machtype = $FC);
    END {ATmachine} ;

  PROCEDURE readDASD(drive : Byte; VAR dType : Byte);
      { read dasd for DOS 3 }
      { whatever dasd is! }
    BEGIN
      reg.ah := $15;
      reg.dl := drive;
      Intr($13, reg);
      IF Odd(reg.flags AND 1) THEN BEGIN
        WriteLn('error reading DASD for format...');
        Halt;
      END;
      dType := reg.ah;
    END {readdasd} ;

  PROCEDURE setDASD(drive, dType : Byte);
      { execute int 13 to "set DASD" for format of 360K disks on 1.2MB
        floppies}
    VAR
      tries : Byte;
    BEGIN
      tries := 0;
      REPEAT
        tries := Succ(tries);
        reg.ah := $17;
        reg.al := dType;
        reg.dl := drive;
        Intr($13, reg);
      UNTIL (tries = 3) OR NOT(Odd(reg.flags AND 1));

      IF Odd(reg.flags AND 1) THEN BEGIN
        WriteLn('error setting DASD for format...');
        Halt;
      END;
    END {setdasd} ;

  PROCEDURE InitFAT;
      { initialize a FAT sector}
    BEGIN
      {fill fat with all zeros}
      FillChar(FAT, 1024, 0);
      {fill in the ID Bytes}
      FAT[0] := $FD;          {9 sector DSDD drive}
      FAT[1] := $FF;          {boilerplate}
      FAT[2] := $FF;
    END {initfat} ;

  PROCEDURE InitDiskBase;
      { modify the disk base data per DOS 3 instructions}
    BEGIN
      {save old pointer}
      OldDiskBase := BiosDiskBase;
      {make a new disk base data area}
      New(BiosDiskBase);
      {put the data from the old area in the new one}
      BiosDiskBase^ := OldDiskBase^;
      {modify per dos 3 instructions, doesn't hurt on DOS 2}
      BiosDiskBase^.glf := $50;
      BiosDiskBase^.eot := 9;
    END {initdiskbase} ;

  PROCEDURE Format(drive : Byte; VAR FMT : FormatArray; VAR error : Integer);
      { lay down format tracks }
    VAR
      i : Integer;
    BEGIN
      {initialize format table}
      FOR i := 1 TO 9 DO
        WITH FMT[i] DO BEGIN
          cyl := 0;           {cylinder number, will fill in during format}
          hed := 0;           {head number}
          rec := i;           {sector number}
          num := 2;           {indicates 512 bytes per sector}
        END;
      FOR i := 1 TO 9 DO
        WITH FMT[i+9] DO BEGIN
          cyl := 0;           {cylinder number, will fill in during format}
          hed := 1;           {head number}
          rec := i;           {sector number}
          num := 2;           {indicates 512 bytes per sector}
        END;
      {write the format information}
      INLINE(
        $8A/$56/$0C/          {MOV    DL,[BP+0C] - get drive number}
        $C4/$5E/$08/          {LES    BX,[BP+08] - get pointer to format array}
        $B9/$01/$00/          {MOV    CX,0001 - track 0 sector 1}

        {nexttrack: - loop over 40 disk tracks}
        $8B/$FB/              {MOV    DI,BX - index into format array}
        $B0/$12/              {MOV    AL,12 - number of sectors per track = 18}

        {inittrack: - loop over 18 sectors per track}
        $26/$88/$2D/          {MOV    ES:[DI],CH - track track number in format array}
        $81/$C7/$04/$00/      {ADD    DI,0004}
        $FE/$C8/              {DEC    AL}
        $75/$F5/              {JNZ    inittrack}

        $B6/$00/              {MOV    DH,00 - format 9 sectors on side 0}
        $B8/$01/$05/          {MOV    AX,0501}
        $CD/$13/              {INT    13}
        $72/$18/              {JB     error - check for errors}

        $B6/$01/              {MOV    DH,01 - format 9 sectors on side 1}
        $B8/$01/$05/          {MOV    AX,0501}
        $53/                  {PUSH    BX}
        $81/$C3/$24/$00/      {ADD    BX,0024}
        $CD/$13/              {INT    13}
        $72/$0A/              {JB     error - check for errors}

        $5B/                  {POP    BX}
        $FE/$C5/              {INC    CH - next track}
        $80/$FD/$28/          {CMP    CH,28}
        $75/$D2/              {JNZ    nexttrack}

        $31/$C0/              {XOR    AX,AX - no errors, return 0}

        {error:}
        $C4/$7E/$04/          {LES    DI,[BP+04]}
        $26/$89/$05           {MOV    ES:[DI],AX - return error code}
        );
    END {format} ;

  PROCEDURE Verify(drive : Byte; VAR FAT : FATtable; VAR error : Integer);
      { verify that sectors were formatted }
    VAR
      t, h : Integer;
      cluster, fatofs, topcluster, content : Integer;
    BEGIN
      { initialize the verify buffer - 9 sectors * 512 bytes }
      FillChar(VB, 4608, $F6);
      { verify all sectors }
      FOR t := 0 TO 39 DO
        FOR h := 0 TO 1 DO BEGIN
          BIOSreadSectors(4, drive, 1, t, h, 9, VB, error);

          IF error <> 0 THEN BEGIN
            { mark the clusters on this track as unavailable }
            cluster := ((9*(h+2*t)) DIV 2)-4;
            topcluster := cluster+5;
            WHILE cluster < topcluster DO BEGIN
              fatofs := (3*cluster) DIV 2;
              {get a word from the FAT}
              Move(FAT[fatofs], content, 2);
              {replace 12 bits of the word}
              IF Odd(cluster) THEN
                content := content OR $FF70
              ELSE
                content := content OR $0FF7;
              {store it back}
              Move(content, FAT[fatofs], 2);
              cluster := Succ(cluster);
            END;
          END;
        END;
    END {verify} ;

  PROCEDURE InitDIR;
      { initialize a sector for the root directory}
    VAR
      i : Integer;
    BEGIN
      {fill with format bytes}
      FillChar(SB, 512, $F6);
      {mark each directory entry as available}
      FOR i := 1 TO 481 DO
        IF ((i-1) MOD 32) = 0 THEN SB[i] := #0;
    END {initdir} ;


function FormatDisk(Parameter : Integer;
                    DoVerify : boolean): Integer;

BEGIN

    CASE Parameter OF
      -1 : InitBoot;     {clone the boot record into this program}
    ELSE
      drive := Parameter;
    END;

    {make sure the boot record has been cloned into program}
    IF BR[1] = #0 THEN BEGIN
      WriteLn('You must first initialize this program.');
      WriteLn('Type ',ProgramName,' @ <Enter> to initialize.');
      Halt;
    END;

    {get BIOS drive number}

    IF ATmachine AND (DOSversion = 3) THEN
      BEGIN

        {get the drive type, necessary when dealing with 1.2MB drives}
        readDASD(drive, dType);
        IF (dType = 0) OR (dType = 3) THEN BEGIN
          WriteLn('Drive is not present or non-removable.');
          Halt;
        END;
        IF dType = 2 THEN
          begin
            WriteLn('Cannot format a 360K floppy in 1.2MB drive.');
            Halt;
          end;

        { Set the DASD type accordingly}
        setDASD(drive, dType);

      END;

      { Set up the disk_base table }
      InitDiskBase;

      { Lay down format tracks }
      Format(drive, FMT, error);

      { Restore the disk_base table }
      BiosDiskBase := OldDiskBase;

      IF error <> 0 THEN BEGIN
        FormatDisk := Error;
        Exit;
      END;

      { Initialize the FATtable}
      InitFAT;

      IF doVerify THEN BEGIN
        {verify sectors}
        Verify(drive, FAT, error);
        IF error <> 0 THEN
          begin
            WriteLn('Bad disk, format not verified...');
            FormatDisk := Error;
          end
      END;

      {write the boot record}
      BIOSwriteSectors(drive, 1, 0, 0, 1, BR, error);

      {write the FAT sectors}
      Move(FAT[0], SB, 512);
      BIOSwriteSectors(drive, 2, 0, 0, 1, SB, error);
      Move(FAT[512], SB, 512);
      BIOSwriteSectors(drive, 3, 0, 0, 1, SB, error);
      Move(FAT[0], SB, 512);
      BIOSwriteSectors(drive, 4, 0, 0, 1, SB, error);
      Move(FAT[512], SB, 512);
      BIOSwriteSectors(drive, 5, 0, 0, 1, SB, error);

      {write the root directory}
      InitDIR;
      BIOSwriteSectors(drive, 6, 0, 0, 1, SB, error);
      BIOSwriteSectors(drive, 7, 0, 0, 1, SB, error);
      BIOSwriteSectors(drive, 8, 0, 0, 1, SB, error);
      BIOSwriteSectors(drive, 9, 0, 0, 1, SB, error);
      BIOSwriteSectors(drive, 1, 0, 1, 1, SB, error);
      BIOSwriteSectors(drive, 2, 0, 1, 1, SB, error);
      BIOSwriteSectors(drive, 3, 0, 1, 1, SB, error);

      FormatDisk := Error;

END;

procedure Beep;

begin
  Sound(420);
  Delay(20);
  NoSound;
end;

const
  VerifyFormat = False;
  drivea = 0;
  driveb = 1;

type
  { Holds sector data during sector setup after formatting}
  TrackBuffer = array[1..9] of SectorBuffer;
  TrackPtr = ^TrackBuffer;
  diskarray = array[0..39, 0..1] of TrackPtr;

var
  data : diskarray;
  count : Integer;
  t1 : Real;

  procedure BIOSdiskReset;
    { reset the diskettes after an error}
  begin
    reg.ah := 0;
    Intr($13, reg);
  end {BIOSdiskReset} ;

  function Cardinal(i : Integer) : Real;
    { return a real 0..65535}
  var
    r : Real;
  begin                       {Cardinal}
    r := i;
    if r < 0.0 then r := r+65535.0;
    Cardinal := r;
  end {Cardinal} ;

  procedure ReadMasterDisk(drive : Byte);
    { read a full DSDD floppy from drive A}
  var
    t, s, h : Integer;
    error : Integer;
    ch : Char;
    tries : Integer;
  begin                       {ReadMasterDisk}
    Write(0:2);
    for t := 0 to 39 do begin
      Write(^H^H, t:2);
      for h := 0 to 1 do begin
        New(data[t, h]);
        tries := 0;
        repeat
          tries := Succ(tries);
          BIOSreadSectors(2, drive, 1, t, h, 9, data[t, h]^, error);
          if error = 9 then   { 64K DMA boundary condition }
            New(data[t, h])
          else
            if error <> 0 then
              BIOSdiskReset;
        until (error = 0) or (tries > 3);
        if error <> 0 then begin
          Write(^H^H'  ');
          WriteLn;
          WriteLn('Cannot read master disk'^G);
          Write('Insert diskette and press a key... ');
          Read(Kbd, ch);
          WriteLn;
        end;
      end;
    end;
    Write(^H^H'  ');
  end {ReadMasterDisk} ;

  procedure WriteDisk(drive : Byte);
    { write a full DSDD floppy from drive A}
  label
    retry;
  var
    t, s, h : Integer;
    error : Integer;
    good : Boolean;
    ch : Char;

    function time : Real;
      { return time of day in seconds since midnight}
    begin
      reg.ah := $2C;
      MsDos(reg);
      time := 1.0*(reg.dh+60.0*(reg.cl+60.0*reg.ch)+reg.dl/100.0);
    end {time} ;

    procedure BreakPressed;
      { halt if Ctrl-C is pressed}
    var
      ch : Char;
    begin                     {breakpressed}
      while KeyPressed do begin
        Read(Kbd, ch);
        if ch = ^C then begin
          WriteLn('^C');
          Halt(2);
        end;
      end;
    end {breakpressed} ;

  begin

    t1 := time;
    repeat

      breakpressed;
      WriteLn;
      Write(count:3, ' Writing to drive ', Chr(drive+65), ':, track number ');
      write(0:2);

      for t := 0 to 39 do begin
        write(^H^H, t:2);
        for h := 0 to 1 do begin
          BIOSwriteSectors(drive, 1, t, h, 9, data[t, h]^, Error);
          if Error <> 0 then
            begin
              case Error of
                $80 : begin { Timeout }
                        Beep;
                        writeln;
                        write('    Drive not ready.  Insert disk and press any key... ');
                     end;
                02 : begin
                       writeln;
                       write('    Disk is unformatted.  Formatting disk...');
                       Error := FormatDisk(Drive, VerifyFormat);
                       if Error <> 0 then
                         begin
                           Beep;
                           write('Error formatting disk.');
                         end
                       else
                         writeln('Format complete.');
                     end;
                03 : begin
                       writeln;
                       Beep;
                       write('    Disk is write protected.  Press any key to continue.');
                     end
                else
                  begin
                    writeln;
                    Beep;
                    write('    Disk may be unusable.  Press any key to continue.');
                  end
              end;
              if Error <> 0 then
                begin
                  repeat until KeyPressed;
                  BreakPressed;
                  writeln;
                end;
              Good := false;
              BIOSdiskReset;
              Goto Retry;
            end;
          end;
        end;

      count := Succ(count);
      good := True;


retry:

    until Good;
    writeln('    Elapsed time: ',(time-t1):0:2, ' seconds.');

  end {WriteDisk} ;


begin

  if ParamStr(1) = '@' then
    Error := FormatDisk(-1, VerifyFormat);

  WriteLn;

  {check for sufficient memory}
  if 16.0*Cardinal(MemAvail) < 370000.0 then begin
    WriteLn('Insufficient RAM space to read master disk');
    Halt;
  end;

  {prompt to read from drive a:}
  Write('Insert master disk into drive A. Press a key when ready... ');
  Read(Kbd, ch);
  WriteLn;

  {read the disk into memory}
  ReadMasterDisk(drivea);

  WriteLn;
  WriteLn('Insert first disk to copy in drive A.');
  WriteLn('Copies will alternate from A to B. Press ^C to stop.');
  Write('Press a key when ready... ');
  Read(Kbd, ch);
  WriteLn;
  WriteLn;
  count := 1;

  { loop copying to drives a and b }
  repeat
    WriteDisk(drivea);
    WriteDisk(driveb);
  until False;

end.