home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d5 / cak / CAKDIR.ZIP / FLOPPY.PAS < prev    next >
Pascal/Delphi Source File  |  1999-10-21  |  41KB  |  941 lines
  1. {------------------------------------------------------------------------------}
  2. { unit       : floppy                                                          }
  3. { version    : 1.0                                                             }
  4. { last update: 1999/04/05                                                      }
  5. { written for: Delphi 3 & 4                                                    }
  6. { written by : Geir Wikran                                                     }
  7. { e-mail     : gwikran@online.no                                               }
  8. {------------------------------------------------------------------------------}
  9.  
  10. unit floppy;
  11.  
  12. {==============================================================================}
  13. interface
  14.  
  15. uses
  16.   Windows, vwin32;
  17.  
  18. {------------------------------------------------------------------------------}
  19. {                                                                              }
  20. { This unit is designed for 3.5" 1.44Mb floppy drives. It is only meant to be  }
  21. { used for accessing floppy disks. However, the functions in this unit does    }
  22. { not set any restrictions on drive numbers that are pased as parameters, and  }
  23. { no checking is done to see if a drive number really is a floppy drive. The   }
  24. { user must make sure not to use these functions on drives other than floppy   }
  25. { drives.                                                                      }
  26. {                                                                              }
  27. { Logical drives: 1=A, 2=B, etc.                                               }
  28. {                                                                              }
  29. {------------------------------------------------------------------------------}
  30.  
  31. procedure AllocFloppyFSBR(BPB: TBPB; OEMName,VolumeLabel: String; var FSBR: PFSBR);
  32.           { Allocates necessary memory (BPB.BytesPerSector) for and initiates  }
  33.           { a FSBS (File System Boot Record) structure based on the BPB, and   }
  34.           { sets OEMName and VolumeLabel fields as specified.                  }
  35. function  ReadFloppyFSBR(Drive: Byte; var FSBR: PFSBR): Boolean;
  36.           { Allocates memory for and reads the FSBR from a floppy disk. If an  }
  37.           { error occures trying to read the sector on the disk FSBR will be   }
  38.           { nil on return.                                                     }
  39. procedure FreeFloppyFSBR(var FSBR: PFSBR);
  40.           { Releases memory allocated for a FSBR structure.                    }
  41.  
  42. function  CreateFloppyBootRecord(Drive: Byte; FSBR: PFSBR): Boolean;
  43.           { Writes the FSBR to logical sector 0 (cylinder 0, head 0, sector 1).}
  44. function  CreateFloppyFATs(Drive: Byte; FSBR: PFSBR): Boolean;
  45.           { Creates the FATs on a disk.                                        }
  46. function  CreateFloppyRootDir(Drive: Byte; FSBR: PFSBR): Boolean;
  47.           { Creates an empty root directory on a disk.                         }
  48.  
  49. function  FormatFloppyDisk(Drive: Byte; VolumeLabel: String): Boolean;
  50.           { Formates a floppy disk with the default format for the drive, and  }
  51.           { creates an empty file system (FSBR,FAT, and root dir).             }
  52.           { This function can be used as it is, but is meant as an example to  }
  53.           { show the procedure for formating a floppy. In an application the   }
  54.           { formating procedure can be enhanced to show the progress of the    }
  55.           { the process, and maybe write zero-filled sectors to the tracks as  }
  56.           { they are formated.                                                 }
  57.  
  58.  
  59. { $DEFINE INT13}
  60. {$IFDEF INT13}
  61.  
  62. { Windows 95 and later does not support calling low-level BIOS disk functions  }
  63. { (interrupt 13h) to gain access to hard disks. Interrupt 13h functions still  }
  64. { work on floppy disks but always fail on hard disks. However, for performance }
  65. { reasons it is not recomended to use interrupt 13h functions for reading,     }
  66. { writing, and formating floppy disks. Interrupt 13h functions are not ideal   }
  67. { for use in a multitasking environment because they leave very little system  }
  68. { time for other processes. It is therefore recomended to use interrupt 21h    }
  69. { function 440Dh for direct access to floppy disks.                            }
  70.  
  71. const
  72.   { Floppy disk types used with InitFloppyBPB function: }
  73.   FloppyDisk_720K  = $01; { 720Kb standard format                              }
  74.   FloppyDisk_144M  = $02; { 1.44Mb standard format                             }
  75.   FloppyDisk_168M  = $03; { 1.68Mb nonstandard format                          }
  76.   FloppyDisk_DMF1K = $04; { 1Kb (2 sectors) per clusters DMF format            }
  77.   FloppyDisk_DMF2K = $05; { 2Kb (4 sectors) per clusters DMF format            }
  78.  
  79. procedure InitFloppyBPB(DiskType: Byte; var BPB: TBPB);
  80.           { Initializes a BPB (BIOS Parameter Block) structure for a given     }
  81.           { disk type.                                                         }
  82.  
  83. type
  84.   PDPT = ^TDPT;
  85.   TDPT = packed record { Device Parameter Table (located at interrupt 1Eh): }
  86.     FirstSpecifyByte : Byte; { bits 7-4: step rate                             }
  87.                              { bits 3-0: head unload time ($0F=240ms)          }
  88.     SecondSpecifyByte: Byte; { bits 7-1: head loaad time ($01=4ms)             }
  89.                              { bits 0: non-DMA mode (always 0)                 }
  90.     TurnOffDelay     : Byte; { Delay until motor turned off (in clock ticks).  }
  91.     BytesPerSector   : Byte; { Bytes per sector: 0=128 1=256 2=512 3=1024.     }
  92.     SectorsPerTrack  : Byte; { Number of sectors per track.                    }
  93.     LengthSectorGap  : Byte; { Length of gap between sectors                   }
  94.                              { ($2A for 5.25", $1B for 3.5").                  }
  95.     DataLength       : Byte; { Data length (ignored if BytesPerSector field    }
  96.                              { is nonzero).                                    }
  97.     GapLength        : Byte; { Gap length when formating ($50 for 5.25",       }
  98.                              { $6C for 3.5").                                  }
  99.     FormatFiller     : Byte; { Format filler byte (default $F6).               }
  100.     HeadSettleTime   : Byte; { Head settle time in milliseconds.               }
  101.     MotorStartTime   : Byte; { Motor start time in 1/8 seconds.                }
  102.   end;
  103.  
  104. procedure InitFloppyDPT(BPB: TBPB; var DPT: TDPT);
  105.           { Initialize a DPT (Device Parameter Table) stucture for a diskette  }
  106.           { based on the BPB.                                                  }
  107.  
  108.  
  109. type
  110.   PInt13SectorHeader = ^TInt13SectorHeader;
  111.   TInt13SectorHeader = packed record
  112.     Track   : Byte;
  113.     Head    : Byte;
  114.     Sector  : Byte;
  115.     SizeCode: Byte;
  116.   end;
  117.  
  118.   PInt13TrackTable = ^TInt13TrackTable;
  119.   TInt13TrackTable = packed array[1..$FFFF] of TInt13SectorHeader;
  120.  
  121. function  Int13HasChangeLine(Drive: Byte): Boolean;
  122.           { Returnes true if drive is a floppy disk with change-line support.  }
  123. function  Int13DiskHasChanged(Drive: Byte): Boolean;
  124.           { Returnes true if the diskette in a floppy drive has been changed   }
  125.           { since the last time the drive was accessed, or if change-line is   }
  126.           { not supported by the drive. Because this function only returns     }
  127.           { true if the diskette has changed since the last time the drive     }
  128.           { was accessed, it is important not to access the drive in any way   }
  129.           { before calling this function. Even chech to see if change-line is  }
  130.           { supported (HasChangeLine function) may clear the changed-flag.     }
  131.  
  132. function  Int13ResetDisk(Drive: Byte): Boolean;
  133.           { Resets a floppy disk to power-up state, and forces the controller  }
  134.           { to recalibrate drive heads (seek to track 0).                      }
  135. function  Int13ReadTrack(Drive,Cylinder,Head,Sector,Count: Byte; Buffer: Pointer): Boolean;
  136.           { Reads Count number of sectors from a floppy disk using absolute    }
  137.           { cylinder, head, and sector address.                                }
  138. function  Int13WriteTrack(Drive,Cylinder,Head,Sector,Count: Byte; Buffer: Pointer): Boolean;
  139.           { Writes Count number of sectors from a floppy disk using absolute   }
  140.           { cylinder, head, and sector address.                                }
  141. function  Int13FormatTrack(Drive,Cylinder,Head,Sectors: Byte; Table: PInt13TrackTable): Boolean;
  142.           { Formates Sectors number of sectors on the given cylinder and head  }
  143.           { on a floppy disk. The number of sectors per track is read from the }
  144.           { current drive parameter table.                                     }
  145. function  Int13VerifyTrack(Drive,Cylinder,Head,Sector,Count: Byte; Buffer: Pointer): Boolean;
  146.           { Verifies Count number of sectors at the absolute cylinder, head,   }
  147.           { and sector address on a floppy disk. Check whether the sectors were}
  148.           { correctly written to disk by comparing the data in the sector      }
  149.           { against the CRC stored on the disk.                                }
  150.  
  151. procedure Int13SectorToTrack(Logical: DWord; BPB: TBPB; var Cylinder,Head,Sector: Byte);
  152.           { Converts a logical sector number into absolute track, head, and    }
  153.           { sector address. Sector 0 is the first logical sector on a disk.    }
  154. function  Int13ReadSector(Drive: Byte; Logical: DWord; BPB: TBPB; Buffer: Pointer): Boolean;
  155.           { Reads a logical sector.                                            }
  156. function  Int13WriteSector(Drive: Byte; Logical: DWord; BPB: TBPB; Buffer: Pointer): Boolean;
  157.           { Writes a logical sector.                                           }
  158. function  Int13VerifySector(Drive: Byte; Logical: DWord; BPB: TBPB; Buffer: Pointer): Boolean;
  159.           { Verifies a logical sector.                                         }
  160.  
  161. function  Int13SetMediaFormat(Drive,MaxCylinder,MaxSector: Byte; var DPT: PDPT): Boolean;
  162.           { Sets drive parameters to be used when formatting a floppy disk.    }
  163.           { Highest vaild value for MaxCylinder on a floppy is 79, but it is   }
  164.           { still possible to formate tracks 80. Highest valid value for       }
  165.           { MaxSector per track is 18, but it is still possible to formate     }
  166.           { 21 sectors per track. The function returns a pointer to the        }
  167.           { diskette parameters (located at interrupt address 1Eh). Use        }
  168.           { this pointer to manipulate the parameter values.                   }
  169. function  Int13SectorSizeCode(BPB: TBPB): Byte;
  170.           { Returns the sector size code that shoud be used in sector headers  }
  171.           { when formating a track.                                            }
  172.  
  173. function  Int13FormatDisk(Drive: Byte; BPB: TBPB; Wipe: Boolean): Boolean;
  174.           { Formates a floppy disk with the format specified in the BPB. If    }
  175.           { Wipe is true each sector will be overwriten with blank (zeros-     }
  176.           { filled) data. If Wipe is false only the formating data is writen   }
  177.           { to the disk without blanking out the sectors.                      }
  178.           { NOTE: This function will not format successfully other formates    }
  179.           {       than 1.44Mb standard format (type FloppyDisk_144M). Could    }
  180.           {       not get it to work with other formates, not even 720Kb       }
  181.           {       format.                                                      }
  182.           { NOTE: If Norton Antivirus 5 (don't know about other versions) is   }
  183.           {       running on the system diskettes formated with the FormatDisk }
  184.           {       function will not be formated correctly. I have not be able  }
  185.           {       to locate the actuall problem, but suspect that the problem  }
  186.           {       has to do with interrupt 13h function 5h (format track). If  }
  187.           {       Norton Antivirus 5 is installed on the system the problem    }
  188.           {       can be solved by opening autoexec.bat and rem out the command}
  189.           {       that runs navdx.exe when the system boots.                   }
  190.  
  191. {------------------------------------------------------------------------------}
  192. {                                                                              }
  193. { Drives are numbered 1->                                                      }
  194. {   Floppy drive A=1 B=2.                                                      }
  195. {                                                                              }
  196. { Cylinders are numbered 0->MaxCylinders                                       }
  197. {   On a floppy disk the highest valid value for MaxCylinder as parameter to   }
  198. {   the SetMediaFormat function is 79, but it is still possible to access and  }
  199. {   use (formate, read, and write) track 80. One a floppy disk formated by by  }
  200. {   DOS or Windows track 80 is not formated.                                   }
  201. {                                                                              }
  202. { Heads are numbered 0->MaxHead                                                }
  203. {   A floppy disk has two heads, 0 and 1.                                      }
  204. {                                                                              }
  205. { Sectors on each track are numbered 0->MaxSector                              }
  206. {   DOS and Windows only uses sectors 1->MaxSector, but it is possible to      }
  207. {   access and use sector 0 also. When formating a track with the FormatTrack  }
  208. {   function all sectors from 0 to number of sectors are formated. Howeven,    }
  209. {   even if sector 0 is formated the sectors in the track table pased to the   }
  210. {   FormatDisk function MUST be numbered from 1 and up, not from 0.            }
  211. {   NOTE: Sector 0 is accessible on all tracks but track 0, head 0. The first  }
  212. {         sector on a disk (the boot sector) is track 0, head 0, sector 1.     }
  213. {   The higest valid value for MaxSector per track as pased as parameter to    }
  214. {   the SetMediaFormat function is 18, but it is actually possible to format   }
  215. {   21 sectors per track with the FormatTrack function.                        }
  216. {                                                                              }
  217. { Logical sectors are numbered 0->BPB.SectorsOnDrive-1                         }
  218. {                                                                              }
  219. {------------------------------------------------------------------------------}
  220.  
  221. var
  222.   FloppyDiskRetries: Byte = 3; { Number of times to retry a disk operation if  }
  223.                                { it fails. Error on a floppy may be due to the }
  224.                                { motor failing to spin up quickly enough; the  }
  225.                                { operation should be retried at least three    }
  226.                                { times, resetting the disk between attemps.    }
  227.  
  228. {$ENDIF}
  229.  
  230. {==============================================================================}
  231. implementation
  232.  
  233. const
  234.   FloppySectorSize = 512;
  235.  
  236. type
  237.   PFloppySectorArray = ^TFloppySectorArray;
  238.   TFloppySectorArray = array[1..FloppySectorSize] of Byte;
  239.  
  240. var
  241.   FloppyFSBSTemplate: TFloppySectorArray = (
  242.     $EB,$3E,$90,$29,$33,$75,$39,$68,$49,$48,$43,$00,$02,$01,$01,$00,
  243.     $02,$E0,$00,$40,$0B,$F0,$09,$00,$12,$00,$02,$00,$00,$00,$00,$00,
  244.     $00,$00,$00,$00,$00,$00,$29,$43,$16,$EA,$18,$4E,$4F,$20,$4E,$41,
  245.     $4D,$45,$20,$20,$20,$20,$46,$41,$54,$31,$32,$20,$20,$20,$F1,$7D,
  246.     $FA,$33,$C9,$8E,$D1,$BC,$FC,$7B,$16,$07,$BD,$78,$00,$C5,$76,$00,
  247.     $1E,$56,$16,$55,$BF,$22,$05,$89,$7E,$00,$89,$4E,$02,$B1,$0B,$FC,
  248.     $F3,$A4,$06,$1F,$BD,$00,$7C,$C6,$45,$FE,$0F,$8B,$46,$18,$88,$45,
  249.     $F9,$FB,$38,$66,$24,$7C,$04,$CD,$13,$72,$3C,$8A,$46,$10,$98,$F7,
  250.     $66,$16,$03,$46,$1C,$13,$56,$1E,$03,$46,$0E,$13,$D1,$50,$52,$89,
  251.     $46,$FC,$89,$56,$FE,$B8,$20,$00,$8B,$76,$11,$F7,$E6,$8B,$5E,$0B,
  252.     $03,$C3,$48,$F7,$F3,$01,$46,$FC,$11,$4E,$FE,$5A,$58,$BB,$00,$07,
  253.     $8B,$FB,$B1,$01,$E8,$94,$00,$72,$47,$38,$2D,$74,$19,$B1,$0B,$56,
  254.     $8B,$76,$3E,$F3,$A6,$5E,$74,$4A,$4E,$74,$0B,$03,$F9,$83,$C7,$15,
  255.     $3B,$FB,$72,$E5,$EB,$D7,$2B,$C9,$B8,$D8,$7D,$87,$46,$3E,$3C,$D8,
  256.     $75,$99,$BE,$80,$7D,$AC,$98,$03,$F0,$AC,$84,$C0,$74,$17,$3C,$FF,
  257.     $74,$09,$B4,$0E,$BB,$07,$00,$CD,$10,$EB,$EE,$BE,$83,$7D,$EB,$E5,
  258.     $BE,$81,$7D,$EB,$E0,$33,$C0,$CD,$16,$5E,$1F,$8F,$04,$8F,$44,$02,
  259.     $CD,$19,$BE,$82,$7D,$8B,$7D,$0F,$83,$FF,$02,$72,$C8,$8B,$C7,$48,
  260.     $48,$8A,$4E,$0D,$F7,$E1,$03,$46,$FC,$13,$56,$FE,$BB,$00,$07,$53,
  261.     $B1,$04,$E8,$16,$00,$5B,$72,$C8,$81,$3F,$4D,$5A,$75,$A7,$81,$BF,
  262.     $00,$02,$42,$4A,$75,$9F,$EA,$00,$02,$70,$00,$50,$52,$51,$91,$92,
  263.     $33,$D2,$F7,$76,$18,$91,$F7,$76,$18,$42,$87,$CA,$F7,$76,$1A,$8A,
  264.     $F2,$8A,$56,$24,$8A,$E8,$D0,$CC,$D0,$CC,$0A,$CC,$B8,$01,$02,$CD,
  265.     $13,$59,$5A,$58,$72,$09,$40,$75,$01,$42,$03,$5E,$0B,$E2,$CC,$C3,
  266.     $03,$18,$01,$27,$0D,$0A,$49,$6E,$76,$61,$6C,$69,$64,$20,$73,$79,
  267.     $73,$74,$65,$6D,$20,$64,$69,$73,$6B,$FF,$0D,$0A,$44,$69,$73,$6B,
  268.     $20,$49,$2F,$4F,$20,$65,$72,$72,$6F,$72,$FF,$0D,$0A,$52,$65,$70,
  269.     $6C,$61,$63,$65,$20,$74,$68,$65,$20,$64,$69,$73,$6B,$2C,$20,$61,
  270.     $6E,$64,$20,$74,$68,$65,$6E,$20,$70,$72,$65,$73,$73,$20,$61,$6E,
  271.     $79,$20,$6B,$65,$79,$0D,$0A,$00,$49,$4F,$20,$20,$20,$20,$20,$20,
  272.     $53,$59,$53,$4D,$53,$44,$4F,$53,$20,$20,$20,$53,$59,$53,$80,$01,
  273.     $00,$57,$49,$4E,$42,$4F,$4F,$54,$20,$53,$59,$53,$00,$00,$55,$AA
  274.   );
  275.  
  276.  
  277. procedure AllocFloppyFSBR;
  278. var
  279.   SectorSize: Word;
  280.   StringPtr : PChar;
  281.   StringPos : Integer;
  282. begin
  283.   GetMem(FSBR,BPB.BytesPerSector);
  284.   FillChar(FSBR^,BPB.BytesPerSector,0);
  285.   SectorSize := BPB.BytesPerSector;
  286.   if SectorSize > FloppySectorSize then SectorSize := FloppySectorSize;
  287.   CopyMemory(FSBR,@FloppyFSBSTemplate,SectorSize);
  288.   FSBR^.OEMName := '        ';
  289.   FSBR^.BPB := BPB;
  290.   FSBR^.BootSignature := $29;
  291.   FSBR^.VolumeSerial := MakeSerialNumber;
  292.   FSBR^.VolumeLabel := '           ';
  293.   FSBR^.SystemType := 'FAT12   ';
  294.   if OEMName <> '' then begin
  295.     StringPtr := PChar(OEMName);
  296.     StringPos := 0;
  297.     while (StringPtr^ <> #0) and (StringPos < SizeOf(FSBR^.OEMName)) do begin
  298.       FSBR^.OEMName[StringPos] := UpCase(StringPtr^);
  299.       Inc(StringPtr);
  300.       Inc(StringPos);
  301.     end;
  302.   end;
  303.   if VolumeLabel <> '' then begin
  304.     StringPtr := PChar(VolumeLabel);
  305.     StringPos := 0;
  306.     while (StringPtr^ <> #0) and (StringPos < SizeOf(FSBR^.VolumeLabel)) do begin
  307.       FSBR^.VolumeLabel[StringPos] := UpCase(StringPtr^);
  308.       Inc(StringPtr);
  309.       Inc(StringPos);
  310.     end;
  311.   end;
  312. end;
  313.  
  314. function ReadFloppyFSBR;
  315. begin
  316.   GetMem(FSBR,2024);
  317.   Result := ReadSector(Drive,0,1,FSBR);
  318.   if Result then ReallocMem(FSBR,FSBR^.BPB.BytesPerSector)
  319.   else ReallocMem(FSBR,0);
  320. end;
  321.  
  322. procedure FreeFloppyFSBR;
  323. begin
  324.   ReallocMem(FSBR,0);
  325. end;
  326.  
  327. function CreateFloppyBootRecord;
  328. begin
  329.   Result := WriteSector(Drive,0,1,FSBR,WRITE_MODE_UNSPECIFIED_DATA);
  330. end;
  331.  
  332. function CreateFloppyFATs;
  333. var
  334.   FATSector   : Pointer;
  335.   SectorIndex : Byte;
  336.   FATIndex    : Byte;
  337.   SectorNumber: Word;
  338. begin
  339.   Result := true;
  340.   with FSBR^.BPB do begin
  341.     GetMem(FATSector,BytesPerSector);
  342.     for FatIndex := 1 to NumberOfFats do
  343.       for SectorIndex := 1 to SectorsPerFat do begin
  344.         FillChar(FATSector^,BytesPerSector,0);
  345.         if SectorIndex = 1 then
  346.           PDWord(FATSector)^ := $00FFFF00 or MediaDescriptor;
  347.             { The first byte in a FAT must be a copy of the media desriptor  }
  348.             { byte. The second and third byte must be set to FFh. These tree }
  349.             { bytes (24 bits) actually occupy FAT entries 0 and 1. In FAT12  }
  350.             { system: 12 bits * 2 (entries 0 and 1) = 24 bits. So, the first }
  351.             { data cluster entry in a FAT is entry 2 (cluster 2).            }
  352.         SectorNumber := ReservedSectors+((FATIndex-1)*SectorsPerFat)+(SectorIndex-1);
  353.         Result := WriteSector(Drive,SectorNumber,1,FATSector,WRITE_MODE_UNSPECIFIED_DATA);
  354.       end;
  355.     ReallocMem(FATSector,0);
  356.   end;
  357. end;
  358.  
  359. function CreateFloppyRootDir;
  360. var
  361.   RootSector  : PDirEntry;
  362.   FirstSector : Word;
  363.   LastSector  : Word;
  364.   SectorNumber: Word;
  365.   SystemTime  : TSystemTime;
  366.   FileTime    : TFileTime;
  367. begin
  368.   Result := true;
  369.   with FSBR^.BPB do begin
  370.     GetMem(RootSector,BytesPerSector);
  371.     FirstSector := ReservedSectors+(NumberOfFats*SectorsPerFat);
  372.     LastSector := FirstSector+((RootDirEntries*SizeOf(TDirEntry)) div BytesPerSector);
  373.     for SectorNumber := FirstSector to LastSector do begin
  374.       FillChar(RootSector^,BytesPerSector,0);
  375.       if SectorNumber = FirstSector then
  376.         if FSBR^.VolumeLabel <> '           ' then
  377.           with PVolumeLabelDirEntry(RootSector)^ do begin
  378.             CopyMemory(@VolumeLabel,@FSBR^.VolumeLabel,SizeOf(VolumeLabel));
  379.             Attributes := $08;
  380.             GetSystemTime(SystemTime);
  381.             SystemTimeToFileTime(SystemTime,FileTime);
  382.             FileTimeToDosDateTime(FileTime,CreationDate,CreationTime);
  383.           end;
  384.       Result := WriteSector(Drive,SectorNumber,1,RootSector,WRITE_MODE_UNSPECIFIED_DATA);
  385.     end;
  386.     ReallocMem(RootSector,0);
  387.   end;
  388. end;
  389.  
  390. function FormatFloppyDisk;
  391. var
  392.   DeviceParameters: PExtDeviceParameters;
  393.   CylinderIndex   : Byte;
  394.   HeadIndex       : Byte;
  395.   SectorIndex     : Byte;
  396.   FSBR            : PFSBR;
  397. begin
  398.   if LockPhysicalVolume(1,0,LOCK_FOR_FORMATTING) then begin
  399.     LockPhysicalVolume(1,0,LOCK_FOR_FORMATTING);
  400.     GetMem(DeviceParameters,SizeOf(TExtDeviceParameters));
  401.     Result := GetDeviceParameters(Drive,DeviceParameters,SizeOf(TExtDeviceParameters));
  402.     if Result then with DeviceParameters^ do begin
  403.       ReallocMem(DeviceParameters,SizeOf(TExtDeviceParameters)
  404.                  +SizeOf(TSectorEntry)*BPB.SectorsPerTrack);
  405.       SpecialFunctions := $05;
  406.       EntriesInTable := BPB.SectorsPerTrack;
  407.       for SectorIndex := 1 to BPB.SectorsPerTrack do begin
  408.         SectorTable[SectorIndex-1].SectorNumber := SectorIndex;
  409.         SectorTable[SectorIndex-1].SectorSize := BPB.BytesPerSector;
  410.       end;
  411.       Result := SetDeviceParameters(Drive,DeviceParameters,SizeOf(TExtDeviceParameters));
  412.       if Result then begin
  413.         for CylinderIndex := 0 to Cylinders do
  414.           for HeadIndex := 0 to BPB.NumberOfHeads-1 do begin
  415.             if Result then Result := FormatTrack(Drive,CylinderIndex,HeadIndex);
  416.           end;
  417.         SpecialFunctions := $04;
  418.         SetDeviceParameters(Drive,DeviceParameters,SizeOf(TExtDeviceParameters));
  419.         ReallocMem(DeviceParameters,0);
  420.       end;
  421.       AllocFloppyFSBR(PBPB(@BPB)^,'',VolumeLabel,FSBR);
  422.       if Result then Result := CreateFloppyBootRecord(Drive,FSBR);
  423.       if Result then Result := CreateFloppyFATs(Drive,FSBR);
  424.       if Result then Result := CreateFloppyRootDir(Drive,FSBR);
  425.       FreeFloppyFSBR(FSBR);
  426.     end;
  427.     UnlockPhysicalVolume(1);
  428.     UnlockPhysicalVolume(1);
  429.   end;
  430. end;
  431.  
  432. {$IFDEF INT13}
  433.  
  434. procedure InitFloppyBPB;
  435. begin
  436.   FillChar(BPB,SizeOf(BPB),0);
  437.   case DiskType of
  438.     FloppyDisk_720K: with BPB do begin { 720Kb standard format }
  439.       BytesPerSector    := 512;
  440.       SectorsPerCluster := 2;
  441.       ReservedSectors   := 1;
  442.       NumberOfFats      := 2;
  443.       RootDirEntries    := 112;
  444.       SectorsOnDrive    := 1440;
  445.       MediaDescriptor   := $F9;
  446.       SectorsPerFat     := 3;
  447.       SectorsPerTrack   := 9;
  448.       NumberOfHeads     := 2;
  449.     end;
  450.     FloppyDisk_144M: with BPB do begin { 1.44Mb standard format }
  451.       BytesPerSector    := 512;
  452.       SectorsPerCluster := 1;
  453.       ReservedSectors   := 1;
  454.       NumberOfFats      := 2;
  455.       RootDirEntries    := 224;
  456.       SectorsOnDrive    := 2880;
  457.       MediaDescriptor   := $F0;
  458.       SectorsPerFat     := 9;
  459.       SectorsPerTrack   := 18;
  460.       NumberOfHeads     := 2;
  461.     end;
  462.     FloppyDisk_168M: with BPB do begin { 1.68Mb nonstandard format }
  463.       BytesPerSector    := 512;
  464.       SectorsPerCluster := 1;
  465.       ReservedSectors   := 1;
  466.       NumberOfFats      := 2;
  467.       RootDirEntries    := 224;
  468.       SectorsOnDrive    := 3360;
  469.       MediaDescriptor   := $F0;
  470.       SectorsPerFat     := 10;
  471.       SectorsPerTrack   := 21;
  472.       NumberOfHeads     := 2;
  473.     end;
  474.     FloppyDisk_DMF1K: with BPB do begin { 1Kb (2 sectors) per clusters DMF format }
  475.       BytesPerSector    := 512;
  476.       SectorsPerCluster := 2;
  477.       ReservedSectors   := 1;
  478.       NumberOfFats      := 2;
  479.       RootDirEntries    := 16;
  480.       SectorsOnDrive    := 3360;
  481.       MediaDescriptor   := $F0;
  482.       SectorsPerFat     := 5;
  483.       SectorsPerTrack   := 21;
  484.       NumberOfHeads     := 2;
  485.     end;
  486.     FloppyDisk_DMF2K: with BPB do begin { 2Kb (4 sectors) per clusters DMF format }
  487.       BytesPerSector    := 512;
  488.       SectorsPerCluster := 4;
  489.       ReservedSectors   := 1;
  490.       NumberOfFats      := 2;
  491.       RootDirEntries    := 16;
  492.       SectorsOnDrive    := 3360;
  493.       MediaDescriptor   := $F0;
  494.       SectorsPerFat     := 3;
  495.       SectorsPerTrack   := 21;
  496.       NumberOfHeads     := 2;
  497.     end;
  498.   end;
  499. end;
  500.  
  501. procedure InitFloppyDPT;
  502. begin
  503.   with BPB do begin
  504.     with DPT do begin
  505.       FirstSpecifyByte  := $DF;
  506.       SecondSpecifyByte := $02;
  507.       TurnOffDelay      := $25;
  508.       BytesPerSector    := $02;
  509.       SectorsPerTrack   := SectorsPerTrack;
  510.       LengthSectorGap   := $02;
  511.       DataLength        := $FF;
  512.       FormatFiller      := $F6;
  513.       HeadSettleTime    := $0F;
  514.       MotorStartTime    := $08;
  515.     end;
  516.     case SectorsPerTrack of
  517.       9 : DPT.GapLength := $50;
  518.       18: DPT.GapLength := $6C;
  519.       21: DPT.GapLength := $0C;
  520.     end;
  521.   end;
  522. end;
  523.  
  524. { Interrupt 13h functions requires 0-based (0=A 1=B etc.) drive numbers. To    }
  525. { conform with the 1-based (1=A 2=B etc.) drive numbers of other drive related }
  526. { functions in the, the implementation of the following functions converts     }
  527. { from 1-based to 0-based drive numbers. However, the value 0=default drive is }
  528. { not supported by interrupt 13h.                                              }
  529.  
  530. function Int13ResetDisk;
  531. { int 13h, func 00h                                 }
  532. { in  AH = 00h                                      }
  533. {     DL = drive (bit 7 set for hard disk)          }
  534. { out AH = status                                   }
  535. var
  536.   Registers: TDIOC_Registers;
  537. begin
  538.   VWIN32Error := ERROR_NON;
  539.   Result := false;
  540.   if Drive > 0 then Dec(Drive);
  541.   with Registers do begin
  542.     EAX := $0000;
  543.     EDX := Drive;
  544.     if VWIN32DIOC(VWIN32_DIOC_DOS_INT13,@Registers) then begin
  545.       if (AX and $FF00) = 0 then Result := true
  546.       else VWIN32Error := $10000 or ((AX and $FF00) shr 8);
  547.     end;
  548.   end;
  549. end;
  550.  
  551. function Int13HasChangeLine;
  552. { int 13h, func 15h                                 }
  553. { in  AH = 15h                                      }
  554. {     DL = drive (bit 7 set for hard disk)          }
  555. { out CF set on error                               }
  556. {     AH = status                                   }
  557. { out CF clear if successful                        }
  558. {     AH = 00h no such drive                        }
  559. {          01h floppy without change-line support   }
  560. {          02h floppy with change-line support      }
  561. {          03h hard disk                            }
  562. var
  563.   Registers: TDIOC_Registers;
  564. begin
  565.   VWIN32Error := ERROR_NON;
  566.   Result := false;
  567.   if Drive > 0 then Dec(Drive);
  568.   with Registers do begin
  569.     EAX := $1500;
  570.     EDX := Drive;
  571.     Flags := $00000000;
  572.     if VWIN32DIOC(VWIN32_DIOC_DOS_INT13,@Registers) then begin
  573.       if (Flags and FLAG_CARRY) = 0 then
  574.         Result := ((AX and $FF00) shr 8) = $02
  575.       else VWIN32Error := $10000 or ((AX and $FF00) shr 8);
  576.     end;
  577.   end;
  578. end;
  579.  
  580. function Int13DiskHasChanged;
  581. { int 13h, func 16h                                 }
  582. { in  AH = 16h                                      }
  583. {     DL = drive (bit 7 set for hard disk)          }
  584. { out CF set if change line active                  }
  585. {     AH = 06h change line active or not supported  }
  586. {          80h drive not ready or not present       }
  587. { out CF clear if chage line inactive               }
  588. {     AH = 00h no drive change                      }
  589. var
  590.   Registers: TDIOC_Registers;
  591. begin
  592.   VWIN32Error := ERROR_NON;
  593.   Result := true;
  594.   if Drive > 0 then Dec(Drive);
  595.   with Registers do begin
  596.     EAX := $1600;
  597.     EDX := Drive;
  598.     Flags := $00000000;
  599.     if VWIN32DIOC(VWIN32_DIOC_DOS_INT13,@Registers) then begin
  600.       if (Flags and FLAG_CARRY) = 0 then
  601.         Result := ((AX and $FF00) shr 8) <> $00
  602.       else VWIN32Error := $10000 or ((AX and $FF00) shr 8);
  603.     end;
  604.   end;
  605. end;
  606.  
  607. function Int13ReadTrack;
  608. { int 13h, func 02h                                 }
  609. { in  AH = 02h                                      }
  610. {     AL = number of sectors to read                }
  611. {     CH = low eight bits of track number           }
  612. {     CL = sector number (bits 5-0)                 }
  613. {          high two bits of track number (bits 7-6) }
  614. {     DH = head number                              }
  615. {     DL = drive number (bit 7 set for hard disk)   }
  616. {     ES:BX -> data buffer                          }
  617. { out CF set on error                               }
  618. {     AH = status                                   }
  619. { out CF clear if successful                        }
  620. {     AL = number of sectors transferred            }
  621. var
  622.   Registers: TDIOC_Registers;
  623.   Retries  : Byte;
  624. begin
  625.   VWIN32Error := ERROR_NON;
  626.   Result := false;
  627.   if Drive > 0 then Dec(Drive);
  628.   Retries := FloppyDiskRetries;
  629.   while (not Result) and (Retries > 0) do with Registers do begin
  630.     EAX := $0200 or Count;
  631.     ECX := (Cylinder shl 8) or Sector;
  632.     EDX := (Head shl 8) or Drive;
  633.     EBX := DWord(Buffer);
  634.     if VWIN32DIOC(VWIN32_DIOC_DOS_INT13,@Registers) then begin
  635.       if (Flags and FLAG_CARRY) = 0 then Result := true
  636.       else VWIN32Error := $10000 or ((AX and $FF00) shr 8);
  637.     end;
  638.     Dec(Retries);
  639.   end;
  640. end;
  641.  
  642. function Int13WriteTrack;
  643. { int 13h, func 03h                                 }
  644. { in  AH = 03h                                      }
  645. {     AL = number of sectors to write               }
  646. {     CH = low eight bits of track number           }
  647. {     CL = sector number (bits 5-0)                 }
  648. {          high two bits of track number (bits 7-6) }
  649. {     DH = head number                              }
  650. {     DL = drive number (bit 7 set for hard disk)   }
  651. {     ES:BX -> data buffer                          }
  652. { out CF set on error                               }
  653. {     AH = status                                   }
  654. { out CF clear if successful                        }
  655. {     AL = number of sectors transferred            }
  656. var
  657.   Registers: TDIOC_Registers;
  658.   Retries  : Byte;
  659. begin
  660.   VWIN32Error := ERROR_NON;
  661.   Result := false;
  662.   if Drive > 0 then Dec(Drive);
  663.   Retries := FloppyDiskRetries;
  664.   while (not Result) and (Retries > 0) do with Registers do begin
  665.     EAX := $0300 or Count;
  666.     ECX := (Cylinder shl 8) or Sector;
  667.     EDX := (Head shl 8) or Drive;
  668.     EBX := DWord(Buffer);
  669.     if VWIN32DIOC(VWIN32_DIOC_DOS_INT13,@Registers) then begin
  670.       if (Flags and FLAG_CARRY) = 0 then Result := true
  671.       else VWIN32Error := $10000 or ((AX and $FF00) shr 8);
  672.     end;
  673.     Dec(Retries);
  674.   end;
  675. end;
  676.  
  677. function Int13FormatTrack;
  678. { int 13h, func 05h                        }
  679. { in  AH =05h                              }
  680. {     AL = number of sectors to format     }
  681. {     CH = track number                    }
  682. {     DH = head number                     }
  683. {     DL = drive number                    }
  684. {     ES:BX -> track table                 }
  685. {       the Sector fields must be numbered }
  686. {       from 1 (not 0) and upward          }
  687. { out CF set on error                      }
  688. {     AH = status                          }
  689. { out CF clear if successful               }
  690. var
  691.   Registers: TDIOC_Registers;
  692.   Retries  : Byte;
  693. begin
  694.   VWIN32Error := ERROR_NON;
  695.   Result := false;
  696.   if Drive > 0 then Dec(Drive);
  697.   Retries := FloppyDiskRetries;
  698.   while (not Result) and (Retries > 0) do with Registers do begin
  699.     EAX := $0500 or Sectors;
  700.     ECX := (Cylinder shl 8);
  701.     EDX := (Head shl 8) or Drive;
  702.     EBX := DWord(Table);
  703.     if VWIN32DIOC(VWIN32_DIOC_DOS_INT13,@Registers) then begin
  704.       if (Flags and FLAG_CARRY) = 0 then Result := true
  705.       else VWIN32Error := $10000 or ((AX and $FF00) shr 8);
  706.     end;
  707.     Dec(Retries);
  708.   end;
  709. end;
  710.  
  711. function Int13VerifyTrack;
  712. { int 13h, func 04h                                 }
  713. { in  AH = 04h                                      }
  714. {     AL = number of sectors to verify              }
  715. {     CH = low eight bits of track number           }
  716. {     CL = sector number (bits 5-0)                 }
  717. {          high two bits of track number (bits 7-6) }
  718. {     DH = head number                              }
  719. {     DL = drive number (bit 7 set for hard disk)   }
  720. {     ES:BX -> data buffer                          }
  721. { out CF set on error                               }
  722. {     AH = status                                   }
  723. { out CF clear if successful                        }
  724. {     AL = number of sectors verified               }
  725. var
  726.   Registers: TDIOC_Registers;
  727.   Retries  : Byte;
  728. begin
  729.   VWIN32Error := ERROR_NON;
  730.   Result := false;
  731.   if Drive > 0 then Dec(Drive);
  732.   Retries := FloppyDiskRetries;
  733.   while (not Result) and (Retries > 0) do with Registers do begin
  734.     EAX := $0400 or Count;
  735.     ECX := (Cylinder shl 8) or Sector;
  736.     EDX := (Head shl 8) or Drive;
  737.     EBX := DWord(Buffer);
  738.     if VWIN32DIOC(VWIN32_DIOC_DOS_INT13,@Registers) then begin
  739.       if (Flags and FLAG_CARRY) = 0 then Result := true
  740.       else VWIN32Error := $10000 or ((AX and $FF00) shr 8);
  741.     end;
  742.     Dec(Retries);
  743.   end;
  744. end;
  745.  
  746. procedure Int13SectorToTrack;
  747. begin
  748.   Cylinder := (Logical div BPB.SectorsPerTrack) div BPB.NumberOfHeads;
  749.   Head := (Logical div BPB.SectorsPerTrack) mod BPB.NumberOfHeads;
  750.   Sector := (Logical mod BPB.SectorsPerTrack) + 1;
  751. end;
  752.  
  753. function Int13ReadSector;
  754. var
  755.   Cylinder : Byte;
  756.   Head     : Byte;
  757.   Sector   : Byte;
  758. begin
  759.   Int13SectorToTrack(Logical,BPB,Cylinder,Head,Sector);
  760.   Result := Int13ReadTrack(Drive,Cylinder,Head,Sector,1,Buffer);
  761. end;
  762.  
  763. function Int13WriteSector;
  764. var
  765.   Cylinder : Byte;
  766.   Head     : Byte;
  767.   Sector   : Byte;
  768. begin
  769.   Int13SectorToTrack(Logical,BPB,Cylinder,Head,Sector);
  770.   Result := Int13WriteTrack(Drive,Cylinder,Head,Sector,1,Buffer);
  771. end;
  772.  
  773. function Int13VerifySector;
  774. var
  775.   Cylinder : Byte;
  776.   Head     : Byte;
  777.   Sector   : Byte;
  778. begin
  779.   Int13SectorToTrack(Logical,BPB,Cylinder,Head,Sector);
  780.   Result := Int13VerifyTrack(Drive,Cylinder,Head,Sector,1,Buffer);
  781. end;
  782.  
  783. function Int13SetMediaFormat;
  784. { int 13h, func 18h                                     }
  785. { in  AH = 18h                                          }
  786. {     CH = low eight bits of max track number           }
  787. {     CL = max sector number on each track (bits 5-0)   }
  788. {          high two bits of max track number (bits 7-6) }
  789. {     DL = drive number                                 }
  790. { out AH = status                                       }
  791. {     ES:DI -> 11-byte parameter table                  }
  792. var
  793.   Registers: TDIOC_Registers;
  794.   Retries  : Byte;
  795. begin
  796.   VWIN32Error := ERROR_NON;
  797.   Result := false;
  798.   if Drive > 0 then Dec(Drive);
  799.   Retries := FloppyDiskRetries;
  800.   while (not Result) and (Retries > 0) do with Registers do begin
  801.     EAX := $1800;
  802.     ECX := (MaxCylinder shl 8) or MaxSector;
  803.     EDX := Drive;
  804.     if VWIN32DIOC(VWIN32_DIOC_DOS_INT13,@Registers) then begin
  805.       if (AX and $FF00) = 0 then begin
  806.         Result := true;
  807.         DPT := PDPT(EDI);
  808.       end
  809.       else VWIN32Error := $10000 or ((AX and $FF00) shr 8);
  810.     end;
  811.     Dec(Retries);
  812.   end;
  813. end;
  814.  
  815. function Int13SectorSizeCode;
  816. var
  817.   SizeBase: Word;
  818. begin
  819.   Result := 0;
  820.   SizeBase := 128;
  821.   while (SizeBase < BPB.BytesPerSector) and (SizeBase < $FFFF) do begin
  822.     Inc(Result);
  823.     Inc(SizeBase,SizeBase);
  824.   end;
  825. end;
  826.  
  827. function Int13FormatDisk;
  828. { This function will only format standard 1.44Mb floppies. To formate floppies }
  829. { in nonstandard formates (1.68 etc.) the device parameter table has to be     }
  830. { tweeked manually. The address for this table is located at interrupt 1Eh,    }
  831. { and it is not possible (as far as I know) to change this interrupt in Win9x. }
  832. { In DOS the interrupte can be changed with calls to interrupt 21 function 25h }
  833. { (set interrupt vector) but I know no way to call this function from Win9x.   }
  834. var
  835.   DPT           : PDPT;
  836.   NumberOfTracks: Byte;
  837.   TrackTable    : PInt13TrackTable;
  838.   TableOffset   : Byte;
  839.   TableDisplace : Byte;
  840.   SectorNumber  : Byte;
  841.   SizeCode      : Byte;
  842.   BlankTrack    : Pointer;
  843.   CylinderIndex : Byte;
  844.   HeadIndex     : Byte;
  845.   SectorIndex   : Byte;
  846. begin
  847.   Int13ResetDisk(1);
  848.  
  849.   with BPB do begin
  850.  
  851.     { Set media type for formating: }
  852.     NumberOfTracks := (SectorsOnDrive div SectorsPerTrack div NumberOfHeads)-1;
  853.     if NumberOfTracks > 79 then NumberOfTracks := 79;
  854.     if SectorsPerTrack <= 18 then
  855.       Result := Int13SetMediaFormat(Drive,NumberOfTracks,SectorsPerTrack,DPT)
  856.     else
  857.       Result := Int13SetMediaFormat(Drive,NumberOfTracks,18,DPT);
  858.     { Highest valid number of sectors per track is 18.  }
  859.     { Highest vaild number of tracks on a floppy is 79, }
  860.     { but it is still possible to formate tracks 0-80.  }
  861.  
  862.     if Result then begin
  863.       { Allocate track table: }
  864.       GetMem(TrackTable,SizeOf(TInt13SectorHeader)*(SectorsPerTrack));
  865.  
  866.       { Initialize TableOffset and TableDisplace based on SectorsPerTrack: }
  867.       TableOffset := (SectorsPerTrack+1) div 2;
  868.       TableDisplace := 1;
  869.  
  870.       { Get the sector size code to be used in track table: }
  871.       SizeCode := Int13SectorSizeCode(BPB);
  872.  
  873.       { Allocate and initialize blank sectors for wiping a track: }
  874.       if Wipe then begin
  875.         GetMem(BlankTrack,BytesPerSector*SectorsPerTrack);
  876.         FillChar(BlankTrack^,BytesPerSector*SectorsPerTrack,0);
  877.       end;
  878.  
  879.       CylinderIndex := 0;
  880.       while Result and (CylinderIndex <= NumberOfTracks) do begin
  881.                        {NumberOfTracks+1 to formate track 80}
  882.         HeadIndex := 0;
  883.         while Result and (HeadIndex < NumberOfHeads) do begin
  884.  
  885.           { Initialize track table for this track: }
  886.           if SectorsPerTrack <= 18 then begin
  887.             { This works when SectorsPerTrack <= 18, }
  888.             { but not when SectorsPerTrack > 18.     }
  889.             for SectorIndex := 1 to SectorsPerTrack do begin
  890.               TrackTable[SectorIndex].Track := CylinderIndex;
  891.               TrackTable[SectorIndex].Head := HeadIndex;
  892.               TrackTable[SectorIndex].Sector := SectorIndex;
  893.               TrackTable[SectorIndex].SizeCode := SizeCode;
  894.             end;
  895.           end
  896.           else begin
  897.             { Interleaving sector etries when SectorsPerTrack > 18. }
  898.             { This will also work when SectorsPeTrack <= 18.        }
  899.             for SectorIndex := 1 to SectorsPerTrack do begin
  900.               TrackTable[SectorIndex].Track := CylinderIndex;
  901.               TrackTable[SectorIndex].Head := HeadIndex;
  902.               SectorNumber := ((SectorIndex+TableDisplace) div 2);
  903.               if (SectorIndex+TableDisplace) and $01 = $01 then
  904.                 SectorNumber := SectorNumber+TableOffset;
  905.               if SectorNumber > SectorsPerTrack then
  906.                 SectorNumber := SectorNumber-SectorsPerTrack;
  907.               TrackTable[SectorIndex].Sector := SectorIndex;
  908.               TrackTable[SectorIndex].SizeCode := SizeCode;
  909.             end;
  910.             if HeadIndex = (NumberOfHeads-1) then begin
  911.               Inc(TableDisplace,SectorsPerTrack-18);
  912.               if TableDisplace > SectorsPerTrack then
  913.                 TableDisplace := TableDisplace-SectorsPerTrack;
  914.             end;
  915.           end;
  916.  
  917.           { Set device parameters: }
  918.           {InitFloppyDPT(BPB,DPT^);}
  919.  
  920.           { Format the track: }
  921.           Result := Int13FormatTrack(Drive,CylinderIndex,HeadIndex,SectorsPerTrack,TrackTable);
  922.  
  923.           { Write black sectors to wipe out this track: }
  924.           if Result and Wipe then
  925.             Result := Int13WriteTrack(Drive,CylinderIndex,HeadIndex,1,SectorsPerTrack,BlankTrack);
  926.             { This implementation does not wipe out sector 0. }
  927.  
  928.           Inc(HeadIndex);
  929.         end;
  930.         Inc(CylinderIndex);
  931.       end;
  932.       if Wipe then FreeMem(BlankTrack,BytesPerSector*SectorsPerTrack);
  933.       FreeMem(Pointer(TrackTable),SizeOf(TInt13SectorHeader)*(SectorsPerTrack+1));
  934.     end;
  935.   end;
  936. end;
  937.  
  938. {$ENDIF}
  939.  
  940. end.
  941.