home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / xheap / edd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-25  |  25.6 KB  |  815 lines
  1. (*--------------------------------------------------------*)
  2. (*                        EDD.PAS                         *)
  3. (*               Expanded DiskDoubler v1.51               *)
  4. (*           (c) 1991  Michael Winter & TOOLBOX           *)
  5. (*    Compiler: Quick Pascal 1.0, Turbo Pascal 5.x/6.0    *)
  6. (*--------------------------------------------------------*)
  7. {$A-,B-,D-,F-,G-,I-,L-,N-,R-,S-,V-,M 4096, 0, 655360}
  8. {$IFDEF VER10} {$M-} {$ENDIF}
  9.  
  10. PROGRAM ExpandedDiskDoubler;
  11.  
  12. USES 
  13.   Crt, Dos;
  14.  
  15. TYPE
  16.   Zeiger       = ^List;
  17.   List         = RECORD       (* Liste der Spuren im Heap *)
  18.                    Element         : Pointer;
  19.                    Next            : Zeiger;
  20.                  END;
  21.   BSec         = RECORD         (* Aufbau des Bootsektors *)
  22.                    Jump            : ARRAY [1..3] OF BYTE;
  23.                    Name            : ARRAY [1..8] OF BYTE;
  24.                    BpS             : WORD;
  25.                    SpC             : BYTE;
  26.                    SecR            : WORD;
  27.                    FatS            : BYTE;
  28.                    Root, SecC      : WORD;
  29.                    Media           : BYTE;
  30.                    SecF,  SpS,
  31.                    Heads, DiS      : WORD;
  32.                    STrap           : ARRAY [1..482] OF BYTE;
  33.                  END;
  34.   FormatPuffer = RECORD  (* wird zum Formatieren benötigt *)
  35.                    Spur,
  36.                    Seite,
  37.                    Sektor,
  38.                    LaengenTyp      : BYTE;
  39.                  END;
  40.   LWParamRec   = RECORD      (* Laufwerksparametertabelle *)
  41.                    StepTime,
  42.                    DMA,
  43.                    MotorEnd,
  44.                    BpS,
  45.                    SpS,
  46.                    GapTime,
  47.                    DataTransferLen,
  48.                    Gap,
  49.                    FormatFillChar,
  50.                    HeadPause,
  51.                    MotorStart      : BYTE;
  52.                  END;
  53. {$IFNDEF VER10}
  54.   CString      = STRING[255];     (* nur für Turbo-Pascal *)
  55. {$ENDIF}
  56.   EMMName      = ARRAY [1..8] OF CHAR;    (* Name des EMM *)
  57.   EMMNaPtr     = ^EMMName;        (* Zeiger auf den Namen *)
  58.   PageRec      = RECORD  (* benötigt für EMM-Funktion 50h *)
  59.                    Logical, Physical : WORD;
  60.                  END;
  61. CONST
  62.   Copyright    : STRING[65] = 'EDD - Expanded DiskDoubler'
  63.                + ' v1.5 (C) 1991 Michael Winter & TOOLBOX';
  64.   Disk         : BOOLEAN    = FALSE;
  65.   EMS          : BOOLEAN    = FALSE;
  66.   HeapOnly     : BOOLEAN    = FALSE;
  67.   TempFName    : STRING[12] = 'TEMPFILE.EDD';
  68.   Format       : BOOLEAN    = FALSE;
  69.   Verify       : BOOLEAN    = FALSE;
  70.   Name         : EMMName    = 'EMMXXXX0';
  71.   CRLF                      = #13#10;
  72.  
  73. VAR
  74.   Source, drive,
  75.   Target       : BYTE;
  76.   Buffer       : Pointer;
  77.   Help, Top, LP: Zeiger;
  78.   TempFile     : FILE;
  79.   Temp         : STRING;
  80.   Regs         : Registers;
  81.   OldDir       : DirStr;
  82.   s, t         : STRING[2];
  83.   BootSector   : BSec;
  84.   SpS, Sides,
  85.   Tracks, Media,
  86.   BpS, i       : WORD;
  87.   Size,
  88.   HdAvail      : LONGINT;
  89.   DoFormat     : BOOLEAN;
  90.   FormatBuf    : ARRAY [1..18] OF FormatPuffer;
  91.   ParamTab     : ^LWParamRec;   (* Laufwerksparametertab. *)
  92.   PageFrame,                    (* Segment des Pageframes *)
  93.   Handle       : WORD;  (* Handle f. Zugriff auf EMS-Page *)
  94.   Spuren       : LONGINT;
  95.   Versuche     : BYTE;
  96.   ch           : CHAR;
  97.   OldEnd       : Pointer;     (* Zeiger auf alte Exitproc.*)
  98. {$IFDEF VER10}
  99.   OldTab       : LWParamRec;     (* Alte Parametertabelle *)
  100. {$ELSE}                (* Unterschied Turbo-/Quick-Pascal *)
  101.     OldTab     : Pointer;
  102. {$ENDIF}
  103.   PageBuffer   : ARRAY [0..3] OF PageRec;
  104.  
  105. PROCEDURE ClearBuffer;     (* Löschen des Tastaturpuffers *)
  106. VAR
  107.   x : CHAR;
  108. BEGIN
  109.   WHILE KeyPressed DO x := ReadKey;
  110. END;
  111.  
  112. FUNCTION ExistEMM: BOOLEAN;              (* Test auf EMM  *)
  113. BEGIN
  114.   Regs.AX := $3567;                      (* GetIntVec $67 *)
  115.   MsDos(Regs);   (* wenn Zeiger auf Null: kein EM-Manager *)
  116.   ExistEMM := (EMMNaPtr(Ptr(Regs.ES, 10))^ = Name);
  117. END;
  118.  
  119. FUNCTION EMSAvail : LONGINT; (* Speichergröße feststellen *)
  120. VAR
  121.   h : LONGINT;
  122. BEGIN
  123.   IF ExistEMM THEN WITH Regs DO BEGIN    (* EMS vorhanden *)
  124.     AH := $42;
  125.     Intr($67, Regs);                     (* EMS-Interrupt *)
  126.     h := (BX DIV 4) * 4;
  127.     EMSAvail := h * $4000;               (* Größe EMS     *)
  128.     AH := $46;
  129.     Intr($67, Regs);
  130.     IF AL < $40 THEN EMSAvail := 0;      (* zu wenig oder *)
  131.   END ELSE EMSAvail := 0;                (* kein EMS      *)
  132. END;
  133.  
  134. FUNCTION Exist(Datei: STRING): BOOLEAN;
  135. VAR
  136.   f: SearchRec;
  137. BEGIN
  138.   FindFirst(Datei, AnyFile, f); Exist := (DosError = 0);
  139. END;
  140.  
  141. PROCEDURE DeleteFile(Name : CString);
  142. (* Datei löschen über DOS-Funktion 41h                    *)
  143. BEGIN
  144.   Regs.AH := $41;
  145.   Regs.DS := Seg(Name);
  146.   Regs.DX := Ofs(Name);
  147.   MsDos(Regs);
  148. END;
  149.  
  150. PROCEDURE Error(Number : BYTE);
  151. (* Ausgabe eines Diskettenfehlers, evtl. Programmabbruch  *)
  152. VAR
  153.   Str : STRING[80];
  154. BEGIN
  155.   IF Number IN [$08, $20, $BB, $FF] THEN BEGIN
  156.     CASE Number OF
  157.       $08: Str := 'DMA-Überlauf';
  158.       $20: Str := 'Diskettencontroller-Fehler';
  159.       $BB: Str := 'BIOS-Fehler / BIOS-Inkompatibilität';
  160.       $FF: Str := 'nicht aufschlüsselbarer Fehler';
  161.     END;
  162.     WriteLn('Fataler Fehler Nr. ', Number, ':', CRLF + Str);
  163.     Halt(Number);
  164.   END;
  165.   CASE Number OF
  166.     $02: Str := 'Sektorkennung nicht gefunden';
  167.     $03: Str := 'Diskette ist schreibgeschützt';
  168.     $04: Str := 'Sektor nicht gefunden';
  169.     $06: Str := 'Diskette nicht im Laufwerk';
  170.     $10: Str := 'Lesefehler';
  171.     $40: Str := 'Spur nicht gefunden';
  172.     $80: Str := 'Laufwerk antwortet nicht';
  173.     ELSE Str := '';
  174.   END;
  175.   GotoXY(1, WhereY); ClrEoL;
  176.   GotoXY(1, WhereY); Write(Str);
  177.   IF Number = $09 THEN BEGIN
  178.     IF DosVersion = $1F03 THEN (* DR-DOS 3.41, DR-DOS 5.0 *)
  179.     ELSE BEGIN
  180.       WriteLn('Fataler Fehler Nummer 9:');
  181.       WriteLn('DMA-Segmentgrenzen-Überschreitung');
  182.       Halt(Number);
  183.     END;
  184.   END;
  185.   ClearBuffer;
  186.   IF Number IN [$03, $04, $06, $80] THEN BEGIN
  187.     CASE Number OF
  188.       $03: Str := 'Schreibschutz entfernen';
  189.       $04: Str := 'neue Diskette einlegen';
  190.       $06: Str := 'andere Diskette einlegen';
  191.       $80: Str := 'Diskette einlegen';
  192.     END;
  193.     Write(#7' - ' + Str + ' und Taste drücken ');
  194.     REPEAT UNTIL KeyPressed;
  195.     ch := ReadKey;
  196.     IF ch IN [#3, #27] THEN Halt(0);
  197.     Inc(Versuche);
  198.     GotoXY(1, WhereY); ClrEoL;
  199.   END;
  200. END;
  201.  
  202. PROCEDURE EMSError(Number : BYTE);      (* Fehler des EMM *)
  203. BEGIN
  204.   GotoXY(1, WhereY); ClrEoL;
  205.   GotoXY(1, WhereY); Write(Number);
  206.   WriteLn(' - Fehlfunktion des EMM oder der EMS-Hardware');
  207.   WriteLn('Kopiervorgang abbrechen (J/N)? ');
  208.   REPEAT
  209.     ClearBuffer; ch := UpCase(ReadKey);
  210.   UNTIL ch IN ['J', 'Y', 'N'];
  211.   IF ch IN ['J', 'Y'] THEN Halt(Number);
  212. END;
  213.  
  214. PROCEDURE InitTab;
  215. (* Diskettenparameter zur Laufwerksbeschleunigung patchen *)
  216. BEGIN                       (* und Diskettentyp festlegen *)
  217.   WITH ParamTab^ DO BEGIN
  218.     StepTime       := 223;                MotorEnd  := 25;
  219.     SpS            := Lo(BootSector.SpS); GapTime   := 27;
  220.     FormatFillChar := 246;                HeadPause := 1;
  221.     MotorStart     := 0;
  222.   END;
  223. END;
  224.  
  225. PROCEDURE HelpDisp;  (* bei Parameter '/?' Hilfe ausgeben *)
  226. BEGIN
  227.   HighVideo; WriteLn(CRLF + Copyright); LowVideo; WriteLn;
  228.   WriteLn('Edd [A:|B:] [A:|B:] [/F[ORMAT]] [/V[ERIFY]]');
  229.   WriteLn('Voreinstellung: A: A:' + CRLF);
  230.   WriteLn('Optionen:' + CRLF);
  231.   WriteLn('/FORMAT: Zieldiskette wird immer formatiert':50);
  232.   WriteLn('/VERIFY: Nach dem Schreiben einer Spur wird':50);
  233.   WriteLn('diese nochmals überprüft':40);
  234.   WriteLn('/?     : diese Hilfeanzeige':34, CRLF); Halt(1);
  235. END;
  236.  
  237. PROCEDURE CheckParameters;    (* Kommandozeile überprüfen *)
  238. VAR
  239.   Next : BOOLEAN;
  240.   Hilf : STRING[128];
  241.   i, j : BYTE;
  242. BEGIN
  243.   t := ''; s := '';
  244.   FOR i := 1 TO ParamCount DO BEGIN
  245.     Hilf := ParamStr(i);
  246.     FOR j := 1 TO Length(Hilf) DO
  247.       IF Hilf[j] = '-' THEN Hilf[j] := '/'
  248.                        ELSE Hilf[j] := UpCase(Hilf[j]);
  249.     IF Pos('/F', Hilf) > 0 THEN Format := TRUE;
  250.     IF Pos('/V', Hilf) > 0 THEN Verify := TRUE;
  251.     IF Pos('/?', Hilf) > 0 THEN HelpDisp;
  252.   END;
  253.   IF ParamCount = 0 THEN BEGIN
  254.     Source := 0; Target := 0; s := 'A:'; t := 'A:';
  255.   END;
  256.   IF ParamCount = 1 THEN BEGIN
  257.     Hilf := ParamStr(1);
  258.     FOR i := 1 TO Length(Hilf) DO
  259.       Hilf[i] := UpCase(Hilf[i]);
  260.     IF (Pos('/F', Hilf) > 0) OR (Pos('/V', Hilf) > 0) THEN
  261.       s := 'A:' ELSE s := Hilf;
  262.     t := s;
  263.     IF ((s <> 'A:') AND (s <> 'B:')) THEN HelpDisp;
  264.   END;
  265.   IF ParamCount > 1 THEN BEGIN
  266.     i := 1; Next := FALSE;
  267.     REPEAT
  268.       Hilf := ParamStr(i);
  269.       FOR j := 1 TO Length(Hilf) DO
  270.         Hilf[j] := UpCase(Hilf[j]);
  271.       IF (Hilf = 'A:') OR (Hilf = 'B:') THEN BEGIN
  272.         s := Hilf; Next := TRUE;
  273.       END;
  274.       Inc(i);
  275.     UNTIL (i = ParamCount + 1) OR Next;
  276.     Next := FALSE;
  277.     REPEAT
  278.       Hilf := ParamStr(i);
  279.       FOR j := 1 TO Length(Hilf) DO
  280.         Hilf[j] := UpCase(Hilf[j]);
  281.       IF (Hilf = 'A:') OR (Hilf = 'B:') THEN BEGIN
  282.         t := Hilf; Next := TRUE;
  283.       END;
  284.       Inc(i);
  285.     UNTIL (i = ParamCount + 1) OR Next;
  286.     IF t = '' THEN t := s;
  287.   END;
  288.   IF ((s = '') OR (t = '')) THEN HelpDisp;
  289.   Source := Ord(UpCase(s[1])) - 65;
  290.   Target := Ord(UpCase(t[1])) - 65;
  291. END;
  292.  
  293. PROCEDURE DiskTest(Source : BYTE);
  294. (* Testen, ob Laufwerk bereit ist und Bootsektor einlesen *)
  295. VAR                      (* danach Diskettentyp festlegen *)
  296.   ch    : CHAR;
  297.   Ok    : BOOLEAN;
  298.   Hilfe : BYTE;
  299. BEGIN
  300.   Versuche := 3; Ok := TRUE;
  301.   WriteLn('Bitte die QUELLDISKETTE in Laufwerk '
  302.           + Chr(Source + 65) + ': einlegen');
  303.   Write('Wenn bereit, beliebige Taste drücken  . . .');
  304.   REPEAT
  305.     ClearBuffer;
  306.     ch := ReadKey;
  307.     WriteLn;
  308.     IF ch IN [#3, #27] THEN Halt(1);
  309.     REPEAT
  310.       ChDir(s + '\');
  311.       IF IOResult <> 0 THEN Error(6)    (* Laufwerk nicht *)
  312.     UNTIL IOResult = 0;                 (* bereit         *)
  313.     ChDir(OldDir);
  314.     WITH Regs DO BEGIN
  315.       AH := $02;
  316.       DL := Source;
  317.       DH := 0;
  318.       CH := 0;
  319.       CL := 1;
  320.       AL := 1;
  321.       ES := Seg(BootSector);
  322.       BX := Ofs(BootSector);
  323.       Intr($13, Regs);
  324.       Dec(Versuche);
  325.     END;
  326.   UNTIL (Regs.AH = 0) OR (Versuche = 0);
  327.   IF Regs.AH <> 0 THEN Error(Regs.AH);
  328.   BpS   := BootSector.BpS;
  329.   SpS   := BootSector.SpS;
  330.   Media := BootSector.Media;
  331.   CASE BootSector.Media OF
  332.     $F0: BEGIN Sides := 2; Tracks := 80; SpS := 18; END;
  333.     $F9: BEGIN Sides := 2; Tracks := 80;            END;
  334.     $FA: BEGIN Sides := 1; Tracks := 80; SpS :=  8; END;
  335.     $FB: BEGIN Sides := 2; Tracks := 80; SpS :=  8; END;
  336.     $FC: BEGIN Sides := 1; Tracks := 40; SpS :=  9; END;
  337.     $FD: BEGIN Sides := 2; Tracks := 40; SpS :=  9; END;
  338.     $FE: BEGIN Sides := 1; Tracks := 40; SpS :=  8; END;
  339.     $FF: BEGIN Sides := 2; Tracks := 40; SpS :=  8; END;
  340.     ELSE BEGIN
  341.       WriteLn('Unbekanntes Diskettenformat!'); Halt(1);
  342.     END;
  343.   END;
  344.   WriteLn(CRLF + 'Kopiere ', Sides, ' Seite(n), ', Tracks,
  345.                  ' Spuren zu ', SpS,' Sektoren.');
  346.   Size := DiskSize(Source + 1);
  347.   (* Speicherverwaltungsstrategie festlegen: *)
  348.   IF MemAvail > Size THEN HeapOnly := TRUE
  349.   ELSE IF (MemAvail + EMSAvail > Size) THEN BEGIN
  350.     HeapOnly := FALSE; EMS := TRUE;
  351.   END ELSE IF (MemAvail + HdAvail > Size) THEN BEGIN
  352.     HeapOnly := FALSE; Disk := TRUE;
  353.   END ELSE BEGIN
  354.     WriteLn(CRLF + 'Nicht genügend Pufferspeicher ' +
  355.                    'vorhanden' + CRLF);
  356.     Halt(1);
  357.   END;
  358.   Write('Puffere Daten ');
  359.   IF HeapOnly THEN WriteLn('im Hauptspeicher  . . .');
  360.   IF EMS  THEN WriteLn('im Expanded Memory  . . .');
  361.   IF Disk THEN WriteLn('in der Datei ' + Temp + TempFName);
  362.   FOR i := 1 TO SpS DO BEGIN
  363.     FormatBuf[i].Sektor := i;
  364.     CASE BootSector.BpS OF
  365.      $080: FormatBuf[i].LaengenTyp := 0;
  366.      $100: FormatBuf[i].LaengenTyp := 1;
  367.      $200: FormatBuf[i].LaengenTyp := 2;
  368.      $400: FormatBuf[i].LaengenTyp := 3;
  369.       ELSE BEGIN
  370.         WriteLn(CRLF + 'Unbekanntes Diskettenformat!');
  371.         Halt(1);
  372.       END;
  373.     END;
  374.   END;
  375.   InitTab;
  376. END;
  377.  
  378. PROCEDURE TestTarget(Target : BYTE);     (* Laufwerkstest *)
  379. VAR
  380.   ch               : CHAR;
  381.   y, Result, Hilfe : BYTE;
  382. BEGIN
  383.   DoFormat := FALSE;
  384.   WriteLn;
  385.   y := WhereY;
  386.   FOR i := y TO 23 DO BEGIN GotoXY(1, i); ClrEoL; END;
  387.   GotoXY(1, y);
  388.   WriteLn(CRLF + 'Bitte die ZIELDISKETTE in Laufwerk ' +
  389.           Chr(Target + 65) + ': einlegen');
  390.   IF Source = Target THEN BEGIN
  391.     Write('Wenn bereit, beliebige Taste drücken  . . .');
  392.     ClearBuffer;
  393.     ch := ReadKey; WriteLn; IF ch IN [#3, #27] THEN Halt(1);
  394.   END ELSE WriteLn;
  395.   Versuche := 3;
  396.   InitTab;
  397.   REPEAT  (* Test, ob die Diskette bereits formatiert ist *)
  398.     WITH Regs DO BEGIN
  399.       AH := $00;
  400.       DL := Target;
  401.       Intr($13, Regs);
  402.       AH := $02;
  403.       DL := Target;
  404.       DH := 0;
  405.       CH := 0;
  406.       CL := 1;
  407.       AL := 1;
  408.       ES := Seg(BootSector);
  409.       BX := Ofs(BootSector);
  410.       Intr($13, Regs);
  411.       IF AH <> 0 THEN BEGIN
  412.         Hilfe := AH;
  413.         AH := $00;
  414.         DL := Target;
  415.         Intr($13, Regs);
  416.         AH := Hilfe;
  417.       END;
  418.       Dec(Versuche);
  419.     END;
  420.   UNTIL (Versuche = 0) OR (Regs.AH = 0);
  421.   IF (Regs.AH <> 0) OR (BootSector.SpS <> SpS) OR
  422.      (BootSector.Media <> Media) OR Format THEN BEGIN
  423.     DoFormat := TRUE;
  424.     WriteLn('Formatieren beim Schreiben  . . .');
  425.   END;
  426. END;
  427.  
  428. PROCEDURE DiskCopy; (* Diskette wird kopiert *)
  429. VAR
  430.   Counter,
  431.   i, j, z     : LONGINT;
  432.   DoDisk,
  433.   First       : BOOLEAN;
  434.   AktPage, k,
  435.   Pages,
  436.   Offset      : WORD;
  437.   DoEMS       : BOOLEAN;
  438.   AHPuffer, y : BYTE;
  439. BEGIN
  440.   IF EMS THEN BEGIN
  441.     WITH Regs DO BEGIN       (* Freie EMS-Pages ermitteln *)
  442.       AH := $42;
  443.       Intr($67, Regs);
  444.       Pages := BX;
  445.       IF AH <> 0 THEN EMSError(AH);
  446.       (* EMS Speicher allokieren - Standard Pages *)
  447.       AH := $5A;
  448.       AL := $00;
  449.       BX := Pages;
  450.       Intr($67, Regs);
  451.       IF AH <> 0 THEN EMSError(AH);
  452.       Handle := DX;                    (* Mapping sichern *)
  453.       AH := $47;
  454.       DX := Handle;
  455.       Intr($67, Regs);
  456.       IF AH <> 0 THEN EMSError(AH);
  457.     END;
  458.     Spuren := 65536 DIV (SpS * BpS);
  459.              (* Wieviele Spuren passen auf den Pageframe? *)
  460.     Offset  := 0;
  461.     Counter := 1;
  462.     AktPage := 0;
  463.     FOR k := 0 TO 3 DO BEGIN   (* Erste 4 S. in Pageframe *)
  464.       WITH PageBuffer[k] DO BEGIN
  465.         Physical := k; Logical := Physical;
  466.       END;
  467.       WITH Regs DO BEGIN
  468.         AH := $50;
  469.         AL := $00;
  470.         CX := 4;
  471.         DX := Handle;
  472.         DS := Seg(PageBuffer);
  473.         SI := Ofs(PageBuffer);
  474.         Intr($67, Regs);
  475.       END;
  476.     END;
  477.   END;
  478.   First := TRUE; DoDisk := FALSE; DoEMS := FALSE;
  479.   IF Disk THEN BEGIN             (* Temporärdatei anlegen *)
  480.     Assign(TempFile, Temp + TempFName);
  481.     ReWrite(TempFile, SpS * BpS);
  482.   END;
  483.   First := TRUE; InitTab;
  484.   y := WhereY;
  485.   FOR j := 0 TO Tracks - 1 DO
  486.     FOR i := 0 TO Sides - 1 DO BEGIN
  487.       GotoXY(1, y); Write(i, ':', j);
  488.       IF (MemAvail > SpS * BpS + 8) AND
  489.          (MaxAvail > SpS * BpS) THEN BEGIN
  490.         IF First THEN BEGIN (* Speicherblockliste anlegen *)
  491.           New(LP);
  492.           GetMem(LP^.Element, SpS * BpS); LP^.Next := NIL;
  493.           Top := LP; Help := LP; First := FALSE;
  494.         END ELSE BEGIN         (* ... und Liste erweitern *)
  495.           New(LP); GetMem(LP^.Element, SpS * BpS);
  496.           LP^.Next := NIL; Top^.Next := LP; Top := LP;
  497.         END;
  498.       END ELSE IF Disk THEN DoDisk := TRUE
  499.           ELSE IF EMS  THEN DoEMS := TRUE;
  500.       Versuche := 3;
  501.       WITH Regs DO BEGIN
  502.         REPEAT                              (* Spur lesen *)
  503.           AH := $02;
  504.           DL := Source;
  505.           DH := i;
  506.           CH := j;
  507.           CL := 1;
  508.           AL := SpS;
  509.           IF (NOT DoDisk) AND (NOT DoEMS) THEN BEGIN
  510.             ES := Seg(LP^.Element^);     (* Daten in der  *)
  511.             BX := Ofs(LP^.Element^);     (* Liste ablegen *)
  512.           END ELSE BEGIN
  513.             ES := Seg(Buffer^); (* Daten im Puffer ablegen*)
  514.             BX := Ofs(Buffer^); (* zur Übergabe an HD/EMS *)
  515.           END;
  516.           Intr($13, Regs);
  517.           Dec(Versuche);
  518.         UNTIL (AH = 0) OR (Versuche = 0);
  519.         IF AH <> 0 THEN Error(AH);
  520.       END;
  521.       IF DoDisk THEN BlockWrite(TempFile, Buffer^, 1);
  522.       IF DoEMS THEN BEGIN
  523.         Move(Buffer^, Ptr(PageFrame, Offset)^, SpS * BpS);
  524.         IF Counter = Spuren THEN BEGIN
  525.           Inc(AktPage, 4);
  526.           Offset := 0; Counter := 1;
  527.           FOR k := 0 TO 3 DO BEGIN
  528.             WITH PageBuffer[k] DO BEGIN
  529.               Physical := k; Logical := k + AktPage;
  530.             END;
  531.             WITH Regs DO BEGIN
  532.               AH := $50;
  533.               AL := $00;
  534.               CX := 4;
  535.               DX := Handle;
  536.               DS := Seg(PageBuffer);
  537.               SI := Ofs(PageBuffer);
  538.               Intr($67, Regs);
  539.             END;
  540.           END;
  541.         END ELSE BEGIN
  542.           Inc(Offset, (SpS * BpS)); Inc(Counter);
  543.         END;
  544.       END;
  545.     END;
  546.   IF Disk THEN Close(TempFile);
  547.   REPEAT
  548.     TestTarget(Target);
  549.     Offset := 0; Counter := 1; AktPage := 0;
  550.     IF EMS THEN     (* Erste vier Seiten in den Pageframe *)
  551.       FOR k := 0 TO 3 DO BEGIN
  552.         WITH PageBuffer[k] DO BEGIN
  553.           Physical := k; Logical := Physical;
  554.         END;
  555.         WITH Regs DO BEGIN
  556.           AH := $50;
  557.           AL := $00;
  558.           CX := 4;
  559.           DX := Handle;
  560.           DS := Seg(PageBuffer);
  561.           SI := Ofs(PageBuffer);
  562.           Intr($67, Regs);
  563.         END;
  564.       END;
  565.     IF Disk THEN BEGIN
  566.       Assign(TempFile, Temp + TempFName);
  567.       Reset(TempFile, SpS * BpS);
  568.     END;
  569.     WITH Regs DO BEGIN
  570.       AH := $00;                       (* Disketten-Reset *)
  571.       DL := Target;
  572.       Intr($13, Regs);
  573.       AH := $17;
  574.       (*   Diskettentyp für die Formatierung festlegen:   *)
  575.       IF (SpS = 15) AND (Tracks = 80) THEN AL := 3;
  576.       IF (SpS =  9) AND (Tracks = 40) THEN AL := 2;
  577.       IF (SpS = 18) AND (Tracks = 80) THEN AL := 5;
  578.       IF (SpS =  9) AND (Tracks = 80) THEN AL := 4;
  579.       Intr($13, Regs);
  580.       IF AH <> 0 THEN Error(AH);
  581.     END;
  582.     y := WhereY; DelLine; DelLine;
  583.     LP := Help;
  584.     InitTab;
  585.     FOR j := 0 TO Tracks - 1 DO
  586.       FOR i := 0 TO Sides - 1 DO BEGIN
  587.         GotoXY(1, y); Write(i, ':', j);
  588.         IF DoFormat THEN BEGIN
  589.           FOR k := 1 TO SpS DO BEGIN
  590.             FormatBuf[k].Spur := j; FormatBuf[k].Seite := i;
  591.           END;
  592.           WITH Regs DO BEGIN
  593.             Versuche := 3;
  594.             REPEAT
  595.               AH := $05;          (* Diskette formatieren *)
  596.               DL := Target;
  597.               DH := i;
  598.               CH := j;
  599.               AL := SpS;
  600.               ES := Seg(FormatBuf[1]);
  601.               BX := Ofs(FormatBuf[1]);
  602.               Intr($13, Regs);
  603.               Dec(Versuche);
  604.               IF AH = $03 THEN Error(AH);
  605.             UNTIL (AH = 0) OR (Versuche = 0);
  606.             IF AH <> 0 THEN Error(AH);
  607.           END;
  608.         END;
  609.         IF LP = NIL THEN
  610.           IF Disk THEN BlockRead(TempFile, Buffer^, 1);
  611.         WITH Regs DO BEGIN
  612.           Versuche := 3;
  613.           REPEAT
  614.             AH := $03;
  615.             DL := Target;
  616.             DH := i;
  617.             CH := j;
  618.             CL := 1;
  619.             AL := SpS;
  620.             IF LP = NIL THEN BEGIN   (* Spur aus Speicher *)
  621.               IF Disk THEN BEGIN     (* holen             *)
  622.                 ES := Seg(Buffer^);
  623.                 BX := Ofs(Buffer^);
  624.               END ELSE BEGIN
  625.                 Move(Ptr(PageFrame, Offset)^, Buffer^,
  626.                      SpS * BpS);
  627.                 ES := Seg(Buffer^);
  628.                 BX := Ofs(Buffer^);
  629.               END;
  630.             END ELSE BEGIN
  631.               ES := Seg(LP^.Element^);
  632.               BX := Ofs(LP^.Element^);
  633.             END;
  634.             Intr($13, Regs);
  635.             IF Verify THEN BEGIN
  636.               AH := $04;        (* Verify: Puffer = Disk? *)
  637.               DL := Target;
  638.               DH := i;
  639.               CH := j;
  640.               CL := 1;
  641.               AL := SpS;
  642.               Intr($13, Regs);
  643.             END;
  644.             Dec(Versuche);
  645.             IF AH = $03 THEN Error(AH);
  646.             IF AH <> 0 THEN InitTab;
  647.             IF (AH <> 0) AND (Versuche = 1) THEN BEGIN
  648.               AHPuffer := AH;
  649.               FOR k := 1 TO SpS DO BEGIN
  650.                 FormatBuf[k].Spur := j;
  651.                 FormatBuf[k].Seite := i;
  652.               END;
  653.               WITH Regs DO BEGIN
  654.                 AH := $00;
  655.                 DL := Target;
  656.                 Intr($13, Regs);
  657.                 AH := $17;
  658.                 IF (SpS = 15) AND (Tracks = 80) THEN
  659.                   AL := 3;
  660.                 IF (SpS = 9) AND (Tracks = 40) THEN AL := 2;
  661.                 IF (SpS = 18) AND (Tracks = 80) THEN
  662.                   AL := 5;
  663.                 IF (SpS = 9) AND (Tracks = 80) THEN AL := 4;
  664.                 Intr($13, Regs);
  665.                 AH := $05;
  666.                 DL := Target;
  667.                 DH := i;
  668.                 CH := j;
  669.                 AL := SpS;
  670.                 ES := Seg(FormatBuf[1]);
  671.                 BX := Ofs(FormatBuf[1]);
  672.                 Intr($13, Regs);
  673.               END;
  674.               AH := AHPuffer;
  675.             END;
  676.           UNTIL (AH = 0) OR (Versuche = 0);
  677.           IF LP <> NIL THEN LP := LP^.Next
  678.           ELSE IF EMS THEN BEGIN
  679.             IF Counter = Spuren THEN BEGIN
  680.               Inc(AktPage, 4);
  681.               Offset := 0;
  682.               Counter := 1;
  683.               FOR k := 0 TO 3 DO BEGIN
  684.                 WITH PageBuffer[k] DO BEGIN
  685.                   Physical := k; Logical := k + AktPage;
  686.                 END;
  687.                 WITH Regs DO BEGIN
  688.                   AH := $50;
  689.                   AL := $00;
  690.                   CX := 4;
  691.                   DX := Handle;
  692.                   DS := Seg(PageBuffer);
  693.                   SI := Ofs(PageBuffer);
  694.                   Intr($67, Regs);
  695.                 END;
  696.               END;
  697.             END ELSE BEGIN
  698.               Inc(Counter); Inc(Offset, (SpS * BpS));
  699.             END;
  700.           END;
  701.           IF AH <> 0 THEN Error(AH);
  702.         END;
  703.       END;
  704.     IF Disk THEN Close(TempFile);
  705.     Write(CRLF+ 'Noch eine Kopie von der Diskette (J/N)? ');
  706.     REPEAT
  707.       ClearBuffer; ch := UpCase(ReadKey);
  708.     UNTIL ch IN ['J', 'Y', 'N'];
  709.     Write(ch);
  710.   UNTIL ch = 'N';
  711. END;
  712.  
  713. PROCEDURE ReleaseEMS;                    (* EMS freigeben *)
  714. BEGIN
  715.   IF EMS THEN BEGIN         (* nur wenn EMS benutzt wurde *)
  716.     EMS := FALSE;           (* EMS ist leer               *)
  717.     Regs.AH := $48;         (* gesich. Mapp. restaurieren *)
  718.     Regs.DX := Handle;
  719.     Intr($67, Regs);
  720.     Regs.AH := $45;                   (* Handle freigeben *)
  721.     Regs.DX := Handle;
  722.     Intr($67, Regs);
  723.   END;
  724. END;
  725.  
  726. PROCEDURE ClearList(wo : Zeiger);       (* Heap aufräumen *)
  727. BEGIN
  728.   IF (wo <> NIL) AND ((SpS * BpS) > 0) THEN BEGIN
  729.     LP := wo;
  730.     FreeMem(LP^.Element, SpS * BpS);
  731.     LP := LP^.Next;
  732.     Dispose(wo);
  733.     ClearList(LP);                          (* Rekursion! *)
  734.   END;
  735. END;
  736.  
  737. {$F+}
  738. PROCEDURE NewEnd;
  739. BEGIN
  740.   ExitProc := OldEnd;
  741.   ReleaseEMS;                        (* EMS freigeben     *)
  742.   IF Disk THEN Erase(TempFile);      (* Swapdatei löschen *)
  743.   IF Help <> NIL THEN ClearList(Help); Help := NIL;
  744.   IF Buffer <> NIL THEN BEGIN        (* Puffer löschen    *)
  745.     FreeMem(Buffer, BpS * SpS); Buffer := NIL;
  746.   END;
  747.   {$IFDEF VER10}
  748.     ParamTab^ := OldTab;       (* Alte Laufwerksparameter *)
  749.   {$ELSE}
  750.     SetIntVec($1E, OldTab);    (* restaurieren            *)
  751.   {$ENDIF}
  752.   ChDir(OldDir);
  753. END;
  754. {$F-}
  755.  
  756. BEGIN (* Hauptprogramm *)
  757.   IF Lo(DosVersion) >= 10 THEN BEGIN
  758.     Write('This program requires DOS'); Halt(2);  (* OS/2 *)
  759.   END ELSE IF Lo(DosVersion) < 3 THEN BEGIN
  760.     Write('Falsche DOS-Version'); Halt(2);    (* DOS 2.XX *)
  761.   END;
  762.   OldEnd := ExitProc;
  763.   ExitProc := @NewEnd;
  764.   {$IFNDEF VER10}
  765.     GetIntVec($1E, OldTab);
  766.     ParamTab := OldTab;                   (* Turbo-Pascal *)
  767.   {$ELSE}
  768.     GetIntVec($1E, ParamTab);
  769.     OldTab := ParamTab^;                  (* Quick-Pascal *)
  770.   {$ENDIF}
  771.   InitTab; Help := NIL; Buffer := NIL; GetDir(0, OldDir);
  772.   Temp := GetEnv('TEMP'); (* Temporärpfad aus Environment *)
  773.   IF Temp = '' THEN Temp := OldDir;
  774.   FOR i := 1 TO Length(Temp) DO Temp[i] := UpCase(Temp[i]);
  775.   ChDir(Temp);
  776.   IF IOResult <> 0 THEN Temp := 'C:\';
  777.   ChDir(OldDir);
  778.   IF Temp[Length(Temp)] <> '\' THEN Temp := Temp + '\';
  779.   IF Exist(Temp + TempFName) THEN
  780.     DeleteFile(Temp + TempFName);
  781.   CheckParameters;
  782.   IF Temp[1] = '\' THEN drive := 0
  783.                    ELSE drive := Ord(Temp[1]) - 64;
  784.   HdAvail := DiskFree(drive);
  785.   IF ExistEMM THEN WITH Regs DO BEGIN
  786.     AH := $40;                    (* EMM-Status ermitteln *)
  787.     Intr($67, Regs);
  788.     IF AH <> 0 THEN EMSError(AH);
  789.     AH := $41;             (* Pageframe-Segment ermitteln *)
  790.     Intr($67, Regs);
  791.     IF AH <> 0 THEN EMSError(AH);
  792.     PageFrame := BX;
  793.   END;
  794.   REPEAT
  795.     ClrScr; HighVideo; WriteLn(Copyright + CRLF); NormVideo;
  796.     DiskTest(Source);
  797.     GetMem(Buffer, SpS * BpS);         (* Puffer zuweisen *)
  798.     IF Buffer = NIL THEN BEGIN
  799.       Write(#7 + CRLF + 'Zu wenig Speicher zur Verfügung');
  800.       ClearBuffer;
  801.       REPEAT UNTIL KeyPressed;
  802.       Halt(1);
  803.     END;
  804.     DiskCopy;
  805.     ReleaseEMS; ClearList(Help);  (* ordentlich aufräumen *)
  806.     Help := NIL; FreeMem(Buffer, SpS * BpS); Buffer := NIL;
  807.     Write(CRLF + 'Eine weitere Diskette kopieren (J/N)? ');
  808.     REPEAT
  809.       ClearBuffer; ch := UpCase(ReadKey);
  810.     UNTIL ch IN ['J', 'Y', 'N'];
  811.     WriteLn(ch);
  812.   UNTIL ch = 'N';
  813. END.
  814. (*--------------------------------------------------------*)
  815. (*                    Ende von EDD.PAS                    *)