{$F+,I-,O+,X+}
unit Disks;

interface

type
  DiskClass =
    (Floppy360, Floppy12, Floppy720, Floppy144, Floppy288, OtherFloppy,
     Bernoulli, HardDisk, RamDisk, SubstDrive, NetDisk, UnknownDisk,
     InvalidDrive, CDROMDisk, DoubleSpaceDisk, Stacker4Disk, NetResource);

  TSeekDrive = (sdDisk, sdUser, sdAuto);

  TUserDrives = Array['A'..'Z'] of Byte;

const
  udNoLFN   = $40;
  udEnabled = $80;

var
  UserDrives: TUserDrives;

function GetDiskClass(Drive: Char; var SubstDriveChar: Char): DiskClass;
function GetDiskDescription(Class: DiskClass): String;
function WhatFloppy(Drive: Char): Byte;
function IsRemovable(Drive: Char): Boolean;
function IsRemote(Drive: Char): Boolean;
procedure ClassifyDrive(Drive: Char; var Class: DiskClass);
function FDiskSize(Drive: Byte): Real;
function FDiskFree(Drive: Byte): Real;
function TotalDiskSpace(Drive: Byte): Longint;
function FreeDiskSpace(Drive: Byte): Longint;
{
function LDiskSize(Drive: Byte): Longint;
function LDiskFree(Drive: Byte): Longint;
}
function GetClusterSize(Drive: Byte): Longint;

function UserDrivesEnabled: Byte;
function UserDriveEnabled(Drive: Char): Boolean;
function GetUserDriveClass(Drive: Char): DiskClass;
function DriveAvailable(Drive: Char; Mode: TSeekDrive): Boolean;

implementation

uses Dos, Drivers, Defaults;

function GetDiskClass(Drive: Char; var SubstDriveChar: Char): DiskClass;
type
  ParamBlock = record
    DriveNumber, DeviceDriverUnit: Byte;
    BytesPerSector: Word;
    SectorsPerCluster, ShiftFactor: Byte;
    ReservedBootSectors: Word;
    FatCopies: Byte;
    RootDirEntries, FirstDataSector, HighestCluster: Word;
    SectorsPerFat: Byte;
    RootDirStartingSector: Word;
    DeviceDriverAddress: Pointer;
    Media2and3: Byte;
    Media4: Byte;
    NextDeviceParamBlock: Pointer;
  end;
  ParamBlockPtr = ^ParamBlock;
var
  DriveNum: Byte;
  MediaDescriptor: Byte;
  Regs: Registers;
begin
  GetDiskClass := InvalidDrive;

  SubstDriveChar := Drive;

  Drive := Upcase(Drive);
  case Drive of
    'A'..'Z': DriveNum := Ord(Drive) - $40;
    else Exit;
  end;

  with Regs do begin
    AH := $1C;
    DL := DriveNum;
    MsDos(Regs);
    MediaDescriptor := Mem[DS:BX];

    AH := $32;
    DL := DriveNum;
    MsDos(Regs);

    if (Flags and fCarry <> 0) or (AL = $FF) then Exit;

    with ParamBlockPtr(Ptr(DS,BX))^ do begin
      if DriveNumber <> Pred(DriveNum) then begin
        GetDiskClass := SubstDrive;
        SubstDriveChar := Char(Ord('A') + DriveNumber);
      end
      else if FatCopies = 1 then
        GetDiskClass := RamDisk
      else if MediaDescriptor = $F8 then
        GetDiskClass := HardDisk
      else if (MediaDescriptor = $FD) and (SectorsPerFat <> 2) then
        GetDiskClass := Bernoulli
      else if MediaDescriptor >= $F9 then
        case HighestCluster of
           355 : GetDiskClass := Floppy360;
           714,
          1423 : GetDiskClass := Floppy720;
          2372 : GetDiskClass := Floppy12;
          else   GetDiskClass := OtherFloppy;
        end
      else if (MediaDescriptor = $F0) and (HighestCluster = 2848) then
        GetDiskClass := Floppy144
      else
        GetDiskClass := UnknownDisk;
    end;
  end;
