Contributor: HENNING JORGENSEN
{$R-,S-,I-,B-,F-,O+}
{---------------------------------------------------------
BIOS disk I/O routines for floppy drives. Supports DOS
real mode, DOS protected mode, and Windows. Requires
TP6, TPW, or BP7.
All functions are for floppy disks only; no hard drives.
See the individual types and functions in the interface of
this unit for more information. See the FMT.PAS sample
program for an example of formatting disks.
For status code definitions, see the implementation of
function GetStatusStr.
---------------------------------------------------------
Based on a unit provided by Henning Jorgensen of Denmark.
Modified and cleaned up by TurboPower Software for pmode
and Windows operation.
TurboPower Software
P.O. Box 49009
Colorado Springs, CO 80949-9009
CompuServe: 76004,2611
Version 1.0 10/25/93
Version 1.1 10/29/93
fix a dumb bug in the MediaArray check
---------------------------------------------------------}
unit BDisk;
{-BIOS disk I/O routines for floppy drives}
interface
const
MaxRetries : Byte = 3; {Number of automatic retries for
read, write, verify, format}
type
DriveNumber = 0..7; {Acceptable floppy drive numbers}
{Generally, 0 = A, 1 = B}
DriveType = 0..4; {Floppy drive or disk types}
{0 = unknown or error
1 = 360K
2 = 1.2M
3 = 720K
4 = 1.44M}
VolumeStr = String[11]; {String for volume labels}
FormatAbortFunc = {Prototype for format abort func}
function (Track : Byte; {Track number being formatted, 0..MaxTrack}
MaxTrack : Byte; {Maximum track number for this format}
Kind : Byte {0 = format beginning}
{1 = formatting Track}
{2 = verifying Track}
{3 = writing boot and FAT}
{4 = format ending, Track = format status}
) : Boolean; {Return True to abort format}
procedure ResetDrive(Drive : DriveNumber);
{-Reset drive system (function $00). Call after any other
disk function fails}
function GetDiskStatus : Byte;
{-Get status of last int $13 operation (function $01)}
function GetStatusStr(ErrNum : Byte) : String;
{-Return message string for any of the status codes used by
this unit.}
function GetDriveType(Drive : DriveNumber) : DriveType;
{-Get drive type (function $08). Note that this returns the
type of the *drive*, not the type of the diskette in it.
GetDriveType returns 0 for an invalid drive.}
function AllocBuffer(var P : Pointer; Size : Word) : Boolean;
{-Allocate a buffer useable in real and protected mode.
Buffers passed to ReadSectors and WriteSectors in pmode
*MUST* be allocated by using this function. AllocBuffer returns
False if sufficient memory is not available. P is also set to
nil in that case.}
procedure FreeBuffer(P : Pointer; Size : Word);
{-Free buffer allocated by AllocBuffer. Size must match the
size originally passed to AllocBuffer. FreeBuffer does
nothing if P is nil.}
function ReadSectors(Drive : DriveNumber;
Track, Side, SSect, NSect : Byte;
var Buffer) : Byte;
{-Read absolute disk sectors (function $02). Track, Side,
and SSect specify the location of the first sector to
read. NSect is the number of sectors to read. Buffer
must be large enough to hold these sectors. ReadSectors
returns a status code, 0 for success.}
function WriteSectors(Drive : DriveNumber;
Track, Side, SSect, NSect : Byte;
var Buffer) : Byte;
{-Write absolute disk sectors (function $03). Track, Side,
and SSect specify the location of the first sector to
write. NSect is the number of sectors to write. Buffer
must contain all the data to write. WriteSectors
returns a status code, 0 for success.}
function VerifySectors(Drive : DriveNumber;
Track, Side, SSect, NSect : Byte) : Byte;
{-Verify absolute disk sectors (function $04). This
tests a computed CRC with the CRC stored along with the
sector. Track, Side, and SSect specify the location of
the first sector to verify. NSect is the number of
sectors to verify. VerifySectors returns a status code,
0 for success. Don't call VerifySectors on PC/XTs and
PC/ATs with a BIOS from 1985. It will overwrite the
stack.}
function FormatDisk(Drive : DriveNumber; DType : DriveType;
Verify : Boolean; MaxBadSects : Byte;
VLabel : VolumeStr;
FAF : FormatAbortFunc) : Byte;
{-Format drive that contains a disk of type DType. If Verify
is True, each track is verified after it is formatted.
MaxBadSects specifies the number of sectors that can be
bad before the format is halted. If VLabel is not an
empty string, FormatDisk puts the BIOS-level volume
label onto the diskette. It does *not* add a DOS-level
volume label. FAF is a user function hook that can be
used to display status during the format, and to abort
the format if the user so chooses. Parameters passed to
this function are described in FormatAbortFunc above.
FormatDisk also writes a boot sector and empty File
Allocation Tables for the disk. FormatDisk returns a
status code, 0 for success.}
function EmptyAbortFunc(Track : Byte; MaxTrack : Byte; Kind : Byte) : Boolean;
{-Do-nothing abort function for FormatDisk}
{========================================================================}
implementation
uses
{$IFDEF DPMI}
WinApi,
Dos;
{$DEFINE pmode}
{$ELSE}
{$IFDEF Windows}
WinApi,
WinDos;
{$DEFINE pmode}
{$ELSE}
Dos;
{$UNDEF pmode}
{$ENDIF}
{$ENDIF}
{$IFDEF Windows}
type
Registers = TRegisters;
DateTime = TDateTime;
{$ENDIF}
type
DiskRec =
record
SSZ : Byte; {Sector size}
SPT : Byte; {Sectors/track}
TPD : Byte; {Tracks/disk}
SPF : Byte; {Sectors/FAT}
DSC : Byte; {Directory sectors}
FID : Byte; {Format id for FAT}
BRD : array[0..13] of Byte; {Variable boot record data}
end;
DiskRecs = array[1..4] of DiskRec;
SectorArray = array[0..511] of Byte;
const
DData : DiskRecs = {BRD starts at offset 13 of FAT}
((SSZ : $02; SPT : $09; TPD : $27; SPF : $02; DSC : $07; FID : $FD; {5.25" - 360K}
BRD : ($02, $01, $00, $02, $70, $00, $D0, $02, $FD, $02, $00, $09, $00, $02)),
(SSZ : $02; SPT : $0F; TPD : $4F; SPF : $07; DSC : $0E; FID : $F9; {5.25" - 1.2M}
BRD : ($01, $01, $00, $02, $E0, $00, $60, $09, $F9, $07, $00, $0F, $00, $02)),
(SSZ : $02; SPT : $09; TPD : $4F; SPF : $03; DSC : $07; FID : $F9; {3.50" - 720K}
BRD : ($02, $01, $00, $02, $70, $00, $A0, $05, $F9, $03, $00, $09, $00, $02)),
(SSZ : $02; SPT : $12; TPD : $4F; SPF : $09; DSC : $0E; FID : $F0; {3.50" - 1.44M}
BRD : ($01, $01, $00, $02, $E0, $00, $40, $0B, $F0, $09, $00, $12, $00, $02)));
BootRecord : SectorArray = {Standard boot program}
($EB, $34, $90, $41, $4D, $53, $54, $20, $33, $2E, $30, $00, $02, $01, $01, $00, $02, $E0, $00, $40, $0B, $F0, $09, $00,
$12, $00, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $12,
$00, $00, $00, $00, $01, $00, $FA, $33, $C0, $8E, $D0, $BC, $00, $7C, $16, $07, $BB, $78, $00, $36, $C5, $37, $1E, $56,
$16, $53, $BF, $2B, $7C, $B9, $0B, $00, $FC, $AC, $26, $80, $3D, $00, $74, $03, $26, $8A, $05, $AA, $8A, $C4, $E2, $F1,
$06, $1F, $89, $47, $02, $C7, $07, $2B, $7C, $FB, $CD, $13, $72, $67, $A0, $10, $7C, $98, $F7, $26, $16, $7C, $03, $06,
$1C, $7C, $03, $06, $0E, $7C, $A3, $3F, $7C, $A3, $37, $7C, $B8, $20, $00, $F7, $26, $11, $7C, $8B, $1E, $0B, $7C, $03,
$C3, $48, $F7, $F3, $01, $06, $37, $7C, $BB, $00, $05, $A1, $3F, $7C, $E8, $9F, $00, $B8, $01, $02, $E8, $B3, $00, $72,
$19, $8B, $FB, $B9, $0B, $00, $BE, $D6, $7D, $F3, $A6, $75, $0D, $8D, $7F, $20, $BE, $E1, $7D, $B9, $0B, $00, $F3, $A6,
$74, $18, $BE, $77, $7D, $E8, $6A, $00, $32, $E4, $CD, $16, $5E, $1F, $8F, $04, $8F, $44, $02, $CD, $19, $BE, $C0, $7D,
$EB, $EB, $A1, $1C, $05, $33, $D2, $F7, $36, $0B, $7C, $FE, $C0, $A2, $3C, $7C, $A1, $37, $7C, $A3, $3D, $7C, $BB, $00,
$07, $A1, $37, $7C, $E8, $49, $00, $A1, $18, $7C, $2A, $06, $3B, $7C, $40, $38, $06, $3C, $7C, $73, $03, $A0, $3C, $7C,
$50, $E8, $4E, $00, $58, $72, $C6, $28, $06, $3C, $7C, $74, $0C, $01, $06, $37, $7C, $F7, $26, $0B, $7C, $03, $D8, $EB,
$D0, $8A, $2E, $15, $7C, $8A, $16, $FD, $7D, $8B, $1E, $3D, $7C, $EA, $00, $00, $70, $00, $AC, $0A, $C0, $74, $22, $B4,
$0E, $BB, $07, $00, $CD, $10, $EB, $F2, $33, $D2, $F7, $36, $18, $7C, $FE, $C2, $88, $16, $3B, $7C, $33, $D2, $F7, $36,
$1A, $7C, $88, $16, $2A, $7C, $A3, $39, $7C, $C3, $B4, $02, $8B, $16, $39, $7C, $B1, $06, $D2, $E6, $0A, $36, $3B, $7C,
$8B, $CA, $86, $E9, $8A, $16, $FD, $7D, $8A, $36, $2A, $7C, $CD, $13, $C3, $0D, $0A, $4E, $6F, $6E, $2D, $53, $79, $73,
$74, $65, $6D, $20, $64, $69, $73, $6B, $20, $6F, $72, $20, $64, $69, $73, $6B, $20, $65, $72, $72, $6F, $72, $0D, $0A,
$52, $65, $70, $6C, $61, $63, $65, $20, $61, $6E, $64, $20, $73, $74, $72, $69, $6B, $65, $20, $61, $6E, $79, $20, $6B,
$65, $79, $20, $77, $68, $65, $6E, $20, $72, $65, $61, $64, $79, $0D, $0A, $00, $0D, $0A, $44, $69, $73, $6B, $20, $42,
$6F, $6F, $74, $20, $66, $61, $69, $6C, $75, $72, $65, $0D, $0A, $00, $49, $4F, $20, $20, $20, $20, $20, $20, $53, $59,
$53, $4D, $53, $44, $4F, $53, $20, $20, $20, $53, $59, $53, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $55, $AA);
MediaArray : array[DriveType, 1..2] of Byte =
(($00, $00), {Unknown disk}
($01, $02), {360K disk}
($00, $03), {1.2M disk}
($00, $04), {720K disk}
($00, $04)); {1.44M disk}
{$IFDEF pmode}
type
DPMIRegisters =
record
DI : LongInt;
SI : LongInt;
BP : LongInt;
Reserved : LongInt;
BX : LongInt;
DX : LongInt;
CX : LongInt;
AX : LongInt;
Flags : Word;
ES : Word;
DS : Word;
FS : Word;
GS : Word;
IP : Word;
CS : Word;
SP : Word;
SS : Word;
end;
function GetRealSelector(RealPtr : Pointer; Limit : Word) : Word;
{-Set up a selector to point to RealPtr memory}
type
OS =
record
O, S : Word;
end;
var
Status : Word;
Selector : Word;
Base : LongInt;
begin
GetRealSelector := 0;
Selector := AllocSelector(0);
if Selector = 0 then
Exit;
{Assure a read/write selector}
Status := ChangeSelector(CSeg, Selector);
Base := (LongInt(OS(RealPtr).S) shl 4)+LongInt(OS(RealPtr).O);
if SetSelectorBase(Selector, Base) = 0 then begin
Selector := FreeSelector(Selector);
Exit;
end;
Status := SetSelectorLimit(Selector, Limit);
GetRealSelector := Selector;
end;
procedure GetRealIntVec(IntNo : Byte; var Vector : Pointer); Assembler;
asm
mov ax,0200h
mov bl,IntNo
int 31h
les di,Vector
mov word ptr es:[di],dx
mov word ptr es:[di+2],cx
end;
function RealIntr(IntNo : Byte; var Regs : DPMIRegisters) : Word; Assembler;
asm
xor bx,bx
mov bl,IntNo
xor cx,cx {StackWords = 0}
les di,Regs
mov ax,0300h
int 31h
jc @@ExitPoint
xor ax,ax
@@ExitPoint:
end;
{$ENDIF}
procedure Int13Call(var Regs : Registers);
{-Call int $13 for real or protected mode}
{$IFDEF pmode}
var
Base : LongInt;
DRegs : DPMIRegisters;
{$ENDIF}
begin
{$IFDEF pmode}
{This pmode code is valid only for the AH values used in this unit}
FillChar(DRegs, SizeOf(DPMIRegisters), 0);
DRegs.AX := Regs.AX;
DRegs.BX := Regs.BX;
DRegs.CX := Regs.CX;
DRegs.DX := Regs.DX;
case Regs.AH of
2, 3, 5 :
{Calls that use ES as a buffer segment}
begin
Base := GetSelectorBase(Regs.ES);
if (Base <= 0) or (Base > $FFFF0) then begin
Regs.Flags := 1;
Regs.AX := 1;
Exit;
end;
DRegs.ES := Base shr 4;
end;
end;
if RealIntr($13, DRegs) <> 0 then begin
Regs.Flags := 1;
Regs.AX := 1;
end else begin
Regs.Flags := DRegs.Flags;
Regs.AX := DRegs.AX;
Regs.BX := DRegs.BX; {BX is returned by GetDriveType function only}
end;
{$ELSE}
Intr($13, Regs);
{$ENDIF}
end;
function GetDriveType(Drive : DriveNumber) : DriveType;
var
Regs : Registers;
begin
Regs.AH := $08;
Regs.DL := Drive;
Int13Call(Regs);
if Regs.AH = 0 then
GetDriveType := Regs.BL
else
GetDriveType := 0;
end;
function GetDiskStatus : Byte;
var
Regs : Registers;
begin
Regs.AH := $01;
Int13Call(Regs);
GetDiskStatus := Regs.AL;
end;
function GetStatusStr(ErrNum : Byte) : String;
var
NumStr : string[3];
begin
case ErrNum of
{Following codes are defined by the floppy BIOS}
$00 : GetStatusStr := '';
$01 : GetStatusStr := 'Invalid command';
$02 : GetStatusStr := 'Address mark not found';
$03 : GetStatusStr := 'Disk write protected';
$04 : GetStatusStr := 'Sector not found';
$06 : GetStatusStr := 'Floppy disk removed';
$08 : GetStatusStr := 'DMA overrun';
$09 : GetStatusStr := 'DMA crossed 64KB boundary';
$0C : GetStatusStr := 'Media type not found';
$10 : GetStatusStr := 'Uncorrectable CRC error';
$20 : GetStatusStr := 'Controller failed';
$40 : GetStatusStr := 'Seek failed';
$80 : GetStatusStr := 'Disk timed out';
{Following codes are added by this unit}
$FA : GetStatusStr := 'Format aborted';
$FB : GetStatusStr := 'Invalid media type';
$FC : GetStatusStr := 'Too many bad sectors';
$FD : GetStatusStr := 'Disk bad';
$FE : GetStatusStr := 'Invalid drive or type';
$FF : GetStatusStr := 'Insufficient memory';
else
Str(ErrNum, NumStr);
GetStatusStr := 'Unknown error '+NumStr;
end;
end;
procedure ResetDrive(Drive : DriveNumber);
var
Regs : Registers;
begin
Regs.AH := $00;
Regs.DL := Drive;
Int13Call(Regs);
end;
function AllocBuffer(var P : Pointer; Size : Word) : Boolean;
var
L : LongInt;
begin
{$IFDEF pmode}
L := GlobalDosAlloc(Size);
if L <> 0 then begin
P := Ptr(Word(L and $FFFF), 0);
AllocBuffer := True;
end else begin
P := nil;
AllocBuffer := False
end;
{$ELSE}
if MaxAvail >= Size then begin
GetMem(P, Size);
AllocBuffer := True;
end else begin
P := nil;
AllocBuffer := False;
end;
{$ENDIF}
end;
procedure FreeBuffer(P : Pointer; Size : Word);
begin
if P = nil then
Exit;
{$IFDEF pmode}
Size := GlobalDosFree(LongInt(P) shr 16);
{$ELSE}
FreeMem(P, Size);
{$ENDIF}
end;
function CheckParms(DType : DriveType; Drive : DriveNumber) : Boolean;
{-Make sure drive and type are within range}
begin
CheckParms := False;
if (DType < 1) or (DType > 4) then
Exit;
if (Drive > 7) then
Exit;
CheckParms := True;
end;
function SubfSectors(SubFunc : Byte;
Drive : DriveNumber;
Track, Side, SSect, NSect : Byte;
var Buffer) : Byte;
{-Code shared by ReadSectors, WriteSectors, VerifySectors, FormatTrack}
var
Tries : Byte;
Done : Boolean;
Regs : Registers;
begin
Tries := 1;
Done := False;
repeat
Regs.AH := SubFunc;
Regs.AL := NSect;
Regs.CH := Track;
Regs.CL := SSect;
Regs.DH := Side;
Regs.DL := Drive;
Regs.ES := Seg(Buffer);
Regs.BX := Ofs(Buffer);
Int13Call(Regs);
if Regs.AH <> 0 then begin
ResetDrive(Drive);
Inc(Tries);
if Tries > MaxRetries then
Done := True;
end else
Done := True;
until Done;
SubfSectors := Regs.AH;
end;
function ReadSectors(Drive : DriveNumber;
Track, Side, SSect, NSect : Byte;
var Buffer) : Byte;
begin
ReadSectors := SubfSectors($02, Drive, Track, Side, SSect, NSect, Buffer);
end;
function WriteSectors(Drive : DriveNumber;
Track, Side, SSect, NSect : Byte;
var Buffer) : Byte;
begin
WriteSectors := SubfSectors($03, Drive, Track, Side, SSect, NSect, Buffer);
end;
function VerifySectors(Drive : DriveNumber;
Track, Side, SSect, NSect : Byte) : Byte;
var
Dummy : Byte;
begin
VerifySectors := SubfSectors($04, Drive, Track, Side, SSect, NSect, Dummy);
end;
function SetDriveTable(DType : DriveType) : Boolean;
{-Set drive table parameters for formatting}
var
P : Pointer;
DBSeg : Word;
DBOfs : Word;
begin
SetDriveTable := False;
{$IFDEF pmode}
GetRealIntVec($1E, P);
DBSeg := GetRealSelector(P, $FFFF);
if DBSeg = 0 then
Exit;
DBOfs := 0;
{$ELSE}
GetIntVec($1E, P);
DBSeg := LongInt(P) shr 16;
DBOfs := LongInt(P) and $FFFF;
{$ENDIF}
{Set gap length for formatting}
case DType of
1 : Mem[DBSeg:DBOfs+7] := $50; {360K}
2 : Mem[DBSeg:DBOfs+7] := $54; {1.2M}
3,
4 : Mem[DBSeg:DBOfs+7] := $6C; {720K or 1.44M}
end;
{Set max sectors/track}
Mem[DBSeg:DBOfs+4] := DData[DType].SPT;
{$IFDEF pmode}
DBSeg := FreeSelector(DBSeg);
{$ENDIF}
SetDriveTable := True;
end;
function GetMachineID : Byte;
{-Return machine ID code}
{$IFDEF pmode}
var
SegFFFF : Word;
{$ENDIF}
begin
{$IFDEF pmode}
SegFFFF := GetRealSelector(Ptr($FFFF, $0000), $FFFF);
if SegFFFF = 0 then
GetMachineID := 0
else begin
GetMachineID := Mem[SegFFFF:$000E];
SegFFFF := FreeSelector(SegFFFF);
end;
{$ELSE}
GetMachineID := Mem[$FFFF:$000E];
{$ENDIF}
end;
function IsATMachine : Boolean;
{-Return True if AT or better machine}
begin
IsATMachine := False;
if Lo(DosVersion) >= 3 then
case GetMachineId of
$FC, $F8 : {AT or PS/2}
IsATMachine := True;
end;
end;
function GetChangeLineType(Drive : DriveNumber; var CLT : Byte) : Byte;
{-Return change line type of drive}
var
Regs : Registers;
begin
Regs.AH := $15;
Regs.DL := Drive;
Int13Call(Regs);
if (Regs.Flags and FCarry) <> 0 then begin
GetChangeLineType := Regs.AH;
CLT := 0;
end else begin
GetChangeLineType := 0;
CLT := Regs.AH;
end;
end;
function SetFloppyType(Drive : DriveNumber; FType : Byte) : Byte;
{-Set floppy type for formatting}
var
Tries : Byte;
Done : Boolean;
Regs : Registers;
begin
Tries := 1;
Done := False;
repeat
Regs.AH := $17;
Regs.AL := FType;
Regs.DL := Drive;
Int13Call(Regs);
if Regs.AH <> 0 then begin
ResetDrive(Drive);
Inc(Tries);
if Tries > MaxRetries then
Done := True;
end else
Done := True;
until Done;
SetFloppyType := Regs.AH;
end;
function SetMediaType(Drive : DriveType; TPD : Byte; SPT : Byte) : Byte;
{-Set media type for formatting}
var
Regs : Registers;
begin
Regs.AH := $18;
Regs.DL := Drive;
Regs.CH := TPD;
Regs.CL := SPT;
Int13Call(Regs);
SetMediaType := Regs.AH;
end;
function FormatDisk(Drive : DriveNumber; DType : DriveType;
Verify : Boolean; MaxBadSects : Byte;
VLabel : VolumeStr;
FAF : FormatAbortFunc) : Byte;
label
ExitPoint;
type
CHRNRec =
record
CTrack : Byte; {Track 0..?}
CSide : Byte; {Side 0..1}
CSect : Byte; {Sector 1..?}
CSize : Byte; {Size 0..?}
end;
CHRNArray = array[1..18] of CHRNRec;
FATArray = array[0..4607] of Byte;
var
Tries : Byte;
Track : Byte;
Side : Byte;
Sector : Byte;
RWritten : Byte;
RTotal : Byte;
FatNum : Byte;
BadSects : Byte;
ChangeLine : Byte;
DiskType : Byte;
Status : Byte;
Done : Boolean;
Trash : Word;
DT : DateTime;
VDate : LongInt;
Regs : Registers;
BootPtr : ^SectorArray;
CHRN : ^CHRNArray;
FATs : ^FATArray;
procedure MarkBadSector(Track, Side, Sector : Byte);
const
BadMark = $FF7; {Bad cluster mark}
var
CNum : Integer; {Cluster number}
FOfs : Word; {Offset into fat for this cluster}
FVal : Word; {FAT value for this cluster}
OFVal : Word; {Old FAT value for this cluster}
begin
CNum := (((((Track*2)+Side)*DData[DType].SPT)+Sector-RTotal-2) div
DData[DType].BRD[0])+2;
if CNum > 1 then begin
{Sector is in data space}
FOfs := (CNum*3) div 2;
Move(FATs^[FOfs], FVal, 2);
if Odd(CNum) then
OFVal := (FVal and (BadMark shl 4))
else
OFVal := (FVal and BadMark);
if OFVal = 0 then begin
{Not already marked bad, mark it}
if Odd(CNum) then
FVal := (FVal or (BadMark shl 4))
else
FVal := (FVal or BadMark);
Move(FVal, FATs^[FOfs], 2);
{Add to bad sector count}
Inc(BadSects, DData[DType].BRD[0]);
end;
end;
end;
begin
{Validate parameters. Can't do anything unless these are reasonable}
if not CheckParms(DType, Drive) then
Exit;
{Initialize buffer pointers in case of failure}
FATs := nil;
CHRN := nil;
BootPtr := nil;
{Status proc: starting format}
if FAF(0, DData[DType].TPD, 0) then begin
Status := $FA;
goto ExitPoint;
end;
{Error code for invalid drive or media type}
Status := $FE;
case GetDriveType(Drive) of
1 : {360K drive formats only 360K disks}
if DType <> 1 then
goto ExitPoint;
2 : {1.2M drive formats 360K or 1.2M disk}
if DType > 2 then
goto ExitPoint;
3 : {720K drive formats only 720K disks}
if DType <> 3 then
goto ExitPoint;
4 : {1.44M drive formats 720K or 1.44M disks}
if Dtype < 3 then
goto ExitPoint;
else
goto ExitPoint;
end;
{Error code for out-of-memory or DPMI error}
Status := $FF;
{Allocate buffers}
if not AllocBuffer(Pointer(FATs), SizeOf(FATArray)) then
goto ExitPoint;
if not AllocBuffer(Pointer(CHRN), SizeOf(CHRNArray)) then
goto ExitPoint;
if not AllocBuffer(Pointer(BootPtr), SizeOf(BootRecord)) then
goto ExitPoint;
{Initialize boot record}
Move(BootRecord, BootPtr^, SizeOf(BootRecord));
Move(DData[DType].BRD, BootPtr^[13], 14);
{Initialize the FAT table}
FillChar(FATs^, SizeOf(FATArray), 0);
FATs^[0] := DData[DType].FID;
FATs^[1] := $FF;
FATs^[2] := $FF;
{Set drive table parameters by patching drive table in memory}
if not SetDriveTable(DType) then
goto ExitPoint;
{On AT class machines, set format parameters via BIOS}
if IsATMachine then begin
{Get change line type: 1 -> 360K drive, 2 -> 1.2M or 3.5" drive}
Status := GetChangeLineType(Drive, ChangeLine);
if Status <> 0 then
goto ExitPoint;
if (ChangeLine < 1) or (ChangeLine > 2) then begin
Status := 1;
goto ExitPoint;
end;
{Determine floppy type for SetFloppyType call}
DiskType := MediaArray[DType, ChangeLine];
if DiskType = 0 then begin
Status := $FB;
goto ExitPoint;
end;
{Set floppy type for drive}
Status := SetFloppyType(Drive, DiskType);
if Status <> 0 then
goto ExitPoint;
{Set media type for format}
Status := SetMediaType(Drive, DData[DType].TPD, DData[DType].SPT);
if Status <> 0 then
goto ExitPoint;
end;
{Format each sector}
ResetDrive(Drive);
BadSects := 0;
for Track := 0 to DData[DType].TPD do begin
{Status proc: formatting track}
if FAF(Track, DData[DType].TPD, 1) then begin
Status := $FA;
goto ExitPoint;
end;
for Side := 0 to 1 do begin
{Initialize CHRN for this sector}
for Sector := 1 to DData[DType].SPT do
with CHRN^[Sector] do begin
CTrack := Track;
CSide := Side;
CSect := Sector;
CSize := DData[DType].SSZ;
end;
{Format this sector, with retries}
Status := SubfSectors($05, Drive, Track, Side,
1, DData[DType].SPT, CHRN^);
if Status <> 0 then
goto ExitPoint;
end;
if Verify then begin
{Status proc: verifying track}
if FAF(Track, DData[DType].TPD, 2) then begin
Status := $FA;
goto ExitPoint;
end;
for Side := 0 to 1 do
{Verify the entire track}
if VerifySectors(Drive, Track, Side,
1, DData[DType].SPT) <> 0 then begin
if Track = 0 then begin
{Disk bad}
Status := $FD;
goto ExitPoint;
end;
for Sector := 1 to DData[DType].SPT do
if VerifySectors(Drive, Track, Side,
Sector, 1) <> 0 then begin
MarkBadSector(Track, Side, Sector);
if BadSects > MaxBadSects then begin
Status := $FC;
goto ExitPoint;
end;
end;
end;
end;
end;
{Status proc: writing boot and FAT}
if FAF(0, DData[DType].TPD, 3) then begin
Status := $FA;
goto ExitPoint;
end;
{Write boot record}
Status := WriteSectors(Drive, 0, 0, 1, 1, BootPtr^);
if Status <> 0 then begin
Status := $FD;
goto ExitPoint;
end;
{Write FATs and volume label}
Track := 0;
Side := 0;
Sector := 2;
FatNum := 0;
RTotal := (2*DData[DType].SPF)+DData[DType].DSC;
for RWritten := 0 to RTotal-1 do begin
if Sector > DData[DType].SPT then begin
Sector := 1;
Inc(Side);
end;
if RWritten < (2*DData[DType].SPF) then begin
if FatNum > DData[DType].SPF-1 then
FatNum := 0;
end else begin
FillChar(FATs^, 512, 0);
if ((VLabel <> '') and (RWritten = 2*DData[DType].SPF)) then begin
{Put in volume label}
for Trash := 1 to Length(VLabel) do
VLabel[Trash] := Upcase(VLabel[Trash]);
while Length(VLabel) < 11 do
VLabel := VLabel+' ';
Move(VLabel[1], FATs^, 11);
FATs^[11] := 8;
GetDate(DT.Year, DT.Month, DT.Day, Trash);
GetTime(DT.Hour, DT.Min, DT.Sec, Trash);
PackTime(DT, VDate);
Move(VDate, FATs^[22], 4);
end;
FatNum := 0;
end;
if WriteSectors(Drive, Track, Side,
Sector, 1, FATs^[FatNum*512]) <> 0 then begin
Status := $FD;
goto ExitPoint;
end;
Inc(Sector);
Inc(FatNum);
end;
{Success}
Status := 0;
ExitPoint:
FreeBuffer(BootPtr, SizeOf(BootRecord));
FreeBuffer(CHRN, SizeOf(CHRNArray));
FreeBuffer(FATs, SizeOf(FATArray));
{Status proc: ending format}
Done := FAF(Status, DData[DType].TPD, 4);
FormatDisk := Status;
end;
function EmptyAbortFunc(Track, MaxTrack : Byte; Kind : Byte) : Boolean;
begin
EmptyAbortFunc := False;
end;
end.
{ ------------------------------- DEMO PROGRAM -------------------- }
{ ------------------------------- CUT HERE ---------------------}
{$R-,S-,I-}
program Fmt;
{-Simple formatting program to demonstate DISKB unit}
uses
{$IFDEF Windows}
WinCrt,
{$ENDIF}
BDisk;
const
ESC = #27;
CR = #13;
type
CharSet = set of Char;
var
DLet : Char;
DTyp : Char;
Verf : Char;
GLet : Char;
DNum : Byte;
Status : Byte;
VStr : VolumeStr;
const
DriveTypeName : array[DriveType] of string[5] =
('other', '360K', '1.2M', '720K', '1.44M');
{$IFNDEF Windows}
function ReadKey : Char; assembler;
{-Low budget readkey routine}
asm
xor ah,ah
int 16h
end;
{$ENDIF}
function GetKey(Prompt : String; OKSet : CharSet) : Char;
{-Get and return a key in the OKSet}
var
Ch : Char;
begin
Write(Prompt);
repeat
Ch := Upcase(ReadKey);
if Ch = ESC then begin
WriteLn;
Halt;
end;
until (Ch in OKSet);
if Ch <> CR then
Write(Ch);
WriteLn;
GetKey := Ch;
end;
function AbortFunc(Track, MaxTrack : Byte; Kind : Byte) : Boolean; far;
{-Display formatting status. Could check for abort here too}
begin
case Kind of
0 : {Format beginning}
Write('Formatting ');
1 : {Formatting track}
Write(^H^H^H^H, ((Track*100) div MaxTrack):3, '%');
2 : {Verifying track}
Write(^H, 'V');
3 : {Writing boot and FAT}
Write(^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H, 'Writing boot and FAT');
4 : {Format ending}
begin
Write(^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H);
{Track returns final status code in this case}
if Track = 0 then
WriteLn('Formatted successfully')
else
WriteLn('Format failed: ', GetStatusStr(Track));
end;
end;
AbortFunc := False;
end;
begin
WriteLn('Floppy Formatter: to exit');
{Get formatting parameters}
DLet := GetKey('Drive to format? (A or B): ', ['A'..'B']);
DTyp := GetKey('Disk type? (1=360K, 2=1.2M, 3=720K, 4=1.44M): ', ['1'..'4']);
Verf := GetKey('Verify? (Y or N) ', ['N', 'Y']);
Write('Volume label? ');
ReadLn(VStr);
GLet := GetKey('Insert disk and press ', [#13]);
{Compute drive number}
DNum := Byte(DLet)-Byte('A');
WriteLn('Drive type is ', DriveTypeName[GetDriveType(DNum)]);
Status := FormatDisk(DNum, {drive number}
Byte(DTyp)-Byte('0'), {format type}
(Verf = 'Y'), {verify?}
10, {max bad sectors}
VStr, {volume label}
AbortFunc); {abort function}
{AbortFunc reports the status}
end.