'===========================================================================
' Subject: FORMAT DISKETTE                   Date: 10-31-90 (00:00)       
' Author:  Cornel Huth                       Code: QB, PDS                
' Origin:  FidoNet QUIK_BAS Echo           Packet: DISK.ABC
'===========================================================================
'QBFORMAT.BAS by Cornel Huth 31-Oct-90
'format MS-DOS floppy disks using QB and BIOS
'requires QB.QLB/QB.LIB (specifically INTERRUPTX())

'{5.25-inch media types supported in this code}
'{DS9=double-sided 9-sector(360K)  DS15=double-sided 15-sector (1.2M)}
CONST DS9 = &HFD, DS15 = &HF9
'{3.5-inch media types partially supported in this code}
'{DX9=double-sided 9-sector(720K)  DX18=double-sided 18-sector (1.44M)}
'{*** DX9 media byte is NEGATIVE to differ from DS15 ***}
CONST DX9 = -&HF9, DX18 = &HF0
CONST RETRIES = 3  '{retries on BIOS error}

TYPE REGtypeX
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
ds AS INTEGER
es AS INTEGER
END TYPE '20

TYPE ADDRFIELDtype
track AS STRING * 1
head AS STRING * 1
sector AS STRING * 1
bytesec AS STRING * 1
END TYPE '4

TYPE INFOtype
OEM AS STRING * 8 'system name
BS AS INTEGER     'bytes/sector
SC AS STRING * 1  'sectors/cluster
RS AS INTEGER     'reserved sectors
NF AS STRING * 1  'FATs
DE AS INTEGER     'root directory entries
TS AS INTEGER     'total sectors on volume
MB AS STRING * 1  'media byte
SF AS INTEGER     'sectors/FAT
ST AS INTEGER     'sectors/track
NH AS INTEGER     'heads
HS AS INTEGER     'hidden sectors
END TYPE '27

TYPE BOOTRECtype
jmp AS STRING * 3
parms AS INFOtype
code AS STRING * 482
END TYPE '512

'{External routine included with QB 4.0 in QB.LIB & QB.QLB}
'{The INTRPT.ASM supplied with QB 4.00 has 2 known bugs, one of}
'{which is so bad that this code cannot work properly with it.}
'{The INTRPT.ASM supplied with QB 4.00b has 1 known bug, this}
'{code will work with it but DOS BIOS INT25/26h calls will not.}
'{Later versions may still have that bug!}
DECLARE SUB INTERRUPTX (intnum%, ireg AS REGtypeX, oreg AS REGtypeX)

DEFINT A-Z
'{INT 1Eh disk parameter table vectors}
DIM SHARED OldDPTseg, OldDPToff
DIM SHARED NewDPTseg, NewDPToff
'{Number of tracks on media}
DIM SHARED NoTracks
'{format info for media}
DIM SHARED Info AS INFOtype
'{interface with INTERRUPTX routine}
DIM SHARED ireg AS REGtypeX, oreg AS REGtypeX
'{boot record buffer}
DIM SHARED BootRec AS BOOTRECtype
'{sector buffer to write FAT & root directory sectors}
DIM SHARED SectorBuff AS STRING * 512
REM $STATIC
'{Allocate address field data to max possible sectors per track}
DIM SHARED AddrField(1 TO 18) AS ADDRFIELDtype