end;

function GetDiskDescription(Class: DiskClass): String;
begin
  case Class of
    Floppy360: GetDiskDescription := 'Floppy 360 kB 5¬';
    Floppy720: GetDiskDescription := 'Floppy 720 kB 5¬';
    Floppy12: GetDiskDescription := 'Floppy 1.2 MB 5«';
    Floppy144: GetDiskDescription := 'Floppy 1.44 MB 3«';
    Floppy288: GetDiskDescription := 'Floppy 2.88 MB 3«';
    OtherFloppy: GetDiskDescription := 'Floppy drive';
    Bernoulli: GetDiskDescription := 'Bernoulli drive';
    HardDisk: GetDiskDescription := 'Hard disk';
    RamDisk: GetDiskDescription := 'RAM disk';
    SubstDrive: GetDiskDescription := 'Substitute drive';
    NetDisk: GetDiskDescription := 'Network disk';
    UnknownDisk: GetDiskDescription := 'Unknown disk';
    CDROMDisk: GetDiskDescription := 'CD-ROM disk';
    DoubleSpaceDisk: GetDiskDescription := 'DoubleSpace disk';
    Stacker4Disk: GetDiskDescription := 'Stacker disk';
    NetResource: GetDiskDescription := 'Network resource';
    else GetDiskDescription := 'Invalid drive';
  end;
end;

function DriveInstalled(Drive: Char): Boolean; assembler;
asm
        MOV     AH,19H
        INT     21H
        MOV     BL,AL
        MOV     DL,Drive
        SUB     DL,'A'
        MOV     AH,0EH
        INT     21H
        MOV     AH,19H
        INT     21H
        MOV     CX,0
        CMP     AL,DL
        JNE     @@1
        MOV     CX,1
        MOV     DL,BL
        MOV     AH,0EH
        INT     21H
@@1:    XCHG    AX,CX
end;

function WhatFloppy(Drive: Char): Byte;
begin
  Drive := Upcase(Drive);
asm
        MOV     DL,Drive
        SUB     DL,'A'
        MOV     AX,0800H
        INT     13H
        JNC     @@1
        XOR     BX,BX
@@1:
        MOV     @Result,BL
end;
end;

function IsRemovable(Drive: Char): Boolean;
begin
  Drive := Upcase(Drive);
asm
        MOV     BL,Drive
        SUB     BL,'A'-1
        MOV     AX,4408H
        INT     21H
        XOR     AL,1
        MOV     @Result,AL
end;
end;

function IsRemote(Drive: Char): Boolean;
begin
  Drive := Upcase(Drive);
asm
        MOV     BL,Drive
        SUB     BL,'A'-1
        MOV     AX,4409H
        INT     21H
        JC      @@1
        CMP     AL,0
        JNE     @@1
        TEST    DX,1000H
        JE      @@1
        MOV     AL,1
        JMP     @@2
@@1:
        XOR     AL,AL
@@2:
        MOV     @Result,AL
end;
end;

function IsSubst(Drive: Char): Boolean;
begin
  Drive := Upcase(Drive);
asm
        MOV     BL,Drive
        SUB     BL,'A'-1
        MOV     AX,4409H
        INT     21H
        JC      @@1
        CMP     AL,0
        JNE     @@1
        TEST    DX,8000H
        JE      @@1
        MOV     AL,1
        JMP     @@2
@@1:
        XOR     AL,AL
@@2:
        MOV     @Result,AL
end;
end;

function IsCD_ROM(Drive: Char): Boolean; { Check for CD-ROM v2.00+ }
begin
  Drive := Upcase(Drive);
