diskio.pas

MiniHex 1.1 源程序说明 “MiniHex11SrcSource”目录中的所有文件是MiniHex 1.1的主程序； “MiniHex11SrcControls”目录中的是该软件

{$A-}
unit DiskIO;

interface

uses Windows, Messages, Classes, SysUtils, Forms, DIOCtrl;

const
    {FAT values explanations}
    FAT_Available    = 0;
    FAT_Reserved_Min = $FFFFFFF0;
    FAT_Reserved_Max = $FFFFFFF6;
    FAT_BAD          = $FFFFFFF7;
    FAT_EOF_Min      = $FFFFFFF8;
    FAT_EOF_Max      = $FFFFFFFF;

    {FAT values masks for different file systems}
    FAT_MASK_12      = $FFF;
    FAT_MASK_16      = $FFFF;
    FAT_MASK_32      = $FFFFFFF;

    {Attribute field bits meanings}
    ATTR_ARCHIVE     = $20;
    ATTR_DIRECTORY   = $10;
    ATTR_VOLUME      = $08;
    ATTR_SYSTEM      = $04;
    ATTR_HIDDEN      = $02;
    ATTR_READONLY    = $01;

type
    {File system used type on selected volume}
    TFileSystem = (fsNone, fsFAT12, fsFAT16, fsFAT32);

    {Universal directory entry - valid on all file systems}
    PDIR_Entry = ^TDIR_Entry;
    TDIR_Entry = record
      Attributes: Byte;        // File attributes
      StartCluster: Longint;   // File starting cluster
      CreateTime: Longint;     // File creation time
      CreateDate: Longint;     // File creation date
      FileSize: Longint;       // File size
      LastAccessDate: Longint; // File last access date
      Name: String[255];       // DOS 8.3 filename as DOS reports
      LongName: String[255];   // Windows 95 long filename
                               // if '' then no long filename available
      Erased: Boolean;         // True for erased file entry
    end;

    TDiskIO = class
    private
      FHandle: THandle;
      FVolume: Longint;
      FPhysicalVolume: Longint;
      FLogicalSectors: Longint;
      FPhysicalSectors: Longint;
      FHeads: Longint;
      FCylinders: Longint;
      FBytesPerSector: Longint;
      FSectorsPerCluster: Longint;
      FFATSector: Pointer;
      FFATCount: Longint;
      FRootDirSector: Longint;
      FRootDirCluster: Longint;
      FFileSystem: TFileSystem;
      FSectorsPerFAT: Longint;
      FRootDirEntries: Longint;
      FCluster2Sector: Longint;
      FFATSize: Longint;
      FFAT: Pointer;
      FEndingCluster: Longint;
      FSerial: Longint;
      FLabel: String;
      procedure IOCTL(Command: Longint; var Regs: T32Regs);
      function ObtainVolumeLock(Level: Byte; Lock: TLockType): Boolean;
      procedure ReleaseVolumeLock(Lock: TLockType);
      function VolumeLock(Lock: TLockType): Boolean;
      procedure VolumeUnlock(Lock: TLockType);
      function GetDrive: Char;
      procedure SetDrive(Value: Char);
      procedure CheckFileSystem;
      function WriteLogicalSectorEx(StartSector, nSectors: Longint; var Buffer; nSize: Longint): Boolean;
      function ReadLogicalSectorEx(StartSector, nSectors: Longint; var Buffer; nSize: Longint): Boolean;
      function GetFATCluster(FATIndex: Longint): Longint;
      function GetFATEntry(CopyOfFAT: Longint; Cluster: Longint): Longint;
      procedure SetFATEntry(CopyOfFAT: Longint; Cluster: Longint; Value: Longint);
      function VolumeCheck(var Flags: Longint): Boolean;
      function GetMediaID(MID: PMID): Boolean;
      function ReadRootDIR(var DIR: PDIR_Entry; var Entries: Longint): Boolean;
      function ReadOtherDir(Cluster: Longint; var DIR: PDIR_Entry; var Entries: Longint): Boolean;
    public
      constructor Create; virtual;
      destructor Destroy; override;
      function ValidCluster(Cluster: Longint): Boolean; 
      // Check cluster for bounds validation
      function ReadLogicalSector(StartSector, nSectors: Longint; var Buffer; nSize: Longint): Boolean;
      // Reads nSectors from disk into Buffer of size nSize startin at StartSector number
      function WriteLogicalSector(StartSector, nSectors: Longint; var Buffer; nSize: Longint): Boolean;
      // Writes nSectors to disk from Buffer of size nSize startin at StartSector number
      procedure FlushFAT;
      // Flushes internal memory FAT image to disk
      procedure DriveReread;
      // Rescans drive (usually used after changes made)
      function ReadCluster(Cluster: Longint; var Buffer; BufferSize: Longint): Boolean;
      // Reads cluster number Cluster into Buffer of size BufferSize 
      function WriteCluster(Cluster: Longint; var Buffer; BufferSize: Longint): Boolean;
      // Writes cluster number Cluster to disk from Buffer of size BufferSize 
      function ReadClusterChain(StartCluster: Longint; var Buffer: Pointer; var BufferSize: Longint): Boolean;
      // Reads total cluster chain starting from StartCluster into Buffer returning size of buffer BufferSize
      function WriteClusterChain(StartCluster: Longint; Buffer: Pointer; BufferSize: Longint): Boolean;
      // Writes total cluster chain starting from StartCluster from Buffer of size BufferSize
      function SeekForChainStart(Cluster: Longint): Longint;
      // Seeks for starting chain cluster number, Cluster represents any mid cluster of a chain
      function DIRPath(Path: String; var DIR: PDIR_Entry; var Entries: Longint): Boolean;
      // Returns all directory entries of a path Path including deleted entries into
      // DIR as a pointer to TDIR_Entry array returning amount of Entries found
      function ExtractDIREntry(Path: String; var DIR: TDIR_Entry): Boolean;
      // Gets DIR entry of a Path (or file as Path) specified
      property Drive: Char read GetDrive write SetDrive;
      // Assign drive letter for class
      property LogicalSectors: Longint read FLogicalSectors;
      // Amount of Logical sectors on selected drive
      property PhysicalSectors: Longint read FPhysicalSectors;
      // Amount of Physical sectors on selected drive
      property Heads: Longint read FHeads;
      // Amount of heads on selected drive
      property Cylinders: Longint read FCylinders;
      // Amount of Cylinders on selected drive
      property BytesPerSector: Longint read FBytesPerSector;
      // Amount of Bytes per sector on selected drive
      property PhysicalDrive: Longint read FPhysicalVolume;
      // Physical drive number
      property SectorsPerCluster: Longint read FSectorsPerCluster;
      // Amount of sectors per cluster on selected drive
      property SectorsPerFAT: Longint read FSectorsPerFAT;
      // Amount of sectors per FAT on selected drive
      property FATSector[FATIndex: Longint]: Longint read GetFATCluster;
      // Returns first sector number of a FAT copy FATIndex
      property FATCount: Longint read FFATCount;
      // Amount of FAT copies
      property RootDirCluster: Longint read FRootDirCluster;
      // First cluster number of a Root dir (has meaning only for FAT32)
      property RootDirSector: Longint read FRootDirSector;
      // First sector number of a Root dir
      property RootDirEntries: Longint read FRootDirEntries;
      // Amount of a Root dir entries for a drive (non FAT32 only)
      property Cluster2Sector: Longint read FCluster2Sector;
      // Gives exact Sector number of Cluster number 2 (data start for non FAT32 drives) 
      property EndingCluster: Longint read FEndingCluster;
      // Maximum FAT number for a drive
      property FATEntry[CopyOfFAT, Cluster: Longint]: Longint read GetFATEntry write SetFATEntry;
      // Gets or sets FAT Entry for cluster Cluster and for FAT copy CopyOfFAT
      property Serial: Longint read FSerial;
      // Gets volume serial number 
      property VolumeLabel: String read FLabel;
      // Shows volume label
      property FileSystem: TFileSystem read FFileSystem;
      // What kind of FAT system is used for a drive
    end;

