home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 11 / praxis / megacopy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-09  |  26.1 KB  |  816 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    MEGACOPY.PAS                        *)
  3. (*       (c) 1989  Michael Holin  &  TOOLBOX              *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM MegaCopy;
  6.  
  7. {$I-,D-,S-,R-,V-}
  8.  
  9. USES Dos, Crt;
  10.  
  11. TYPE
  12.   FormatTyp = RECORD
  13.                 spur, seite, sektor, laenge : BYTE;
  14.               END;
  15. CONST
  16.   ver = 'MegaCopy (c) 1989 Michael Holin & TOOLBOX';
  17.   msgln = 22;  barln = 12;    txtln = 4;
  18.   Lesen = 2;   Schreiben = 3; Verify = 4;
  19.   FName = 'c:\mcopy.$$$';
  20.   Cat   = ' einlegen / A oder B für Directory';
  21.  
  22. VAR
  23.   Regs    : Registers;
  24.   FormBuff: ARRAY [1..18]   OF FormatTyp;
  25.   t       : ARRAY [0..160]  OF POINTER;
  26.   Buffer  : ARRAY [0..3999] OF BYTE;
  27.   GDT     : ARRAY [0..47]   OF BYTE;
  28.                                  { Global Descriptor Table }
  29.  
  30.   ErrCode, ei, ej, elast,
  31.   i, j, last, quell, ziel,
  32.   sp, sek, tries, DriveTyp : BYTE;
  33.   EMtracks, EM, cursor,
  34.   bytes, ii, segm, offs,
  35.   garp, ScrBase, coo       : WORD;
  36.   useEM, AT, amDOSlesen,
  37.   Verify_an, Format,
  38.   DochFormat, HD, useHD,
  39.   Again, NoPara, amEMlesen : BOOLEAN;
  40.   c, beep                  : CHAR;
  41.   f                        : FILE;
  42.   Master                   : POINTER;
  43.   EMadr                    : LONGINT;
  44.   ID        : BYTE ABSOLUTE $F000:$FFFE;      { AT oder XT }
  45.   VideoMode : BYTE ABSOLUTE 0:$449;      { Mono oder Color }
  46.   crsr      : WORD ABSOLUTE 0:$460;           { Cursorform }
  47.   tabseg    : WORD ABSOLUTE 0:122;
  48.                              { Zeiger auf Laufwerkstabelle }
  49.   tabofs    : WORD ABSOLUTE 0:120;
  50.  
  51. LABEL LOOP, NOCHMAL;
  52.  
  53.   PROCEDURE ClearLine(x, y : BYTE);
  54.                                  { löscht Bildschirmzeilen }
  55.   VAR
  56.     i, j : BYTE;
  57.   BEGIN
  58.     FOR i := x TO y DO BEGIN
  59.       GotoXY(1,i);
  60.       FOR j := 1 TO 40 DO Write(#32#32);
  61.     END;
  62.     GotoXY(1,x);
  63.   END;
  64.  
  65.   PROCEDURE Bye;
  66.   BEGIN
  67.     ClearLine(msgln, msgln);
  68.                            { eventuelles Blinken abstellen }
  69.     TextColor(LightGray);
  70.     Regs.ah := 1;
  71.     Regs.cx := cursor;
  72.     Intr(16, Regs);                    { Cursor wieder an! }
  73.     Halt;                              { Programm beenden  }
  74.   END;
  75.  
  76.   PROCEDURE ErrorMsg(TEXT : STRING);
  77.   BEGIN
  78.     GotoXY(1,24);
  79.     TextColor(LightRed);
  80.     WriteLn('Fatal: ', TEXT, beep);
  81.     Bye;
  82.   END;
  83.  
  84.   PROCEDURE Wait;
  85.   BEGIN
  86.     REPEAT UNTIL KeyPressed;
  87.     c := UpCase(ReadKey);
  88.     IF c = #0 THEN c := UpCase(ReadKey);
  89.     IF (c = #27) OR (c = #3) THEN Bye;      { ESC & CTRL C }
  90.     IF c = #13 THEN c := #7;
  91.     TextColor(LightGray);
  92.     CASE c OF
  93.       'Q': BEGIN                  { Ton an und ausschalten }
  94.              IF beep = #7 THEN beep := #32 ELSE beep := #7;
  95.              IF beep = #7 THEN Mem[ScrBase:158] := $20
  96.                           ELSE MemW[ScrBase:158] := $0751;
  97.              Wait;
  98.            END;
  99.       'F': IF sp > 0 THEN BEGIN { Format an und abschalten }
  100.              IF Format THEN Format := FALSE
  101.                        ELSE Format := TRUE;
  102.            GotoXY(65, txtln);
  103.            IF Format THEN Write('J') ELSE Write('N');
  104.            Wait;
  105.           END;
  106.      'V': IF sp > 0 THEN BEGIN  { Verify an und abschalten }
  107.             IF Verify_an THEN Verify_an := FALSE
  108.                          ELSE Verify_an := TRUE;
  109.             GotoXY(65, txtln+1);
  110.             IF Verify_an THEN Write('J') ELSE Write('N');
  111.             Wait;
  112.           END;
  113.     END;
  114.   END;
  115.  
  116.   PROCEDURE Input(a, b : CHAR);
  117.              { Wartet bis einer der übergebenen Buchstaben }
  118.   VAR
  119.     x, y : BYTE;                          { gedrückt wurde }
  120.   BEGIN
  121.     x := WhereX;  y := WhereY;
  122.     REPEAT
  123.       Wait;
  124.       GotoXY(x,y);  Write(c);
  125.     UNTIL (c = a) OR (c = b);
  126.   END;
  127.  
  128.   PROCEDURE CheckParameter;
  129.   VAR
  130.     a, b : STRING[1];
  131.     i    : BYTE;
  132.   BEGIN
  133.     Format    := FALSE;               { Grundeinstellungen }
  134.     Verify_an := FALSE;
  135.     Again     := TRUE;
  136.     NoPara    := TRUE;
  137.     beep      := #7;
  138.     IF ParamCount = 0 THEN Exit;
  139.     NoPara    := FALSE;
  140.     a         := ParamStr(1);
  141.     b         := ParamStr(2);
  142.     quell     := Ord(UpCase(a[1]))-65;
  143.     ziel      := quell;
  144.     IF ParamCount = 1 THEN Exit;
  145.     ziel      := Ord(UpCase(b[1]))-65;
  146.     IF ParamCount = 2 THEN Exit;
  147.     FOR i := 3 TO ParamCount DO BEGIN
  148.       a := ParamStr(i);
  149.       IF UpCase(a[1]) = 'V' THEN Verify_an := TRUE;
  150.       IF UpCase(a[1]) = 'F' THEN Format := TRUE;
  151.       IF UpCase(a[1]) = 'Q' THEN beep := #32;
  152.     END;
  153.   END;
  154.  
  155.   PROCEDURE Catalog(laufw : CHAR);
  156.   { der aktuelle Bildschirminhalt wird gerettet und das    }
  157.   { Directory des angegebenen Laufwerks angezeigt. Danach  }
  158.   { wird der alte Bildschirm wiederhergestellt.            }
  159.   VAR
  160.     dir : SearchRec;
  161.     x   : BYTE;
  162.   BEGIN
  163.     TextColor(LightMagenta);
  164.     Move(Mem[ScrBase:0], Buffer, 4000);
  165.     ClrScr;
  166.     WriteLn('Directory von Laufwerk ', laufw, ':');
  167.     TextColor(LightGray);
  168.     Regs.ah := 28;
  169.     Regs.dl := Ord(laufw)-64;
  170.     Intr(33, Regs);              { Laufwerk initialisieren }
  171.     IF Regs.al = 255 THEN
  172.       WriteLn(#13#10'Diskette ist nicht formatiert!')
  173.     ELSE BEGIN
  174.       FindFirst(laufw + ':\*.*', AnyFile - VolumeID, dir);
  175.       x := 1;
  176.       WHILE DosError = 0 DO BEGIN
  177.         GotoXY(x, WhereY);
  178.         Write(dir.name);
  179.         GotoXY(x+14, WhereY);
  180.         IF dir.attr AND 16 = 16 THEN WriteLn('(DIR)')
  181.                                 ELSE WriteLn(dir.size);
  182.         FindNext(dir);
  183.         IF WhereY = 25 THEN BEGIN
  184.           IF x < 50 THEN Inc(x, 25);
  185.           GotoXY(1,2);
  186.         END;
  187.       END;
  188.     END;
  189.     GotoXY(65,25);
  190.     Write('Press Any Key');
  191.     Wait;
  192.     ClrScr;
  193.     Move(Buffer, Mem[ScrBase:0], 4000);
  194.   END;
  195.  
  196.   PROCEDURE CenterAndWait(zeile : BYTE; TEXT : STRING);
  197.   { gibt übergebenen Text aus und wartet auf Tastendruck.  }
  198.   { Sollte A oder B gedrückt worden sein, so wird das      }
  199.   { entsprechende Directory angezeigt.                     }
  200.   VAR
  201.     spalte : BYTE;
  202.   BEGIN
  203.     spalte := 40 - (Length(TEXT) DIV 2);
  204.     GotoXY(spalte, zeile);
  205.     TextColor(Blink + LightRed);
  206.     Write(TEXT, beep);
  207.     REPEAT
  208.       Wait;
  209.       IF (c = 'A') OR (c = 'B') THEN BEGIN
  210.         Catalog(c);
  211.         CenterAndWait(zeile, TEXT);
  212.       END;
  213.     UNTIL (c <> 'A') AND (c <> 'B');
  214.     NormVideo;
  215.     ClearLine(zeile, zeile);
  216.   END;
  217.  
  218.   PROCEDURE LFehler;
  219.   BEGIN
  220.     GotoXY(1, msgln+1);
  221.     IF Regs.ah = 3 THEN
  222.       WriteLn('Disk ist schreibgeschützt!!')
  223.     ELSE
  224.       WriteLn('Ein Schreib-, Lese-Fehler: ', Regs.ah,
  225.               ' ist aufgetreten!', beep);
  226.     Write('R)etry, I)gnore, A)bort ?');
  227.     IF (Regs.ah <> 3) AND (NOT (amDOSlesen OR amEMlesen))
  228.         AND (NOT Format) THEN
  229.       Write(#8'oder F)ormatieren einschalten ?');
  230.     Wait;
  231.     CASE c OF
  232.       'R': ErrCode := 1;
  233.       'A': ErrCode := 2;
  234.       'F': BEGIN
  235.              Format     := TRUE;
  236.              DochFormat := TRUE;
  237.              ErrCode    := 1;
  238.            END;
  239.       'I': BEGIN
  240.              Mem[ScrBase:coo] := $45;    { ein E schreiben }
  241.              ErrCode:=3;
  242.            END;
  243.       ELSE ErrCode := 1;
  244.     END;
  245.     ClearLine(msgln+1, msgln+2);
  246.   END;
  247.  
  248.   PROCEDURE ClearBuffer;       { gibt Speicher wieder frei }
  249.   VAR
  250.     i : BYTE;
  251.   BEGIN
  252.     IF Master <> NIL THEN FreeMem(Master, bytes);
  253.     Master := NIL;
  254.     FOR i := 0 TO sp DO BEGIN
  255.       IF t[i] <> NIL THEN BEGIN
  256.         FreeMem(t[i], bytes);
  257.         t[i] := NIL;
  258.       END;
  259.     END;
  260.   END;
  261.  
  262.   FUNCTION Wohin(spur : BYTE) : WORD;
  263.   BEGIN                      { berechnet Screen-Koordinate }
  264.     Wohin := barln * 160 + 160 + (spur SHR 1) SHL 1 +
  265.                            160 * (spur AND 1);
  266.   END;
  267.  
  268.   PROCEDURE DiskIO(funktion, laufw, sp : BYTE; p : POINTER);
  269.   { liest, schreibt oder verifiziert eine Spur }
  270.   BEGIN
  271.     CASE funktion OF
  272.       2: MemW[ScrBase:coo] := $074c;
  273.                           { ein L schreiben & Farbe setzen }
  274.       3: Mem [ScrBase:coo] := $53;                     { S }
  275.       4: Mem [ScrBase:coo] := $56;                     { V }
  276.     END;
  277.     tries := 0;
  278.     ErrCode := 0;
  279.     Regs.ah := 6;
  280.     Regs.dl := 255;
  281.     Intr(33, Regs);  { eine Taste abfragen, ohne zu warten }
  282.     IF (Regs.al = 27) OR (Regs.al = 3) THEN Exit;
  283.     REPEAT
  284.       Inc(tries);
  285.       IF tries > 1 THEN BEGIN
  286.         Regs.ah := 0;
  287.         Intr(19, Regs);                   { LaufwerksReset }
  288.       END;
  289.       Regs.ah := funktion;
  290.       Regs.dl := laufw;
  291.       Regs.dh := (sp AND 1);  { seite }
  292.       Regs.ch := (sp SHR 1);  { spur }
  293.       Regs.cl := 1;           { sektor }
  294.       Regs.al := sek;         { anzahl }
  295.       Regs.es := Seg(p^);
  296.       Regs.bx := Ofs(p^);
  297.       Intr(19, Regs);
  298.     UNTIL (Regs.ah = 0) OR (tries = 4);
  299.     IF tries = 4 THEN LFehler;
  300.     IF ErrCode = 2 THEN Regs.al := 27
  301.                    ELSE Regs.al := 0;  { Abort nach Fehler }
  302.   END;
  303.  
  304.   FUNCTION CheckTyp : BYTE;
  305.   { liefert Laufwerkstyp für Formatierung auf ATs }
  306.   BEGIN
  307.     Regs.ah := 21;
  308.     Regs.dl := ziel;       { erkennt Laufwerk Diskwechsel? }
  309.     Intr(19, Regs);
  310.     IF (Regs.flags AND 1) = 1 THEN
  311.       ErrorMsg('Kann Laufwerke nicht initialisieren.');
  312.     CASE Regs.ah OF
  313.       1: BEGIN       { 360KB Drive (erkennt Wechsel nicht) }
  314.            IF sek > 9 THEN
  315.              ErrorMsg('Ziellaufwerk kann keine ' +
  316.                       'HD-Disketten schreiben.');
  317.            CheckTyp := 1;
  318.          END;
  319.       2: BEGIN                { HD-Drive (erkennt Wechsel) }
  320.            IF sek < 15 THEN
  321.              IF sp = 40 THEN
  322.                CheckTyp := 2         { 360K im 1.2 MB }
  323.              ELSE
  324.                CheckTyp := 4;        { 720K im 1.4 MB }
  325.            IF sek = 15 THEN
  326.              CheckTyp := 3;          { 1.2 MB im 1.2 MB }
  327.            IF sek = 18 THEN
  328.              CheckTyp := 5;          { 1.4 MB im 1.4 MB }
  329.         END;
  330.       ELSE ErrorMsg('Laufwerk nicht vorhanden?!');
  331.     END;
  332.   END;
  333.  
  334.   PROCEDURE AnzSektoren;
  335.   { liest 1.Sektor der Quelldisk und stellt am 24.Byte die }
  336.   { Anzahl der Sektoren fest                               }
  337.   VAR
  338.     MD, i : BYTE;
  339.   BEGIN
  340.     tries := 0;
  341.     TextColor(LightGray);
  342.     REPEAT
  343.       Inc(tries);
  344.       Regs.ah := 0;
  345.       IF tries > 1 THEN Intr(19, Regs);   { LaufwerksReset }
  346.       Regs.ah := Lesen;
  347.       Regs.dl := quell;
  348.       Regs.dh := 0;          { seite }
  349.       Regs.ch := 0;          { spur }
  350.       Regs.cl := 1;          { sektor }
  351.       Regs.al := 1;          { anzahl }
  352.       Regs.es := Seg(Buffer);
  353.       Regs.bx := Ofs(Buffer);
  354.       Intr(19, Regs);
  355.     UNTIL (Regs.ah = 0) OR (tries = 6);
  356.     IF tries = 6 THEN ErrorMsg('Spur 0 ist nicht lesbar!');
  357.     MD  := Buffer[21];
  358.     sek := Buffer[24];
  359.     IF (sek < 8) OR (sek > 18) THEN
  360.       ErrorMsg('Kann Anzahl der Sektoren nicht bestimmen!');
  361.     CASE MD OF                          { Media Descriptor }
  362.       $F9, $F0:  sp := 80;
  363.                         { $F0 für 1.44 MB Disks ab DOS 3.3 }
  364.       $FF, $FD:  sp := 40;
  365.       ELSE
  366.        ErrorMsg('Kann nur zweiseitige Disketten kopieren!');
  367.     END;
  368.     ClearLine(txtln+4, txtln+6);
  369.     GotoXY(24, txtln+5);
  370.     Write('Kopiere ', sp,' Spuren mit ', sek,' Sektoren. ');
  371.     GotoXY(32, txtln+3);
  372.     IF AT THEN DriveTyp := CheckTyp;
  373.     Write('Format: ');
  374.     IF Buffer[0] < 200 THEN
  375.       Write('Atari ST')
  376.     ELSE
  377.       FOR i := 3 TO 10 DO Write(Chr(Buffer[i]));
  378.     sp    := sp * 2 - 1;
  379.     bytes := sek * 512;
  380.     FOR i := 1 TO sek DO BEGIN
  381.                     { Parameterblock für Format. erstellen }
  382.       FormBuff[i].sektor := i;
  383.       FormBuff[i].laenge := 2;     { nur 512-Byte Sektoren }
  384.     END;
  385.     Mem[tabseg:tabofs+4] := sek;
  386.             { Anz. Sektoren in Laufwerkstabelle eintragen. }
  387.             { Dies ist für's Handhaben von HD-Disks        }
  388.             { unbedingt nötig!  Hey Michael Tischer, warum }
  389.             { steht das nicht im PC-INTERN 2.0 ?           }
  390.   END;
  391.  
  392.   PROCEDURE EMInt;
  393.              { Speicher-Verschiebe-Routine wird aufgerufen }
  394.   BEGIN
  395.     Regs.ah := 135;
  396.     Regs.cx := bytes SHR 1;    { BYTES/2 Words verschieben }
  397.     Regs.es := Seg(GDT);
  398.     Regs.si := Ofs(GDT);
  399.     Intr(21, Regs);
  400.     IF Regs.flags AND 1 = 1 THEN
  401.       ErrorMsg('Probleme mit Extended Memory!');
  402.   END;
  403.  
  404.   PROCEDURE EMup(p : POINTER; Adr : LONGINT);
  405.   { Hier werden die nötigen Eintragungen in die GDT für's  }
  406.   { Verschieben des Speichers gemacht. p ist der Zeiger    }
  407.   { auf den Quellbereich, Adr gibt die Zieladresse im      }
  408.   { Extended Memory an. Aus diesen Werten werden zwei 24   }
  409.   { Bit-Einträge für die GDT erzeugt.                      }
  410.   VAR
  411.     l : LONGINT;
  412.   BEGIN
  413.     l := 16;
  414.     l := l * Seg(p^) + Ofs(p^);
  415.     GDT[20] := l DIV 65536;
  416.     l := l MOD 65536;
  417.     GDT[19] := l DIV 256;
  418.     GDT[18] := l MOD 256;
  419.     GDT[28] := Adr DIV 65536;
  420.     Adr := Adr MOD 65536;
  421.     GDT[27] := Adr DIV 256;
  422.     GDT[26] := Adr MOD 256;
  423.     EMInt;                          { Speicher verschieben }
  424.   END;
  425.  
  426.   PROCEDURE EMdown(Adr : LONGINT; p : POINTER);
  427.   { Hier genau das Gegenteil: vom Extended Memory in den   }
  428.   { Hauptspeicher                                          }
  429.   VAR
  430.     l : LONGINT;
  431.   BEGIN
  432.     l := 16;
  433.     l := l * Seg(p^) + Ofs(p^);
  434.     GDT[28] := l DIV 65536;
  435.     l := l MOD 65536;
  436.     GDT[27] := l DIV 256;
  437.     GDT[26] := l MOD 256;
  438.     GDT[20] := Adr DIV 65536;
  439.     Adr := Adr MOD 65536;
  440.     GDT[19] := Adr DIV 256;
  441.     GDT[18] := Adr MOD 256;
  442.     EMInt;
  443.   END;
  444.  
  445.   PROCEDURE FormatTrack(spur : BYTE);
  446.   VAR
  447.     n, s1, s2 : BYTE;
  448.   BEGIN
  449.     ErrCode := 0;
  450.     Regs.ah := 6;
  451.     Regs.dl := 255;
  452.     Intr(33, Regs);  { eine Taste abfragen, ohne zu warten }
  453.     IF (Regs.al = 27) OR (Regs.al = 3) THEN Exit;
  454.     IF AT THEN BEGIN    { Modus des HD-Laufwerks festlegen }
  455.       Regs.ah := 23;
  456.       Regs.al := DriveTyp;
  457.       Regs.dl := ziel;
  458.       Intr(19, Regs);
  459.     END;
  460.     s1 := spur SHR 1;
  461.     s2 := spur AND 1;
  462.     FOR n := 1 TO sek DO BEGIN  { Parameterblock erstellen }
  463.       FormBuff[n].spur  := s1;
  464.       FormBuff[n].seite := s2;
  465.     END;
  466.     tries := 0;
  467.     REPEAT
  468.       Inc(tries);
  469.       Regs.ah := 5;
  470.       Regs.dl := ziel;
  471.       Regs.dh := s2;
  472.       Regs.ch := s1;
  473.       Regs.al := sek;
  474.       Regs.es := Seg(FormBuff);
  475.                              { Adresse des Parameterblocks }
  476.       Regs.bx := Ofs(FormBuff);
  477.       Intr(19, Regs);                   { Spur formatieren }
  478.     UNTIL (Regs.ah = 0) OR (tries = 4);
  479.     IF tries = 4 THEN LFehler;
  480.   END;
  481.  
  482. BEGIN
  483.   FOR i := 0 TO 160 DO t[i] := NIL;
  484.   IF (ID = 252) OR (ID = 248) THEN AT := TRUE
  485.                               ELSE AT := FALSE;
  486.   IF VideoMode = 7 THEN ScrBase := $B000
  487.                    ELSE ScrBase := $B800;
  488.   GDT[16] := $FF;  GDT[17] := $FF;
  489.   GDT[21] := $92;  GDT[22] := 0;
  490.   GDT[23] := 0;    GDT[24] := $FF;
  491.   GDT[25] := $FF;  GDT[29] := $92;
  492.   GDT[30] := 0;    GDT[31] := 0;
  493.   Regs.ah := 8;
  494.   Regs.dl := $80;                  { Festplatte vorhanden? }
  495.   Intr(19, Regs);
  496.   IF Regs.flags AND 1 = 1 THEN HD := FALSE ELSE HD := TRUE;
  497.   EM := 0;                { kein Extended Memory vorhanden }
  498.   Master := NIL;
  499.   sp := 0;
  500.   cursor := crsr;
  501.   Regs.ah := 1;
  502.   Regs.cx := $2020;
  503.   Intr(16, Regs);                      { Cursor abschalten }
  504.   CheckParameter;
  505.   IF NoPara THEN BEGIN
  506.     ClrScr;  TextColor(LightBlue);  WriteLn(ver);
  507.     TextColor(LightGray);
  508.     WriteLn(' Bei Ein-Laufwerks-Copy kann Extended Memory ',
  509.             'oder Festplatte zum Puffern');
  510.     WriteLn('   der Daten genutzt werden'#10);
  511.     WriteLn(' Kopiert nur Tracks mit Inhalt; leere Tracks ',
  512.             'werden nicht geschrieben');
  513.     WriteLn('Nach einmaligem Lesen kann auf mehrere ',
  514.             'Disketten geschrieben werden'#10);
  515.     WriteLn('Sollten beim Schreiben Fehler auftreten, so ',
  516.             'kann nachträglich noch das');
  517.     WriteLn('   Formatieren angeschaltet werden'#10);
  518.     WriteLn('Die Directories der Disketten lassen sich ',
  519.             'anzeigen');
  520.     WriteLn('Kopiert auch Atari ST Disketten ',
  521.             '(nur Standard-Format)'#10);
  522.     TextColor(Cyan);
  523.     WriteLn('Aufruf: MCOPY [source] [dest] [format] ',
  524.             '[verify] [quiet]');
  525.     WriteLn('        Alle Parameter sind optional! ');
  526.     WriteLn('        MCOPY a         : von A: nach A: ',
  527.             'Ohne Format & Verify');
  528.     WriteLn('        MCOPY b: a: f   : von B: nach A: ',
  529.             'Mit Format, Ohne Verify');
  530.     WriteLn('        MCOPY a b f v q : von A: nach B: ',
  531.             'Mit Format & Verify & ohne Ton'#10);
  532.     TextColor(LightGray);
  533.     WriteLn('Format, Verify und Ton lassen sich mit F V Q ',
  534.             'nachträgl. an- und ausschalten');
  535.     WriteLn('Es werden nur zweiseitige Disketten mit 8 ',
  536.             'bis 18 Sektoren kopiert');
  537.     CenterAndWait(25,'Press Any Key');
  538.   END;
  539.   REPEAT                                { Noch eine Kopie? }
  540.     ClrScr;
  541.     GotoXY(80,1);
  542.     TextColor(LightGray);
  543.     IF beep = #7 THEN Write(' ') ELSE Write('Q');
  544.     TextColor(LightGreen);
  545.     IF AT THEN BEGIN
  546.       Regs.ah := 136;
  547.       Intr(21, Regs);
  548.       EM := Regs.ax;            { wieviel Extended Memory? }
  549.     END;
  550.     useEM := FALSE;
  551.     useHD := FALSE;
  552.     Regs.ah := 1;
  553.     Regs.cx := cursor;
  554.     Intr(16, Regs);                    { Cursor anschalten }
  555.     DochFormat := FALSE;
  556.     GotoXY(23,1);
  557.     WriteLn(ver);
  558.     TextColor(Cyan);
  559.     GotoXY(1, barln);
  560.     Write('          1         2         3         4      ',
  561.           '   5         6         7        7');
  562.     Write('01234567890123456789012345678901234567890123456',
  563.           '789012345678901234567890123456789');
  564.     GotoXY(14, txtln);
  565.     TextColor(LightGray);
  566.     Write('Quellaufwerk : ');
  567.     IF NoPara THEN BEGIN
  568.       Input('A', 'B');
  569.       quell := Ord(c)-65;
  570.     END;
  571.     Write(Chr(65 + quell));
  572.     GotoXY(14, txtln+1);
  573.     Write('Ziellaufwerk : ');
  574.     IF NoPara THEN BEGIN
  575.       INPUT('A', 'B');
  576.       ziel := Ord(c)-65;
  577.     END ELSE Write(Chr(65 + ziel));
  578.     GotoXY(36, txtln);
  579.     Write('Zieldisk formatieren..(J/N): ');
  580.     IF NoPara THEN BEGIN
  581.       Input('J', 'N');
  582.       IF c = 'J' THEN Format := TRUE ELSE Format := FALSE;
  583.     END ELSE
  584.       IF Format THEN Write('J') ELSE Write('N');
  585.     GotoXY(36, txtln+1);
  586.     Write('Zieldisk verifizieren.(J/N): ');
  587.     IF NoPara THEN BEGIN
  588.       Input('J', 'N');
  589.       IF c = 'J' THEN Verify_an := TRUE
  590.                  ELSE Verify_an := FALSE;
  591.     END ELSE
  592.       IF Verify_an THEN Write('J') ELSE Write('N');
  593.     GotoXY(24, txtln+4);
  594.     IF (quell = ziel) AND NoPara THEN BEGIN
  595.       Write('Puffer mehrmals schreiben (J/N): ');
  596.       Input('J', 'N');
  597.       IF c = 'N' THEN Again := FALSE ELSE Again := TRUE;
  598.     END ELSE Again := FALSE;
  599.     NoPara := TRUE;
  600.     IF (EM > 0) AND (quell = ziel) THEN BEGIN
  601.       GotoXY(24, txtln+5);
  602.       Write('Extended Memory benutzen  (J/N): ');
  603.       INPUT('J', 'N');
  604.       IF c = 'N' THEN BEGIN
  605.         useEM := FALSE;
  606.         EM := 0;
  607.       END ELSE useEM := TRUE;
  608.     END;
  609.     IF HD AND (NOT useEM) AND (quell = ziel) THEN BEGIN
  610.       GotoXY(24, WhereY+1);
  611.       Write('Daten auf Platte puffern  (J/N): ');
  612.       Input('J', 'N');
  613.       IF c = 'N' THEN useHD := FALSE ELSE useHD := TRUE;
  614.     END;
  615.  
  616.     REPEAT    { Noch eine Kopie mit diesen Einstellungen? }
  617.       sp := 160;
  618.       ClearBuffer;
  619.       IF DochFormat THEN BEGIN
  620.                       { Formatieren ggf wieder abschalten }
  621.         Format := FALSE;
  622.         DochFormat := FALSE;
  623.       END;
  624.       bytes := 0;
  625.       ClearLine(barln+2, barln+3);
  626.       Regs.ah := 1;
  627.       Regs.cx := $2020;
  628.       Intr(16, Regs);                  { Cursor abschalten }
  629.       IF quell <> ziel THEN BEGIN
  630.         CenterAndWait(msgln, 'Bitte Disketten' + Cat);
  631.         AnzSektoren;
  632.       END;
  633.       last := 0;  elast := 0;
  634.       i    := 0;  j     := 0;  ei := 0;  ej := 0;
  635.       REPEAT  { Falls Disk nicht ganz in den Speicher paßt }
  636.         IF quell = ziel THEN BEGIN
  637.           CenterAndWait(msgln, 'Bitte Quelldiskette' + Cat);
  638.           IF bytes = 0 THEN AnzSektoren;
  639.         END;
  640.         ClearBuffer;
  641.         IF useEM THEN BEGIN
  642.           GetMem(Master, bytes);
  643.           EMtracks := EM * 10 DIV (bytes DIV 102) - 1;
  644.           IF EM > 1500 THEN EMtracks := 160;
  645.                              { soviel Spuren passen ins EM }
  646.         END;
  647.         IF useHD THEN BEGIN
  648.           GetMem(Master, bytes);
  649.           EMtracks := 160;
  650.                           { die ganze Disk paßt auf die HD }
  651.           EM := DiskFree(3) DIV 1024;
  652.           IF ((EM + (MaxAvail DIV 1024))*2) < (sp*sek) THEN
  653.             ErrorMsg('Nicht genügend freier Speicher auf '+
  654.                      'Laufwerk C:');
  655.           Assign(f, FName);
  656.           Rewrite(f, bytes);
  657.           coo := IOResult;
  658.           IF coo = 150 THEN
  659.             ErrorMsg('Festplatte ist schreibgeschützt!');
  660.           IF coo > 0 THEN
  661.             ErrorMsg('Schreibfehler auf Festplatte!');
  662.         END;
  663.  
  664.         GotoXY(33, msgln);
  665.         Write('FreeMem:');
  666.         amDOSlesen := TRUE;
  667.         amEMlesen  := FALSE;
  668.         REPEAT
  669.           GetMem(t[i], bytes);
  670.           coo := Wohin(i);
  671.           REPEAT
  672.             DiskIO(Lesen, quell, i, t[i]);
  673.           UNTIL ErrCode <> 1;
  674.           IF (Regs.al = 27) OR (Regs.al = 3) THEN
  675.             GOTO NOCHMAL;                  { ESC gedrückt? }
  676.           segm := Seg(t[i]^);
  677.           offs := Ofs(t[i]^);
  678.           ii   := 8;
  679.           garp := MemW[segm:offs];  { erstes Word der Spur }
  680.           REPEAT
  681.             IF MemW[segm:offs+ii] <> garp THEN ii := 10000;
  682.             Inc(ii, 8);                   { ist Spur leer? }
  683.           UNTIL ii >= bytes;
  684.           IF ii < 10000 THEN BEGIN
  685.                           { dann Speicher wieder freigeben }
  686.             FreeMem(t[i], bytes);
  687.             t[i] := NIL;
  688.             Mem[ScrBase:coo] := $FA;   { einen . schreiben }
  689.           END;
  690.           Inc(i);
  691.           GotoXY(42, msgln);
  692.           Write(EM + MaxAvail DIV 1024, ' KB ');
  693.         UNTIL (MaxAvail < bytes) OR (i > sp);
  694.                               { Lesen bis Speicher voll,   }
  695.         last := j;            { oder Diskende erreicht ist }
  696.         ei   := i;
  697.         amDOSlesen := FALSE;
  698.         IF (useEM OR useHD) AND (i <= sp) THEN BEGIN
  699.                                        { EM oder HD füllen }
  700.           EMadr := 1048576;            { bei 1 MB beginnen }
  701.           amEMlesen := TRUE;
  702.           REPEAT
  703.             coo := Wohin(ei);
  704.             REPEAT
  705.               DiskIO(Lesen, quell, ei, Master);
  706.             UNTIL ErrCode <> 1;
  707.             IF (Regs.al = 27) OR (Regs.al = 3) THEN
  708.               GOTO NOCHMAL;                { ESC gedrückt? }
  709.             IF useEM THEN EMup(Master, EMadr)
  710.                      ELSE BlockWrite(f, master^, 1);
  711.             Inc(ei);
  712.             Inc(EMadr, bytes);
  713.             GotoXY(42, msgln);
  714.             Write(EM - (EMadr - 1048576) DIV 1024, ' KB ');
  715.           UNTIL (EMtracks < ei-i) OR (ei > sp);
  716.                                        { Lesen bis EM voll }
  717.           elast := ej;       { oder Diskeende erreicht ist }
  718.           IF useHD THEN Close(f);
  719.           amEMlesen := FALSE;
  720.         END;
  721.  
  722. LOOP:
  723.         IF quell = ziel THEN
  724.           CenterAndWait(msgln, 'Bitte Zieldiskette' + Cat);
  725.         amDOSlesen := FALSE;
  726.         IF Format THEN FormatTrack(j);
  727.         REPEAT
  728.           coo := Wohin(j);
  729.           REPEAT
  730.             REPEAT
  731.               IF Format THEN BEGIN
  732.                   Mem[ScrBase:coo] := $46; { ein F ... }
  733.                 REPEAT
  734.                   FormatTrack(j);
  735.                 UNTIL ErrCode <> 1;
  736.                 IF (Regs.al = 27) OR (Regs.al = 3) THEN
  737.                   GOTO NOCHMAL;
  738.               END;
  739.               IF t[j] <> NIL THEN
  740.                 DiskIO(Schreiben, ziel, j, t[j]);
  741.             UNTIL ErrCode <> 1;
  742.             IF (Regs.al = 27) OR (Regs.al = 3) THEN
  743.               GOTO NOCHMAL;                { ESC gedrückt? }
  744.             IF Verify_an THEN DiskIO(Verify, ziel, j, t[j]);
  745.           UNTIL ErrCode <> 1;
  746.           IF (Regs.al = 27) OR (Regs.al = 3) THEN
  747.             GOTO NOCHMAL;
  748.           IF ErrCode = 3 THEN Mem[ScrBase:coo] := $45
  749.                          ELSE Mem[ScrBase:coo] := $FA;
  750.           Inc(j);
  751.         UNTIL j = i;
  752.         ej := j;
  753.         IF (useEM OR useHD) AND (j <= sp) THEN BEGIN
  754.           IF useHD THEN Reset(f, bytes);
  755.           elast := ei;
  756.           EMadr := 1048576;
  757.           REPEAT
  758.             coo := Wohin(ej);
  759.             IF useEM THEN EMdown(EMadr, Master)
  760.                      ELSE BlockRead(f, master^, 1);
  761.             REPEAT
  762.               REPEAT
  763.                 IF Format THEN BEGIN
  764.                   Mem[ScrBase:coo] := $46; { ein F ... }
  765.                   REPEAT
  766.                     FormatTrack(ej);
  767.                   UNTIL ErrCode <> 1;
  768.                 END;
  769.                 DiskIO(Schreiben, ziel, ej, Master);
  770.               UNTIL ErrCode <> 1;
  771.               IF (Regs.al = 27) OR (Regs.al = 3) THEN
  772.                 GOTO NOCHMAL;
  773.               IF Verify_an THEN
  774.                 DiskIO(Verify, ziel, ej, Master);
  775.             UNTIL ErrCode <> 1;
  776.             IF (Regs.al = 27) OR (Regs.al = 3) THEN
  777.               GOTO NOCHMAL;
  778.             IF ErrCode = 3 THEN Mem[ScrBase:coo] := $45
  779.                            ELSE Mem[ScrBase:coo] := $FA;
  780.             Inc(ej);
  781.             Inc(EMadr, bytes);
  782.           UNTIL ej = ei;
  783.           IF useHD THEN Close(f);
  784.         END;
  785.         IF Again THEN BEGIN
  786.           CenterAndWait(msgln, 'Nochmal schreiben (J/N)?');
  787.           IF c = 'J' THEN BEGIN
  788.             j  := last;
  789.             ej := elast;
  790.             ClearLine(barln+2, barln+3);
  791.             GOTO LOOP;
  792.           END;
  793.         END;
  794.         i := ei;
  795.         j := ej;
  796.       UNTIL ei > sp;
  797.  
  798. NOCHMAL:
  799.       IF useHD THEN BEGIN
  800.         EM := 0;
  801.         Assign(f, FName);
  802.         IF Regs.ah = 27 THEN Close(f);
  803.         Erase(f);              { Pufferfile auf HD löschen }
  804.       END;
  805.       CenterAndWait(msgln,
  806.          'Noch eine Kopie mit diesen Einstellungen (J/N)?');
  807.     UNTIL c <> 'J';
  808.     CenterAndWait(msgln, 'Noch weitere Kopien (J/N)?');
  809.   UNTIL c <> 'J';
  810.   ClrScr;
  811.   WriteLn('So long...');
  812.   Bye;
  813. END.
  814. (* ------------------------------------------------------ *)
  815. (*               Ende von MEGACOPY.PAS                    *)
  816.