asm
        MOV     AX,1500H
        SUB     BX,BX
        INT     2FH
        OR      BX,BX
        JZ      @@1
        MOV     AX,150BH
        SUB     CH,CH
        MOV     CL,Drive
        SUB     CL,'A' { -1 Fixed 19.09.95 }
        INT     2FH
        CMP     BX,0ADADH
        JNE     @@1
        OR      AX,AX
        JZ      @@2
        MOV     AL,1
        JMP     @@2
@@1:
        XOR     AL,AL
@@2:
        MOV     @Result,AL
end;
end;

function IsDoubleSpace(Drive: Char): Boolean;
begin
  Drive := Upcase(Drive);
asm
        MOV     AX,4A11H
        MOV     BX,1
        MOV     DL,Drive
        SUB     DL,'A'
        INT     2FH
        OR      AX,AX
        JNZ     @@1
        CMP     DL,BL
        JE      @@1
        TEST    BL,10000000B
        JZ      @@1
        ADD     DL,'A'
        CMP     DL,Drive
        JNE     @@1
        MOV     AL,1
        JMP     @@2
@@1:
        XOR     AL,AL
@@2:
        MOV     @Result,AL
end;
end;

procedure ClassifyDrive(Drive: Char; var Class: DiskClass);
var
  B: Byte;
  SD: Char;
begin
  FailSysErrors := True;
  if (DriveListOptions and dlGetFromUser <> 0) and
    UserDriveEnabled(Drive) then Class := GetUserDriveClass(Drive)
  else if DisableSysInfo then Class := UnknownDisk
  else if IsCD_ROM(Drive) then Class := CDROMDisk
  else if IsRemote(Drive) then Class := NetDisk
  else if IsSubst(Drive) then Class := SubstDrive
  else if IsDoubleSpace(Drive) then Class := DoubleSpaceDisk
  else
  begin
    B := WhatFloppy(Drive);
    Dec(B);
    if B <= Byte(OtherFloppy) then Class := DiskClass(B)
    else Class := GetDiskClass(Drive, SD);
  end;
  FailSysErrors := False;
end;

function GetDiskInfo(Drive: Byte;
  var AAvailClusters, ATotalClusters,
  ABytesPerSector, ASectorsPerCluster: Longint): Boolean;
type
 TEFS = record
  r1: Word;
  r2: Word;
  SectorsPerCluster: Longint;
  BytesPerSector: Longint;
  AvailClusters: Longint;
  TotalClusters: Longint;
  r3: Array[0 .. 23] of byte;
end;

var
 Dir: Longint;
 EFS: TEFS;
 Regs: Registers;
begin
 FillChar(EFS, SizeOf(EFS), 0);
 if Drive = 0 then
  begin
   Regs.AH := $19;
   Intr($21, Regs);
   Dir := $5c3a41+Regs.AL;
  end
 else Dir := $5c3a40+Drive;
 with Regs do
  begin
   AX := $7303;
   DS := Seg(Dir);
   DX := Ofs(Dir);
   ES := Seg(EFS);
   DI := Ofs(EFS);
   CX := SizeOf(EFS);
   asm
    stc
   end;
   Intr($21, Regs);
  end;
  if (Regs.Flags and fCarry <> 0) or (EFS.SectorsPerCluster = 0) then
   begin
    asm
     mov ah, 36h
     mov dl, Drive
     int 21h
     mov Word ptr EFS.SectorsPerCluster, ax
     mov Word ptr EFS.AvailClusters, bx
     mov Word ptr EFS.BytesPerSector, cx
     mov Word ptr EFS.TotalClusters, dx
    end;
   end;
   if EFS.SectorsPerCluster = $ffff then GetDiskInfo := False
   else
    begin
     GetDiskInfo := True;
     ASectorsPerCluster := EFS.SectorsPerCluster;
     AAvailClusters := EFS.AvailClusters;
     ABytesPerSector := EFS.BytesPerSector;
     ATotalClusters := EFS.TotalClusters;
    end;
end;

function GetClusterSize(Drive: Byte): Longint;
var
  Size: Longint;
  ClustersAvailable, TotalClusters,
  BytesPerSector, SectorsPerCluster: Longint;