BootSector:
DATA &HEB,&H3E,&H90,&H20,&H20,&H20,&H20,&H20,&H20,&H20,&H20,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &HA,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H2B,&HC0,&H8E,&HD0,&HBC,&H0,&H7C,&HB8,&HC0,&H7,&H8E,&HD8,&H8E,&HC0,&HBE,&H3
DATA &H0,&HBF,&HAF,&H0,&HB9,&H4,&H0,&HF3,&HA5,&HBE,&HAF,&H0,&HB4,&HE,&H8A,&H4
DATA &HA,&HC0,&H74,&H7,&H56,&HCD,&H10,&H5E,&H46,&HEB,&HF1,&HFC,&HBE,&H7A,&H0,&HBF
DATA &H0,&H2,&HB9,&H0,&H2,&HF3,&HA4,&HE9,&H86,&H1,&HB8,&H1,&H2,&H2B,&HDB,&HB9
DATA &H1,&H0,&HBA,&H50,&H0,&HCD,&H13,&H72,&HC,&HBB,&HFE,&H1,&H81,&H3F,&H55,&HAA
DATA &H75,&H3,&HE9,&HE5,&HFD,&HBE,&H58,&H2,&HB4,&HE,&H8A,&H4,&HA,&HC0,&H74,&H7
DATA &H56,&HCD,&H10,&H5E,&H46,&HEB,&HF1,&H2B,&HC0,&HCD,&H16,&HCD,&H19,&HCD,&H18,&H20
DATA &H20,&H20,&H20,&H20,&H20,&H20,&H20,&H20,&H6E,&H6F,&H6E,&H2D,&H62,&H6F,&H6F,&H74
DATA &H61,&H62,&H6C,&H65,&H20,&H64,&H69,&H73,&H6B,&H20,&H69,&H6E,&H20,&H41,&H3A,&HD
DATA &HA,&H0,&H4E,&H6F,&H20,&H62,&H6F,&H6F,&H74,&H20,&H64,&H69,&H73,&H6B,&H20,&H66
DATA &H6F,&H75,&H6E,&H64,&H2C,&H20,&H72,&H65,&H70,&H6C,&H61,&H63,&H65,&H20,&H61,&H6E
DATA &H64,&H20,&H70,&H72,&H65,&H73,&H73,&H20,&H61,&H20,&H6B,&H65,&H79,&H20,&HD,&HA
DATA &HD,&HA,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0
DATA &H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H0,&H55,&HAA

'============================================================================
'{The following code is a sample run to format a disk}
'{All other code can be compiled and put in a library}
'{format test drive A: double-sided/9-sector media (360K)}
'{...and you thought that this was going to be hard}
drive = 0: media = DS9
CLS : DO: LOOP WHILE INKEY$ <> ""
INPUT "Insert DS9 disk to format in drive A: and press a key", a$
INPUT "Press a key to start QBFORMAT", a$
PRINT "formatting..."
xerr = QBFORMAT(drive, media)
IF xerr THEN
   errl = xerr \ 256
   errc = xerr AND 255
   PRINT "*** Error level:"; errl; " code:"; errc
ELSE
   PRINT "done."
END IF
STOP

SUB ComputeCHS (LogSec, cyl, hd, sec)
'{convert a DOS logical sector to BIOS form}
CylSec = Info.ST * Info.NH
cyl = LogSec \ CylSec
rm = LogSec - (cyl * CylSec)
hd = rm \ Info.ST
sec = rm - (hd * Info.ST) + 1

END SUB

FUNCTION FormatDisk (drive)
'{format a track at a time a side at a time}
'{any error aborts format,diskette presumed unreliable}
'{retry format 1 or 2 more times before trashing the diskette}
FOR track = 0 TO (NoTracks - 1)
   FOR head = 0 TO (Info.NH - 1)
      FOR i = 1 TO RETRIES
         xerr = FormatTrack(drive, track, head)
         IF xerr = 0 THEN EXIT FOR
      NEXT
      IF xerr THEN FormatDisk = xerr: EXIT FUNCTION
   NEXT
NEXT
FormatDisk = 0

END FUNCTION

FUNCTION FormatTrack (drive, track, head)
'{Initialize address field for each sector on this track}
FOR sec = 1 TO Info.ST
   AddrField(sec).track = CHR$(track)
   AddrField(sec).head = CHR$(head)
   AddrField(sec).sector = CHR$(sec)
   AddrField(sec).bytesec = CHR$(2)  '{bytecode 2 = 512-byte sector}
NEXT
ireg.ax = &H500 + Info.ST            '{format track with sectors/track}
ireg.cx = (track * 256) + 1          '{track to format,start with sector 1}
ireg.dx = (head * 256) + drive       '{head,drive}
ireg.es = VARSEG(AddrField(1))       '{point to address field data}
ireg.bx = VARPTR(AddrField(1))
INTERRUPTX &H13, ireg, oreg
cf = oreg.flags AND 1                '{cf=1 if disk error}
IF cf THEN
   e& = oreg.ax
   IF e& < 0 THEN e& = e& + 65536
   FormatTrack = e& \ 256            '{return with status byte}
   ResetFDC drive
