home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / Samples / VFORMAT.ARJ / VFORMAT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-11-04  |  51.8 KB  |  1,331 lines
  1. {$A+,B-,D+,E+,F-,L+,N-,O-,R-,S-,V-}
  2. {$M 8192,0,0}
  3. PROGRAM VFORMAT;
  4.  
  5. USES dos,auxdos,baseconv,desqview;
  6.  
  7.   {Written by Christoph H. Hochstätter}
  8.   {Modified by Alexander V. Sessa}
  9.   {Last Updated: 4-Nov-1991}
  10.   {Donated to the Public-Domain for non-commercial usage}
  11.   {Compiled in Turbo-Pascal 6.0}
  12.  
  13.  
  14. const text02 = '(A)bort (R)etry (I)gnore ? ';
  15. const text04 = 'No valid drive.';
  16. const text05 = 'SUBST/ASSIGN/Network-Drive.';
  17. const text06 = 'Not a floppy drive.';
  18. const text07 = 'Unknown drive type.';
  19. const text08 = 'Formatting drive ';
  20. const text09 = ' Head(s), ';
  21. const text10 = ' Tracks, ';
  22. const text11 = ' Sectors/track, ';
  23. const text12 = ' Root Directory Entries, ';
  24. const text13 = ' Sector(s)/Cluster, Sector-Shift: ';
  25. const text14 = 'Head: ';
  26. const text15 = #9#9'Track: ';
  27. const text16 = 'Sector: ';
  28. const text17 = 'Format error in system area: Program aborted.';
  29. const text18 = 'More than ';
  30. const text19 = ' sectors unreadable. Program aborted.';
  31. const text20 = 'marked as bad.';
  32. const text21 = 'proceed by Sectors:';
  33. const text22 = 'Total sectors on disk:  ';
  34. const text23 = 'Sectors per track:      ';
  35. const text24 = 'Heads:                  ';
  36. const text29 = 'Sectors per FAT:        ';
  37. const text30 = 'Total clusters on disk: ';
  38. const text79 = 'Volume serial number:   ';
  39. const text34 = 'This drive cannot be formatted.';
  40. const text35 = 'Drive is physical ';
  41. const text36 = 'BIOS double-step support: ';
  42. const text37 = 'XT-like';
  43. const text38 = 'EPSON QX-16 like';
  44. const text39 = 'AT-like';
  45. const text40 = 'Not available or unknown';
  46. const text41 = 'Syntax Error.';
  47. const text42 = 'Usage is: VFORMAT drive: [mode] [options]';
  48. const text43 = ' Example: VFORMAT A: U t41 h2 n10 C1 D112';
  49. const text44 = 'Mode:        [default - MS/DOS-5.0-like "intellectual" format]';
  50. const text45 = 'U     Uncoditional (old simple) format         R     skip veRifying';
  51. const text46 = 'W     format Without erase (Cure format)       Q     Quick (track 0/1 only)';
  52. const text47 = 'P[nn] Packet mode (format nn diskettes)        K     don'#39't wait Keyboard';
  53. const text48 = 'Z     restore Zero track (unformat)'#10#10#13'Options:'#10#13;
  54. const text49 = 'Tnn   number of Tracks       [default 40/80]   Inn   set Interleave factor';
  55. const text50 = 'Hnn   number of Heads                    [2]   Gnnn  specify GAP-length';
  56. const text51 = 'Nnn   Number of Sectors per track  [9/15/18]   Xnn   slide sectors (head)';
  57. const text52 = 'Cn    sectors per Cluster    [HD - 1/DD - 2]   Ynn   slide sectors (track)';
  58. const text53 = 'Dnnn  root Directory entries [HD-224/DD-112]   Bnnn  force disk type Byte';
  59. const text69 = 'Fnnn  specify diskette Format {360,1.44 etc}   Mnnn  set Media descriptor';
  60. const text70 = 'V[...] write Volume label                      A     use BIOS-calls only';
  61. const text71 = 'O - Olivetti 720kB     1 - single side disk    4 - 360kB     8 - 8-sectors';
  62. const text54 = 'This program requires DOS 3.2 or higher.';
  63. const text55 = 'VFORMAT - Diskette Formatter with VITAMIN-B Boot Vaccine - Ver 1.90';
  64. const text56 = 'by Christoph H. Hochstatter (Germany) and Alexander V. Sessa (USSR)';
  65. const text57 = 'Heads must be 1 or 2.';
  66. const text58 = 'At least one track should be formatted.';
  67. const text59 = 'Interleave must be from 1 to ';
  68. const text60 = '.';
  69. const text61 = 'WARNING! DOS supports only 1 or 2 sectors per cluster.';
  70. const text62 = 'WARNING! So many tracks could cause damage to your drive.';
  71. const text63 = 'WARNING! DOS supports a maximum of 240 root directory entries.';
  72. const text64 = 'Insert new Diskette in drive ';
  73. const text65 = ':';
  74. const text66 = 'Press ENTER when ready (ESC=QUIT)';
  75. const text67 = 'Data Transfer Rate: ';
  76. const text68 = ', GAP-Length: ';
  77. const text72 = 'ON';
  78. const text73 = 'OFF';
  79. const text74 = 'Enter Volume Name (max. 11 characters): ';
  80. const text75 = 'Error creating volume label.';
  81. const text76 = 'Syntax Error in FDFORMAT.CFG.';
  82. const text77 = 'Error reading FDFORMAT.CFG.';
  83. const text80 = 'Error building new disk-parameter-block. DOS-Error: ';
  84. const text81 = 'Cannot read old diskette parameters. Format without erase impossible.';
  85. CONST text31 = ' Bytes total';
  86. CONST text32 = ' Bytes in boot-sector';
  87. CONST text33 = ' Bytes in Root-Directory';
  88. CONST text82 = ' Bytes in the FAT';
  89. CONST text83 = ' Bytes in bad sectors';
  90. CONST text84 = ' Bytes available for files';
  91. CONST text85 = ' Bytes actually free';
  92. CONST text86 = 'Setting drive parameters via track/sector-combination...';
  93. CONST text87 = 'Setting drive parameters via media typ...';
  94. CONST text88 = 'successful';
  95. CONST text89 = 'Error';
  96. CONST text90 = 'WARNING! BIOS-Media-Byte could not set correctly.';
  97. CONST text91 = 'BIOS-media-byte is: ';
  98. CONST text92 = 'x, should be: ';
  99. CONST text93 = 'Drive parameters set via direct write to BIOS-media-byte.';
  100. CONST text94 = 'Program aborted by user.';
  101. CONST error02 = 'Address mark not found';
  102. CONST error03 = 'Disk is write protected';
  103. CONST error04 = 'Sector not found';
  104. CONST error08 = 'DMA overrun';
  105. CONST error09 = 'DMA accross 64 kB boundary';
  106. CONST error0c = 'Format not compatible with data transfer rate';
  107. CONST error10 = 'CRC error';
  108. CONST error20 = 'controller/adapter error';
  109. CONST error40 = 'seek error';
  110. CONST error80 = 'No disk in drive';
  111. CONST errorxx = 'Unknown error';
  112.  
  113. CONST maxform = 15;
  114.  
  115. CONST TRead   = 2;
  116. CONST TWrite  = 3;
  117. CONST TVerify = 4;
  118. CONST TFormat = 5;
  119.  
  120. TYPE tabletyp = ARRAY[1..25] OF RECORD
  121.                                   t,h,s,f:Byte;
  122.                                 END;
  123.  
  124.   paratyp =  ARRAY[0..10] OF Byte;
  125.   boottyp =  ARRAY[62..511] OF Byte;
  126.  
  127.   bsttyp  =  ARRAY[1..512] OF RECORD
  128.                                head:  Byte;
  129.                                track: Byte;
  130.                                sector:Byte;
  131.                              END;
  132.   ftabtyp = ARRAY[1..maxform] OF RECORD
  133.                                    fmt: Word;
  134.                                    trk: Byte;
  135.                                    sec: Byte;
  136.                                    hds: Byte;
  137.                                  END;
  138.  
  139.   bpbtyp  =  RECORD
  140.                jmp: ARRAY[1..3] OF Byte;                               {3 bytes of JMP instruction}
  141.                oem: ARRAY[1..8] OF Char;                                                {OEM-Entry}
  142.                bps: Word;                                                        {Bytes per Sector}
  143.                spc: Byte;                                                     {Sectors per Cluster}
  144.                res: Word;                                                        {Reserved Sectors}
  145.                fat: Byte;                                                                   {FAT's}
  146.                rde: Word;                                                            {Root Entries}
  147.                sec: Word;                                               {Total Sectors on Diskette}
  148.                mds: Byte;                                                        {Media-Deskriptor}
  149.                spf: Word;                                                         {Sectors per FAT}
  150.                spt: Word;                                                       {Sectors per Track}
  151.                hds: Word;                                                                   {Sides}
  152.                shh: LongInt;                                                       {Hidden Sectors}
  153.                lse: LongInt;                                       {Total Sectors for BIGDOS Disks}
  154.                pdn: Word;                                                   {Physical Drive Number}
  155.                ebs: Byte;                                                 {Extended Boot Signature}
  156.                vsn: LongInt;                                                 {Volume Serial-Number}
  157.                vlb: ARRAY[1..11] OF Char;                                            {Volume Label}
  158.                fsi: ARRAY[1..8] OF Char;                                           {File System Id}
  159.                boot_code: boottyp;                                           {Buffer for BOOT-Code}
  160.              END;
  161.  
  162.   bdib = RECORD
  163.            flag   : Byte;                                                         {Bitmapped flags}
  164.            dtyp   : Byte;                             {Drive Type: 0,1,2 or 7 supported by VFORMAT}
  165.            dflag  : Word;                                                         {Bitmapped flags}
  166.            noc    : Word;                                                     {Number of cylinders}
  167.            mt     : Byte;                                                              {Media Type}
  168.            bpb    : ARRAY[0..30] OF Byte;                                                     {BPB}
  169.            nos    : Word;                                             {Number of sectors per track}
  170.            sly    : ARRAY[0..4598] OF RECORD                                        {sector layout}
  171.                                         num: Word;                                  {Sector Number}
  172.                                         siz: Word;                                 {Size of sector}
  173.                                       END;
  174.          END;
  175.  
  176. VAR regs:     registers;                                                      {Processor Registers}
  177.   track:      Byte;                                                                  {Actual Track}
  178.   head:       Byte;                                                                   {Actual Side}
  179.   table:      tabletyp;                                                             {Formats Table}
  180.   table2:     ARRAY[1..25] OF Byte;                                              {Interleave Table}
  181.   x:          Word;                                                                 {Work variable}
  182.   buffer:     ARRAY[0..18435] OF Byte;                                                {Work Buffer}
  183.   old1E:      Pointer;                                               {Old vector of Parameter list}
  184.   new1E:      ^paratyp;                                              {New vector of Parameter list}
  185.   old13:      Pointer;                                                 {Old vector of Interrupt 13}
  186.   chx:        Char;                                                                 {Work variable}
  187.   lw:         Byte;                                                                {Phisical Drive}
  188.   hds,sec:    Word;                                                                {Sides, Sectors}
  189.   trk:        Word;                                                                        {Tracks}
  190.   hd,lwhd:    Boolean;                                                         {High-Density Flags}
  191.   lwtrk:      Byte;                                                           {max Tracks on Drive}
  192.   lwsec:      Byte;                                                          {max Sectors on Drive}
  193.   para:       ARRAY[1..50] OF String[20];                              {Parameters of Command line}
  194.   rde:        Byte;                                                        {Root directory entries}
  195.   srde:       Byte;                                                  {Saved root directory entries}
  196.   spc:        Byte;                                                           {Sectors per Cluster}
  197.   i:          Byte;                                                                {Work variables}
  198.   j,n:        Integer;                                                              {Work variable}
  199.   again:      Boolean;                                                     {Flag: try INT 13 again}
  200.   bstCount:   Word;                                                           {Bad sectors counter}
  201.   bst:        bsttyp;                                                        {Table of bad sectors}
  202.   Offset:     Word;                                                      {Relative Position in FAT}
  203.   Mask:       Word;                                                         {Mask for Cluster link}
  204.   bytes:      LongInt;                                                        {Total bytes on disk}
  205.   bytesub:    LongInt;                                                       {Bytes in system area}
  206.   at80:       Boolean;                                       {TRUE, when 80/40 tracks with AT-BIOS}
  207.   DiskId:     Byte;                                                    {Disk type byte for AT-BIOS}
  208.   il:         Byte;                                                             {Interleave-Factor}
  209.   gpl:        Byte;                                                                    {GAP-Length}
  210.   shiftt:     Byte;                                                       {Sector Shift for Tracks}
  211.   shifth:     Byte;                                                        {Sector Shift for Heads}
  212.   ModelByte:  Byte ABSOLUTE $F000:$FFFE;                                                {XT/AT/386}
  213.   ForceType:  Byte;                                                         {User specified Diskid}
  214.   ForceMedia: Byte;                                               {User specified Media-Deckriptor}
  215.   dosdrive:   Byte;                                                          {DOS Drive Identifier}
  216.   PCount:     Byte;                                                            {Parameters counter}
  217.   found:      Boolean;                                                         {Fixed Format found}
  218. { sys:        Boolean;}                                                               {System disk}
  219.   lwtab:      ARRAY[0..3] OF Byte ABSOLUTE $40:$90;                               {Table of Drives}
  220.   dlabel:     String[15];                                                          {Diskette Label}
  221.   setlabel:   Boolean;                                                                  {Set Label}
  222.   batch:      Boolean;                                                         {Don't wait any Key}
  223.   cfgat80:    Boolean;                                         {TRUE, when Drive configured for AT}
  224.   cfgpc80:    Boolean;                                         {TRUE, when Drive configured for XT}
  225.   cfgdrive:   Byte;                                                              {Configured Drive}
  226.   bios:       Boolean;                                                  {TRUE, when use BIOS-calls}
  227.   pc80:       Byte;                                                  {Mask of 80 track for XT-BIOS}
  228.   pc40:       Byte;                                                  {Mask of 80 track for XT-BIOS}
  229.   v720:       Byte;                                                       {Media Typ for 720 kByte}
  230.   v360:       Byte;                                                       {Media Typ for 360 kByte}
  231.   v12:        Byte;                                                       {Media Typ for 1.2 MByte}
  232.   v144:       Byte;                                                      {Media Typ for 1.44 MByte}
  233.   lwphys:     Byte;                                                                {Physical Drive}
  234.   NormExit:   Pointer;                                                      {Normal Exit-Procedure}
  235.   packet:     Byte;                                                         {Packet format counter}
  236.  
  237. CONST para17: paratyp =($df,$02,$25,$02,17,$02,$ff,$23,$f6,$0f,$08);
  238.   para18a:    paratyp =($df,$02,$25,$02,18,$02,$ff,$02,$f6,$0f,$08);
  239.   para18:     paratyp =($df,$02,$25,$02,18,$02,$ff,$6c,$f6,$0f,$08);
  240.   para10:     paratyp =($df,$02,$25,$02,10,$02,$ff,$2e,$f6,$0f,$08);                    {GPL 26-36}
  241.   para11:     paratyp =($df,$02,$25,$02,11,$02,$ff,$02,$f6,$0f,$08);
  242.   para15:     paratyp =($df,$02,$25,$02,15,$02,$ff,$54,$f6,$0f,$08);
  243.   para09:     paratyp =($df,$02,$25,$02,09,$02,$ff,$50,$f6,$0f,$08);
  244.   para08:     paratyp =($df,$02,$25,$02,08,$02,$ff,$58,$f6,$0f,$08);
  245.   para20:     paratyp =($df,$02,$25,$02,20,$02,$ff,$2a,$f6,$0f,$08);                    {GPL 17-33}
  246.   para21:     paratyp =($df,$02,$25,$02,21,$02,$ff,$0c,$f6,$0f,$08);
  247.   para22:     paratyp =($df,$02,$25,$02,22,$02,$ff,$01,$f6,$0f,$08);
  248.  
  249.   ftab:    ftabtyp = ((fmt:360;trk:40;sec:9;hds:2),                      {Requires 360 kByte Drive}
  250.                       (fmt:400;trk:40;sec:10;hds:2),                     {Requires 360 kByte Drive}
  251.                       (fmt:410;trk:41;sec:10;hds:2),                     {Requires 360 kByte Drive}
  252.                       (fmt:720;trk:80;sec:9;hds:2),                      {Requires 720 kByte Drive}
  253.                       (fmt:800;trk:80;sec:10;hds:2),                     {Requires 720 kByte Drive}
  254.                       (fmt:820;trk:82;sec:10;hds:2),                     {Requires 720 kByte Drive}
  255.                       (fmt:120;trk:80;sec:15;hds:2),                     {Requires 1.2 MByte Drive}
  256.                       (fmt:12;trk:80;sec:15;hds:2),                      {Requires 1.2 MByte Drive}
  257.                       (fmt:144;trk:80;sec:18;hds:2),                     {Requires 1.2 MByte Drive}
  258.                       (fmt:14;trk:80;sec:18;hds:2),                      {Requires 1.2 MByte Drive}
  259.                       (fmt:148;trk:82;sec:18;hds:2),                     {Requires 1.2 MByte Drive}
  260.                       (fmt:16;trk:80;sec:20;hds:2),                      {Requires 1.4 MByte Drive}
  261.                       (fmt:164;trk:82;sec:20;hds:2),                     {Requires 1.4 MByte Drive}
  262.                       (fmt:168;trk:80;sec:21;hds:2),                     {Requires 1.4 MByte Drive}
  263.                       (fmt:172;trk:82;sec:21;hds:2));                    {Requires 1.4 MByte Drive}
  264.  
  265.   swchar:       Char      ='/';                                               {Default-Switch-Char}
  266.   Quick:        Boolean   =False;                                                    {Quick-Format}
  267.   noformat:     Boolean   =True;                                              {Don't really format}
  268.   noverify:     Boolean   =False;                                                    {Don't verify}
  269.   fwe:          Boolean   =False;                                            {Format without erase}
  270.   safe:         Boolean   =True;                                                   {Noformat again}
  271.   ssafe:        Boolean   =True;                                                       {Safe again}
  272.   bad:          LongInt   =0;                                                {Bytes in bad Sectors}
  273.   ExitRequest:  Boolean   =False;                                               {User interruption}
  274.   slow:         Boolean   =False;                                        {Operate track by sectors}
  275.  
  276.   PROCEDURE GetPhys; Far; Assembler;
  277.     ASM
  278.       push  ds
  279.       mov   ax,Seg @data
  280.       mov   ds,ax
  281.       mov   ds:lwphys,dl
  282.       pop   ds
  283.       mov   ax,101h
  284.       iret
  285.     END;
  286.  
  287.   CONST bpb: bpbtyp = (
  288.  
  289.     jmp      : ($EB,$42,$90);
  290.     oem      : 'Vaccined';
  291.     bps      : 512;
  292.     spc      : 0;
  293.     res      : 1;
  294.     fat      : 2;
  295.     rde      : 0;
  296.     sec      : 0;
  297.     mds      : 0;
  298.     spf      : 0;
  299.     spt      : 0;
  300.     hds      : 2;
  301.     shh      : 0;
  302.     lse      : 0;
  303.     pdn      : 0;
  304.     ebs      : $29;
  305.     vsn      : 0;
  306.     vlb      : '           ';
  307.     fsi      : 'FAT12   ';
  308.     boot_code: (
  309. $2E,$80,
  310. $26,$90,$04,$DF,$FA,$FC,$33,$C0,$8E,$D0,$BC,$00,$7C,$16,$07,$BB,
  311. $78,$00,$36,$C5,$37,$1E,$56,$BF,$2B,$7C,$B9,$0B,$00,$F3,$A4,$06,
  312. $1F,$C6,$45,$FE,$0F,$C6,$45,$F9,$16,$89,$47,$02,$C7,$07,$2B,$7C,
  313. $FB,$CD,$13,$72,$6B,$BA,$00,$F0,$33,$ED,$E8,$CD,$00,$22,$73,$04,
  314. $C7,$05,$A5,$FE,$E8,$C3,$00,$26,$73,$04,$C7,$05,$87,$E9,$E8,$B9,
  315. $00,$5E,$73,$04,$C7,$05,$D2,$EF,$E8,$AF,$00,$72,$73,$04,$C7,$05,
  316. $53,$FF,$B6,$C8,$E8,$A3,$00,$4E,$73,$02,$A5,$A5,$4D,$73,$21,$BE,
  317. $DC,$7D,$E8,$8F,$00,$98,$CD,$16,$3C,$6E,$74,$14,$B9,$01,$00,$BA,
  318. $00,$00,$B7,$7C,$B8,$01,$03,$0E,$07,$CD,$13,$EA,$F0,$FF,$00,$F0,
  319. $B9,$06,$00,$BA,$00,$00,$BB,$00,$05,$B8,$01,$02,$CD,$13,$73,$13,
  320. $BE,$9F,$7D,$E8,$5E,$00,$98,$CD,$16,$8F,$06,$78,$00,$8F,$06,$7A,
  321. $00,$CD,$19,$80,$7F,$0B,$04,$74,$E7,$BE,$2C,$00,$B7,$07,$B9,$04,
  322. $00,$B6,$01,$A1,$18,$7C,$2A,$C1,$40,$3B,$F0,$77,$02,$8B,$C6,$50,
  323. $B4,$02,$CD,$13,$58,$72,$C9,$98,$2B,$F0,$76,$14,$02,$F8,$02,$F8,
  324. $B1,$01,$FE,$C6,$3A,$36,$1A,$7C,$72,$D9,$FE,$C5,$B6,$00,$EB,$D3,
  325. $8A,$2E,$15,$7C,$B2,$00,$BB,$0C,$00,$B8,$00,$00,$EA,$00,$00,$70,
  326. $00,$E8,$4F,$00,$AC,$0A,$C0,$75,$F8,$C3,$5E,$AC,$56,$98,$97,$26,
  327. $39,$15,$73,$47,$BE,$D1,$7D,$E8,$EA,$FF,$8B,$C7,$D0,$E8,$D0,$E8,
  328. $E8,$1F,$00,$B0,$2D,$E8,$2B,$00,$8B,$05,$E8,$0C,$00,$B0,$3A,$E8,
  329. $21,$00,$89,$15,$83,$EF,$02,$8B,$05,$8A,$E8,$8A,$C4,$E8,$02,$00,
  330. $8A,$C5,$50,$B1,$04,$D2,$E8,$E8,$01,$00,$58,$24,$0F,$04,$90,$27,
  331. $14,$40,$27,$33,$DB,$B4,$0E,$CD,$10,$45,$F9,$C3,$00,$00,$00,$0A,
  332. $0D,$4E,$6F,$20,$73,$79,$73,$74,$65,$6D,$20,$6F,$72,$20,$64,$69,
  333. $73,$6B,$20,$65,$72,$72,$6F,$72,$0A,$0D,$50,$72,$65,$73,$73,$20,
  334. $61,$20,$6B,$65,$79,$20,$74,$6F,$20,$72,$65,$74,$72,$79,$0A,$0D,
  335. $00,$07,$0A,$0D,$49,$6E,$74,$00,$59,$EC,$00,$F0,$0A,$0D,$56,$69,
  336. $72,$75,$73,$20,$73,$74,$65,$72,$69,$6C,$69,$7A,$65,$64,$2E,$20,
  337. $43,$75,$72,$65,$20,$42,$4F,$4F,$54,$3F,$0A,$0D,$07,$00,$55,$AA
  338.       ));
  339.  
  340.     FUNCTION ReadKey:Char;
  341.     VAR r:registers;
  342.     BEGIN
  343.       GiveUpIdle;
  344.       WITH r DO BEGIN
  345.         ah:=7;
  346.         intr($21,r);
  347.         IF al IN [3,27] THEN BEGIN
  348.           WriteLn;
  349.           Halt(4);
  350.         END;
  351.         ReadKey:=Chr(al);
  352.       END;
  353.     END;
  354.  
  355.       PROCEDURE RequestAbort; Far;
  356.       BEGIN
  357.         SetIntVec($1E,old1E);
  358.         SetIntVec($13,old13);
  359.         DefExitProc;
  360.       END;
  361.  
  362.       PROCEDURE ConfigError;
  363.       BEGIN
  364.         WriteLn(stderr,#10#13,text76);
  365.         Halt(16);
  366.       END;
  367.  
  368.       PROCEDURE GetValue(x,y:String;VAR Value:Byte);
  369.       VAR i,k: Byte;
  370.         j:   Integer;
  371.       BEGIN
  372.         y:=' '+y+'=';
  373.         i:=pos(y,x);
  374.         IF i<>0 THEN BEGIN
  375.           i:=i+Length(y);
  376.           WHILE x[i]=' ' DO Inc(i);
  377.           IF i>Length(x) THEN ConfigError;
  378.           k:=i;
  379.           WHILE x[k]<>' ' DO Inc(k);
  380.           IF x[i]<>'$' THEN BEGIN
  381.             Val(Copy(x,i,k-i),Value,j);
  382.             IF j<>0 THEN ConfigError;
  383.           END ELSE BEGIN
  384.             Value:=dezh(Copy(x,i+1,k-i-1));
  385.             IF BaseError<>0 THEN ConfigError;
  386.           END;
  387.         END;
  388.       END;
  389.  
  390.       PROCEDURE CfgRead;
  391.       VAR f: Text;
  392.         x: String;
  393.         i: Byte;
  394.       BEGIN
  395.         cfgat80:=False;
  396.         cfgpc80:=False;
  397.         cfgdrive:=255;
  398.         bios:=False;
  399.         pc80:=0;
  400.         pc40:=0;
  401.         v720:=0;
  402.         v360:=0;
  403.         v12:=0;
  404.         v144:=0;
  405.         x:=FSearch('FDFORMAT.CFG',GetEnv('PATH'));
  406.         IF x<>'' THEN BEGIN
  407.           Assign(f,x);
  408.           {$I-} Reset(f); {$I+}
  409.           IF IoResult=0 THEN BEGIN
  410.             WHILE NOT eof(f) DO BEGIN
  411.               ReadLn(f,x);
  412.               x:=x+' ';
  413.               FOR i:=1 TO Length(x) DO x[i]:=Upcase(x[i]);
  414.               IF Copy(x,1,2)=para[1] THEN BEGIN
  415.                 IF pos(' BIOS ',x)<>0 THEN bios:=True;
  416.                 IF pos(' AT ',x)<>0 THEN cfgat80:=True;
  417.                 GetValue(x,'F',cfgdrive);
  418.                 IF NOT(cfgdrive IN [0,1,2,7,255]) THEN ConfigError;
  419.                 IF pos(' XT ',x)<>0 THEN cfgpc80:=True;
  420.                 GetValue(x,'40',pc40);
  421.                 GetValue(x,'80',pc80);
  422.                 GetValue(x,'360',v360);
  423.                 GetValue(x,'720',v720);
  424.                 GetValue(x,'1.2',v12);
  425.                 GetValue(x,'1.44',v144);
  426.                 GetValue(x,'X',shifth);
  427.                 GetValue(x,'Y',shiftt);
  428.               END;
  429.               IF cfgat80 AND cfgpc80 THEN ConfigError;
  430.             END;
  431.             {$I-} Close(f); {$I+}
  432.           END ELSE BEGIN
  433.             WriteLn(stderr,#10#13,text77);
  434.             Halt(8);
  435.           END;
  436.         END;
  437.       END;
  438.  
  439.       PROCEDURE int13;
  440.       VAR axs: Word;
  441.         chx: Char;
  442.       BEGIN
  443.         again:=False;
  444.         WITH regs DO BEGIN
  445.           axs:=ax;
  446.           REPEAT
  447.             GiveUpCPU;
  448.             ax:=axs;
  449.             IF ah IN [2,3,4,5] THEN SetIntVec($1E,new1E);
  450.             IF trk>43 THEN dl:=dl OR pc80 ELSE dl:=dl OR pc40;
  451.             IF NOT(bios) THEN lwtab[dl]:=DiskId;
  452.             intr($13,regs);
  453.             SetIntVec($1E,old1E);
  454.             GiveUpCPU;
  455.           UNTIL ah<>6;
  456.           IF ah>1 THEN BEGIN
  457.             Write(stderr,#10#13,text14,dh,text15,ch);
  458.             IF slow THEN Write(stderr,#9,text16,cl);
  459.             CASE regs.ah OF
  460.               $02: Write(stderr,#9,error02);
  461.               $03: Write(stderr,#9,error03);
  462.               $04: Write(stderr,#9,error04);
  463.               $08: Write(stderr,#9,error08);
  464.               $09: Write(stderr,#9,error09);
  465.               $0c: Write(stderr,#9,error0c);
  466.               $10: Write(stderr,#9,error10);
  467.               $20: Write(stderr,#9,error20);
  468.               $40: Write(stderr,#9,error40);
  469.               $80: Write(stderr,#9,error80);
  470.               ELSE Write(stderr,#9,errorxx);
  471.             END;
  472.             WriteLn(stderr,'.');
  473.             Write(text14,head,text15,track,#9);
  474.             IF (slow AND fwe) OR ((ah<>2) AND (ah<>4) AND (ah<>16)) THEN BEGIN
  475.               WriteLn(stderr,text02);
  476.               REPEAT
  477.                 chx:=Upcase(ReadKey);
  478.                 CASE chx OF
  479.                   'A': Halt(4);
  480.                   'R': again:=True;
  481.                 END;
  482.               UNTIL chx IN ['A','I','R'];
  483.             END;
  484.           END;
  485.           ax:=axs;
  486.         END;
  487.       END;
  488.  
  489.  
  490.       PROCEDURE MakeTrack(Operation:Byte);
  491.       VAR csec: Byte;
  492.       BEGIN
  493.         WITH regs DO BEGIN
  494.           ah:=Operation;
  495.           al:=sec;
  496.           dl:=lw;
  497.           dh:=head;
  498.           ch:=track;
  499.           cl:=1;
  500.           es:=Seg(buffer);
  501.           bx:=Ofs(buffer);
  502.           int13;
  503.           IF (FCarry AND Flags) <> 0 THEN BEGIN
  504.             IF noformat AND (Operation=TVerify) THEN BEGIN
  505.               noformat:=False;
  506.               again:=True;
  507.             END ELSE BEGIN
  508.               slow:=True;
  509.               Writeln(stderr,text21);
  510.               FOR csec:=1 TO sec DO BEGIN
  511.                 ah:=Operation;
  512.                 al:=1;
  513.                 dl:=lw;
  514.                 dh:=head;
  515.                 ch:=track;
  516.                 cl:=csec;
  517.                 es:=Seg(buffer);
  518.                 bx:=Ofs(buffer)+(csec-1)*512;
  519.                 int13;
  520.                 IF ((FCarry AND Flags) <> 0) AND
  521.                    (Operation=TVerify) AND (NOT again) THEN BEGIN
  522.                   IF (track=0) THEN BEGIN
  523.                     WriteLn(stderr,text17);
  524.                     Halt(2);
  525.                   END;
  526.                   Inc(bstCount);
  527.                   IF bstCount>512 THEN BEGIN
  528.                     WriteLn(stderr,text18,512,text19);
  529.                     Halt(2);
  530.                   END;
  531.                   bst[bstCount].track:=track;
  532.                   bst[bstCount].head:=head;
  533.                   bst[bstCount].sector:=csec;
  534.                   WriteLn(stderr,text16,csec,#9,text20);
  535.                 END;
  536.               END;
  537.             END;
  538.           END;
  539.           slow:=False;
  540.         END;
  541.       END;
  542.  
  543.  
  544.       PROCEDURE parse;
  545.       VAR j:    Byte;
  546.         argstr: String[80];
  547.       BEGIN
  548.         argstr:='';
  549.         FOR j:=1 TO 50 DO para[j]:='';
  550.         FOR j:=1 TO ParamCount DO argstr:=argstr+' '+ParamStr(j);
  551.         FOR j:=1 TO Length(argstr) DO argstr[j]:=Upcase(argstr[j]);
  552.         PCount:=0;
  553.         FOR j:=1 TO Length(argstr) DO BEGIN
  554.           IF argstr[j] IN [swchar,' ','-','/']
  555.           THEN
  556.             Inc(PCount)
  557.           ELSE IF (NOT(argstr[j] IN [':','.'])) OR (PCount=1)
  558.           THEN
  559.             para[PCount]:=para[PCount]+argstr[j];
  560.         END;
  561.       END;
  562.  
  563.       FUNCTION GetPhysical(lw:Byte):Byte;
  564.       BEGIN
  565.         WITH regs DO BEGIN
  566.           SetIntVec($13,@GetPhys);
  567.           ASM
  568.             cli
  569.             mov  al,lw
  570.             mov  cx,1
  571.             xor  dx,dx
  572.             mov  bx,offset buffer
  573.             push bp                  {DOS 3 alters BP, DOS 4 & 5 don't}
  574.             int  25h
  575.             pop  cx
  576.             pop  bp
  577.           END;
  578.           SetIntVec($13,old13);
  579.           ASM
  580.             sti
  581.           END;
  582.           GetPhysical:=lwphys;
  583.         END;
  584.       END;
  585.  
  586.       PROCEDURE DriveTyp(VAR lw:Byte;VAR hd:Boolean;VAR trk,sec:Byte);
  587.       BEGIN
  588.         WITH regs DO BEGIN
  589.           ax:=$4409; bx:=lw+1;
  590.           intr($21,regs);
  591.           IF (FCarry AND Flags) <> 0 THEN BEGIN
  592.             WriteLn(stderr,text04);
  593.             trk:=0;
  594.             Exit;
  595.           END;
  596.           IF (dx AND $9200)<>0 THEN BEGIN
  597.             WriteLn(stderr,text05);
  598.             trk:=0;
  599.             Exit;
  600.           END;
  601.           ax:=$440f; bx:=lw+1;
  602.           intr($21,regs);
  603.           IF (FCarry AND Flags)<>0 THEN BEGIN
  604.             WriteLn(stderr,text04);
  605.             trk:=0;
  606.             Exit;
  607.           END;
  608.           ax:=$440d; cx:=$860; bx:=lw+1;
  609.           dx:=Ofs(buffer); ds:=Seg(buffer);
  610.           buffer[0]:=0;
  611.           intr($21,regs);
  612.           dosdrive:=bdib(buffer).dtyp;
  613.           IF cfgdrive<>255 THEN
  614.             dosdrive:=cfgdrive;
  615.           CASE dosdrive OF
  616.             0: BEGIN trk:=39; sec:= 9; hd:=False; END;
  617.             1: BEGIN trk:=79; sec:=15; hd:=True ; END;
  618.             2: BEGIN trk:=79; sec:= 9; hd:=False; END;
  619.             7: BEGIN trk:=79; sec:=18; hd:=True ; END;
  620.             ELSE
  621.               BEGIN
  622.                 WriteLn(stderr,text06);
  623.                 trk:=0;
  624.                 Exit;
  625.               END
  626.           END;
  627.           IF Swap(DosVersion)<$1000 THEN lw:=GetPhysical(lw);
  628.           lw:=lw AND $9f;
  629.           IF NOT(lw IN [0..3]) THEN BEGIN
  630.             WriteLn(stderr,text07);
  631.             trk:=0;
  632.             Exit;
  633.           END;
  634.           IF cfgat80 THEN
  635.             at80:=cfgat80
  636.           ELSE
  637.             at80:=(ModelByte=$f8) OR (ModelByte=$fc);
  638.         END;
  639.       END;
  640.  
  641.       PROCEDURE ATSetDrive(lw:Byte; trk,sec,Disk2,Disk,SetUp:Byte);
  642.       BEGIN
  643.         WITH regs DO BEGIN
  644.           IF lw>1 THEN bios:=True;
  645.           dh:=lw; ah:=$18; ch:=trk; cl:=sec;
  646.           IF bios THEN Write(text86);
  647.           intr($13,regs);
  648.           IF ah>1 THEN BEGIN
  649.             IF bios THEN Write(text89,#10#13,text87);
  650.             ah:=$17; al:=SetUp; dl:=lw;
  651.             intr($13,regs);
  652.             IF ah<>0 THEN BEGIN
  653.               IF bios THEN WriteLn(text89);
  654.             END ELSE BEGIN
  655.               IF bios THEN WriteLn(text88);
  656.             END;
  657.           END ELSE
  658.             IF bios THEN WriteLn(text88);
  659.           IF ForceType<>0 THEN BEGIN
  660.             lwtab[lw]:=ForceType;
  661.             bios:=False;
  662.           END ELSE IF Disk2<>0 THEN BEGIN
  663.             bios:=False;
  664.             lwtab[lw]:=Disk2;
  665.           END ELSE IF NOT(bios) THEN BEGIN
  666.             lwtab[lw]:=Disk;
  667.           END;
  668.           DiskId:=lwtab[lw];
  669.           IF not(bios) THEN
  670.             WriteLn(text93)
  671.           ELSE BEGIN
  672.             IF (lw<2) AND ((lwtab[lw] AND $F0) <> (Disk AND $F0)) THEN BEGIN
  673.               Writeln(stderr,text90);
  674.               Writeln(stderr,text91,hexf(lwtab[lw] shr 4,1),
  675.               text92,hexf(Disk shr 4,1),'x.');
  676.             END;
  677.           END;
  678.         END;
  679.       END;
  680.  
  681.       PROCEDURE SectorAbsolute(sector:Word;VAR hds,trk,sec:Byte);
  682.       VAR h:Word;
  683.       BEGIN
  684.         sec:=(sector MOD bpb.spt)+1;
  685.         h:=sector DIV bpb.spt;
  686.         trk:=h DIV bpb.hds;
  687.         hds:=h MOD bpb.hds;
  688.       END;
  689.  
  690.       FUNCTION SectorLogical(hds,trk,sec:Byte):Word;
  691.       BEGIN
  692.         SectorLogical:=trk*bpb.hds*bpb.spt+hds*bpb.spt+sec-1;
  693.       END;
  694.  
  695.       FUNCTION Cluster(sector: Word):Word;
  696.       BEGIN
  697.         Cluster:=((sector-(bpb.rde SHR 4)-(bpb.spf SHL 1)-1) DIV Word(bpb.spc))+2;
  698.       END;
  699.  
  700.       PROCEDURE ClusterOffset(Cluster:Word; VAR Offset,Mask:Word);
  701.       BEGIN
  702.         Offset:=Cluster*3 SHR 1;
  703.         IF Cluster AND 1 = 0 THEN
  704.           Mask:=$ff7
  705.         ELSE
  706.           Mask:=$ff70;
  707.       END;
  708.  
  709.       PROCEDURE GetOldParms;
  710.       VAR bpb2: bpbtyp;
  711.       BEGIN
  712.         WITH regs DO BEGIN
  713.           ax:=$201;
  714.           dx:=lw;
  715.           cx:=$101;
  716.           es:=Seg(bpb2);
  717.           bx:=Ofs(bpb2);
  718.           intr($13,regs);
  719.           ax:=$201;
  720.           dx:=lw;
  721.           cx:=$1;
  722.           es:=Seg(bpb2);
  723.           bx:=Ofs(bpb2);
  724.           intr($13,regs);
  725.           IF ((FCarry AND Flags) = 0) AND (bpb2.hds<>0) AND (bpb2.spt<>0)
  726.           AND (bpb2.sec MOD (bpb2.hds*bpb2.spt)=0) THEN BEGIN
  727.             IF NOT(Quick) AND ((sec<>bpb2.spt) OR (hds<>bpb2.hds) OR
  728.                                (trk<>bpb2.sec DIV bpb2.hds DIV bpb2.spt)) THEN BEGIN
  729.               safe:=False;
  730.             END ELSE BEGIN
  731.               sec:=bpb2.spt;
  732.               hds:=bpb2.hds;
  733.               trk:=bpb2.sec DIV bpb2.hds DIV bpb2.spt;
  734.               rde:=bpb2.rde;
  735.               bpb.spf:=bpb2.spf;
  736.               spc:=bpb2.spc;
  737.             END;
  738.           END ELSE BEGIN
  739.             IF fwe THEN BEGIN
  740.               WriteLn(stderr,text81);
  741.               Halt(3);
  742.             END ELSE BEGIN
  743.               safe:=False;
  744.             END;
  745.           END;
  746.         END;
  747.       END;
  748.  
  749.       PROCEDURE format;
  750.       VAR i:Byte;
  751.          st:Byte;
  752.       BEGIN
  753.         IF NOT(fwe) THEN BEGIN
  754.           IF rde AND 15 <> 0 THEN Inc(rde,16);
  755.           rde:=rde SHR 4;
  756.           IF (spc=2) AND (rde AND 1 = 0) THEN Inc(rde);
  757.           bpb.rde:=rde SHL 4;
  758.         END;
  759.         CASE sec OF
  760.           0..8:   new1E:=@para08;
  761.           9:      new1E:=@para09;
  762.           10:     new1E:=@para10;
  763.           11:     new1E:=@para11;
  764.           12..15: new1E:=@para15;
  765.           17:     new1E:=@para17;
  766.           18:     IF lwsec>17 THEN
  767.                     new1E:=@para18
  768.                   ELSE
  769.                     new1E:=@para18a;
  770.           19..20: new1E:=@para20;
  771.           21:     new1E:=@para21;
  772.           22..255:new1E:=@para22;
  773.         END;
  774.         IF gpl<>0 THEN
  775.           new1E^[7]:=gpl
  776.         ELSE
  777.           gpl:=new1E^[7];
  778.         WriteLn;
  779.         Write(text08,Chr(lw+$41),', ');
  780.         IF hd THEN WriteLn('High-Density') ELSE WriteLn('Double-Density');
  781.         WriteLn(hds,text09,trk,text10,sec,text11,'Interleave: ',il,text68,gpl);
  782.         WriteLn(bpb.rde,text12,spc,text13,shiftt,':',shifth);
  783.         bstCount:=0;
  784.         WITH regs DO BEGIN
  785.           FOR i:=1 TO 25 DO BEGIN
  786.             table[i].f:=2;
  787.             table2[i]:=0;
  788.           END;
  789.           i:=1;
  790.           n:=1;
  791.           REPEAT
  792.             REPEAT
  793.               WHILE table2[n]<>0 DO Inc(n);
  794.               IF n>sec THEN n:=1;
  795.             UNTIL table2[n]=0;
  796.             table2[n]:=i;
  797.             n:=n+il;
  798.             Inc(i);
  799.           UNTIL i>sec;
  800.           ax:=0;
  801.           bx:=0;
  802.           dl:=lw;
  803.           IF at80 AND NOT(fwe) THEN BEGIN
  804.             CASE dosdrive OF
  805.               0: ATSetDrive(lw,39,9,v360,$53,1);
  806.               1: IF (trk>43) AND (sec>11) THEN
  807.                    ATSetDrive(lw,79,15,v12,$14,3)
  808.                  ELSE IF (trk>43) AND (sec<12) THEN
  809.                    ATSetDrive(lw,79,9,v720,$53,5)
  810.                  ELSE IF sec<12 THEN
  811.                    ATSetDrive(lw,39,9,v360,$73,2)
  812.                  ELSE
  813.                    ATSetDrive(lw,39,15,0,$34,2);
  814.               2: IF (trk>43) THEN
  815.                    ATSetDrive(lw,79,9,v720,$97,4)
  816.                  ELSE
  817.                    ATSetDrive(lw,39,9,v360,$B7,2);
  818.               7: IF (trk>43) AND (sec>11) THEN
  819.                    ATSetDrive(lw,79,18,v144,$14,3)
  820.                  ELSE IF (trk>43) AND (sec<12) THEN
  821.                    ATSetDrive(lw,79,9,v720,$97,5)
  822.                  ELSE IF sec<12 THEN
  823.                    ATSetDrive(lw,39,9,v360,$B7,2)
  824.                  ELSE
  825.                    ATSetDrive(lw,39,18,0,$34,3);
  826.             END;
  827.           END;
  828.           IF at80 AND NOT(bios) THEN BEGIN
  829.             Write(text67);
  830.             CASE (DiskId AND $C0) OF
  831.               $00: Write('500');
  832.               $40: Write('300');
  833.               $80: Write('250');
  834.               $C0: Write('???');
  835.             END;
  836.             Write(' kBaud, Double-Stepping: ');
  837.             IF (DiskId AND 32)=0 THEN
  838.               Write(text73,', ')
  839.             ELSE
  840.               Write(text72,', ');
  841.           END;
  842.           bpb.spt:=sec;
  843.           bpb.hds:=hds;
  844.           bpb.spc:=spc;
  845.           bpb.sec:=sec*bpb.hds*trk;
  846.                 if (sec<11) and (bpb.sec>850) then bpb.jmp[2]:=$3C;
  847.           IF ForceMedia=0 THEN BEGIN
  848.             CASE bpb.spc OF
  849.               1:   IF (trk>44) AND (bpb.spt IN [12..17]) THEN
  850.                      bpb.mds:=$f9
  851.                    ELSE
  852.                      bpb.mds:=$f0;
  853.               2:   IF trk IN [1..43] THEN bpb.mds:=$fd ELSE bpb.mds:=$f9;
  854.               ELSE bpb.mds:=$f8;
  855.             END;
  856.           END
  857.           ELSE bpb.mds:=ForceMedia;
  858.           IF NOT fwe THEN BEGIN
  859.             bpb.spf:=Trunc(bpb.sec*1.5/512/bpb.spc)+1;
  860.             WHILE Trunc((1.5*(((bpb.sec-bpb.res-(bpb.rde DIV 16)
  861.                                 -bpb.fat*(bpb.spf-1)) DIV bpb.spc)+2)-1)/bpb.bps)+1<bpb.spf DO
  862.               Dec(bpb.spf);
  863.           END;
  864.           SectorAbsolute((bpb.spf shl 1)+1,dh,ch,cl);
  865.           bpb.boot_code[$D1]:=cl;
  866.           bpb.boot_code[$D2]:=ch;
  867.           bpb.boot_code[$D5]:=dh;
  868.           SectorAbsolute((bpb.rde shr 4)+(bpb.spf shl 1)+1,dh,ch,cl);
  869.           bpb.boot_code[$FF]:=cl;
  870.           bpb.boot_code[$100]:=ch;
  871.           bpb.boot_code[$102]:=dh;
  872.           bpb.boot_code[$137]:=(bpb.rde shr 4)+(bpb.spf shl 1)+1;
  873.           WriteLn('Media-Byte: ',hexf(bpb.mds,2));
  874.           WriteLn;
  875.           dl:=lw;
  876.           ax:=0;
  877.           REPEAT int13 UNTIL NOT again;
  878.           n:=0;
  879.           FillChar(buffer,SizeOf(buffer),#0);
  880.           IF safe THEN st:=0
  881.                   ELSE st:=1;
  882.           FOR track:=trk-st DOWNTO 0 DO BEGIN
  883.             FOR head:=hds-1 DOWNTO 0 DO BEGIN
  884.               Write(text14,head,text15,track,#9);
  885.               EndProgram(4,text94);
  886.               n:=n MOD sec;
  887.               FOR i:=1 TO sec DO BEGIN
  888.                 table[i].s:=table2[(i+n-1) MOD sec+1];
  889.                 table[i].t:=track;
  890.                 table[i].h:=head;
  891.               END;
  892.               noformat:=safe;
  893.               again:=False;
  894.               Write('R'#8);
  895.               IF (st=0) THEN REPEAT
  896.                 i:=track;
  897.                 track:=0;
  898.                 MakeTrack(TRead);
  899.                 track:=i;
  900.               UNTIL NOT again;
  901.               IF fwe AND (st<>0) THEN REPEAT MakeTrack(TRead) UNTIL NOT again;
  902.               REPEAT
  903.                 Write('F'#8);
  904.                 IF (NOT noformat) OR (st=0) THEN BEGIN
  905.                   ah:=5;
  906.                   al:=sec;
  907.                   dl:=lw;
  908.                   dh:=head;
  909.                   ch:=track;
  910.                   cl:=1;
  911.                   es:=Seg(table);
  912.                   bx:=Ofs(table);
  913.                   int13;
  914.                 END;
  915.                 Write('W'#8);
  916.                 IF fwe OR (track<(3-hds)) OR (st=0) THEN MakeTrack(TWrite);
  917.                 Write('V'#8);
  918.                 IF NOT noverify THEN MakeTrack(TVerify);
  919.               UNTIL NOT again;
  920.               IF (st<>0) THEN Write(#9,100-((track+track+head)*50 DIV trk),'%'#13)
  921.               ELSE BEGIN
  922.                 Write(#9,'0%'#13);
  923.                 FillChar(buffer,SizeOf(buffer),#0);
  924.               END;
  925.               n:=n+shifth;
  926.             END;
  927.             st:=1;
  928.             n:=n+shiftt;
  929.           END;
  930.         END;
  931.       END;
  932.  
  933.       PROCEDURE WriteBootSect;
  934.       BEGIN
  935.         WITH regs DO BEGIN
  936.           IF setlabel THEN
  937.             Move(dlabel[1],bpb.vlb,Length(dlabel))
  938.           ELSE
  939.             bpb.vlb:='NO NAME    ';
  940.           inc(bpb.vsn);
  941.           dh:=0; dl:=lw; ch:=0; cl:=1;
  942.           al:=1; ah:=3; es:=Seg(bpb);
  943.           bx:=Ofs(bpb);
  944.           REPEAT int13 UNTIL NOT again;
  945.           FillChar(buffer[3],18430,#0);
  946.           buffer[0]:=bpb.mds;
  947.           buffer[1]:=$ff;
  948.           buffer[2]:=$ff;
  949.           bad:=0;
  950.           FOR i:=1 TO bstCount DO BEGIN
  951.             x:=SectorLogical(bst[i].head,bst[i].track,bst[i].sector);
  952.             x:=Cluster(x);
  953.             ClusterOffset(x,Offset,Mask);
  954.             IF buffer[Offset] AND Lo(Mask)=0 THEN Inc(bad,bpb.spc*512);
  955.             buffer[Offset]:=buffer[Offset] OR Lo(Mask);
  956.             buffer[Offset+1]:=buffer[Offset+1] OR Hi(Mask);
  957.           END;
  958.           es:=Seg(buffer);
  959.           bx:=Ofs(buffer);
  960.           Inc(cl);
  961.           al:=bpb.spf;
  962.           REPEAT int13 UNTIL NOT again;
  963.           SectorAbsolute(bpb.spf+1,dh,ch,cl);
  964.           ah:=3;
  965.           dl:=lw;
  966.           IF bpb.spf+cl>sec+1 THEN al:=sec-cl+1;
  967.           REPEAT int13 UNTIL NOT again;
  968.           IF bpb.spf+cl>sec+1 THEN BEGIN
  969.             bx:=bx+al*512;
  970.             al:=bpb.spf-al;
  971.             Inc(dh);
  972.             cl:=1;
  973.             REPEAT int13 UNTIL NOT again;
  974.           END;
  975.           ax:=$440f; bx:=lw+1;
  976.           intr($21,regs);
  977.         END;
  978.       END;
  979.  
  980.  
  981.       PROCEDURE WriteLabel(x:String);
  982.       VAR i: Byte;
  983.       BEGIN
  984.         WITH regs DO BEGIN
  985.           IF x='' THEN BEGIN
  986.             REPEAT
  987.               Write(text74);
  988.               ReadLn(x);
  989.             UNTIL Length(x)<12;
  990.           END;
  991.           IF x<>'' THEN BEGIN
  992.             IF Length(x)>8 THEN Insert('.',x,9);
  993.             x:=Chr(lw+$41)+':\'+x;
  994.             x[Length(x)+1]:=#0;
  995.             cx:=8;
  996.             ds:=Seg(x);
  997.             dx:=Ofs(x)+1;
  998.             ah:=$3c;
  999.             msdos(regs);
  1000.             IF (FCarry AND Flags) <> 0 THEN BEGIN
  1001.               WriteLn(stderr,text75);
  1002.               Exit;
  1003.             END;
  1004.             bx:=ax;
  1005.             ah:=$3e;
  1006.             msdos(regs);
  1007.             IF (FCarry AND Flags) <> 0 THEN BEGIN
  1008.               WriteLn(stderr,text75);
  1009.               Halt(32);
  1010.             END;
  1011.           END;
  1012.         END;
  1013.       END;
  1014.  
  1015.       PROCEDURE DrivePrt;
  1016.       BEGIN
  1017.         WriteLn;
  1018.         IF lwtrk=0 THEN BEGIN
  1019.           WriteLn(stderr,text34);
  1020.           Exit;
  1021.         END;
  1022.         Write(text35,lw);
  1023.         IF lwhd THEN
  1024.           Write(': High-Density, ')
  1025.         ELSE
  1026.           Write(': Double-Density, ');
  1027.         WriteLn(lwtrk+1,text10,lwsec,text11);
  1028.         Write(text36);
  1029.         IF pc80=$20 THEN WriteLn(text37);
  1030.         IF pc80=$40 THEN WriteLn(text38);
  1031.         IF at80 THEN WriteLn(text39);
  1032.         IF NOT(at80) AND (pc80=0) THEN WriteLn(text40);
  1033.         WriteLn;
  1034.       END;
  1035.  
  1036.       PROCEDURE SyntaxError;
  1037.       BEGIN
  1038.         WriteLn(stderr); WriteLn(stderr,text41); WriteLn(stderr);
  1039.         WriteLn(stderr,text42); WriteLn(stderr,text43); WriteLn(stderr);
  1040.         WriteLn(stderr,text44); WriteLn(stderr); WriteLn(stderr,text45);
  1041.         WriteLn(stderr,text46); WriteLn(stderr,text47); WriteLn(stderr,text48);
  1042.         WriteLn(stderr,text49); WriteLn(stderr,text50); WriteLn(stderr,text51);
  1043.         WriteLn(stderr,text52); WriteLn(stderr,text53);
  1044.         WriteLn(stderr,text69); WriteLn(stderr,text70); WriteLn(stderr);
  1045.         WriteLn(stderr,text71);
  1046.         Halt(1);
  1047.       END;
  1048.  
  1049.       PROCEDURE CheckDos;
  1050.       VAR Version: Word;
  1051.       BEGIN
  1052.         IF Swap(DosVersion)<$314 THEN BEGIN
  1053.           WriteLn(stderr,text54);
  1054.           Halt(128);
  1055.         END;
  1056.         ASM
  1057.           mov   ax,3700h
  1058.           int   21h
  1059.           cmp   al,255
  1060.           jz    @def
  1061.           mov   swchar,dl
  1062.           @def:
  1063.         END;
  1064.       END;
  1065.  
  1066.       PROCEDURE BuildDPBError;
  1067.       BEGIN
  1068.         WriteLn(stderr,#10,text80,regs.ax,#10);
  1069.         Halt(64);
  1070.       END;
  1071.  
  1072.     BEGIN
  1073.       GetIntVec($1E,old1E);
  1074.       GetIntVec($13,old13);
  1075.       NormExit:=ExitProc;                                                 {Save old Exit-Procedure}
  1076.       ExitProc:=@RequestAbort;                   {Use our own Exit-Procedure to restore Interrupts}
  1077.       SetIntVec($1B,@CtrlBreak);          {Our own Ctrl-Break-Handler, to exit only, if it is save}
  1078.       SetIntVec($23,@IgnoreInt);                                                    {Ignore Ctrl-C}
  1079.       WriteLn(#10,text55);
  1080.       WriteLn(text56);
  1081.       CheckDos;
  1082.       new1E:=old1E;
  1083.       parse;
  1084.       IF (Length(para[1])<>2) OR (para[1,2]<>':') THEN SyntaxError;
  1085.       lw:=Ord(Upcase(para[1,1]))-$41;
  1086.       shiftt:=0;
  1087.       shifth:=0;
  1088.       packet:=0;
  1089.       CfgRead;
  1090.       DriveTyp(lw,lwhd,lwtrk,lwsec);
  1091.       DrivePrt;
  1092.       IF (lwtrk=0) AND (para[1]<>'') THEN Halt(1);
  1093.       rde:=0;
  1094.       il:=0;
  1095.       spc:=0;
  1096.       gpl:=0;
  1097.       setlabel:=False;
  1098. {     sys:=False;}
  1099.       ForceType:=0;
  1100.       ForceMedia:=0;
  1101.       batch:=False;
  1102.       trk:=lwtrk+1;
  1103.       sec:=lwsec;
  1104.       hds:=2;
  1105.       FOR i:=2 TO PCount DO
  1106.         IF para[i]<>'' THEN BEGIN
  1107.           chx:=para[i,1];
  1108.           IF Upcase(chx)='V' THEN BEGIN
  1109.             dlabel:='           ';
  1110.             setlabel:=True;
  1111.             dlabel:=Copy(para[i],2,11);
  1112.           END ELSE
  1113.           IF Length(para[i])=1 THEN BEGIN
  1114.             CASE Upcase(chx) OF
  1115.               'A': bios:=True;
  1116.               'R': noverify:=True;
  1117.               'U': ssafe:=False;
  1118.               'Q': IF NOT(fwe) THEN BEGIN
  1119.                      ssafe:=True;
  1120.                      noverify:=True;
  1121.                      Quick:=True;
  1122.                    END;
  1123.               'W': BEGIN
  1124.                      ssafe:=False;
  1125.                      Quick:=True;
  1126.                      fwe:=True;
  1127.                      bios:=True;
  1128.                      ForceType:=0;
  1129.                    END;
  1130.               'O': BEGIN
  1131.                      trk:=80;
  1132.                      sec:=9;
  1133.                      rde:=144;
  1134.                    END;
  1135.               '4': BEGIN
  1136.                      trk:=40;
  1137.                      sec:=9;
  1138.                    END;
  1139.               '1': BEGIN
  1140.                      hds:=1;
  1141.                    END;
  1142.               '8': BEGIN
  1143.                      sec:=8;
  1144.                    END;
  1145. {             'S': BEGIN
  1146.                      sys:=True;
  1147.                    END;}
  1148.               'K': BEGIN
  1149.                      batch:=True;
  1150.                    END;
  1151.               'P': BEGIN
  1152.                      packet:=255;
  1153.                    END;
  1154.                             'Z': BEGIN
  1155.                      CASE sec OF
  1156.                        0..8:   new1E:=@para08;
  1157.                        9:      new1E:=@para09;
  1158.                        10:     new1E:=@para10;
  1159.                        11:     new1E:=@para11;
  1160.                        12..15: new1E:=@para15;
  1161.                        17:     new1E:=@para17;
  1162.                        18:     IF lwsec>17 THEN
  1163.                                  new1E:=@para18
  1164.                                ELSE
  1165.                                  new1E:=@para18a;
  1166.                        19..20: new1E:=@para20;
  1167.                        21:     new1E:=@para21;
  1168.                        22..255:new1E:=@para22;
  1169.                      END;
  1170.                                  WITH regs DO BEGIN
  1171.                                          fwe:=True;
  1172.                                          safe:=True;
  1173.                                          Quick:=True;
  1174.                                          again:=False;
  1175.                                          GetOldParms;
  1176.                                          IF safe THEN BEGIN
  1177.                                               FOR head:=0 TO hds-1 DO BEGIN
  1178.                                                track:=trk;
  1179.                                                  REPEAT MakeTrack(TRead) UNTIL NOT again;
  1180.                          IF (FCarry AND Flags) <> 0 THEN BEGIN
  1181.                                                      Writeln(stderr,'Can not read Unformat info - program aborted.');
  1182.                                                      Halt(1);
  1183.                                                  END;
  1184.                                                  IF (head=0) AND ((buffer[510]<>$55) OR (buffer[511]<>$AA)) THEN BEGIN
  1185.                                                      Writeln(stderr,'Bad Unformat info - program aborted.');
  1186.                                                      Halt(1);
  1187.                                                  END;
  1188.                                                  track:=0;
  1189.                                                  REPEAT MakeTrack(TWrite) UNTIL NOT again;
  1190.                          IF (FCarry AND Flags) <> 0 THEN BEGIN
  1191.                                                      Writeln(stderr,'Can not restore Zero track - program aborted.');
  1192.                                                      Halt(1);
  1193.                                                  END;
  1194.                                              END;
  1195.                                              Writeln('Diskette is successfully unformatted.');
  1196.                                          END ELSE Writeln(stderr,'Diskette is not formatted or bad BPB');
  1197.                                          Halt(0);
  1198.                                      END;
  1199.                                  END;
  1200.               ELSE SyntaxError;
  1201.             END;
  1202.           END ELSE BEGIN
  1203.             IF para[i,2]='$' THEN BEGIN
  1204.               n:=dezh(Copy(para[i],3,255));
  1205.               j:=BaseError
  1206.             END ELSE
  1207.               Val(Copy(para[i],2,255),n,j);
  1208.             IF j<>0 THEN SyntaxError;
  1209.             CASE Upcase(para[i,1]) OF
  1210.               'T':trk:=n;
  1211.               'H':hds:=n;
  1212.               'N':sec:=n;
  1213.               'S':sec:=n;
  1214.               'M':ForceMedia:=n;
  1215.               'D':rde:=n;
  1216.               'C':spc:=n;
  1217.               'I':il:=n;
  1218.               'G':gpl:=n;
  1219.               'X':shifth:=n;
  1220.               'Y':shiftt:=n;
  1221.               'B':IF NOT(fwe) THEN ForceType:=n;
  1222.               'P':packet:=n;
  1223.               'F':BEGIN
  1224.                     found:=False;
  1225.                     FOR j:=1 TO maxform DO
  1226.                       IF NOT(found) AND (n=ftab[j].fmt) THEN BEGIN
  1227.                         trk:=ftab[j].trk;
  1228.                         sec:=ftab[j].sec;
  1229.                         hds:=ftab[j].hds;
  1230.                         found:=True;
  1231.                       END;
  1232.                     IF NOT(found) THEN BEGIN
  1233.                       Writeln(stderr,'You can specify formats:  360,  400,  410            for => 360 KB Drives');
  1234.                       Writeln(stderr,'                          720,  800,  820            for => 720 KB Drives');
  1235.                       Writeln(stderr,'    12 | 1.2 | 120,  14 | 1.4 | 144,  148 | 1.48     for => 1.2 MB Drives');
  1236.                       Writeln(stderr,'    16 | 1.6,       164 | 1.64,       172 | 1.72     for = 1.44 MB Drives');
  1237.                       Halt(1);
  1238.                     END;
  1239.                   END;
  1240.               ELSE SyntaxError;
  1241.             END;
  1242.           END;
  1243.         END;
  1244.       Randomize;
  1245.       bpb.vsn:=LongInt(Ptr(Random(65535),Random(65535)));
  1246.       REPEAT
  1247.         safe:=ssafe;
  1248.         IF NOT(hds IN [1..2]) THEN BEGIN
  1249.           WriteLn(stderr,text57);
  1250.           Halt(1);
  1251.         END;
  1252.         IF trk<1 THEN BEGIN
  1253.           WriteLn(stderr,text58);
  1254.           Halt(1);
  1255.         END;
  1256.         IF spc>2 THEN
  1257.           WriteLn(stderr,text61);
  1258.         IF ShortInt(trk-lwtrk)>4 THEN
  1259.           WriteLn(stderr,text62);
  1260.         IF rde>240 THEN
  1261.         WriteLn(stderr,text63);
  1262.         IF NOT(batch) OR (packet>0) THEN BEGIN
  1263.           WriteLn;
  1264.           WriteLn(text64,Chr(lw+$41),text65);
  1265.           WriteLn(text66);
  1266.           chx:=ReadKey;
  1267.         END;
  1268.         IF ssafe OR Quick THEN GetOldParms;
  1269.         srde:=rde;
  1270.         IF sec>11 THEN hd:=True ELSE hd:=False;
  1271.         IF rde=0 THEN
  1272.           CASE hd OF
  1273.             True:  rde:=224;
  1274.             False: rde:=112;
  1275.           END;
  1276.         IF spc=0 THEN
  1277.           CASE hd OF
  1278.             True:  spc:=1;
  1279.             False: spc:=2;
  1280.           END;
  1281.         IF il=0 THEN
  1282.           IF sec-lwsec IN [3..8] THEN il:=2 ELSE il:=1;
  1283.         IF il>=Pred(sec) THEN BEGIN
  1284.           WriteLn(stderr,text59,Pred(sec),text60);
  1285.           Halt(1);
  1286.         END;
  1287.         format;
  1288.         IF NOT(fwe) THEN BEGIN
  1289.           WriteBootSect;
  1290.           regs.bx:=lw+1;
  1291.           regs.ax:=$440D;
  1292.           regs.cx:=$860;
  1293.           regs.ds:=Seg(buffer);
  1294.           regs.dx:=Ofs(buffer);
  1295.           bdib(buffer).flag:=5;
  1296.           msdos(regs);
  1297.           IF (regs.Flags AND FCarry) <> 0 THEN BuildDPBError;
  1298.           Move(bpb.bps,bdib(buffer).bpb,31);
  1299.           regs.bx:=lw+1;
  1300.           regs.ax:=$440D;
  1301.           regs.cx:=$840;
  1302.           regs.ds:=Seg(buffer);
  1303.           regs.dx:=Ofs(buffer);
  1304.           bdib(buffer).flag:=4;
  1305.           msdos(regs);
  1306.           IF (regs.Flags AND FCarry) <> 0 THEN BuildDPBError;
  1307. {         IF sys THEN WriteSys;}
  1308.           IF setlabel THEN WriteLabel(dlabel);
  1309.         END;
  1310.         rde:=srde;
  1311.         WriteLn(#10);
  1312.         WriteLn(text22,bpb.sec); WriteLn(text23,bpb.spt);
  1313.         WriteLn(text24,bpb.hds); WriteLn(text29,bpb.spf);
  1314.         WriteLn(text30,Cluster(bpb.sec)-2);
  1315.         WriteLn(text79,hexf(bpb.vsn SHR 16,4),'-',hexf(bpb.vsn AND $FFFF,4));
  1316.         bytes:=LongInt(bpb.sec) SHL 9;
  1317.         WriteLn(#10,bytes:9,text31);
  1318.         WriteLn(512:9,text32);
  1319.         bytes:=bytes-512;
  1320.         bytesub:=bpb.rde SHL 5;
  1321.         WriteLn(bytesub:9,text33);
  1322.         bytes:=bytes-bytesub;
  1323.         bytesub:=bpb.spf SHL 10;
  1324.         bytes:=bytes-bytesub;
  1325.         WriteLn(bytesub:9,text82);
  1326.         IF bad<>0 THEN WriteLn(bad:9,text83);
  1327.         WriteLn(bytes-bad:9,text84);
  1328.         WriteLn(Diskfree(Succ(lw)):9,text85,#10);
  1329.         IF packet>0 THEN dec(packet);
  1330.       UNTIL packet=0;
  1331.     END.