procedure ParseDOSDate(Date: Word; var Day, Month, Year: Word);
// Use this function to get Day, Month and Year of a Date fields in Dir_Entry

procedure ParseDOSTime(Time: Word; var Hour, Minute, Second: Word);
// Use this function to get Hour, Minute and Second of a Time fields in Dir_Entry

implementation

procedure ParseDOSTime(Time: Word; var Hour, Minute, Second: Word);
begin
   Second := (Time and $001f)*2;
   Minute := (Time and $07e0) shr 5;
   Hour := (Time and $f800) shr 11;
end;

procedure ParseDOSDate(Date: Word; var Day, Month, Year: Word);
begin
   Day := Date and $001f;
   Month := (Date and $01e0) shr 5;
   Year := (Date and $fe00) shr 9;
end;

function TDiskIO.GetFATCluster(FATIndex: Longint): Longint;
begin
   Result := 0;
   if FFATCount=0 then Exit;
   if FATIndex<1 then FATIndex := 1;
   if FATIndex>FFATCount then FATIndex := FFATCount;
   Result := Longint(Pointer(Longint(FFATSector)+(FATIndex-1)*4)^);
end;

procedure TDiskIO.IOCTL(Command: Longint; var Regs: T32Regs);
var R: T32Regs;
    cb: DWord;
begin
   if FHandle = 0 then Exit;
   R := Regs;
   DeviceIOControl(FHandle, Command,
                   @R, SizeOf(R), @R, SizeOf(R), cb, NIL);
   Regs := R;
end;