ELSE ireg.ax = &H400 + Info.ST       '{ok, verify track integrity-}
   INTERRUPTX &H13, ireg, oreg       '{-optional but recommended on format}
   cf = oreg.flags AND 1             '{cf=1 if disk error}
   IF cf THEN
      e& = oreg.ax
      IF e& < 0 THEN e& = e& + 65536
      FormatTrack = e& \ 256         '{return with status byte}
      ResetFDC drive
   ELSE
      FormatTrack = 0                '{format ok}
   END IF
END IF

END FUNCTION

SUB InitFormatParms (media)
'{set up media's format data}
Info.OEM = "IBM  3.1"   '{avoid changing 'IBM'}
Info.BS = 512
Info.RS = 1
Info.NF = CHR$(2)
Info.NH = 2
Info.HS = 0
SELECT CASE media
CASE DS9
   Info.SC = CHR$(2)
   Info.DE = 112
   Info.TS = 720
   Info.MB = CHR$(DS9)
   Info.SF = 2
   Info.ST = 9
CASE DS15
   Info.SC = CHR$(1)
   Info.DE = 224
   Info.TS = 2400
   Info.MB = CHR$(DS15)
   Info.SF = 7
   Info.ST = 15
CASE DX9
   Info.SC = CHR$(2)
   Info.DE = 112
   Info.TS = 720
   Info.MB = CHR$(ABS(DX9))
   Info.SF = 3
   Info.ST = 9
CASE DX18
   Info.SC = CHR$(1)
   Info.DE = 224
   Info.TS = 2880
   Info.MB = CHR$(DX18)
   Info.SF = 9
   Info.ST = 18
CASE ELSE
   Info.OEM = ""
   Info.BS = 0
   Info.RS = 0
   Info.NF = CHR$(0)
   Info.NH = 0
   Info.HS = 0
   Info.SC = CHR$(0)
   Info.DE = 0
   Info.TS = 0
   Info.MB = CHR$(0)
   Info.SF = 0
   Info.ST = 0
END SELECT
NoTracks = Info.TS \ Info.NH \ Info.ST
NewDPTseg = 0   'INT 1Eh vector
NewDPToff = 0   'new -> disk parameter table for formatted media
OldDPTseg = 0   'original-
OldDPToff = 0   '-vector

END SUB

FUNCTION QBFORMAT (drive, media)
'{control routine}
xerr = ValidateDisk(drive, media)
IF xerr = 0 THEN xerr = FormatDisk(drive) ELSE level = 1
IF xerr = 0 THEN xerr = WriteBoot(drive) ELSE IF level = 0 THEN level = 2
IF xerr = 0 THEN xerr = WriteFAT(drive) ELSE IF level = 0 THEN level = 3
IF xerr = 0 THEN xerr = WriteDir(drive) ELSE IF level = 0 THEN level = 4
IF xerr THEN IF level = 0 THEN level = 5
'{reset INT 1Eh vector to original,check both for <>0}
IF OldDPTseg <> 0 OR OldDPToff <> 0 THEN
   ireg.ax = &H251E
   ireg.ds = OldDPTseg
   ireg.dx = OldDPToff
   INTERRUPTX &H21, ireg, oreg
END IF
QBFORMAT = (level * 256) + xerr

'sample call
'xerr = QBFORMAT(drive, media)
'IF xerr THEN errl = xerr \ 256: errc = xerr AND 255

'level error codes
'0:no error
'1:validate error
'2:format error
'3:boot record write error
'4:FAT write error
'5:directory write error

'floppy disk error codes (xerr,in decimal):
'0:no error
'1:invalid function request
'2:address mark not found
'3:write protected
'4:sector not found
'6:diskette changed
'8:DMA overrun
'9:DMA boundary error
'12:media type not available
'16:bad CRC
'32:diskette controller failed
'64:seek failed
'128:time-out/drive not ready

END FUNCTION

