home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / FLOPPIES / HCFORMAT.ZIP / HCFORMAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-06-02  |  22.6 KB  |  712 lines
  1. {$A+,B-,D+,E+,F-,I-,L+,N-,O-,R-,S-,V-}
  2. {$M 8192,0,0}
  3. Program HCFORMAT;
  4.  
  5. uses dos;
  6.  
  7. {Written in Turbo-Pascal 5.0}
  8.  
  9. const text01 = 'Error ';
  10. const text02 = '(A)bort (R)etry (I)gnore ? ';
  11. const t3     = 'R';
  12. const text04 = 'No valid drive.';
  13. const text05 = 'SUBST/ASSIGN/Network-Drive.';
  14. const text06 = 'Not a floppy drive.';
  15. const text07 = 'Unknown drive type.';
  16. const text08 = 'Formatting drive ';
  17. const text09 = ' Head(s), ';
  18. const text10 = ' Tracks, ';
  19. const text11 = ' Sectors/track, ';
  20. const text12 = ' Root Directory Entries, ';
  21. const text13 = ' Sector(s)/Cluster, Sector-Shift: ';
  22. const text14 = 'Head: ';
  23. const text15 = ', Cylinder: ';
  24. const text16 = ', Sector: ';
  25. const text17 = 'Format error in system area: Program aborted.';
  26. const text18 = 'More than ';
  27. const text19 = ' sectors unreadable. Program aborted.';
  28. const text20 = ' marked as bad';
  29. const text21 = 'OEM-Entry:              ';
  30. const text22 = 'Total sectors on disk:  ';
  31. const text23 = 'Sectors per track:      ';
  32. const text24 = 'Heads:                  ';
  33. const text25 = 'Bytes per sector:       ';
  34. const text26 = 'Hidden sectors:         ';
  35. const text27 = 'Boot-sectors:           ';
  36. const text28 = 'Number of FATs:         ';
  37. const text29 = 'Sectors per FAT:        ';
  38. const text30 = 'Total clusters on disk: ';
  39. const text31 = ' total bytes on disk';
  40. const text32 = ' bytes in bad sectors';
  41. const text33 = ' bytes available';
  42. const text34 = 'This drive cannot be formatted.';
  43. const text35 = 'Drive is physical ';
  44. const text36 = 'BIOS double-step support: ';
  45. const text37 = 'XT-like';
  46. const text38 = 'EPSON QX-16 like';
  47. const text39 = 'AT-like';
  48. const text40 = 'Not available or unknown';
  49. const text41 = 'Syntax Error.';
  50. const text42 = 'Usage is: HCFORMAT drive: [options]';
  51. const text43 = ' Example: HCFORMAT a: t41 h2 s10 C1 D112';
  52. const text44 = 'Option   Meaning                                 Default';
  53. const text45 = 'drive:   drive to be formatted                   none';
  54. const text46 = 'Tnn      Number of tracks                        40/80 depends on drive';
  55. const text47 = 'Hnn      Number of heads                         2';
  56. const text48 = 'Snn      Number of sectors per track             9/15/18 depends on drive';
  57. const text49 = 'Cn       Number of sectors per cluster           1 for HD, 2 for DD';
  58. const text50 = 'Dnnn     Number of root directory entries        224 for HD, 112 for DDD';
  59. const text51 = 'Inn      Interleave                              1';
  60. const text52 = 'P        for use on PS/2 Computers';
  61. const text53 = 'V        Skip verifying';
  62. const text69 = 'Bnnn     Force a specified Format-Descriptor     depends on format';
  63. const text70 = 'Gnnn     Use specified GAP-Length                depends on format';
  64. const text71 = 'Fnn      Use specified Sector-Shift              0';
  65. const text54 = 'This program requires DOS 3.2 or higher.';
  66. const text55 = 'HCFORMAT - Disk Formatter for High Capacity Disks - Ver 1.3';
  67. const text56 = 'Copyright (C) 1989, Carlo Ayars, The Computer Wizzard.';
  68. const text57 = 'Heads must be 1 or 2.';
  69. const text58 = 'At least one track should be formatted.';
  70. const text59 = 'Interleave must be from 1 to ';
  71. const text60 = '.';
  72. const text61 = 'WARNING! DOS supports only 1 or 2 sectors per cluster.';
  73. const text62 = 'WARNING! That many tracks could cause damage to your drive.';
  74. const text63 = 'WARNING! DOS supports a maximum of 240 root directory entries.';
  75. const text64 = 'Insert Diskette in drive ';
  76. const text65 = ':';
  77. const text66 = 'Press ENTER when ready (ESC=QUIT)';
  78. const text67 = 'Sector-Shift: ';
  79. const text68 = ', GAP-Length: ';
  80.  
  81.  
  82. type tabletyp = array[1..25] of record
  83.                   t,h,s,f:byte;
  84.         end;
  85.  
  86.      paratyp =  array[0..10] of byte;
  87.      boottyp =  array[30..511] of byte;
  88.  
  89.      btttyp  =  array[1..20] of record
  90.                   head:  byte;
  91.                   track: byte;
  92.                 end;
  93.  
  94.      bpbtyp  =  record
  95.           jmp: array[1..3] of byte;
  96.           oem: array[1..8] of char;  {OEM-Eintrag}
  97.           bps: word;                 {Bytes pro Sektor}
  98.           spc: byte;                 {Sektoren pro Cluster}
  99.           res: word;                 {BOOT-Sektoren}
  100.           fat: byte;                 {Anzahl der FAT's}
  101.           rde: word;                 {Basisverzeichniseinträge}
  102.           sec: word;                 {Gesamtsektoren der Diskette}
  103.           mds: byte;                 {Media-Deskriptor}
  104.           spf: word;                 {Sektoren pro FAT}
  105.           spt: word;                 {Sektoren pro Spur}
  106.           hds: word;                 {Seiten}
  107.           shh: word;                 {Versteckte Sektoren}
  108.           boot_code: boottyp;        {Puffer für BOOT-Code}
  109.         end;
  110.  
  111. var regs:       registers;                {Prozessor-Register}
  112.     track:      byte;                     {Aktuelle Spur}
  113.     head:       byte;                     {Aktuelle Seite}
  114.     table:      tabletyp;                 {Formatierungs-Tabelle}
  115.     table2:     array[1..25] of byte;     {Interleave-Tabelle}
  116.     x:          word;                     {Hilfsvariable}
  117.     buffer:     array[0..18432] of byte;  {Puffer für eingelesene Sektoren}
  118.     old1E:      pointer;                  {Alter Zeiger auf die Parameterliste}
  119.     new1E:      ^paratyp;                 {Neuer Zeiger auf die Parameterliste}
  120.     old13:      pointer;                  {Alter Zeiger auf Interrupt 13}
  121.     old58:      pointer;                  {Alter Zeiger auf Hilfsinterrupt 58}
  122.     bpb:    bpbtyp;                   {Boot-Sektor mit BIOS-Parameterblock}
  123.     chx:        Char;                     {Hilfsvariable}
  124.     lw:         Byte;                     {Ausgewähltes Laufwerk}
  125.     hds,sec:    word;                     {Anzahl der Seiten, Sektoren}
  126.     trk:        word;                     {Anzahl der Spuren}
  127.     hd,lwhd:    Boolean;                  {High-Density Flags}
  128.     lwtrk:      byte;                     {maximale Spuren des Laufwerks}
  129.     lwsec:      byte;                     {maximale Sektoren des Laufwerks}
  130.     para:    String[5];                {Parameter von der Kommandozeile}
  131.     rde:    byte;                     {Basisverzeichniseinträge}
  132.     spc:    byte;                     {Sektoren pro Cluster}
  133.     i,n:    byte;                     {Hilfsvariablen}
  134.     j:        integer;                  {Hilfsvariable}
  135.     again:      boolean;                  {Flag, ob INT 13 nochmal kommen muß}
  136.     bttCount:   word;                     {Anzahl der schlechten Spuren}
  137.     btt:        btttyp;                   {Tabelle der schlechten Spuren}
  138.     Offset:     word;                     {Relative Position im FAT}
  139.     Mask:       word;                     {Maske für schlechten Cluster}
  140.     bytes:    LongInt;                  {Bytes Gesamtkapazität}
  141.     bad:        Longint;                  {Bytes in schlechten Sektoren}
  142.     pc80:    Byte;                     {Maske, für 40/80 Spur nach XT-BIOS}
  143.     at80:       Boolean;                  {TRUE, wenn 80/40 Spur nach AT-BIOS}
  144.     ps2:        Boolean;                  {TRUE, wenn PS2}
  145.     noverify:   Boolean;                  {TRUE, wenn Verify nicht verlangt wurde}
  146.     DiskId:     Byte;                     {Disketten-Format-Beschreibung für AT-BIOS}
  147.     il:         Byte;                     {Interleave-Faktor}
  148.     gpl:        Byte;                     {GAP-Länge}
  149.     shift:      Byte;                     {Sektor-Shifting}
  150.     ModelByte:  Byte absolute $F000:$FFFE {XT/AT/386};
  151.     ForceType:  Byte;                     {Gezwungener Diskid}
  152.  
  153. const para17:  paratyp =($df,$02,$25,$02,17,$1b,$ff,$23,$00,$0f,$08);
  154.       para18a: paratyp =($df,$02,$25,$02,18,$1b,$ff,$02,$00,$0f,$08);
  155.       para18:  paratyp =($df,$02,$25,$02,18,$1b,$ff,$6c,$00,$0f,$08);
  156.       para10:  paratyp =($df,$02,$25,$02,10,$2a,$ff,$2e,$00,$0f,$08);  {GPL 26-36}
  157.       para11:  paratyp =($df,$02,$25,$02,11,$2a,$ff,$02,$00,$0f,$08);
  158.       para15:  paratyp =($df,$02,$25,$02,15,$1b,$ff,$54,$00,$0f,$08);
  159.       para09:  paratyp =($df,$02,$25,$02,09,$2a,$ff,$50,$00,$0f,$08);
  160.       para08:  paratyp =($df,$02,$25,$02,08,$2a,$ff,$58,$00,$0f,$08);
  161.       para20:  paratyp =($df,$02,$25,$02,20,$1b,$ff,$25,$00,$0f,$08);  {GPL 17-33}
  162.       para21:  paratyp =($df,$02,$25,$02,21,$1b,$ff,$0c,$00,$0f,$08);
  163.       para22:  paratyp =($df,$02,$25,$02,22,$1b,$ff,$01,$00,$0f,$08);
  164.  
  165.       GetPhys: Array[0..14] of Byte =(
  166.  
  167.             $1E,               {  PUSH DS             }
  168.         $B8,$40,$00,       {  MOV  AX,40H         }
  169.         $8E,$D8,           {  MOV  DS,AX          }
  170.             $88,$16,$41,$00,   {  MOV  [41H],DL       }
  171.             $1F,               {  POP  DS             }
  172.             $B8,$01,$01,       {  MOV  AX,101H        }
  173.             $CF);              {  IRET                }
  174.  
  175.       Help58: Array[0..3] of Byte =(
  176.  
  177.             $CD,$25,           {  INT  25H            }
  178.             $59,               {  POP  CX             }
  179.             $CF);              {  IRET                }
  180.  
  181.  
  182.       boot: boottyp=(
  183. $00,$00,
  184. $00,$00,$00,$00,$00,$00,$FA,$B8,$30,$00,$8E,$D0,$BC,$FC,$00,$FB,
  185. $0E,$1F,$BB,$07,$00,$BE,$5C,$7C,$90,$8A,$04,$46,$3C,$00,$74,$08,
  186. $B4,$0E,$56,$CD,$10,$5E,$EB,$F1,$B4,$01,$CD,$16,$74,$06,$B4,$00,
  187. $CD,$16,$EB,$F4,$B4,$00,$CD,$16,$33,$D2,$CD,$19,$0D,$0A,$54,$68,
  188. $69,$73,$20,$44,$69,$73,$6B,$65,$74,$74,$65,$20,$77,$61,$73,$20,
  189. $66,$6F,$72,$6D,$61,$74,$74,$65,$64,$20,$77,$69,$74,$68,$20,$48,
  190. $44,$46,$4F,$52,$4D,$41,$54,$2E,$20,$49,$74,$20,$69,$73,$20,$6E,
  191. $6F,$74,$20,$62,$6F,$6F,$74,$61,$62,$6C,$65,$2E,$0D,$0A,$54,$6F,
  192. $20,$6D,$61,$6B,$65,$20,$69,$74,$20,$62,$6F,$6F,$74,$61,$62,$6C,
  193. $65,$20,$75,$73,$65,$20,$74,$68,$65,$20,$44,$4F,$53,$2D,$43,$6F,
  194. $6D,$6D,$61,$6E,$64,$3A,$20,$53,$59,$53,$2E,$0D,$0A,$54,$68,$69,
  195. $73,$20,$77,$6F,$72,$6B,$73,$20,$6F,$6E,$6C,$79,$2C,$20,$69,$66,
  196. $20,$79,$6F,$75,$20,$63,$61,$6E,$20,$72,$65,$61,$64,$20,$74,$68,
  197. $69,$73,$20,$44,$69,$73,$6B,$65,$74,$74,$65,$20,$77,$69,$74,$68,
  198. $6F,$75,$74,$20,$48,$44,$52,$45,$41,$44,$2E,$0D,$0A,$0A,$50,$72,
  199. $65,$73,$73,$20,$61,$20,$6B,$65,$79,$20,$74,$6F,$20,$72,$65,$62,
  200. $6F,$6F,$74,$2E,$0D,$0A,$0A,$0A,$00,$00,$00,$00,$00,$00,$00,$00,
  201. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  202. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  203. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  204. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  205. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  206. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  207. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  208. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  209. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  210. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  211. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  212. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  213. $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$55,$AA);
  214.  
  215.  
  216. Function ReadKey:Char;
  217. Var r:Registers;
  218. begin
  219.   with r do begin
  220.     ah:=7;
  221.     intr($21,r);
  222.     if al in [3,27] then begin writeln; halt end;
  223.     ReadKey:=chr(al);
  224.   end;
  225. end;
  226.  
  227. Procedure int13;
  228. var axs: word;
  229.     chs: byte;
  230.     chx: char;
  231.     er:  Boolean;
  232. begin
  233.   again:=false;
  234.   with regs do begin
  235.     axs:=ax;
  236.     repeat
  237.       ax:=axs;
  238.       if ah=5 then SetIntVec($1E,new1E);
  239.       if trk>43 then dl:=dl or pc80;
  240.       mem[$40:$90+dl]:=DiskId;
  241.       intr($13,regs);
  242.       SetIntVec($1E,Old1E);
  243.       er:=ah>1;
  244.     until ah<>6;
  245.     if er then begin
  246.       writeln;
  247.       writeln(text01,regs.ah,': T',ch,' H',dh,' S',cl,'-',
  248.               cl+lo(axs)-1,' L',dl,' C',hi(axs));
  249.       writeln(text02);
  250.       repeat
  251.     chx:=Upcase(ReadKey);
  252.         case chx of
  253.       'A': halt;
  254.       'I': er:=false;
  255.           t3 : begin er:=false; again:=true; end;
  256.         end;
  257.       until chx in ['A','I',t3];
  258.     end;
  259.   ax:=axs;
  260.   end;
  261. end;
  262.  
  263. Procedure GetPhysical(Var lw:Byte);
  264. begin
  265.   with regs do begin
  266.     GetIntVec($58,old58);
  267.     GetIntVec($13,old13);
  268.     SetIntVec($58,@help58);
  269.     SetIntVec($13,@GetPhys);
  270.     al:=lw; cx:=1; dx:=0;
  271.     ds:=seg(buffer); bx:=ofs(buffer);
  272.     intr($58,regs);
  273.     SetIntVec($58,old58);
  274.     SetIntVec($13,old13);
  275.     lw:=mem[$40:$41];
  276.   end;
  277. end;
  278.  
  279. procedure DriveTyp(Var lw:Byte;Var hd:boolean;Var trk,sec:byte);
  280. begin
  281.   with regs do begin
  282.     ax:=$4409; bl:=lw+1; bh:=0;
  283.     intr($21,regs);
  284.     if (FCarry and Flags) <> 0 then begin
  285.       writeln(text04);
  286.       trk:=0;
  287.       exit;
  288.     end;
  289.     if (dx and $9200)<>0 then begin
  290.       writeln(text05);
  291.       trk:=0;
  292.       exit;
  293.     end;
  294.     ax:=$440f; bl:=lw+1; bh:=0;
  295.     intr($21,regs);
  296.     if (FCarry and Flags)<>0 then begin
  297.       writeln(text04);
  298.       trk:=0;
  299.       exit;
  300.     end;
  301.     ax:=$440d; cx:=$860; bl:=lw+1;
  302.     bh:=0; dx:=ofs(buffer); ds:=seg(buffer);
  303.     intr($21,regs);
  304.     case buffer[1] of
  305.       0: begin trk:=39; sec:= 9; hd:=false; end;
  306.       1: begin trk:=79; sec:=15; hd:=true ; end;
  307.       2: begin trk:=79; sec:= 9; hd:=false; end;
  308.       7: begin trk:=79; sec:=18; hd:=true ; end;
  309.     else
  310.       begin
  311.         writeln(text06);
  312.         trk:=0;
  313.         exit;
  314.       end
  315.     end;
  316.     GetPhysical(lw);
  317.     lw:=lw and $9f;
  318.     if not(lw in [0..3]) then begin
  319.       writeln(text07);
  320.       trk:=0;
  321.       exit;
  322.     end;
  323.     ModelByte:=mem[$f000:$fffe];
  324.     at80:=(ModelByte=$f8) or (ModelByte=$fc); pc80:=0;
  325.     if not(at80) then begin
  326.       es:=seg(buffer); bx:=ofs(buffer);
  327.       ax:=$201; cx:=0;
  328.       dh:=0; dl:=lw+$20;
  329.       intr($13,regs);
  330.       if ah<>1 then
  331.         pc80:=$20
  332.       else begin
  333.         dl:=$40+lw; ax:=$201;
  334.         intr($13,regs);
  335.         if ah<>1 then pc80:=$40;
  336.       end;
  337.     end;
  338.   end;
  339. end;
  340.  
  341. Procedure ATSetDrive(lw:Byte; trk,sec,Disk,SetUp:Byte);
  342. begin
  343.   with regs do begin
  344.     dh:=lw; ah:=$18; ch:=trk; cl:=sec;
  345.     intr($13,regs);
  346.     if ah>1 then begin
  347.       ah:=$17; al:=SetUp; dl:=lw;
  348.       intr($13,regs);
  349.     end;
  350.     DiskId:=Disk;
  351.     if ForceType=0 then
  352.       mem[$40:$90+lw]:=Disk
  353.     else
  354.       mem[$40:$90+lw]:=ForceType;
  355.   end;
  356. end;
  357.  
  358. procedure SectorAbsolute(sector:Word;Var hds,trk,sec:Byte);
  359. var h:word;
  360. begin
  361.   sec:=(sector mod bpb.spt)+1;
  362.   h:=sector div bpb.spt;
  363.   trk:=h div bpb.hds;
  364.   hds:=h mod bpb.hds;
  365. end;
  366.  
  367. Function SectorLogical(hds,trk,sec:Byte):Word;
  368. begin
  369.   SectorLogical:=trk*bpb.hds*bpb.spt+hds*bpb.spt+sec-1;
  370. end;
  371.  
  372. Function Cluster(Sector: Word):Word;
  373. Var h: byte;
  374. begin
  375.   Cluster:=((Sector-(bpb.rde shr 4)
  376.             -(bpb.spf shl 1)-1)
  377.            div Word(bpb.spc))+2;
  378. end;
  379.  
  380. Procedure ClusterOffset(Cluster:Word; Var Offset,Mask:Word);
  381. begin
  382.   Offset:=Cluster*3 shr 1;
  383.   if Cluster and 1 = 0 then
  384.     Mask:=$ff7
  385.   else
  386.     Mask:=$ff70;
  387. end;
  388.  
  389. Procedure format;
  390. Var i:Byte;
  391. begin
  392.   if rde and 15 <> 0 then inc(rde,16);
  393.   rde:=rde shr 4;
  394.   if (spc=2) and (rde and 1 = 0) then inc(rde);
  395.   bpb.rde:=rde shl 4;
  396.   case sec of
  397.     0..8:   new1E:=@para08;
  398.     9:      new1E:=@para09;
  399.     10:     new1E:=@para10;
  400.     11:     new1E:=@para11;
  401.     12..15: new1E:=@para15;
  402.     17:     new1E:=@para17;
  403.     18:     if lwsec>17 then
  404.               new1E:=@para18
  405.             else
  406.               new1E:=@para18a;
  407.     19..20: new1E:=@para20;
  408.     21:     new1E:=@para21;
  409.     22..255:new1E:=@para22;
  410.   end;
  411.   if gpl<>0 then
  412.     new1E^[7]:=gpl
  413.   else
  414.     gpl:=new1E^[7];
  415.   writeln;
  416.   write(text08,chr(lw+$41),': ');
  417.   if hd then writeln('High-Density') else writeln('Double-Density');
  418.   writeln(hds,text09,trk,text10,sec,text11,'Interleave: ',il,text68,gpl);
  419.   writeln(bpb.rde,text12,spc,text13,shift);
  420.   writeln;
  421.   bttCount:=0;
  422.   with regs do begin
  423.     for i:=1 to 25 do begin
  424.       table[i].f:=2;
  425.       table2[i]:=0;
  426.     end;
  427.     i:=1;
  428.     n:=1;
  429.     repeat
  430.       repeat
  431.         while table2[n]<>0 do inc(n);
  432.         if n>sec then n:=1;
  433.       until table2[n]=0;
  434.       table2[n]:=i;
  435.       n:=n+il;
  436.       inc(i);
  437.     until i>sec;
  438.     ax:=0;
  439.     bx:=0;
  440.     dl:=lw;
  441.     if at80 then begin
  442.       if (trk>43) and (sec>11) then ATSetDrive(lw,79,lwsec,$14,5);
  443.       if not(ps2) and (trk>43) and (sec<12) then ATSetDrive(lw,79,9,$53,4);
  444.       if ps2 and (trk>43) and (sec<12) then ATSetDrive(lw,79,9,$97,4);
  445.       if (trk<44) and (sec>11) then ATSetDrive(lw,39,lwsec,$34,3);
  446.       if ps2 and (trk<44) and (sec<12) then ATSetDrive(lw,39,9,$B7,2);
  447.       if not(ps2) and (trk<44) and (sec<12) then ATSetDrive(lw,39,9,$73,2);
  448.     end;
  449.     writeln;
  450.     bpb.jmp[1]:=235;
  451.     bpb.jmp[2]:=36;
  452.     bpb.jmp[3]:=144;
  453.     bpb.spt:=sec;
  454.     bpb.hds:=hds;
  455.     bpb.shh:=0;
  456.     bpb.bps:=512;
  457.     bpb.spc:=spc;
  458.     bpb.res:=1;
  459.     bpb.fat:=2;
  460.     bpb.sec:=sec*bpb.hds*trk;
  461.     bpb.boot_code:=boot;
  462.     case bpb.spc of
  463.       1:    if (trk>44) and (bpb.spt in [12..17]) then
  464.                bpb.mds:=$f9
  465.             else
  466.                bpb.mds:=$f0;
  467.       2:    if trk in [1..43] then bpb.mds:=$fd else bpb.mds:=$f9;
  468.       else  bpb.mds:=$f8;
  469.     end;
  470.     bpb.spf:=trunc(bpb.sec*1.5/512/bpb.spc)+1;
  471.     dl:=lw;
  472.     ax:=0;
  473.     repeat int13 until not again;
  474.     for track:=0 to trk-1 do begin
  475.       for head:=0 to hds-1 do begin
  476.         n:=(shift* (track*hds + head) ) mod sec;
  477.         for i:=1 to sec do
  478.           table[i].s:=table2[(sec+i-n-1) mod sec + 1];
  479.         write(text14,head,text15,track);
  480.         x:=SectorLogical(head,track,1);
  481.         write(text16,x);
  482.         x:=Cluster(x);
  483.         if (x>1) and (x<10000) then write(', Cluster: ',x);
  484.         for i:=1 to sec do begin
  485.           table[i].t:=track;
  486.           table[i].h:=head;
  487.         end;
  488.         repeat
  489.           ah:=5;
  490.           al:=sec;
  491.           dl:=lw;
  492.           dh:=head;
  493.           ch:=track;
  494.           cl:=1;
  495.           es:=seg(table);
  496.           bx:=ofs(table);
  497.           write('  F');
  498.           mem[$40:$41]:=0;
  499.           int13;
  500.           write(#8,'V        ');write(#13);
  501.           if not(again or noverify) then begin
  502.             ah:=2;
  503.             dl:=lw;
  504.         es:=seg(buffer);
  505.         bx:=ofs(buffer);
  506.             int13;
  507.           end;
  508.         until not again;
  509.         if (FCarry and flags) <> 0 then begin
  510.           if (x<2) or (x>10000) then begin
  511.             writeln(text17);
  512.             halt;
  513.           end;
  514.           inc(bttCount);
  515.           if bttCount>20 then begin
  516.             writeln(text18,20*sec,text19);
  517.             halt;
  518.           end;
  519.           btt[bttCount].track:=track;
  520.           btt[bttCount].head:=head;
  521.           writeln(text14,head,text15,track,text20);
  522.         end;
  523.       end;
  524.     end;
  525.   end;
  526. end;
  527.  
  528. Procedure WriteBootSect;
  529. begin
  530.   with regs do begin
  531.     writeln; bpb.oem:='CH-FOR12'; writeln;
  532.     writeln(text21,bpb.oem); writeln(text22,bpb.sec);
  533.     writeln(text23,bpb.spt); writeln(text24,bpb.hds);
  534.     writeln(text25,bpb.bps); writeln(text26,bpb.shh);
  535.     writeln(text27,bpb.res); writeln(text28,bpb.fat);
  536.     writeln(text29,bpb.spf); writeln(text30,Cluster(bpb.sec)-2);
  537.     dh:=0; dl:=lw; ch:=0; cl:=1;
  538.     al:=1; ah:=3; es:=seg(bpb);
  539.     bx:=ofs(bpb);
  540.     repeat int13 until not again;
  541.     fillchar(buffer[3],18430,#0);
  542.     buffer[0]:=bpb.mds;
  543.     buffer[1]:=$ff;
  544.     buffer[2]:=$ff;
  545.     bad:=0;
  546.     for i:=1 to bttCount do
  547.       for j:=1 to sec do begin
  548.         x:=SectorLogical(btt[i].head,btt[i].track,j);
  549.         x:=Cluster(x);
  550.         ClusterOffset(x,Offset,Mask);
  551.         if buffer[Offset] and Lo(Mask)=0 then inc(bad,bpb.spc*512);
  552.         buffer[Offset]:=buffer[Offset] or Lo(Mask);
  553.         buffer[Offset+1]:=buffer[Offset+1] or Hi(Mask);
  554.       end;
  555.     es:=seg(buffer);
  556.     bx:=ofs(buffer);
  557.     inc(cl);
  558.     al:=bpb.spf;
  559.     repeat int13 until not again;
  560.     SectorAbsolute(bpb.spf+1,dh,ch,cl);
  561.     ah:=3;
  562.     dl:=lw;
  563.     if bpb.spf+cl>sec+1 then al:=sec-cl+1;
  564.     repeat int13 until not again;
  565.     if bpb.spf+cl>sec+1 then begin
  566.       bx:=bx+al*512;
  567.       al:=bpb.spf-al;
  568.       inc(dh);
  569.       cl:=1;
  570.       repeat int13 until not again;
  571.     end;
  572.     Bytes:=LongInt(Cluster(bpb.sec)-2)*512*LongInt(bpb.spc);
  573.     writeln;
  574.     writeln(Bytes:9,text31);
  575.     if bad<>0 then writeln(bad:9,text32);
  576.     writeln(Bytes-bad:9,text33);
  577.     writeln;
  578.   end;
  579. end;
  580.  
  581. Procedure DrivePrt;
  582. begin
  583.   writeln;
  584.   if lwtrk=0 then begin
  585.     writeln(text34);
  586.     exit;
  587.   end;
  588.   write(text35,chr(lw+$41));
  589.   if lwhd then
  590.     write(': High-Density, ')
  591.   else
  592.     write(': Double-Density, ');
  593.   writeln(lwtrk+1,text10,lwsec,text11);
  594.   write(text36);
  595.   if pc80=$20 then writeln(text37);
  596.   if pc80=$40 then writeln(text38);
  597.   if at80 then writeln(text39);
  598.   if not(at80) and (pc80=0) then writeln(text40);
  599.   writeln;
  600. end;
  601.  
  602. Procedure SyntaxError;
  603. begin
  604.   writeln; writeln(text41); writeln;
  605.   writeln(text42); writeln(text43); writeln;
  606.   writeln(text44); writeln; writeln(text45);
  607.   writeln(text46); writeln(text47); writeln(text48);
  608.   writeln(text49); writeln(text50); writeln(text51);
  609.   writeln(text52); writeln(text53);
  610.   writeln(text69); writeln(text70);
  611.   writeln(text71); writeln;
  612.   halt;
  613. end;
  614.  
  615. Procedure CheckDos;
  616. var Version: Word;
  617. begin
  618.   Version:=swap(DosVersion);
  619.   if Version<$314 then begin
  620.     writeln(text54);
  621.     halt;
  622.   end;
  623. end;
  624.  
  625. begin
  626.   writeln;
  627.   writeln(text55);
  628.   writeln(text56);
  629.   CheckDos;
  630.   GetIntVec($1E,old1E);
  631.   new1E:=old1E;
  632.   para:=paramstr(1);
  633.   ps2:=false;
  634.   noverify:=false;
  635.   if (length(para)<>2) or (para[2]<>':') then SyntaxError;
  636.   lw:=ord(UpCase(para[1]))-$41;
  637.   DriveTyp(lw,lwhd,lwtrk,lwsec);
  638.   DrivePrt;
  639.   if (lwtrk=0) and (para<>'') then halt;
  640.   rde:=0;
  641.   il:=0;
  642.   spc:=0;
  643.   gpl:=0;
  644.   shift:=0;
  645.   ForceType:=0;
  646.   trk:=lwtrk+1;
  647.   sec:=lwsec;
  648.   hds:=2;
  649.   for i:=2 to paramcount do
  650.     if paramstr(i)<>'' then begin
  651.       para:=paramstr(i);
  652.       chx:=para[1];
  653.       if length(para)=1 then
  654.         case UpCase(chx) of
  655.           'P': ps2:=true;
  656.           'V': noverify:=true;
  657.         end
  658.       else begin
  659.         val(copy(para,2,255),n,j);
  660.         if j<>0 then SyntaxError;
  661.         case UpCase(para[1]) of
  662.           'T':trk:=n;
  663.           'H':hds:=n;
  664.           'S':sec:=n;
  665.           'D':rde:=n;
  666.           'C':spc:=n;
  667.           'I':il:=n;
  668.           'G':gpl:=n;
  669.           'F':shift:=n;
  670.           'B':ForceType:=n;
  671.         end;
  672.       end;
  673.     end;
  674.   if sec>11 then hd:=true else hd:=false;
  675.   if rde=0 then
  676.     case hd of
  677.       true:  rde:=224;
  678.       false: rde:=112;
  679.     end;
  680.   if spc=0 then
  681.     case hd of
  682.       true:  spc:=1;
  683.       false: spc:=2;
  684.     end;
  685.   if il=0 then
  686.     if sec-lwsec in [3..8] then il:=2 else il:=1;
  687.   if not(hds in [1..2]) then begin
  688.     writeln(text57);
  689.     halt;
  690.   end;
  691.   if trk<1 then begin
  692.     writeln(text58);
  693.     halt;
  694.   end;
  695.   if il>=pred(sec) then begin
  696.     writeln(text59,pred(sec),text60);
  697.     halt;
  698.   end;
  699.   if not(spc in [1..2]) then
  700.     writeln(text61);
  701.   if ShortInt(trk-lwtrk)>4 then
  702.     writeln(text62);
  703.   if rde>240 then
  704.     writeln(text63);
  705.   writeln;
  706.   writeln(text64,chr(lw+$41),text65);
  707.   writeln(text66);
  708.   chx:=ReadKey;
  709.   format;
  710.   WriteBootSect;
  711. end.
  712.