PROGRAM Backup;
{written by Frank Riemenschneider
            Postfach 730309
            3000 Hannover 71}

USES DOS,PORTCRT;

{$M 2000,65536,65536}

TYPE
buf = array[1..65535] of byte;    {Puffer f�r Magnetkarten-Daten}

VAR
groesse,segment,i : word;
puffer : ^buf;
s : char;
erster,letzter,status,starttrack,endtrack,ascii : byte;
form : string[4];

{-- Bearbtrack : Liest oder schreibt Sektor der Magnetkarte -----}
{-- Eingabe : Modus (2=lesen, 3=schreiben), Track, Sektor   -----}
{-- Ausgabe : Error-Code (0=Fehlerfrei)                     -----}

FUNCTION bearbtrack(modus,track,sektor:byte) : byte;
VAR cylinder,seite : byte;
reg : registers;
position : word;
BEGIN
  seite := 0;
  seite := Trunc(track/16);         {Karten'Seite' (0 oder 1)}
  cylinder := track - 16*seite;     {Karten'Zylinder' (0 bis 15)}
  reg.ah := modus;
  reg.dl := 0;
  reg.dh := seite;
  reg.ch := cylinder;
  reg.cl := sektor;
  reg.al := 1;                     {1 Sektor lesen}
  reg.es := Segment;
  position := (track-erster)*groesse*8+(sektor-1)*groesse;
  reg.bx := position;              {Pufferpositon des Sektors berechnen}
  Intr($13,reg);
  bearbtrack := reg.ah;            {Error-Code zur�ckgeben}
END;

{-- Maketrack : Liest/Beschreibt/Verifiziert einen Track    -----}
{-- Eingabe : Tracknummer, Modus (2=L,3=S,4=V)              -----}
{-- Ausgabe : Error-Code (0=Fehlerfrei)                     -----}

FUNCTION maketrack(track,modus : byte) : byte;
VAR status,i : byte;
BEGIN
  i := 1;
  status := 0;
  WHILE ((i<= 8) and (status=0)) do BEGIN
    status := bearbtrack(modus,track,i);
    inc(i);
  END;
  maketrack := status;
END;

{-- Formattrack : Formatiert einen Track                    -----}
{-- Eingabe : Tracknummer                                   -----}
{-- Ausgabe : Error-Code (0=Fehlerfrei)                     -----}

FUNCTION Formattrack(track : byte) : byte;
VAR modus : byte;
BEGIN
   modus := 5;
   IF track = 0 THEN modus := $83;
   Formattrack := bearbtrack(modus,track,1);
END;

{-- Leseein : Liest einen Bereich der Magnetkarte           -----}
{-- Eingabe : Erster Track, letzter Track                   -----}
{-- Ausgabe : Error-Code (0=Fehlerfrei)                     -----}

FUNCTION leseein(erster,letzter : byte) : byte;
VAR i,status : byte;
BEGIN
  status := 0;
  i := erster;
  WHILE ((status = 0) and (i<=letzter)) do BEGIN
     status := maketrack(i,2);
     inc(i);
  END;
  leseein := status;
END;

{-- Schreibeauf : Beschreibt einen Bereich der Magnetkarte  -----}
{-- Eingabe : Erster Track, letzter Track                   -----}
{-- Ausgabe : Error-Code (0=Fehlerfrei)                     -----}

FUNCTION schreibeauf(erster,letzter : byte) : byte;
VAR i,status : byte;
reg : registers;
BEGIN
  status := 0;
  IF (form = '  Ja') THEN BEGIN
    i := erster;
    WHILE ((status = 0) and (i<=letzter)) do BEGIN
       status := Formattrack(i);
       inc(i);
    END;
  END;
  i := erster;
  WHILE ((status = 0) and (i<=letzter)) do BEGIN
     status := maketrack(i,3);
     inc(i);
  END;
  WHILE ((status = 0) and (i<=letzter)) do BEGIN
     status := maketrack(i,4);
     inc(i);
  END;
  schreibeauf := status;
END;