function TDiskIO.ObtainVolumeLock(Level: Byte; Lock: TLockType): Boolean;
var R: T32Regs;
    cb: DWord;
    W: Longint;
    V: Byte;
begin
   W := Level;
   W := W shl 8;
   if Lock = lPhysical then
      begin
         V := FPhysicalVolume;
         R.EAX := $440D;
         R.EBX := W or V;
         R.ECX := $084B;
         if Level = 1 then R.EDX := 1 else R.EDX := 0;
         DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
                         @R, SizeOf(R), @R, SizeOf(R), cb, NIL);
         Result := (R.Flags and 1)=0;
      end else
      begin
         R.EAX := $440D;
         R.EBX := W or (FVolume and $FF);
         R.ECX := $084A;
         R.EDX := 0;
         DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
                         @R, SizeOf(R), @R, SizeOf(R), cb, NIL);
         Result := (R.Flags and 1)=0;
      end;
end;

procedure TDiskIO.ReleaseVolumeLock(Lock: TLockType);
var R: T32Regs;
    cb: DWord;
    V: Byte;
begin
   if Lock = lPhysical then
      begin
         V := FPhysicalVolume;
         R.EAX := $440D;
         R.EBX := V;
         R.ECX := $086B;
         DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
                         @R, SizeOf(R), @R, SizeOf(R), cb, NIL);
      end else
      begin
         R.EAX := $440D;
         R.EBX := FVolume and $FF;
         R.ECX := $086A;
         DeviceIOControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
                         @R, SizeOf(R), @R, SizeOf(R), cb, NIL);
      end;
end;

function TDiskIO.VolumeLock(Lock: TLockType): Boolean;
begin
   Result := False;
   if FHandle = 0 then Exit;
   if FVolume = 0 then Exit;
   if Lock = lPhysical then
      if FPhysicalVolume = -1 then Exit;
   Result := ObtainVolumeLock(1, Lock);
   if not Result then Exit;
   Result := ObtainVolumeLock(2, Lock);
   if not Result then
      begin
         ReleaseVolumeLock(Lock);
         Exit;
      end;
   Result := ObtainVolumeLock(3, Lock);
   if not Result then
      begin
         ReleaseVolumeLock(Lock);
         ReleaseVolumeLock(Lock);
         Exit;
      end;
end;

procedure TDiskIO.VolumeUnlock(Lock: TLockType);
begin
   if FHandle = 0 then Exit;
   if FVolume = 0 then Exit;
   if Lock = lPhysical then
      if FPhysicalVolume = -1 then Exit;
   ReleaseVolumeLock(Lock);
   ReleaseVolumeLock(Lock);
   ReleaseVolumeLock(Lock);
end;

constructor TDiskIO.Create;
begin
   FVolume := 0;
   FPhysicalVolume := -1;
   FLogicalSectors := 0;
   FPhysicalSectors := 0;
   FHeads := 0;
   FCylinders := 0;
   FBytesPerSector := 0;
   FSectorsPerCluster := 0;
   FSectorsPerFAT := 0;
   FFATSector := NIL;
   FFATSize := 0;
   FFAT := NIL;
   FFATCount := 0;
   FRootDirEntries := 0;
   FEndingCluster := 0;
   FRootDirCluster := 0;
   FRootDirSector := 0;
   FSerial := 0;
   FLabel := '';
   FCluster2Sector := 0;
   FFileSystem := fsNone;
   FHandle := CreateFile('\\.\VWIN32', GENERIC_READ or GENERIC_WRITE,
                         FILE_SHARE_READ or FILE_SHARE_WRITE,
                         NIL, OPEN_EXISTING,
                         FILE_ATTRIBUTE_NORMAL, 0);
   if FHandle = INVALID_HANDLE_VALUE then FHandle := 0;
end;

destructor TDiskIO.Destroy;
begin
   if FHandle <> 0 then CloseHandle(FHandle);
   if FFATSector <> NIL then FreeMem(FFATSector);
   if FFAT <> NIL then FreeMem(FFAT);
   inherited Destroy;
end;

function TDiskIO.GetDrive: Char;
begin
   Result := #0;
   if FVolume = 0 then Exit;
   Result := Char(Byte(FVolume)+$40);
end;

function TDiskIO.VolumeCheck(var Flags: Longint): Boolean;
var R: T32Regs;
    cb: DWord;
begin
   Result := False;
   if FHandle = 0 then Exit;
   if FVolume = 0 then Exit;
   R.EAX := $4409;
   R.EBX := FVolume;
   R.Flags := 1;
   if not DeviceIoControl(FHandle, VWIN32_DIOC_DOS_IOCTL,
          @R, SizeOf(R), @R, SizeOf(R), cb, NIL) then Exit;
   if (R.Flags and 1) <> 0 then Exit;
   Flags := Word(R.EDX);
   Result := True;
end;

function TDiskIO.GetMediaID(MID: PMID): Boolean;
var R: T32Regs;
    cb: DWord;
begin