SUB ResetFDC (drive)
'{reset the controller after any BIOS FDC error}
tax = ireg.ax
tdx = ireg.dx
ireg.ax = 0
ireg.dx = drive
INTERRUPTX &H13, ireg, oreg
ireg.ax = tax
ireg.dx = tdx

END SUB

FUNCTION ValidateDisk (drive, media)
'{check if media supported by program,by drive,and if drive is ready}
InitFormatParms media
IF Info.ST THEN
   '{check to see if there is CMOS RAM (means we have an AT BIOS)}
   OUT &H70, &H10
   CMOS = (INP(&H71) <> &HFF)
   ResetFDC drive
   IF CMOS THEN
      '{get original INT 1Eh vector to disk parameter table}
      ireg.ax = &H351E
      INTERRUPTX &H21, ireg, oreg
      OldDPTseg = oreg.es
      OldDPToff = oreg.bx
      '{set media type for format on AT BIOS/multi-media drive}
      '{let BIOS determine if drive can format media with a DPT in BIOS ROM}
      ireg.ax = &H1800
      ireg.cx = ((NoTracks - 1) * 256) + Info.ST
      ireg.dx = drive
      FOR checks = 1 TO RETRIES '{zerr=0 no error}
         INTERRUPTX &H13, ireg, oreg '{zerr=1 drive invalid}
         zerr = oreg.ax \ 256   '{zerr=&H0C unknown media/maybe invalid CMOS}
         IF zerr THEN ResetFDC drive ELSE EXIT FOR
      NEXT
      '{set INT 1Eh vector to this media's disk parameter table in BIOS ROM}
      IF zerr = 0 THEN
         NewDPTseg = oreg.es
         NewDPToff = oreg.di
         ireg.ax = &H251E
         ireg.ds = NewDPTseg
         ireg.dx = NewDPToff
         INTERRUPTX &H21, ireg, oreg
      ELSE
         OldDPTseg = 0
         OldDPToff = 0
      END IF
   ELSE
      '{pre-AT BIOS}
      '{much more work involved}
      '{if you want more than DS9 support, you need to add it}
      DEF SEG = 0: Equip = PEEK(&H410): DEF SEG
      IF Equip AND 1 THEN
         MaxDrive = ((Equip AND &HC0) \ 64) '{MaxDrive=0=1drive, 1=2}
         IF (drive >= 0) AND (drive <= MaxDrive) THEN
            'get diskette parameter table vector
            ireg.ax = &H351E
            INTERRUPTX &H21, ireg, oreg
            DEF SEG = oreg.es: MaxSectors = PEEK(oreg.bx + 4): DEF SEG
            IF MaxSectors = 9 THEN
               SELECT CASE media
               CASE DS9      '{supported media}
               CASE ELSE
                  zerr = &HC '{invalid media}
               END SELECT
            '{any other max sectors not supported here}
            ELSE
               SELECT CASE media
               CASE ELSE
                  zerr = &HC '{invalid media}
               END SELECT
            END IF
         ELSE
            zerr = 1 '{invalid drive}
         END IF
      ELSE
         zerr = 1 '{no drives to format}
      END IF
   END IF
ELSE
   zerr = &HC '{media not supported by program}
END IF
'{physical check for disk in the drive}
IF zerr = 0 THEN
   ireg.ax = &H401    '{verify 1 sector from drive}
   ireg.cx = &H1      '{track=0 sector=1}
   ireg.dx = drive    '{head=0 drive=drive}
   FOR checks = 1 TO RETRIES
      INTERRUPTX &H13, ireg, oreg
      IF oreg.flags AND 1 THEN   '{bad read}
         e& = oreg.ax
         '{need to detect an unformatted disk}
         IF e& < 0 THEN e& = e& + 65536
         zerr = e& \ 256
         ResetFDC drive
      ELSE
         zerr = 0 '{good read,already formatted disk in drive}
         EXIT FOR
      END IF
   NEXT
   '{zerr may be any of the BIOS diskette error codes if non-zero here}
   '{address mark not found(2)=unformatted disk in drive}
   '{sector not found(4)=wacko disk but okay to proceed}
   IF zerr = 2 OR zerr = 4 THEN zerr = 0