begin
  Size := 0;
  if GetDiskInfo(Drive, ClustersAvailable, TotalClusters,
    BytesPerSector, SectorsPerCluster) then
      Size := BytesPerSector * SectorsPerCluster;
  if Size = 0 then Size := $8000;
  GetClusterSize := Size;
end;

function FDiskSize(Drive: Byte): Real;
var
  ClustersAvailable, TotalClusters,
  BytesPerSector, SectorsPerCluster: Longint;
  R: Real;
begin
  if GetDiskInfo(Drive, ClustersAvailable, TotalClusters,
    BytesPerSector, SectorsPerCluster) then
  begin
   R := SectorsPerCluster;
   FDiskSize := R * BytesPerSector * TotalClusters;
  end
  else FDiskSize := -1;
end;

function FDiskFree(Drive: Byte): Real;
var
  ClustersAvailable, TotalClusters,
  BytesPerSector, SectorsPerCluster: Longint;
  R: Real;
begin
  if GetDiskInfo(Drive, ClustersAvailable, TotalClusters,
    BytesPerSector, SectorsPerCluster) then
  begin
   R := SectorsPerCluster;
   FDiskFree := R * BytesPerSector * ClustersAvailable;
  end
  else FDiskFree := -1;
end;

function TotalDiskSpace(Drive: Byte): Longint;
var
  L: Longint;
  R: Real;
begin
  R := FDiskSize(Drive);
  if R < 0 then L := -1
  else if R > MaxLongint then L := MaxLongint
  else L := Trunc(R);
  TotalDiskSpace := L;
end;

function FreeDiskSpace(Drive: Byte): Longint;
var
  L: Longint;
  R: Real;
begin
  R := FDiskFree(Drive);
  if R < 0 then L := -1
  else if R > MaxLongint then L := MaxLongint
  else L := Trunc(R);
  FreeDiskSpace := L;
end;

{
function LDiskSize(Drive: Byte): Longint;
var
  ClustersAvailable, TotalClusters,
  BytesPerSector, SectorsPerCluster: Longint;
begin
  if GetDiskInfo(Drive, ClustersAvailable, TotalClusters,
    BytesPerSector, SectorsPerCluster) then
   LDiskSize := SectorsPerCluster * BytesPerSector * TotalClusters
  else LDiskSize := -1;
end;

function LDiskFree(Drive: Byte): Longint;
var
  ClustersAvailable, TotalClusters,
  BytesPerSector, SectorsPerCluster: Longint;
begin
  if GetDiskInfo(Drive, ClustersAvailable, TotalClusters,
    BytesPerSector, SectorsPerCluster) then
   LDiskFree := SectorsPerCluster * BytesPerSector * ClustersAvailable
  else LDiskFree := -1;
end;
}

function UserDrivesEnabled: Byte;
var
  B: Byte;
  Drive: Char;
begin
  B := 0;
  for Drive := 'A' to 'Z' do
    if UserDrives[Drive] and udEnabled <> 0 then Inc(B);
  UserDrivesEnabled := B;
end;

function UserDriveEnabled(Drive: Char): Boolean;
begin
  UserDriveEnabled := UserDrives[Drive] and udEnabled <> 0;
end;

function GetUserDriveClass(Drive: Char): DiskClass;
var
  B: Byte;
begin
  B := UserDrives[Drive] and not (udNoLFN + udEnabled);
  if B = 0 then B := Byte(UnknownDisk) else Dec(B);
  GetUserDriveClass := DiskClass(B);
end;

function DriveAvailable(Drive: Char; Mode: TSeekDrive): Boolean;
var
  User: Boolean;
begin
  if Mode = sdDisk then User := False
  else if Mode = sdUser then User := True
  else User := UserDrivesEnabled <> 0;
  if User and (DriveListOptions and dlGetFromUser <> 0) then
    DriveAvailable := UserDriveEnabled(Drive)
  else DriveAvailable := DriveInstalled(Drive);
end;

end.