home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / ldm / form720.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-11-06  |  14.5 KB  |  564 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    FORM720.PAS                         *)
  3. (*      formatiert in AT-Laufwerken in AT-kompatiblen     *)
  4. (*      Rechnern normale Disketten auf 720 KByte          *)
  5. (*         (C) 1989 Jochen Loewer & toolbox               *)
  6. (* ------------------------------------------------------ *)
  7.  
  8. PROGRAM Form720;
  9.  
  10.   {$M 10000,0,0} (* Begrenzung,da DOS.Exec verwendet wird *)
  11.  
  12.  
  13. USES   DOS,CRT;
  14.  
  15. TYPE   Str100 = String[100];
  16.        Str80  = String[80];
  17.  
  18. VAR
  19.        prog      : Str80;
  20.        Int13Save : POINTER;
  21.        Bootflag  : BOOLEAN;
  22.        SecBuf    : ARRAY [0..511] OF BYTE;
  23.        drivenr   : INTEGER;
  24.        rwerror   : INTEGER;
  25.  
  26.  
  27. { NextPath kopiert in single nächste durch ';' separierte  }
  28. { Pfadangabe aus list beginnend ab Position pos            }
  29.  
  30. FUNCTION NextPath (VAR list  :Str100;
  31.                    VAR pos   :INTEGER;
  32.                    VAR single:Str80 )  : BOOLEAN;
  33. VAR   len  : INTEGER;
  34.       stay : BOOLEAN;
  35. BEGIN
  36.   single := '';
  37.   len := Length(list);
  38.   IF pos >= len THEN
  39.     NextPath := FALSE
  40.   ELSE BEGIN
  41.     stay := TRUE;
  42.     WHILE (pos < len) AND stay DO BEGIN
  43.       inc(pos);
  44.       IF list[pos] <> ';' THEN
  45.         single := single+list[pos]
  46.       ELSE stay := FALSE;
  47.       END;
  48.       NextPath := TRUE;
  49.   END;
  50. END;
  51.  
  52. {   IfThere testet, ob FILE name in dem Verzeichnis path   }
  53. {   vorhanden ist.                                         }
  54.  
  55. FUNCTION  IfThere (VAR path : Str80; name : Str80): BOOLEAN;
  56. VAR  f : FILE;
  57. BEGIN
  58.   IF path = '' THEN
  59.     path := name
  60.   ELSE path := path + '\' + name;
  61.   assign(f,path);
  62.   {$I-}
  63.   Reset(f);
  64.   {$I+}
  65.   IF IOResult = 0 THEN  BEGIN
  66.     Close(f);
  67.     IfThere := TRUE;
  68.   END
  69.   ELSE  IfThere := FALSE;
  70. END;
  71.  
  72. { LookUp sucht das FILE name im aktuellen Verzeichnis und  }
  73. { und in den Verzeichnissen, die in der DOS-Variablen PATH }
  74. { angegeben sind. outpath enthält bei Erfolg zusammen-     }
  75. { gesetzt den Pfad und den Filenamen                       }
  76.  
  77. FUNCTION LookUp (VAR outpath : Str80; name : Str80):BOOLEAN;
  78. VAR   pathlinks : Str100;
  79.        pathscan : INTEGER;
  80. BEGIN
  81.   outpath := '';
  82.   IF IfThere(outpath,name) THEN
  83.     LookUp := TRUE
  84.   ELSE BEGIN
  85.     pathlinks := GetEnv('PATH');
  86.     pathscan := 0;
  87.     WHILE NextPath(pathlinks,pathscan,outpath) DO
  88.       IF IfThere(outpath,name) THEN BEGIN
  89.         LookUp := TRUE;
  90.         EXIT;
  91.       END;
  92.     LookUp := FALSE;
  93.   END;
  94. END;
  95.  
  96. { GetAllDisks gibt Anzahl der installierten logischen      }
  97. { Laufwerke zurück.                                        }
  98.  
  99. FUNCTION  GetAllDisks : INTEGER;
  100. VAR   drive : INTEGER;
  101.       r     : Registers;
  102. BEGIN
  103.   r.ax := $1900;
  104.   MSDOS(r);
  105.   drive := r.al;
  106.   r.ax := $0E00;
  107.   r.dl := drive;
  108.   MSDOS(r);
  109.   GetAllDisks := r.al;
  110. END;
  111.  
  112. { NewInt13 wird vor normale INT 13-Biosroutine gesetzt     }
  113. { immer die richtige Datenübertragungsrate von 300 Bits    }
  114. { pro Sekunde bei 360 u/min (AT-Laufwerk)                  }
  115.  
  116. {$F+,S-,R-}
  117. PROCEDURE NewInt13(f,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:WORD);
  118.           INTERRUPT;
  119. BEGIN
  120.    mem[$0040:$0090] := $54;  (* 300 bits/sec 360 u/min *)
  121.    mem[$0040:$0091] := $54;
  122.    port[$0070] := $10;
  123.    port[$0071] := $44;
  124.    INLINE($a1/int13save+2/$87/$46/$10/$8b/$1e/int13save/
  125.           $87/$5e/$0e/$5d/$07/$1f/$5f/$5e/$5a/$59/$cb );
  126. END;
  127. {$F-}
  128.  
  129. { CheckBoot überprüft ob originaler Bootsektorheader von   }
  130. { von DOS 3.2/3.3 vorliegt oder ob schon ein Bootpatch     }
  131. {  durchgeführt wurde.                                     }
  132.  
  133. FUNCTION CheckBoot : BOOLEAN;
  134. BEGIN
  135.    (*** Absolute Disk Read Bootsector ***)
  136.    INLINE( $50/$53/$51/$52/$06/$1e/$55/$57/$56/$a0/drivenr/
  137.            $b9/$01/$00/$ba/$00/$00/$bb/SecBuf/$cd/$25/
  138.            $83/$c4/$02/$b8/rwerror/$5e/$5f/$5d/$1f/$07/$5a/
  139.            $59/$5b/$58);
  140.    IF (SecBuf[$00]=$EB) AND
  141.       (SecBuf[$01]=$34) AND
  142.       (SecBuf[$02]=$90) AND
  143.       (SecBuf[$4A]=$BF) AND
  144.       (SecBuf[$4B]=$2B) AND
  145.       (SecBuf[$60]=$06) AND
  146.       (SecBuf[$61]=$1F) AND
  147.       (SecBuf[$1FE]=$55) AND
  148.       (SecBuf[$1FF]=$AA) THEN
  149.      CheckBoot := TRUE
  150.    ELSE   CheckBoot := FALSE;
  151.    IF (SecBuf[$00]=$EB) AND
  152.       (SecBuf[$01]=$34) AND
  153.       (SecBuf[$02]=$90) AND
  154.       (SecBuf[$4A]=$50) AND
  155.       (SecBuf[$4B]=$1e) AND
  156.       (SecBuf[$60]=$06) AND
  157.       (SecBuf[$61]=$1F) AND
  158.       (SecBuf[$58]=$eb) AND
  159.       (SecBuf[$59]=$06) AND
  160.       (SecBuf[$1FE]=$55) AND
  161.       (SecBuf[$1FF]=$AA) THEN
  162.     writeln(chr(186),
  163.    '============== DISKETTE schon gepatcht ===============',
  164.     chr(186));
  165. END;
  166.  
  167.  
  168. { DoPatch fügt den Patch-Assemblercode an die Anfangs-     }
  169. { routine im Bootsektor                                    }
  170.  
  171. PROCEDURE  DoPatch;
  172. VAR  r : REGISTERS;
  173. BEGIN
  174.   SecBuf[$2B]:=$DF;  SecBuf[$2C]:=$02;  SecBuf[$2D]:=$25;
  175.   SecBuf[$2E]:=$02;  SecBuf[$2F]:=$12;  SecBuf[$30]:=$2A;
  176.   SecBuf[$31]:=$FF;  SecBuf[$32]:=$50;  SecBuf[$33]:=$f6;
  177.   SecBuf[$34]:=$01;  SecBuf[$35]:=$04;
  178.   SecBuf[$4A]:=$50;  SecBuf[$4B]:=$1E;  SecBuf[$4C]:=$B8;
  179.   SecBuf[$4D]:=$40;  SecBuf[$4E]:=$00;  SecBuf[$4F]:=$8E;
  180.   SecBuf[$50]:=$D8;  SecBuf[$51]:=$B0;  SecBuf[$52]:=$54;
  181.   SecBuf[$53]:=$A2;  SecBuf[$54]:=$90;  SecBuf[$55]:=$00;
  182.   SecBuf[$56]:=$1F;  SecBuf[$57]:=$58;
  183.   SecBuf[$58]:=$EB;
  184.   SecBuf[$59]:=$06;
  185.  
  186.   { Absolute Disk write Bootsector }
  187.   INLINE( $50/$53/$51/$52/$06/$1e/$55/$57/$56/$a0/drivenr/
  188.           $b9/$01/$00/$ba/$00/$00/$bb/SecBuf/$cd/$26/
  189.           $83/$c4/$02/$b8/rwerror/$5e/$5f/$5d/$1f/$07/$5a/
  190.           $59/$5b/$58);
  191. END;
  192.  
  193.  
  194. { Einige Hilfsroutinen für das Bildschirm-Layout           }
  195.  
  196. PROCEDURE leave;
  197. VAR   i : INTEGER;
  198. BEGIN
  199.   window(1,1,80,25);
  200.   GotoXY(1,8);
  201.   FOR i:= 1 TO 70 DO Write(chr(177));
  202.   GotoXY(1,9);
  203.   FOR i:=1 TO 1280 DO Write(' ');
  204.   GotoXY(1,9);
  205.   writeln('FORM720: Abbruch');
  206.   halt;
  207. END;
  208.  
  209. PROCEDURE INV;
  210. BEGIN
  211.   TextColor(0);
  212.   TextBackground(7);
  213. END;
  214.  
  215. PROCEDURE NORM;
  216. BEGIN
  217.   TextColor(7);
  218.   TextBackground(0);
  219. END;
  220.  
  221. PROCEDURE g(sel,y : INTEGER);
  222. BEGIN
  223.   GotoXY(3,y+2);
  224.   IF sel = y THEN INV  ELSE NORM;
  225. END;
  226.  
  227. PROCEDURE wrgrc(s : Str80);
  228. VAR   i : INTEGER;
  229.     len : INTEGER;
  230. BEGIN
  231.   len := Length(s);
  232.   i := 1;
  233.   WHILE i<=len DO BEGIN
  234.     CASE s[i] OF
  235.       '!' : write(chr(219));
  236.       '-' : write(chr(223));
  237.       else write(s[i]);
  238.     END;
  239.     i := i +1;
  240.   END;
  241. END;
  242.  
  243.  
  244. PROCEDURE help(sel : INTEGER);
  245. VAR  s,t : Str80;
  246.      i   : INTEGER;
  247. BEGIN
  248.   NORM;
  249.   s:='';  t:='';
  250.   CASE sel OF
  251.     1: BEGIN
  252.      s:='Im AT : mit Installation DEVICE=DRIVE720.SYS /D:x';
  253.      t:='######  720-kB-Disk in Standard-AT-Laufwerk';
  254.      END;
  255.     3: BEGIN
  256.      s:='Im AT : normales High-Density-Format ';
  257.      t:='        (360 u/min 500 kBit/sec)  ';
  258.      END;
  259.     2: BEGIN
  260.      s:='Im AT : 360 kB AT-Laufwerk mit Double-Step';
  261.      t:='        (360 u/min 300 kBit/sec) 40 Tracks ';
  262.      END;
  263.     4: BEGIN
  264.      s:='Im AT/PS2 : High Density 3.5 Zoll => 1.44 MB ';
  265.      t:='            (300 u/min  500 kBit/sec)';
  266.      END;
  267.     5: BEGIN
  268.      s:='Im AT/PS2 : High Density 3.5 Zoll => 720 kB';
  269.      t:='            (300 u/min  250 kBit/sec)';
  270.      END;
  271.     6: BEGIN
  272.      s:='Im PC/AT/PS2 : einfaches 80-Track-Drive';
  273.      t:='               (300 u/min  250 kBit/sec)';
  274.      END;
  275.     7: BEGIN
  276.      s:='Im PC (AT) : einfaches 40-Track-Drive';
  277.      t:='             (300 u/min  250 bKit/sec)';
  278.      END;
  279.   END;
  280.   GotoXY(2,13); FOR i := 16 to 75 DO write(' ');
  281.   GotoXY(2,14); FOR i := 16 to 75 DO write(' ');
  282.   GotoXY(2,13); write(s);
  283.   GotoXY(2,14); write(t);
  284. END;
  285.  
  286.  
  287. { BootPatch erledigt komfortabel den Bootpatchvorgang      }
  288.  
  289. PROCEDURE  BootPatch;
  290. VAR     ch  : CHAR;
  291.     DoAgain : BOOLEAN;
  292.           i : INTEGER;
  293. BEGIN
  294.   writeln;
  295.   REPEAT
  296.     writeln;
  297.     write(chr(201));
  298.     FOR i:=1 TO 11 DO write(chr(205));
  299.     write(' Boot-Patch ');
  300.     FOR i:=1 TO 31 DO write(chr(205));
  301.     writeln(chr(187));
  302.     write(chr(186));
  303.     FOR i:=1 TO 54 DO write(' ');
  304.     writeln(chr(186));
  305.     write(chr(186));
  306.     write(
  307.     ' Legen Sie Diskette (720kByte FORM720-Format) ein,bei '
  308.      );
  309.     writeln(chr(186));
  310.     write(chr(186));
  311.     write(
  312.     ' der der Bootsektor-Patch durchgeführt werden soll.   '
  313.      );
  314.     writeln(chr(186));
  315.     write(chr(186));
  316.     write('       ... Taste ... zum Start');
  317.     writeln('                        ',chr(186));
  318.     ch := Readkey;
  319.     IF ch = #27 THEN exit;
  320.     IF ch = #0 THEN ch := readkey;
  321.     IF CheckBoot THEN BEGIN
  322.       DoPatch;
  323.       END ELSE BEGIN
  324.         write(chr(186));
  325.         write(' !! Patch nur möglich, wenn Bootsektor von');
  326.         writeln('            ',chr(186));
  327.         write(chr(186));
  328.         write('    MSDOS-3.2  oder  MSDOS-3.3');
  329.         writeln('                        ',chr(186));
  330.     END;
  331.     DoAgain := FALSE;
  332.     write(chr(200));
  333.     FOR i:=1 TO 6 DO write(chr(205));
  334.     write(' eine weitere Diskette patchen ? (J/N): ');
  335.     FOR i:=1 TO 8 DO write(chr(205)); writeln(chr(188));
  336.     ch := readkey;
  337.     IF (ch='J') OR (ch='j') THEN DoAgain := TRUE;
  338.     IF ch = #0 THEN ch := readkey;
  339.   UNTIL NOT DoAgain;
  340. END;
  341.  
  342.  
  343. PROCEDURE Menu(VAR command : Str80; VAR bpatch : BOOLEAN);
  344. VAR       i : INTEGER;
  345.    maxdisks : INTEGER;
  346.        goon : BOOLEAN;
  347.         s   : INTEGER;
  348.         ch  : CHAR;
  349. BEGIN
  350.   GotoXY(1,10);
  351.   FOR i:=0 TO 1199 DO Write(chr(177));
  352.   window(8,8,40,10);
  353.   ClrScr;
  354.   GotoXY(3,2);
  355.   write(' Formatieren auf Laufwerk :');
  356.   window(40,12,49,22);
  357.   ClrScr;
  358.   maxdisks := GetAllDisks;
  359.   IF maxdisks > 9 THEN
  360.     maxdisks:=9;
  361.     s := 0;
  362.     goon := TRUE;
  363.  
  364.     { Laufwerk selektieren }
  365.  
  366.     WHILE goon DO BEGIN
  367.       FOR i := 0 TO maxdisks-1 DO BEGIN
  368.         GotoXY(3,2+i);
  369.         IF i=s THEN INV  ELSE  NORM;
  370.         write('  ',chr(i+65),':  ');
  371.         NORM;
  372.       END;
  373.       ch := readkey;
  374.       CASE ch OF
  375.         #27 :  leave;
  376.         #13 :  goon := FALSE;
  377.         '8' :  IF s > 0 THEN dec(s);
  378.         '2' :  IF s < MaxDisks-1 THEN inc(s);
  379.         #00 :  BEGIN
  380.                  ch := readkey;
  381.                  CASE ch OF
  382.                    #72 : IF s > 0 THEN dec(s);
  383.                    #80 : IF s < MaxDisks-1 THEN inc(s);
  384.                  END;
  385.                END;
  386.       END;
  387.   END;
  388.   command := ' x: ';
  389.   command[2] := chr(65+s);
  390.   drivenr := s;
  391.   window(1,1,80,25);
  392.   GotoXY(1,8);
  393.   FOR i:=0 TO 1199 DO write(chr(177));
  394.   window(10,12,42,18);
  395.   ClrScr;
  396.   GotoXY(3,2); write('Bootbare Diskette : ');
  397.   s := 0;
  398.   goon := TRUE;
  399.  
  400.   { Systemdiskette }
  401.  
  402.   WHILE goon DO BEGIN
  403.     IF s = 0 THEN BEGIN
  404.       Gotoxy(10,5);
  405.       INV;   write(' Nein ');
  406.       NORM;  write('/  Bootbar '); END
  407.     ELSE BEGIN
  408.       Gotoxy(10,5);
  409.       NORM;  write(' Nein / ');
  410.       INV;   write(' Bootbar ');
  411.       NORM;
  412.     END;
  413.     ch := readkey;
  414.     IF ch = #27 THEN leave;
  415.     IF ch = #0  THEN ch := readkey;
  416.     IF ch = #13 THEN goon := FALSE
  417.     ELSE s := (s+1) MOD 2;
  418.   END;
  419.   Bootflag := FALSE;
  420.   IF s=1 THEN BEGIN
  421.     bootflag := TRUE;
  422.     command := command + '/S ';
  423.   END;
  424.   window(1,1,80,25);
  425.   GotoXY(1,8);
  426.   FOR i:=0 TO 1199 DO write(chr(177));
  427.   window(3,12,12,14);
  428.   ClrScr;
  429.   GotoXY(2,2);
  430.   write('Format :');
  431.   window(16,9,77,22);
  432.   ClrScr;
  433.   GotoXY(1,12);
  434.   FOR i := 16 TO 77 DO write('─');
  435.   s := 0;
  436.   goon := TRUE;
  437.  
  438.   { Format-Type }
  439.  
  440.   WHILE goon DO BEGIN
  441.  
  442.    g(s,0);write(' -- Kein Parameter (für z.B. HARDDISKs) ');
  443.           write('------------------ ');
  444.    g(s,1);write('*FORM-720 80 Tr ------Step  9 Sec 2 Head');
  445.           write(' spez AT-Laufwerk  ');
  446.    g(s,2);write(' 360 kB - 40 Tr DoubleStep  9 Sec 2 Head');
  447.           write(' F:1  AT-Laufwerk  ');
  448.    g(s,3);write(' 1.2 MB - 80 Tr ------Step 15 Sec 2 Head');
  449.           write(' F:1  AT-Laufwerk  ');
  450.    g(s,4);write(' 1.44 M - 80 Tr ------Step 18 Sec 2 Head');
  451.           write(' F:7   High 3.5    ');
  452.    g(s,5);write(' 720 kB - 80 Tr ------Step  9 Sec 2 Head');
  453.           write(' F:7   High 3.5    ');
  454.    g(s,6);write(' 720 kB - 80 Tr ------Step  9 Sec 2 Head');
  455.           write(' F:2  80-Tr/3.5 low');
  456.    g(s,7);write(' 360 kB - 40 Tr ------Step  9 Sec 2 Head');
  457.           write(' F:0   40-Tr-Drive ');
  458.    help(s);
  459.    ch := readkey;
  460.    CASE ch OF
  461.      #27 :  leave;
  462.      #13 :  goon := FALSE;
  463.      '8' :  IF s > 0 THEN dec(s);
  464.      '2' :  IF s < 7 THEN inc(s);
  465.      #00 :  BEGIN
  466.               ch := readkey;
  467.               CASE ch OF
  468.                 #72 : IF s > 0 THEN dec(s);
  469.                 #80 : IF s < 7 THEN inc(s);
  470.               END;
  471.             END;
  472.    END;
  473.   END;
  474.  
  475.   bpatch := FALSE;
  476.   CASE s OF
  477.     0:  command := command + '';
  478.     1:  bpatch := TRUE;
  479.     2:  command := command + '/4 ';
  480.     3:  command := command + '';
  481.     4:  command := command + '';
  482.     5:  command := command + '/T:80 /N:9 ';
  483.     6:  command := command + '/T:80 /N:9 ';
  484.     7:  command := command + '';
  485.   END;
  486. END;
  487.  
  488.  
  489. PROCEDURE DoIt;
  490. VAR
  491.            i : INTEGER;
  492.      command : Str80;
  493.        patch : BOOLEAN;
  494.         save : INTEGER;
  495.      biosalt : INTEGER;
  496. BEGIN
  497.   NORM;
  498.   ClrScr;
  499.   FOR i:=0 TO 719 DO Write(chr(177));
  500.   GotoXY(3,2);
  501.   FOR i:=0 TO 64  DO write(' ');
  502.   GotoXY(3,3);
  503.   wrgrc(' !--- !---! !--- !-!-!     ---! ---! !--!   ');
  504.   write(' Copyright (c) 1989  ');
  505.   Gotoxy(3,4);
  506.   wrgrc(' !--  !   ! !    ! ! ! ---    ! !--- !  !   ');
  507.   write(' J. Loewer & toolbox ');
  508.   GotoXY(3,5);
  509.   wrgrc(' -    ----- -    - - -        - ---- ----   ');
  510.   write(' 720 KB-Driver V1.2  ');
  511.   GotoXY(3,6);
  512.   FOR i:=0 TO 64 DO write(' ');
  513.   GotoXY(1,10);
  514.   menu(command,patch);
  515.   window(1,1,80,25);
  516.   GotoXY(1,9);
  517.   FOR i:=1 TO 1280 DO Write(' ');
  518.   GotoXY(1,9);
  519.   writeln;
  520.  
  521.   IF patch THEN BEGIN
  522.     IF bootflag THEN BEGIN
  523.       write(chr(219));
  524.       writeln('  Nach Formatiervorgang muß pro Diskette ');
  525.       write(chr(219));
  526.       writeln('  ein BootPatch durchgeführt werden ! ');
  527.       writeln;
  528.     END;
  529.  
  530.     port[$70] := $10;  Delay(2);
  531.     save := port[$71]; Delay(2);
  532.     port[$70] := $10;  Delay(2);
  533.     port[$71] := $44;
  534.     biosalt   := memw[$0040:$0090];
  535.     GetIntVec($13,Int13Save);
  536.     SetIntVec($13,@NewInt13);
  537.   END;
  538.   Exec(prog,Command);
  539.   IF patch THEN BEGIN
  540.     SetIntVec($13,Int13Save);
  541.     memw[$0040:$0090] := biosalt;
  542.     port[$70] := $10;  Delay(2);
  543.     port[$71] := save;
  544.     IF Bootflag THEN BootPatch;
  545.   END;
  546.   writeln;
  547.   IF DosExitCode = 0 THEN
  548.     writeln('FORM720: normal beendet')
  549.     ELSE writeln('FORM720: Vorgang abgebrochen');
  550.   HALT;
  551. END;
  552.  
  553.  
  554. BEGIN
  555.  
  556.  IF LookUp(prog,'FORMAT.COM') THEN DoIt;
  557.  
  558.  Writeln('FORM720 abgebrochen. FORMAT.COM nicht gefunden');
  559.  
  560. END.
  561.  
  562. (* ------------------------------------------------------ *)
  563. (*               Ende von FORM720.PAS                     *)
  564.