END IF
ValidateDisk = zerr

END FUNCTION

FUNCTION WriteBoot (drive)
RESTORE BootSector
'{read default boot record data}
DEF SEG = VARSEG(BootRec): offset = VARPTR(BootRec)
FOR i = 0 TO 511: READ byte: POKE offset + i, byte: NEXT: DEF SEG
'{update OEM name and BIOS parameter block}
BootRec.parms = Info
'{write the boot record}
FOR i = 1 TO RETRIES
   xerr = WriteBootSector(drive)
   IF xerr = 0 THEN EXIT FOR
NEXT
WriteBoot = xerr

END FUNCTION

FUNCTION WriteBootSector (drive)
ireg.ax = &H300 + 1                  '{write 1 sector}
ireg.cx = 1                          '{track 0,sector 1}
ireg.dx = drive                      '{head 0,drive}
ireg.es = VARSEG(BootRec)            '{point to boot record data}
ireg.bx = VARPTR(BootRec)
INTERRUPTX &H13, ireg, oreg
cf = oreg.flags AND 1                '{cf=1 if disk error}
IF cf THEN
   e& = oreg.ax
   IF e& < 0 THEN e& = e& + 65536
   WriteBootSector = e& \ 256        '{return with status byte}
   ResetFDC drive
ELSE
   WriteBootSector = 0               '{ok}
END IF

END FUNCTION

FUNCTION WriteDir (drive)
MID$(SectorBuff, 1, 1) = CHR$(0)
FOR i = 2 TO 512
   IF (i - 1) MOD 32 = 0 THEN
      MID$(SectorBuff, i, 1) = CHR$(0)
   ELSE
      MID$(SectorBuff, i, 1) = CHR$(&HF6)
   END IF
NEXT
LogSec = Info.RS + Info.HS + (Info.SF * ASC(Info.NF)) 'first logical dir sector
FOR i = 1 TO (Info.DE \ 16)  'sectors needed for root directory
   ComputeCHS LogSec, cyl, hd, sec
   FOR k = 1 TO RETRIES
      xerr = WriteSector(drive, cyl, hd, sec)
      IF xerr = 0 THEN EXIT FOR
   NEXT
   IF xerr THEN WriteDir = xerr: EXIT FUNCTION
   LogSec = LogSec + 1
NEXT
WriteDir = 0

END FUNCTION

FUNCTION WriteFAT (drive)
'{do the hussle}
FAT1$ = Info.MB + CHR$(255) + CHR$(255)
FAT2$ = CHR$(0) + CHR$(0) + CHR$(0)
FOR i = 1 TO 512: MID$(SectorBuff, i, 1) = CHR$(0): NEXT
LogSec = Info.RS + Info.HS 'first logical FAT sector
FOR i = 1 TO ASC(Info.NF)
   FOR j = 1 TO Info.SF
      IF j = 1 THEN MID$(SectorBuff, 1) = FAT1$ ELSE MID$(SectorBuff, 1) = FAT2$
      ComputeCHS LogSec, cyl, hd, sec
      FOR k = 1 TO RETRIES
         xerr = WriteSector(drive, cyl, hd, sec)
         IF xerr = 0 THEN EXIT FOR
      NEXT
      IF xerr THEN WriteFAT = xerr: EXIT FUNCTION
      LogSec = LogSec + 1
   NEXT
NEXT
WriteFAT = 0

END FUNCTION

FUNCTION WriteSector (drive, cyl, hd, sec)
'{BIOS write a FAT or directory sector}
ireg.ax = &H300 + 1
ireg.cx = (cyl * 256) + sec
ireg.dx = (hd * 256) + drive
ireg.es = VARSEG(SectorBuff)
ireg.bx = VARPTR(SectorBuff)
INTERRUPTX &H13, ireg, oreg
cf = oreg.flags AND 1
IF cf THEN
   e& = oreg.ax
   IF e& < 0 THEN e& = e& + 65536
   WriteSector = e& \ 256
   ResetFDC drive
ELSE
   WriteSector = 0
END IF

END FUNCTION