{--------------------- Start Hauptprogramm ---------------------}

BEGIN
 New(puffer);
 groesse := 128;
 endtrack := 31;
 starttrack := 0;
 form := 'Nein';
 Segment := Memw[seg(puffer):ofs(puffer)+2];
 ClrScr;
 GotoXY(0,0);
 writeln('***************************************');
 writeln('*     C C M  -  C O P Y  V  1 . 0     *');
 writeln('* (C) 1990 Markt & Technik Verlag AG  *');
 writeln('*   written by Frank Riemenschneider  *');
 writeln('***************************************');
 writeln('* Starttrack : <  >  Endtrack : <  >  *');
 writeln;
 write('***************************************');
 REPEAT
   GotoXY(0,6);
   write('* <C>opy <F>ormat Ziel:       <E>nde  *');
   GotoXY(16,5);
   write('  ');
   GotoXY(16,5);
   write(starttrack);
   GotoXY(33,5);
   write('  ');
   GotoXY(33,5);
   write(endtrack);
   GotoXY(24,6);
   write(form);
   REPEAT
   UNTIL Keypressed;
   s := UpCASE(readKey);
   ascii := Ord(s);
   CASE ascii of
     0 : BEGIN
           s := ReadKey;
           CASE s of
             chr(80) : IF starttrack > 0 THEN dec(starttrack);
             chr(72) : IF ((starttrack < 31) and (starttrack < endtrack)) THEN inc(starttrack);
             chr(75) : IF ((endtrack > 0) and (endtrack > starttrack)) THEN dec(endtrack);
             chr(77) : IF endtrack < 31 THEN inc(endtrack);
           END;
          END;
     67 : BEGIN
            GotoXY(2,6);
            write('Bitte Q U E L L - Karte einlegen   ');
            s := ReadKey;
            erster := 0;        {Boot-Sektor lesen}
            letzter := 0;
            status := leseein(erster,letzter);
            IF status = 0 THEN BEGIN
              groesse := Memw[Segment:11];  {KartengrӇe holen}
              erster := starttrack;
              letzter := endtrack;
              REPEAT
                IF ((groesse = 512) and (letzter > erster+15)) THEN
                    letzter := erster + 15;
                IF erster > starttrack THEN BEGIN
                  GotoXY(2,6);
                  write('Bitte Q U E L L - Karte einlegen   ');
                  s := ReadKey;
                END;
                GotoXY(2,6);
                write('Lese Daten ein .......             ');
                status := leseein(erster,letzter);
                IF status = 0 THEN BEGIN
                   GotoXY(2,6);
                   write('Bitte Z I E L - Karte einlegen     ');
                   s := ReadKey;
                   GotoXY(2,6);
                   write('Schreibe Daten .....               ');
                   status := schreibeauf(erster,letzter);
                END;
                erster := letzter+1;
                letzter := endtrack;
              UNTIL ((status <>0) or (erster > endtrack));
            END;
            GotoXY(2,6);
            IF status = 0 THEN BEGIN
              write('Kopiervorgang abgeschlossen !      ');
            END
            ELSE BEGIN
              write('Fehler : ');
              CASE status of
                 $01 : write('Falsche Funktionsnummer');
                 $02 : write('Keine Adressmarkierung ');
                 $03 : write('Karte schreibgesch�tzt ');
                 $04 : write('Sektor nicht gefunden  ');
                 $08 : write('DMA - šberlauf         ');
                 $09 : write('Segmentgrenze-šberlauf ');
                 $10 : write('Lesefehler             ');
                 $20 : write('Fehler des Controllers ');
                 $40 : write('Track nicht gefunden   ');
                 $80 : write('Laufwerk reagiert nicht');
               END;
            END;
            s := ReadKey;
          END;
          70 : BEGIN
                 IF form = 'Nein' THEN BEGIN
                    form := '  Ja';
                 END
                 ELSE BEGIN
                    form := 'Nein';
                 END;
               END;
   END;
 UNTIL ascii = 69;
 ClrScr;
 Dispose(puffer);
END.