home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / vrac / bdisk.zip / BDISK.PAS next >
Pascal/Delphi Source File  |  1995-10-02  |  38KB  |  1,158 lines
  1. {$R-,S-,I-,B-,F-}
  2. {$IFNDEF Windows}
  3.   {$O+}
  4. {$ENDIF}
  5.  
  6. {---------------------------------------------------------
  7.  BIOS disk I/O routines for floppy drives. Supports DOS
  8.  real mode, DOS protected mode, and Windows. Requires
  9.  TP6, TPW, or BP7.
  10.  
  11.  All functions are for floppy disks only; no hard drives.
  12.  
  13.  See the individual types and functions in the interface of
  14.  this unit for more information. See the FMT.PAS sample
  15.  program for an example of formatting disks.
  16.  
  17.  For status code definitions, see the implementation of
  18.  function GetStatusStr.
  19.  
  20.  ---------------------------------------------------------
  21.  Based on a unit provided by Henning Jorgensen of Denmark.
  22.  Modified and cleaned up by TurboPower Software for pmode
  23.  and Windows operation.
  24.  
  25.  TurboPower Software
  26.  P.O. Box 49009
  27.  Colorado Springs, CO 80949-9009
  28.  
  29.  CompuServe: 76004,2611
  30.  
  31.  Version 1.0  10/25/93
  32.  Version 1.1  10/29/93
  33.    fix a dumb bug in the MediaArray check
  34.  Version 1.2  12/02/93
  35.    make it compile with TPW 1.5
  36.    fix bug in MarkBadSector
  37.    if MaxBadSects passed to FormatDisk is 0, no limit
  38.      is set on maximum bad sectors (emulates DOS FORMAT)
  39.    check more carefully before saying "Disk Bad"
  40.    reduce automatic retries while marking bad sectors
  41.    change boot sector ID string to 'BDISK1.2'
  42.  Version 1.3  05/04/94
  43.    fix bug: not restoring MaxRetries for some bad disk errors
  44.  Version 1.4  10/02/95
  45.    eliminated call to function SetMediaType in FormatDisk
  46.    added support for Win95 volume locking
  47.  
  48.  ---------------------------------------------------------}
  49.  
  50. unit BDisk;
  51.   {-BIOS disk I/O routines for floppy drives}
  52.  
  53. interface
  54.  
  55. const
  56.   MaxRetries : Byte = 3;          {Number of automatic retries for
  57.                                    read, write, verify, format}
  58.  
  59. type
  60.   DriveNumber = 0..7;             {Acceptable floppy drive numbers}
  61.                                   {Generally, 0 = A, 1 = B}
  62.  
  63.   DriveType = 0..4;               {Floppy drive or disk types}
  64.                                   {0 = unknown or error
  65.                                    1 = 360K
  66.                                    2 = 1.2M
  67.                                    3 = 720K
  68.                                    4 = 1.44M}
  69.  
  70.   VolumeStr = String[11];         {String for volume labels}
  71.  
  72.   FormatAbortFunc =               {Prototype for format abort func}
  73.     function (Track : Byte;       {Track number being formatted, 0..MaxTrack}
  74.               MaxTrack : Byte;    {Maximum track number for this format}
  75.               Kind : Byte         {0 = format beginning}
  76.                                   {1 = formatting Track}
  77.                                   {2 = verifying Track}
  78.                                   {3 = writing boot and FAT}
  79.                                   {4 = format ending, Track = format status}
  80.               ) : Boolean;        {Return True to abort format}
  81.  
  82.  
  83. function LockPhysicalVolume (Drive : DriveType;                       {!!.4}
  84.                              LockForFormatting : Boolean) : Integer;  
  85.   {-Attempt to lock the physical volume for Win95 and later.}
  86.  
  87. procedure UnlockPhysicalVolume (Drive : DriveType;                     {!!.4}
  88.                                 WasLockedForFormatting : boolean);
  89.   {-Unlock the physical volume for Win95 and later.  'Formatting' must match
  90.     value passed to LockPhysicalVolume call.}
  91.  
  92. procedure ResetDrive(Drive : DriveNumber);
  93.   {-Reset drive system (function $00). Call after any other
  94.     disk function fails}
  95.  
  96.  
  97. function GetDiskStatus : Byte;
  98.   {-Get status of last int $13 operation (function $01)}
  99.  
  100.  
  101. function GetStatusStr(ErrNum : Byte) : String;
  102.   {-Return message string for any of the status codes used by
  103.     this unit.}
  104.  
  105.  
  106. function GetDriveType(Drive : DriveNumber) : DriveType;
  107.   {-Get drive type (function $08). Note that this returns the
  108.     type of the *drive*, not the type of the diskette in it.
  109.     GetDriveType returns 0 for an invalid drive.}
  110.  
  111.  
  112. function AllocBuffer(var P : Pointer; Size : Word) : Boolean;
  113.   {-Allocate a buffer useable in real and protected mode.
  114.     Buffers passed to ReadSectors and WriteSectors in pmode
  115.     *MUST* be allocated by using this function. AllocBuffer returns
  116.     False if sufficient memory is not available. P is also set to
  117.     nil in that case.}
  118.  
  119.  
  120. procedure FreeBuffer(P : Pointer; Size : Word);
  121.   {-Free buffer allocated by AllocBuffer. Size must match the
  122.     size originally passed to AllocBuffer. FreeBuffer does
  123.     nothing if P is nil.}
  124.  
  125.  
  126. function ReadSectors(Drive : DriveNumber;
  127.                      Track, Side, SSect, NSect : Byte;
  128.                      var Buffer) : Byte;
  129.   {-Read absolute disk sectors (function $02). Track, Side,
  130.     and SSect specify the location of the first sector to
  131.     read. NSect is the number of sectors to read. Buffer
  132.     must be large enough to hold these sectors. ReadSectors
  133.     returns a status code, 0 for success.}
  134.  
  135.  
  136. function ReadSectorsPrim(Drive : DriveNumber;                 {!!.4}
  137.                          Track, Side, SSect, NSect : Byte;
  138.                          var Buffer) : Byte;
  139.   {-Read absolute disk sectors (function $02). Track, Side,
  140.     and SSect specify the location of the first sector to
  141.     read. NSect is the number of sectors to read. Buffer
  142.     must be large enough to hold these sectors. ReadSectors
  143.     returns a status code, 0 for success.
  144.     This function does not perform automatic volume locking
  145.     under Windows95.}
  146.  
  147.  
  148. function WriteSectors(Drive : DriveNumber;
  149.                       Track, Side, SSect, NSect : Byte;
  150.                       var Buffer) : Byte;
  151.   {-Write absolute disk sectors (function $03). Track, Side,
  152.     and SSect specify the location of the first sector to
  153.     write. NSect is the number of sectors to write. Buffer
  154.     must contain all the data to write. WriteSectors
  155.     returns a status code, 0 for success.}
  156.  
  157.  
  158. function WriteSectorsPrim(Drive : DriveNumber;
  159.                           Track, Side, SSect, NSect : Byte;
  160.                           var Buffer) : Byte;
  161.   {-Write absolute disk sectors (function $03). Track, Side,
  162.     and SSect specify the location of the first sector to
  163.     write. NSect is the number of sectors to write. Buffer
  164.     must contain all the data to write. WriteSectors
  165.     returns a status code, 0 for success.
  166.     This function does not perform automatic volume locking
  167.     under Windows95.}
  168.  
  169.  
  170. function VerifySectors(Drive : DriveNumber;
  171.                        Track, Side, SSect, NSect : Byte) : Byte;
  172.   {-Verify absolute disk sectors (function $04). This
  173.     tests a computed CRC with the CRC stored along with the
  174.     sector. Track, Side, and SSect specify the location of
  175.     the first sector to verify. NSect is the number of
  176.     sectors to verify. VerifySectors returns a status code,
  177.     0 for success. Don't call VerifySectors on PC/XTs and
  178.     PC/ATs with a BIOS from 1985. It will overwrite the
  179.     stack.}
  180.  
  181.  
  182. function VerifySectorsPrim(Drive : DriveNumber;
  183.                            Track, Side, SSect, NSect : Byte) : Byte;
  184.   {-Verify absolute disk sectors (function $04). This
  185.     tests a computed CRC with the CRC stored along with the
  186.     sector. Track, Side, and SSect specify the location of
  187.     the first sector to verify. NSect is the number of
  188.     sectors to verify. VerifySectors returns a status code,
  189.     0 for success. Don't call VerifySectors on PC/XTs and
  190.     PC/ATs with a BIOS from 1985. It will overwrite the
  191.     stack.
  192.     This function does not perform automatic volume locking
  193.     under Windows95.}
  194.  
  195.  
  196. function FormatDisk(Drive : DriveNumber; DType : DriveType;
  197.                     Verify : Boolean; MaxBadSects : Byte;
  198.                     VLabel : VolumeStr;
  199.                     FAF : FormatAbortFunc) : Byte;
  200.   {-Format drive that contains a disk of type DType. If Verify
  201.     is True, each track is verified after it is formatted.
  202.     MaxBadSects specifies the number of sectors that can be
  203.     bad before the format is halted. If VLabel is not an
  204.     empty string, FormatDisk puts the BIOS-level volume
  205.     label onto the diskette. It does *not* add a DOS-level
  206.     volume label. FAF is a user function hook that can be
  207.     used to display status during the format, and to abort
  208.     the format if the user so chooses. Parameters passed to
  209.     this function are described in FormatAbortFunc above.
  210.     FormatDisk also writes a boot sector and empty File
  211.     Allocation Tables for the disk. FormatDisk returns a
  212.     status code, 0 for success.}
  213.  
  214.  
  215. function EmptyAbortFunc(Track : Byte; MaxTrack : Byte; Kind : Byte) : Boolean;
  216.   {-Do-nothing abort function for FormatDisk}
  217.  
  218.   {========================================================================}
  219.  
  220. implementation
  221.  
  222. uses
  223. {$IFDEF DPMI}
  224.   WinApi,
  225.   Dos;
  226.   {$DEFINE pmode}
  227. {$ELSE}
  228. {$IFDEF Windows}
  229. {$IFDEF Ver70}
  230.   WinApi,
  231. {$ELSE}
  232.   WinTypes,
  233.   WinProcs,
  234.   Win31,
  235. {$ENDIF}
  236.   WinDos;
  237.   {$DEFINE pmode}
  238. {$ELSE}
  239.   Dos;
  240.   {$UNDEF pmode}
  241. {$ENDIF}
  242. {$ENDIF}
  243.  
  244. {$IFDEF Windows}
  245. type
  246.   Registers = TRegisters;
  247.   DateTime = TDateTime;
  248. {$ENDIF}
  249.  
  250. type
  251.   DiskRec =
  252.     record
  253.       SSZ : Byte;                 {Sector size}
  254.       SPT : Byte;                 {Sectors/track}
  255.       TPD : Byte;                 {Tracks/disk}
  256.       SPF : Byte;                 {Sectors/FAT}
  257.       DSC : Byte;                 {Directory sectors}
  258.       FID : Byte;                 {Format id for FAT}
  259.       BRD : array[0..13] of Byte; {Variable boot record data}
  260.     end;
  261.   DiskRecs = array[1..4] of DiskRec;
  262.   SectorArray = array[0..511] of Byte;
  263.  
  264. const
  265.   DData : DiskRecs =              {BRD starts at offset 13 of FAT}
  266.   ((SSZ : $02; SPT : $09; TPD : $27; SPF : $02; DSC : $07; FID : $FD; {5.25" - 360K}
  267.     BRD : ($02, $01, $00, $02, $70, $00, $D0, $02, $FD, $02, $00, $09, $00, $02)),
  268.    (SSZ : $02; SPT : $0F; TPD : $4F; SPF : $07; DSC : $0E; FID : $F9; {5.25" - 1.2M}
  269.     BRD : ($01, $01, $00, $02, $E0, $00, $60, $09, $F9, $07, $00, $0F, $00, $02)),
  270.    (SSZ : $02; SPT : $09; TPD : $4F; SPF : $03; DSC : $07; FID : $F9; {3.50" - 720K}
  271.     BRD : ($02, $01, $00, $02, $70, $00, $A0, $05, $F9, $03, $00, $09, $00, $02)),
  272.    (SSZ : $02; SPT : $12; TPD : $4F; SPF : $09; DSC : $0E; FID : $F0; {3.50" - 1.44M}
  273.     BRD : ($01, $01, $00, $02, $E0, $00, $40, $0B, $F0, $09, $00, $12, $00, $02)));
  274.  
  275.   BootRecord : SectorArray = {Standard boot program}
  276.   ($EB, $34, $90,
  277.    {'BDISK1.2'}
  278.    $42, $44, $49, $53, $4B, $31, $2E, $32,
  279.  
  280.    $00, $02, $01, $01, $00, $02, $E0, $00, $40, $0B, $F0, $09, $00,
  281.    $12, $00, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $12,
  282.    $00, $00, $00, $00, $01, $00, $FA, $33, $C0, $8E, $D0, $BC, $00, $7C, $16, $07, $BB, $78, $00, $36, $C5, $37, $1E, $56,
  283.    $16, $53, $BF, $2B, $7C, $B9, $0B, $00, $FC, $AC, $26, $80, $3D, $00, $74, $03, $26, $8A, $05, $AA, $8A, $C4, $E2, $F1,
  284.    $06, $1F, $89, $47, $02, $C7, $07, $2B, $7C, $FB, $CD, $13, $72, $67, $A0, $10, $7C, $98, $F7, $26, $16, $7C, $03, $06,
  285.    $1C, $7C, $03, $06, $0E, $7C, $A3, $3F, $7C, $A3, $37, $7C, $B8, $20, $00, $F7, $26, $11, $7C, $8B, $1E, $0B, $7C, $03,
  286.    $C3, $48, $F7, $F3, $01, $06, $37, $7C, $BB, $00, $05, $A1, $3F, $7C, $E8, $9F, $00, $B8, $01, $02, $E8, $B3, $00, $72,
  287.    $19, $8B, $FB, $B9, $0B, $00, $BE, $D6, $7D, $F3, $A6, $75, $0D, $8D, $7F, $20, $BE, $E1, $7D, $B9, $0B, $00, $F3, $A6,
  288.    $74, $18, $BE, $77, $7D, $E8, $6A, $00, $32, $E4, $CD, $16, $5E, $1F, $8F, $04, $8F, $44, $02, $CD, $19, $BE, $C0, $7D,
  289.    $EB, $EB, $A1, $1C, $05, $33, $D2, $F7, $36, $0B, $7C, $FE, $C0, $A2, $3C, $7C, $A1, $37, $7C, $A3, $3D, $7C, $BB, $00,
  290.    $07, $A1, $37, $7C, $E8, $49, $00, $A1, $18, $7C, $2A, $06, $3B, $7C, $40, $38, $06, $3C, $7C, $73, $03, $A0, $3C, $7C,
  291.    $50, $E8, $4E, $00, $58, $72, $C6, $28, $06, $3C, $7C, $74, $0C, $01, $06, $37, $7C, $F7, $26, $0B, $7C, $03, $D8, $EB,
  292.    $D0, $8A, $2E, $15, $7C, $8A, $16, $FD, $7D, $8B, $1E, $3D, $7C, $EA, $00, $00, $70, $00, $AC, $0A, $C0, $74, $22, $B4,
  293.    $0E, $BB, $07, $00, $CD, $10, $EB, $F2, $33, $D2, $F7, $36, $18, $7C, $FE, $C2, $88, $16, $3B, $7C, $33, $D2, $F7, $36,
  294.    $1A, $7C, $88, $16, $2A, $7C, $A3, $39, $7C, $C3, $B4, $02, $8B, $16, $39, $7C, $B1, $06, $D2, $E6, $0A, $36, $3B, $7C,
  295.    $8B, $CA, $86, $E9, $8A, $16, $FD, $7D, $8A, $36, $2A, $7C, $CD, $13, $C3, $0D, $0A, $4E, $6F, $6E, $2D, $53, $79, $73,
  296.    $74, $65, $6D, $20, $64, $69, $73, $6B, $20, $6F, $72, $20, $64, $69, $73, $6B, $20, $65, $72, $72, $6F, $72, $0D, $0A,
  297.    $52, $65, $70, $6C, $61, $63, $65, $20, $61, $6E, $64, $20, $73, $74, $72, $69, $6B, $65, $20, $61, $6E, $79, $20, $6B,
  298.    $65, $79, $20, $77, $68, $65, $6E, $20, $72, $65, $61, $64, $79, $0D, $0A, $00, $0D, $0A, $44, $69, $73, $6B, $20, $42,
  299.    $6F, $6F, $74, $20, $66, $61, $69, $6C, $75, $72, $65, $0D, $0A, $00, $49, $4F, $20, $20, $20, $20, $20, $20, $53, $59,
  300.    $53, $4D, $53, $44, $4F, $53, $20, $20, $20, $53, $59, $53, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
  301.    $00, $00, $00, $00, $00, $00, $55, $AA);
  302.  
  303.   MediaArray : array[DriveType, 1..2] of Byte =
  304.     (($00, $00),     {Unknown disk}
  305.      ($01, $02),     {360K disk}
  306.      ($00, $03),     {1.2M disk}
  307.      ($00, $04),     {720K disk}
  308.      ($00, $04));    {1.44M disk}
  309.  
  310. {$IFDEF pmode}
  311. type
  312.   DPMIRegisters =
  313.     record
  314.       DI : LongInt;
  315.       SI : LongInt;
  316.       BP : LongInt;
  317.       Reserved : LongInt;
  318.       BX : LongInt;
  319.       DX : LongInt;
  320.       CX : LongInt;
  321.       AX : LongInt;
  322.       Flags : Word;
  323.       ES : Word;
  324.       DS : Word;
  325.       FS : Word;
  326.       GS : Word;
  327.       IP : Word;
  328.       CS : Word;
  329.       SP : Word;
  330.       SS : Word;
  331.     end;
  332.  
  333.   function GetRealSelector(RealPtr : Pointer; Limit : Word) : Word;
  334.     {-Set up a selector to point to RealPtr memory}
  335.   type
  336.     OS =
  337.       record
  338.         O, S : Word;
  339.       end;
  340.   var
  341.     Status : Word;
  342.     Selector : Word;
  343.     Base : LongInt;
  344.   begin
  345.     GetRealSelector := 0;
  346.     Selector := AllocSelector(0);
  347.     if Selector = 0 then
  348.       Exit;
  349.     {Assure a read/write selector}
  350.     Status := ChangeSelector(CSeg, Selector);
  351.     Base := (LongInt(OS(RealPtr).S) shl 4)+LongInt(OS(RealPtr).O);
  352.     if SetSelectorBase(Selector, Base) = 0 then begin
  353.       Selector := FreeSelector(Selector);
  354.       Exit;
  355.     end;
  356.     Status := SetSelectorLimit(Selector, Limit);
  357.     GetRealSelector := Selector;
  358.   end;
  359.  
  360.   procedure GetRealIntVec(IntNo : Byte; var Vector : Pointer); Assembler;
  361.   asm
  362.     mov     ax,0200h
  363.     mov     bl,IntNo
  364.     int     31h
  365.     les     di,Vector
  366.     mov     word ptr es:[di],dx
  367.     mov     word ptr es:[di+2],cx
  368.   end;
  369.  
  370.   function RealIntr(IntNo : Byte; var Regs : DPMIRegisters) : Word; Assembler;
  371.   asm
  372.     xor     bx,bx
  373.     mov     bl,IntNo
  374.     xor     cx,cx        {StackWords = 0}
  375.     les     di,Regs
  376.     mov     ax,0300h
  377.     int     31h
  378.     jc      @@ExitPoint
  379.     xor     ax,ax
  380.   @@ExitPoint:
  381.   end;
  382. {$ENDIF}
  383.  
  384.   procedure Int13Call(var Regs : Registers);
  385.     {-Call int $13 for real or protected mode}
  386. {$IFDEF pmode}
  387.   var
  388.     Base : LongInt;
  389.     DRegs : DPMIRegisters;
  390. {$ENDIF}
  391.   begin
  392. {$IFDEF pmode}
  393.     {This pmode code is valid only for the AH values used in this unit}
  394.     FillChar(DRegs, SizeOf(DPMIRegisters), 0);
  395.     DRegs.AX := Regs.AX;
  396.     DRegs.BX := Regs.BX;
  397.     DRegs.CX := Regs.CX;
  398.     DRegs.DX := Regs.DX;
  399.     case Regs.AH of
  400.       2, 3, 5 :
  401.         {Calls that use ES as a buffer segment}
  402.         begin
  403.           Base := GetSelectorBase(Regs.ES);
  404.           if (Base <= 0) or (Base > $FFFF0) then begin
  405.             Regs.Flags := 1;
  406.             Regs.AX := 1;
  407.             Exit;
  408.           end;
  409.           DRegs.ES := Base shr 4;
  410.         end;
  411.     end;
  412.     if RealIntr($13, DRegs) <> 0 then begin
  413.       Regs.Flags := 1;
  414.       Regs.AX := 1;
  415.     end else begin
  416.       Regs.Flags := DRegs.Flags;
  417.       Regs.AX := DRegs.AX;
  418.       Regs.BX := DRegs.BX; {BX is returned by GetDriveType function only}
  419.     end;
  420.  
  421. {$ELSE}
  422.     Intr($13, Regs);
  423. {$ENDIF}
  424.   end;
  425.  
  426.   function LockPhysicalVolume (Drive : DriveType;                     {!!.4}
  427.                                LockForFormatting : Boolean) : Integer;
  428.     {-Attempt to lock the physical volume for Win95 and later.}
  429.   var
  430.     Regs : Registers;
  431.   begin
  432.     fillchar(Regs,sizeof(Regs),0);
  433.     LockPhysicalVolume := 0;
  434.  
  435.     {check for Win95...not needed for other versions or Dos}
  436.     Regs.AX := $1600;
  437.     Intr($2F,Regs);
  438.     if Regs.AL < 4 then
  439.       exit;
  440.  
  441.     Regs.AX := $440D;
  442.     Regs.BH := 0;     {request level 0 lock}
  443.     Regs.BL := Drive;
  444.     Regs.CH := $08;   {diskette operation}
  445.     Regs.CL := $4B;   {subfunction 4Bh, LockPhysicalVolume}
  446.     Regs.DX := 0;     {permission}
  447.     Intr($21,Regs);
  448.     if Odd(Regs.Flags) then begin
  449.       LockPhysicalVolume := Regs.AX;
  450.       exit;
  451.     end;
  452.  
  453.     if LockForFormatting then begin
  454.       {request more restrictive level 0 lock}
  455.       Regs.AX := $440D;
  456.       Regs.BH := 0;     {request level 0 lock}
  457.       Regs.BL := Drive;
  458.       Regs.CH := $08;   {diskette operation}
  459.       Regs.CL := $4B;   {subfunction 4Bh, LockPhysicalVolume}
  460.       Regs.DX := 4;     {permission}
  461.       Intr($21,Regs);
  462.       if Odd(Regs.Flags) then begin
  463.         {remove previously placed lock}
  464.         UnlockPhysicalVolume(Drive,false);
  465.         LockPhysicalVolume := Regs.AX;
  466.       end;
  467.     end;
  468.   end;
  469.  
  470.   procedure UnlockPhysicalVolume (Drive : DriveType;                   {!!.4}
  471.                                   WasLockedForFormatting : boolean);
  472.     {-Unlock the physical volume for Win95 and later.  'WasLockedForFormatting'
  473.       must match value passed to LockPhysicalVolume call.}
  474.   var
  475.     Regs : Registers;
  476.   begin
  477.     fillchar(Regs,sizeof(Regs),0);
  478.  
  479.     {check for Win95...not needed for other versions or Dos}
  480.     Regs.AX := $1600;
  481.     Intr($2F,Regs);
  482.     if Regs.AL < 4 then
  483.       exit;
  484.  
  485.     {note : no error checking done on unlock.}
  486.     if WasLockedForFormatting then begin
  487.       {release more restrictive level 0 lock}
  488.       Regs.AX := $440D;
  489.       Regs.BH := 0;     {request level 0 lock}
  490.       Regs.BL := Drive;
  491.       Regs.CH := $08;   {diskette operation}
  492.       Regs.CL := $6B;   {subfunction 4Bh, LockPhysicalVolume}
  493.       Regs.DX := 4;     {permission}
  494.       Intr($21,Regs);
  495.     end;
  496.  
  497.     Regs.AX := $440D;
  498.     Regs.BH := 0;     {request level 0 lock}
  499.     Regs.BL := Drive;
  500.     Regs.CH := $08;   {diskette operation}
  501.     Regs.CL := $4B;   {subfunction 4Bh, LockPhysicalVolume}
  502.     Regs.DX := 0;     {permission}
  503.     Intr($21,Regs);
  504.   end;
  505.  
  506.   function GetDriveType(Drive : DriveNumber) : DriveType;
  507.   var
  508.     Regs : Registers;
  509.   begin
  510.     Regs.AH := $08;
  511.     Regs.DL := Drive;
  512.     Int13Call(Regs);
  513.     if Regs.AH = 0 then
  514.       GetDriveType := Regs.BL
  515.     else
  516.       GetDriveType := 0;
  517.   end;
  518.  
  519.   function GetDiskStatus : Byte;
  520.   var
  521.     Regs : Registers;
  522.   begin
  523.     Regs.AH := $01;
  524.     Int13Call(Regs);
  525.     GetDiskStatus := Regs.AL;
  526.   end;
  527.  
  528.   function GetStatusStr(ErrNum : Byte) : String;
  529.   var
  530.     NumStr : string[3];
  531.   begin
  532.     case ErrNum of
  533.       {Following codes are defined by the floppy BIOS}
  534.       $00 : GetStatusStr := '';
  535.       $01 : GetStatusStr := 'Invalid command';
  536.       $02 : GetStatusStr := 'Address mark not found';
  537.       $03 : GetStatusStr := 'Disk write protected';
  538.       $04 : GetStatusStr := 'Sector not found';
  539.       $06 : GetStatusStr := 'Floppy disk removed';
  540.       $08 : GetStatusStr := 'DMA overrun';
  541.       $09 : GetStatusStr := 'DMA crossed 64KB boundary';
  542.       $0C : GetStatusStr := 'Media type not found';
  543.       $10 : GetStatusStr := 'Uncorrectable CRC error';
  544.       $20 : GetStatusStr := 'Controller failed';
  545.       $40 : GetStatusStr := 'Seek failed';
  546.       $80 : GetStatusStr := 'Disk timed out';
  547.  
  548.       {Following codes are added by this unit}
  549.       $F9 : GetStatusStr := 'Volume not locked';
  550.       $FA : GetStatusStr := 'Format aborted';
  551.       $FB : GetStatusStr := 'Invalid media type';
  552.       $FC : GetStatusStr := 'Too many bad sectors';
  553.       $FD : GetStatusStr := 'Disk bad';
  554.       $FE : GetStatusStr := 'Invalid drive or type';
  555.       $FF : GetStatusStr := 'Insufficient memory';
  556.     else
  557.       Str(ErrNum, NumStr);
  558.       GetStatusStr := 'Unknown error '+NumStr;
  559.     end;
  560.   end;
  561.  
  562.   procedure ResetDrive(Drive : DriveNumber);
  563.   var
  564.     Regs : Registers;
  565.   begin
  566.     Regs.AH := $00;
  567.     Regs.DL := Drive;
  568.     Int13Call(Regs);
  569.   end;
  570.  
  571.   function AllocBuffer(var P : Pointer; Size : Word) : Boolean;
  572.   var
  573.     L : LongInt;
  574.   begin
  575. {$IFDEF pmode}
  576.     L := GlobalDosAlloc(Size);
  577.     if L <> 0 then begin
  578.       P := Ptr(Word(L and $FFFF), 0);
  579.       AllocBuffer := True;
  580.     end else begin
  581.       P := nil;
  582.       AllocBuffer := False
  583.     end;
  584. {$ELSE}
  585.     if MaxAvail >= Size then begin
  586.       GetMem(P, Size);
  587.       AllocBuffer := True;
  588.     end else begin
  589.       P := nil;
  590.       AllocBuffer := False;
  591.     end;
  592. {$ENDIF}
  593.   end;
  594.  
  595.   procedure FreeBuffer(P : Pointer; Size : Word);
  596.   begin
  597.     if P = nil then
  598.       Exit;
  599. {$IFDEF pmode}
  600.     Size := GlobalDosFree(LongInt(P) shr 16);
  601. {$ELSE}
  602.     FreeMem(P, Size);
  603. {$ENDIF}
  604.   end;
  605.  
  606.   function CheckParms(DType : DriveType; Drive : DriveNumber) : Boolean;
  607.     {-Make sure drive and type are within range}
  608.   begin
  609.     CheckParms := False;
  610.     if (DType < 1) or (DType > 4) then
  611.       Exit;
  612.     if (Drive > 7) then
  613.       Exit;
  614.     CheckParms := True;
  615.   end;
  616.  
  617.   function SubfSectors(SubFunc : Byte;
  618.                        Drive : DriveNumber;
  619.                        Track, Side, SSect, NSect : Byte;
  620.                        var Buffer) : Byte;
  621.     {-Code shared by ReadSectors, WriteSectors, VerifySectors, FormatTrack}
  622.   var
  623.     Tries : Byte;
  624.     Done : Boolean;
  625.     Regs : Registers;
  626.   begin
  627.     Tries := 1;
  628.     Done := False;
  629.     repeat
  630.       Regs.AH := SubFunc;
  631.       Regs.AL := NSect;
  632.       Regs.CH := Track;
  633.       Regs.CL := SSect;
  634.       Regs.DH := Side;
  635.       Regs.DL := Drive;
  636.       Regs.ES := Seg(Buffer);
  637.       Regs.BX := Ofs(Buffer);
  638.       Int13Call(Regs);
  639.  
  640.       if Regs.AH <> 0 then begin
  641.         ResetDrive(Drive);
  642.         Inc(Tries);
  643.         if Tries > MaxRetries then
  644.           Done := True;
  645.       end else
  646.         Done := True;
  647.     until Done;
  648.  
  649.     SubfSectors := Regs.AH;
  650.   end;
  651.  
  652.   function ReadSectorsPrim(Drive : DriveNumber;           {!!.4 - made prim}
  653.                            Track, Side, SSect, NSect : Byte;
  654.                            var Buffer) : Byte;
  655.   begin
  656.     ReadSectorsPrim := SubfSectors($02, Drive, Track, Side, SSect, NSect, Buffer);
  657.   end;
  658.  
  659.   function ReadSectors(Drive : DriveNumber;               {!!.4 - added}
  660.                        Track, Side, SSect, NSect : Byte;
  661.                        var Buffer) : Byte;
  662.   begin
  663.     if LockPhysicalVolume(Drive,false) <> 0 then begin
  664.       ReadSectors := $F9;
  665.       exit;
  666.     end;
  667.     ReadSectors := ReadSectorsPrim(Drive, Track, Side, SSect, NSect, Buffer);
  668.     UnlockPhysicalVolume(Drive,false);
  669.   end;
  670.  
  671.   function WriteSectorsPrim(Drive : DriveNumber;          {!!.4 - made prim}
  672.                             Track, Side, SSect, NSect : Byte;
  673.                             var Buffer) : Byte;
  674.   begin
  675.     WriteSectorsPrim := SubfSectors($03, Drive, Track, Side, SSect, NSect, Buffer);
  676.   end;
  677.  
  678.   function WriteSectors(Drive : DriveNumber;              {!!.4 - added vol lock}
  679.                         Track, Side, SSect, NSect : Byte;
  680.                         var Buffer) : Byte;
  681.   begin
  682.     if LockPhysicalVolume(Drive,false) <> 0 then begin
  683.       WriteSectors := $F9;
  684.       exit;
  685.     end;
  686.     WriteSectors := WriteSectorsPrim(Drive, Track, Side, SSect, NSect, Buffer);
  687.     UnlockPhysicalVolume(Drive,false);
  688.   end;
  689.  
  690.   function VerifySectorsPrim(Drive : DriveNumber;         {!!.4 - made prim}
  691.                              Track, Side, SSect, NSect : Byte) : Byte;
  692.   var
  693.     Dummy : Byte;
  694.   begin
  695.     VerifySectorsPrim := SubfSectors($04, Drive, Track, Side, SSect, NSect, Dummy);
  696.   end;
  697.  
  698.   function VerifySectors(Drive : DriveNumber;             {!!.4 - added}
  699.                          Track, Side, SSect, NSect : Byte) : Byte;
  700.   begin
  701.     if LockPhysicalVolume(Drive,false) <> 0 then begin
  702.       VerifySectors := $F9;
  703.       exit;
  704.     end;
  705.     VerifySectors := VerifySectorsPrim(Drive, Track, Side, SSect, NSect);
  706.     UnlockPhysicalVolume(Drive,false);
  707.   end;
  708.  
  709.   function SetDriveTable(DType : DriveType) : Boolean;
  710.     {-Set drive table parameters for formatting}
  711.   var
  712.     P : Pointer;
  713.     DBSeg : Word;
  714.     DBOfs : Word;
  715.   begin
  716.     SetDriveTable := False;
  717.  
  718. {$IFDEF pmode}
  719.     GetRealIntVec($1E, P);
  720.     DBSeg := GetRealSelector(P, $FFFF);
  721.     if DBSeg = 0 then
  722.       Exit;
  723.     DBOfs := 0;
  724. {$ELSE}
  725.     GetIntVec($1E, P);
  726.     DBSeg := LongInt(P) shr 16;
  727.     DBOfs := LongInt(P) and $FFFF;
  728. {$ENDIF}
  729.  
  730.     {Set gap length for formatting}
  731.     case DType of
  732.       1 : Mem[DBSeg:DBOfs+7] := $50; {360K}
  733.       2 : Mem[DBSeg:DBOfs+7] := $54; {1.2M}
  734.       3,
  735.       4 : Mem[DBSeg:DBOfs+7] := $6C; {720K or 1.44M}
  736.     end;
  737.  
  738.     {Set max sectors/track}
  739.     Mem[DBSeg:DBOfs+4] := DData[DType].SPT;
  740.  
  741. {$IFDEF pmode}
  742.     DBSeg := FreeSelector(DBSeg);
  743. {$ENDIF}
  744.  
  745.     SetDriveTable := True;
  746.   end;
  747.  
  748.   function GetMachineID : Byte;
  749.     {-Return machine ID code}
  750. {$IFDEF pmode}
  751.   var
  752.     SegFFFF : Word;
  753. {$ENDIF}
  754.   begin
  755. {$IFDEF pmode}
  756.     SegFFFF := GetRealSelector(Ptr($FFFF, $0000), $FFFF);
  757.     if SegFFFF = 0 then
  758.       GetMachineID := 0
  759.     else begin
  760.       GetMachineID := Mem[SegFFFF:$000E];
  761.       SegFFFF := FreeSelector(SegFFFF);
  762.     end;
  763. {$ELSE}
  764.     GetMachineID := Mem[$FFFF:$000E];
  765. {$ENDIF}
  766.   end;
  767.  
  768.   function IsATMachine : Boolean;
  769.     {-Return True if AT or better machine}
  770.   begin
  771.     IsATMachine := False;
  772.     if Lo(DosVersion) >= 3 then
  773.       case GetMachineId of
  774.         $FC, $F8 :  {AT or PS/2}
  775.           IsATMachine := True;
  776.       end;
  777.   end;
  778.  
  779.   function GetChangeLineType(Drive : DriveNumber; var CLT : Byte) : Byte;
  780.     {-Return change line type of drive}
  781.   var
  782.     Regs : Registers;
  783.   begin
  784.     Regs.AH := $15;
  785.     Regs.DL := Drive;
  786.     Int13Call(Regs);
  787.     if (Regs.Flags and FCarry) <> 0 then begin
  788.       GetChangeLineType := Regs.AH;
  789.       CLT := 0;
  790.     end else begin
  791.       GetChangeLineType := 0;
  792.       CLT := Regs.AH;
  793.     end;
  794.   end;
  795.  
  796.   function SetFloppyType(Drive : DriveNumber; FType : Byte) : Byte;
  797.     {-Set floppy type for formatting}
  798.   var
  799.     Tries : Byte;
  800.     Done : Boolean;
  801.     Regs : Registers;
  802.   begin
  803.     Tries := 1;
  804.     Done := False;
  805.     repeat
  806.       Regs.AH := $17;
  807.       Regs.AL := FType;
  808.       Regs.DL := Drive;
  809.       Int13Call(Regs);
  810.       if Regs.AH <> 0 then begin
  811.         ResetDrive(Drive);
  812.         Inc(Tries);
  813.         if Tries > MaxRetries then
  814.           Done := True;
  815.       end else
  816.         Done := True;
  817.     until Done;
  818.  
  819.     SetFloppyType := Regs.AH;
  820.   end;
  821.  
  822.   function SetMediaType(Drive : DriveType; TPD : Byte; SPT : Byte) : Byte;
  823.     {-Set media type for formatting}
  824.   var
  825.     Regs : Registers;
  826.   begin
  827.     Regs.AH := $18;
  828.     Regs.DL := Drive;
  829.     Regs.CH := TPD;
  830.     Regs.CL := SPT;
  831.     Int13Call(Regs);
  832.     SetMediaType := Regs.AH;
  833.   end;
  834.  
  835.   function FormatDisk(Drive : DriveNumber; DType : DriveType;
  836.                       Verify : Boolean; MaxBadSects : Byte;
  837.                       VLabel : VolumeStr;
  838.                       FAF : FormatAbortFunc) : Byte;
  839.   label
  840.     ExitPoint;
  841.   type
  842.     CHRNRec =
  843.       record
  844.         CTrack : Byte;            {Track  0..?}
  845.         CSide : Byte;             {Side   0..1}
  846.         CSect : Byte;             {Sector 1..?}
  847.         CSize : Byte;             {Size   0..?}
  848.       end;
  849.     CHRNArray = array[1..18] of CHRNRec;
  850.     FATArray = array[0..4607] of Byte;
  851.   var
  852.     Tries : Byte;
  853.     Track : Byte;
  854.     Side : Byte;
  855.     Sector : Byte;
  856.     SecWritten : Byte;
  857.     SecRsvd : Byte;
  858.     FatNum : Byte;
  859.     BadSects : Byte;
  860.     ChangeLine : Byte;
  861.     DiskType : Byte;
  862.     Status : Byte;
  863.     SaveMaxRetries : Byte;
  864.     VLabelI : Byte;
  865.     Done : Boolean;
  866.     SecNum : Word;
  867.     Trash : Word;
  868.     DT : DateTime;
  869.     VDate : LongInt;
  870.     Regs : Registers;
  871.     BootPtr : ^SectorArray;
  872.     CHRN : ^CHRNArray;
  873.     FATs : ^FATArray;
  874.     VolumeLockAcquired : boolean;
  875.  
  876.     procedure MarkBadSector(SecNum : Word);
  877.       {-Assumes SecNum > SecRsvd}
  878.     const
  879.       BadMark = $FF7;             {Bad cluster mark}
  880.     var
  881.       ClusNum : Word;             {Cluster number}
  882.       FOfs : Word;                {Offset into fat for this cluster}
  883.       FVal : Word;                {FAT value for this cluster}
  884.       OFVal : Word;               {Old FAT value for this cluster}
  885.     begin
  886.       ClusNum := ((SecNum-SecRsvd) div DData[DType].BRD[0])+2;
  887.       FOfs := (ClusNum*3) div 2;
  888.       Move(FATs^[FOfs], FVal, 2);
  889.       if Odd(ClusNum) then
  890.         OFVal := (FVal and (BadMark shl 4))
  891.       else
  892.         OFVal := (FVal and BadMark);
  893.       if OFVal = 0 then begin
  894.         {Not already marked bad, mark it}
  895.         if Odd(ClusNum) then
  896.           FVal := (FVal or (BadMark shl 4))
  897.         else
  898.           FVal := (FVal or BadMark);
  899.         Move(FVal, FATs^[FOfs], 2);
  900.         {Add to bad sector count}
  901.         if MaxBadSects <> 0 then
  902.           Inc(BadSects, DData[DType].BRD[0]);
  903.       end;
  904.     end;
  905.  
  906.   begin
  907.     {Validate parameters. Can't do anything unless these are reasonable}
  908.     if not CheckParms(DType, Drive) then
  909.       Exit;
  910.  
  911.     {Initialize buffer pointers in case of failure}
  912.     FATs := nil;
  913.     CHRN := nil;
  914.     BootPtr := nil;
  915.  
  916.     {Status proc: starting format}
  917.     if FAF(0, DData[DType].TPD, 0) then begin
  918.       Status := $FA;
  919.       goto ExitPoint;
  920.     end;
  921.  
  922.     {Error code for invalid drive or media type}
  923.     Status := $FE;
  924.  
  925.     case GetDriveType(Drive) of
  926.       1 : {360K drive formats only 360K disks}
  927.         if DType <> 1 then
  928.           goto ExitPoint;
  929.       2 : {1.2M drive formats 360K or 1.2M disk}
  930.         if DType > 2 then
  931.           goto ExitPoint;
  932.       3 : {720K drive formats only 720K disks}
  933.         if DType <> 3 then
  934.           goto ExitPoint;
  935.       4 : {1.44M drive formats 720K or 1.44M disks}
  936.         if Dtype < 3 then
  937.           goto ExitPoint;
  938.     else
  939.       goto ExitPoint;
  940.     end;
  941.  
  942.     {Error code for out-of-memory or DPMI error}
  943.     Status := $FF;
  944.  
  945.     {Allocate buffers}
  946.     if not AllocBuffer(Pointer(FATs), SizeOf(FATArray)) then
  947.       goto ExitPoint;
  948.     if not AllocBuffer(Pointer(CHRN), SizeOf(CHRNArray)) then
  949.       goto ExitPoint;
  950.     if not AllocBuffer(Pointer(BootPtr), SizeOf(BootRecord)) then
  951.       goto ExitPoint;
  952.  
  953.     {Initialize boot record}
  954.     Move(BootRecord, BootPtr^, SizeOf(BootRecord));
  955.     Move(DData[DType].BRD, BootPtr^[13], 14);
  956.  
  957.     {Initialize the FAT table}
  958.     FillChar(FATs^, SizeOf(FATArray), 0);
  959.     FATs^[0] := DData[DType].FID;
  960.     FATs^[1] := $FF;
  961.     FATs^[2] := $FF;
  962.  
  963.     {Set drive table parameters by patching drive table in memory}
  964.     if not SetDriveTable(DType) then
  965.       goto ExitPoint;
  966.  
  967.     {On AT class machines, set format parameters via BIOS}
  968.     if IsATMachine then begin
  969.       {Get change line type: 1 -> 360K drive, 2 -> 1.2M or 3.5" drive}
  970.       Status := GetChangeLineType(Drive, ChangeLine);
  971.       if Status <> 0 then
  972.         goto ExitPoint;
  973.       if (ChangeLine < 1) or (ChangeLine > 2) then begin
  974.         Status := 1;
  975.         goto ExitPoint;
  976.       end;
  977.  
  978.       {Determine floppy type for SetFloppyType call}
  979.       DiskType := MediaArray[DType, ChangeLine];
  980.       if DiskType = 0 then begin
  981.         Status := $FB;
  982.         goto ExitPoint;
  983.       end;
  984.  
  985.       VolumeLockAcquired := true;                           {!!.4}
  986.       Status := LockPhysicalVolume(Drive,true);             {!!.4}
  987.       if Status <> 0 then begin                             {!!.4}
  988.         Status := $F9;                                      {!!.4}
  989.         VolumeLockAcquired := false;                        {!!.4}
  990.         goto ExitPoint;                                     {!!.4}
  991.       end;                                                  {!!.4}
  992.  
  993. (* function 17h appears to always fail under Win95          {!!.4}
  994.    and seems to be able to always be replaced by following
  995.    call to function 18h.
  996.       {Set floppy type for drive}
  997.       Status := SetFloppyType(Drive, DiskType);
  998.       if Status <> 0 then
  999.         goto ExitPoint;
  1000. *)
  1001.  
  1002.       {Set media type for format}
  1003.       Status := SetMediaType(Drive, DData[DType].TPD, DData[DType].SPT);
  1004.       if Status <> 0 then
  1005.         goto ExitPoint;
  1006.     end;
  1007.  
  1008.     {Format each sector}
  1009.     ResetDrive(Drive);
  1010.     BadSects := 0;
  1011.     SecRsvd := (2*DData[DType].SPF)+DData[DType].DSC+2;
  1012.     SaveMaxRetries := MaxRetries;
  1013.  
  1014.     for Track := 0 to DData[DType].TPD do begin
  1015.       {Status proc: formatting track}
  1016.       if FAF(Track, DData[DType].TPD, 1) then begin
  1017.         Status := $FA;
  1018.         goto ExitPoint;
  1019.       end;
  1020.  
  1021.       for Side := 0 to 1 do begin
  1022.         {Initialize CHRN for this sector}
  1023.         for Sector := 1 to DData[DType].SPT do
  1024.           with CHRN^[Sector] do begin
  1025.             CTrack := Track;
  1026.             CSide := Side;
  1027.             CSect := Sector;
  1028.             CSize := DData[DType].SSZ;
  1029.           end;
  1030.  
  1031.         {Format this sector, with retries}
  1032.         Status := SubfSectors($05, Drive, Track, Side,
  1033.                               1, DData[DType].SPT, CHRN^);
  1034.         if Status <> 0 then
  1035.           goto ExitPoint;
  1036.       end;
  1037.  
  1038.       if Verify then begin
  1039.         {Status proc: verifying track}
  1040.         if FAF(Track, DData[DType].TPD, 2) then begin
  1041.           Status := $FA;
  1042.           goto ExitPoint;
  1043.         end;
  1044.  
  1045.         for Side := 0 to 1 do
  1046.           {Verify the entire track}
  1047.           if VerifySectorsPrim(Drive, Track, Side,                        {!!.4}
  1048.                                1, DData[DType].SPT) <> 0 then begin
  1049.             {Mark bad sectors}
  1050.             MaxRetries := 1;
  1051.             for Sector := 1 to DData[DType].SPT do begin
  1052.               Status := VerifySectorsPrim(Drive, Track, Side, Sector, 1); {!!.4}
  1053.               if Status <> 0 then begin
  1054.                 SecNum := (Word(2)*Track+Side)*DData[DType].SPT+Sector;
  1055. {$IFDEF Debug}
  1056.                 writeln(^M^J'Track=',Track,
  1057.                         ' Side=',Side,
  1058.                         ' Sector=',Sector,
  1059.                         ' SecNum=',SecNum,
  1060.                         ' Status=',Status);
  1061. {$ENDIF}
  1062.                 if SecNum <= SecRsvd then begin
  1063.                   {No errors allowed in boot sect, FATs, or dir: Disk bad}
  1064.                   Status := $FD;
  1065.                   MaxRetries := SaveMaxRetries;
  1066.                   goto ExitPoint;
  1067.                 end;
  1068.                 MarkBadSector(SecNum);
  1069.                 if BadSects > MaxBadSects then begin
  1070.                   Status := $FC;
  1071.                   MaxRetries := SaveMaxRetries;
  1072.                   goto ExitPoint;
  1073.                 end;
  1074.               end;
  1075.             end;
  1076.             MaxRetries := SaveMaxRetries;
  1077.           end;
  1078.       end;
  1079.     end;
  1080.  
  1081.     {Status proc: writing boot and FAT}
  1082.     if FAF(0, DData[DType].TPD, 3) then begin
  1083.       Status := $FA;
  1084.       goto ExitPoint;
  1085.     end;
  1086.  
  1087.     {Write boot record}
  1088.     Status := WriteSectorsPrim(Drive, 0, 0, 1, 1, BootPtr^);              {!!.4}
  1089.     if Status <> 0 then begin
  1090.       Status := $FD;
  1091.       goto ExitPoint;
  1092.     end;
  1093.  
  1094.     {Write FATs and volume label}
  1095.     Track := 0;
  1096.     Side := 0;
  1097.     Sector := 2;
  1098.     FatNum := 0;
  1099.     for SecWritten := 0 to SecRsvd-3 do begin
  1100.       if Sector > DData[DType].SPT then begin
  1101.         Sector := 1;
  1102.         Inc(Side);
  1103.       end;
  1104.  
  1105.       if SecWritten < (2*DData[DType].SPF) then begin
  1106.         if FatNum > DData[DType].SPF-1 then
  1107.           FatNum := 0;
  1108.       end else begin
  1109.         FillChar(FATs^, 512, 0);
  1110.         if ((VLabel <> '') and (SecWritten = 2*DData[DType].SPF)) then begin
  1111.           {Put in volume label}
  1112.           for VLabelI := 1 to Length(VLabel) do
  1113.             VLabel[VLabelI] := Upcase(VLabel[VLabelI]);
  1114.           while Length(VLabel) < 11 do
  1115.             VLabel := VLabel+' ';
  1116.           Move(VLabel[1], FATs^, 11);
  1117.           FATs^[11] := 8;
  1118.           GetDate(DT.Year, DT.Month, DT.Day, Trash);
  1119.           GetTime(DT.Hour, DT.Min, DT.Sec, Trash);
  1120.           PackTime(DT, VDate);
  1121.           Move(VDate, FATs^[22], 4);
  1122.         end;
  1123.         FatNum := 0;
  1124.       end;
  1125.  
  1126.       if WriteSectorsPrim(Drive, Track, Side,                             {!!.4}
  1127.                           Sector, 1, FATs^[FatNum*512]) <> 0 then begin
  1128.         Status := $FD;
  1129.         goto ExitPoint;
  1130.       end;
  1131.  
  1132.       Inc(Sector);
  1133.       Inc(FatNum);
  1134.     end;
  1135.  
  1136.     {Success}
  1137.     Status := 0;
  1138.  
  1139. ExitPoint:
  1140.     if VolumeLockAcquired then                            {!!.4}
  1141.       UnlockPhysicalVolume(Drive,true);                   {!!.4}
  1142.  
  1143.     FreeBuffer(BootPtr, SizeOf(BootRecord));
  1144.     FreeBuffer(CHRN, SizeOf(CHRNArray));
  1145.     FreeBuffer(FATs, SizeOf(FATArray));
  1146.  
  1147.     {Status proc: ending format}
  1148.     Done := FAF(Status, DData[DType].TPD, 4);
  1149.     FormatDisk := Status;
  1150.   end;
  1151.  
  1152.   function EmptyAbortFunc(Track, MaxTrack : Byte; Kind : Byte) : Boolean;
  1153.   begin
  1154.     EmptyAbortFunc := False;
  1155.   end;
  1156.  
  1157. end.
  1158.