unit Drives;

{ see TEST program below !! }

{ Unit Drives, written by Salvatore Besso   }
{ mc8505@mclink.it                          }

{ This unit is freeware and is donated to   }
{ the SWAG archival group.                  }

{ Finally, a Drives unit that correctly     }
{ works in both real and protected mode,    }
{ in a Windows 95 DOS box, and that doesn't }
{ require a media to be present in the      }
{ removable drive.                          }

{ This unit is still not able to correctly  }
{ recognize Iomega Zip drives in a Windows  }
{ 95 DOS box for now (they are recognized   }
{ as removable media). As soon as new       }
{ informations will be available from the   }
{ interrupt list of Ralph Brown, the unit   }
{ will be modified. Actually informations   }
{ about Iomega interrupt are very scarce.   }

{ A new Dpmi unit is beyond the end of this }
{ unit                                      }

{ Test program is beyond the end of the     }
{ Drives and Dpmi units                     }

{ If you have any feedback, feel free to    }
{ e-mail me                                 }

interface

uses
  {$IFDEF DPMI}
  Dpmi,
  {$ENDIF}
  Dos;

const

  { dtXXXX constants - Drive Type }

  dtInvalid   = $0;
  dtUnknown   = $1;

  { Floppy disk }

  dt8Single   = $2;
  dt8Double   = $4;
  dt360       = $8;
  dt1200      = $10;
  dt720       = $20;
  dt1440      = $40;
  dt2880      = $80;
  dtAnyFloppy = $FE;

  { Other media }

  dtTape      = $100;
  dtFloptical = $200;
  dtRamDisk   = $400;
  dtCdRom     = $800;
  dtIomegaZip = $1000;

  dtHardDisk  = $80000;

  { Other attributes }

  dtRemovable = $100000;
  dtRemote    = $200000;

type

  PParamBlock = ^TParamBlock;
  TParamBlock = record
    SpecialFunctions: Byte;     { Special functions }
    DeviceType      : Byte;     { Device type }
    DeviceAttributes: Word;     { Device attributes }
    MaxCylinders    : Word;     { Number of cylinders }
    MediaType       : Byte;     { Media type }
    { Beginning of BIOS parameter block (BPB) }
    BytesPerSector  : Word;     { Bytes per sector }
    SectPerCluster  : Byte;     { Sectors per cluster }
    ReservedSectors : Word;     { Number of reserved sectors }
    NumberFats      : Byte;     { Number of FATs }
    RootDirEntries  : Word;     { Number of root-directory entries }
    TotalSectors    : Word;     { Total number of sectors }
    MediaDescriptor : Byte;     { Media descriptor }
    SectorsPerFat   : Word;     { Number of sectors per FAT }
    SectorsPerTrack : Word;     { Number of sectors per track }
    NumberHeads     : Word;     { Number of heads }
    HiddenSectors   : LongInt;  { Number of hidden sectors }
    HugeSectors     : LongInt   { Number of sectors if TotalSectors = 0 }
    { End of BIOS parameter block (BPB) }
  end;

  PtrRec = record   { replicated from OBJECTS.PAS to avoid using the unit }
    Ofs,Seg: Word
  end;

  DriveLetters = 'A'..'Z';
  DriveSet     = Set of DriveLetters;

{ returns all available drives in a DriveSet type variable }

procedure GetDrives (var Drive: DriveSet);

{ returns drive type }

function GetDriveType (Drive: Char): LongInt;

implementation

procedure GetDrives (var Drive: DriveSet);

var
  DriveName: array[1..2] of Char;
  FCB      : array[0..43] of Char;
  Dr       : LongInt;

begin
  asm
        PUSH    SI
        PUSH    DI
        PUSH    ES
        PUSH    DS
        MOV     SI,SS     { Stack points to local variables }
        MOV     DS,SI     { also DS ... }
        PUSH    DS
        POP     ES        { ...and ES }
        MOV     BYTE PTR [DriveName],'A'
        MOV     BYTE PTR [DriveName + 1],':'
        MOV     WORD PTR [Dr],0
        MOV     WORD PTR [Dr + 2],0
        MOV     DX,1
        XOR     CX,CX
  @@1:  LEA     SI,DriveName
        LEA     DI,FCB
        MOV     AX,290EH  { Function 29H - Parse Filename - AL = options }
        INT     21H
        CMP     AL,0FFH
        JE      @@2
        PUSH    DX
        PUSH    CX
        MOV     AX,4409H  { SUBST drives are ignored }
        MOV     BL,BYTE PTR [DriveName]
        SUB     BL,'@'
        INT     21H
        JC      @@2
        TEST    DH,10000000B
        POP     CX
        POP     DX
        JNZ     @@2
        OR      WORD PTR [Dr],DX
        OR      WORD PTR [Dr + 2],CX
  @@2:  SHL     DX,1
        RCL     CX,1
        INC     BYTE PTR [DriveName]
        CMP     BYTE PTR [DriveName],'Z'
        JBE     @@1
        SHL     WORD PTR [Dr],1
        RCL     WORD PTR [Dr + 2],1
        POP     DS
        POP     ES
        POP     DI
        POP     SI
  end;
  Drive := DriveSet (Dr)
end;

function GetDriveType (Drive: Char): LongInt;

var
  DPB    : PParamBlock;
  SegInfo: Word;
  Regs   : Registers;
  Temp   : Byte;
  Result : LongInt;
  {$IFDEF DPMI}
  Size   : LongInt;
  {$ENDIF}

function GetDevParms (Drive: Char; var DPB: PParamBlock; Segm: Word): Boolean;

var
  Regs: Registers;

begin
  GetDevParms := False;
  FillChar (Regs,SizeOf (Registers),0);
  Regs.AX := $440D;
  Regs.BL := Byte (Drive) - 64;
  Regs.CH := $08;                       { category: disk drive }
  Regs.CL := $60;                       { device parameters    }
  {$IFNDEF DPMI}
  Regs.DS := PtrRec (DPB).Seg;
  Regs.DX := PtrRec (DPB).Ofs;
  MsDos (Regs);
  {$ELSE}
  Regs.DS := Segm;
  Regs.DX := 0;
  if NOT DpmiMsDos (Regs) then Exit;
  {$ENDIF}
  GetDevParms := Regs.Flags and fCarry = 0
end;

function IsDriveRemote (Drive: Char): Boolean; assembler;

asm
        MOV     AX,4409H  { IOCTL - Check if block device remote }
        MOV     BL,Drive  { BL = drive                           }
        SUB     BL,'@'    { 1 = A:, 2 = B:, etc...               }
        INT     21H
        XOR     AX,AX
        JC      @@1
        AND     DH,00010000B
        JZ      @@1
        INC     AX
  @@1:
end;

function IsCDRomDrive (Drive: Char): Boolean; assembler;

asm
        MOV     AX,150BH  { MSCDEX.EXE installation test }
        XOR     CH,CH     { CX = drive                   }
        MOV     CL,Drive
        SUB     CL,'A'    { 0 = A:, 1 = B:, etc...       }
        INT     2FH
        PUSH    AX
        POP     CX
        XOR     AX,AX
        JCXZ    @@1
        TEST    BX,0ADADH
        JZ      @@1
        INC     AX
  @@1:
end;

function IsIomegaZip: Boolean;

var
  Regs  : Registers;
  Result: Boolean;

begin
  { Find first GUEST.EXE... }
  FillChar (Regs,SizeOf (Registers),0);
  Regs.AX := $5700;                      { GUEST.EXE installation test }
  Regs.BX := $0201;                      { Iomega ID ???               }
  Regs.DX := $496F;                      { 'Io'                        }
  {$IFNDEF DPMI}
  Intr ($2F,Regs);
  {$ELSE}
  if NOT DpmiIntr ($2F,Regs) then Exit;
  {$ENDIF}
  Result := Regs.AL = $FF;
  if NOT Result then
  begin
    { ...GUEST.EXE not found: Find GUEST95.EXE...  }
    { Interrupt informations for GUEST95.EXE still }
    { not available                                }
  end;
  IsIomegaZip := Result
end;

begin { GetDriveType }
  GetDriveType := dtInvalid;
  {$IFNDEF DPMI}
  New (DPB);
  SegInfo := 0;
  {$ELSE}
  Size := SizeOf (TParamBlock);
  if NOT DpmiGetMem (Pointer (DPB),SegInfo,Size) then Exit;
  {$ENDIF}
  FillChar (DPB^,SizeOf (TParamBlock),0);
  FillChar (Regs,SizeOf (Regs),0);
  Regs.AX := $4408;                     { removable media ? }
  Regs.BL := Byte (Drive) - 64;
  {$IFNDEF DPMI}
  MsDos (Regs);
  {$ELSE}
  if NOT DpmiMsDos (Regs) then
  begin
    DpmiFreeMem (Pointer (DPB));
    Exit
  end;
  {$ENDIF}
  Temp := 0;
  if Regs.Flags and fCarry <> 0 then  { error, check error code in AX }
  begin
    { Driver does NOT support this call, so guess as a hard disk }
    if Regs.AX = 1 then Temp := 3
  end
  else begin
    if Regs.AX = 0 then
      Temp := 2          { removable media, floppy, WORM, Floptical, ZIP }
    else Temp := 3       { or hard disk, ramdisk or CD-ROM               }
  end;
  Result := dtInvalid;
  case Temp of
    { Removable }
    2: if GetDevParms (Drive,DPB,SegInfo) then
    begin
      case DPB^.DeviceType of
        0: Result := dt360;
        1: Result := dt1200;
        2: Result := dt720;
        3: Result := dt8Single;
        4: Result := dt8Double;
        5: if IsIomegaZip then Result := dtIomegaZip else Result := dtHardDisk;
        6: Result := dtTape;
        7: Result := dt1440;
        8: Result := dtFloptical;
        9: begin
          if (DPB^.MaxCylinders = 80) and (DPB^.NumberHeads = 2) then
            Result := dt2880
          else if IsIomegaZip then
            Result := dtIomegaZip
          else Result := dtUnknown
        end
        else Result := dtUnknown
      end;
      if Result > dtUnknown then Result := Result or dtRemovable
    end;
    { Fixed }
    3: if GetDevParms (Drive,DPB,SegInfo) then
      if DPB^.DeviceType = 5 then
        Result := dtHardDisk
      else Result := dtUnknown
    else Result := dtRamDisk
  end;
  if IsDriveRemote (Drive) then
    if IsCDRomDrive (Drive) then
      Result := dtCdRom or dtRemovable
    else Result := Result or dtRemote;
  {$IFNDEF DPMI}
  Dispose (DPB);
  {$ELSE}
  if NOT DpmiFreeMem (Pointer (DPB)) then Exit;
  {$ENDIF}
  GetDriveType := Result
end;

end.

(*

unit Dpmi;

{$IFNDEF DPMI}
  Error ! this code works in Protected Mode only
{$ENDIF}

{$G+,S-}

interface

uses
  Dos;

{ Virtual interrupt state values for use with the SetInterruptState and
  GetInterruptState functions. }

const
  intDisabled = False;
  intEnabled  = True;

{ Return values for MemInitSwapFile and MemCloseSwapFile }

const
  rtmOK          = $0;
  rtmNoMemory    = $1;
  rtmFileIOError = $22;

{ TRealModeRegs is a real mode registers data structure for use with the
  RealModeInt, RealModeCall, RealModeIntCall, and AllocRealCallback
  functions. }

type
  PRealModeRegs = ^TRealModeRegs;
  TRealModeRegs = record
    case Integer of
      0: (
        EDI,ESI,EBP,EXX,EBX,EDX,ECX,EAX: LongInt;
        Flags,ES,DS,FS,GS,IP,CS,SP,SS  : Word
      );
      1: (
        DI,DIH,SI,SIH,BP,BPH,XX,XXH: Word;
        case Integer of
          0: (
            BX,BXH,DX,DXH,CX,CXH,AX,AXH: Word
          );
          1: (
            BL,BH,BLH,BHH,DL,DH,DLH,DHH,CL,CH,CLH,CHH,AL,AH,ALH,AHH: Byte
          )
      )
  end;

{ TDescriptor is an 8-byte structure for use with the GetDescriptor and
  SetDescriptor procedures. }

type
  PDescriptor = ^TDescriptor;
  TDescriptor = array[0..7] of Byte;

{ TVersionInfo is a DPMI version information structure for use with the
  GetVersionInfo procedure. }

type
  PVersionInfo = ^TVersionInfo;
  TVersionInfo = record
    MinorVersion : Byte;          { AL }
    MajorVersion : Byte;          { AH }
    Flags        : Word;          { BX }
    ProcessorType: Byte;          { CL }
    Reserved     : Byte;          { CH }
    SlaveBaseInt : Byte;          { DL }
    MasterBaseInt: Byte           { DH }
  end;

{ Corresponds to procedure Intr but uses Registers instead of TRealModeRegs }

function DpmiIntr (IntNo: Byte; var Regs: Registers): Boolean;

{ Corresponds to procedure MsDos but uses Registers instead of TRealModeRegs }

function DpmiMsDos (var Regs: Registers): Boolean;

{ Corresponds to procedure GetMem; allocates memory in the first }
{ megabyte, accessible in both protected - through P - and real  }
{ mode - through Segment:$0000                                   }

function DpmiGetMem (var P: Pointer; var Segment: Word;
  var Size: Longint): Boolean;

{ Corresponds to procedure FreeMem; you must use it to deallocate }
{ memory allocated with DpmiGetMem                                }

function DpmiFreeMem (var P: Pointer): Boolean;

{ IncSelector returns the value to add to the first selector, and to    }
{ the next ones, to access the descriptor array allocated by DpmiGetMem }
{ when blocks greater than 64 K are requested                           }

procedure IncSelector (var Selector: Word);

{ AllocSelectors allocates one or more selectors using Dpmi function  }
{ 0000H. The return value is the base selector of the allocated block }
{ of selectors, or zero if the function is unsuccessful               }

function AllocSelectors (Count: Word): Word;

{ FreeSelector frees a selector using Dpmi function 0001H. }

function FreeSelector (Selector: Word): Boolean;

{ SegmentToSelector maps a real mode segment onto a selector using Dpmi    }
{ function 0002H. The return value is a selector, or zero if the function  }
{ is unsuccessful. Selectors allocated with this function are permanent    }
{ and can never be freed. If you need a temporary selector or pointer, use }
{ the AllocRealSelector or AllocRealPtr functions instead                  }

function SegmentToSelector (Segment: Word): Word;

{ SelectorToSegment returns the real mode segment address (paragraph) that }
{ corresponds to the base address of the given selector. The selector is   }
{ assumed to be a valid selector that references real mode memory. If this }
{ is not the case, the return value is undefined                           }

function SelectorToSegment (Selector: Word): Word;

{ GetSelectorBase returns the 32-bit linear base address of a selector }
{ using Dpmi function 0006H. The return value is zero if the function  }
{ is unsuccessful                                                      }

function GetSelectorBase (Selector: Word): LongInt;

{ SetSelectorBase sets the 32-bit linear base address of a selector }
{ using Dpmi function 0007H                                         }

function SetSelectorBase (Selector: Word; Base: LongInt): Boolean;

{ GetSelectorLimit returns the limit of the specified selector. The }
{ return value is zero if the selector is invalid                   }

function GetSelectorLimit (Selector: Word): LongInt;

{ SetSelectorLimit sets the limit of a selector using Dpmi function 0008H }

function SetSelectorLimit (Selector: Word; Limit: LongInt): Boolean;

{ GetAccessRights returns the access rights for a selector. The return }
{ value is zero if the selector is invalid                             }

function GetAccessRights (Selector: Word): Word;

{ SetAccessRights sets the access rights for a selector using Dpmi }
{ function 0009H                                                   }

function SetAccessRights (Selector: Word; AccessRights: Word): Boolean;

{ AllocSelectorAlias creates an aliased selector using Dpmi function }
{ 000AH. The return value is a selector, or zero if the function is  }
{ unsuccessful                                                       }

function AllocSelectorAlias (Selector: Word): Word;

{ GetDescriptor copies the LDT entry for the given selector into the }
{ given descriptor record using Dpmi function 000BH                  }

function GetDescriptor (Selector: Word; var Descriptor: TDescriptor): Boolean;

{ SetDescriptor copies the given descriptor record into the LDT entry }
{ for the given selector using Dpmi function 000CH                    }

function SetDescriptor (Selector: Word; var Descriptor: TDescriptor): Boolean;

{ AllocSpecificSelector allocates a specific selector using Dpmi function  }
{ 000DH. The return value is True if the selector was allocated. Otherwise }
{ the return value is False                                                }

function AllocSpecificSelector (Selector: Word): Boolean;

{ GetRealModeInt returns the contents of the given real mode interrupt }
{ vector using Dpmi function 0200H                                     }

function GetRealModeInt (Int: Byte): Pointer;

{ SetRealModeInt sets the interrupt vector for the specified real mode }
{ interrupt using Dpmi function 0201H                                  }

function SetRealModeInt (Int: Byte; Vector: Pointer): Boolean;

{ GetException returns the contents of the given exception vector using }
{ Dpmi function 0202H                                                   }

function GetException (Exception: Byte): Pointer;

{ SetException sets the exception vector for the specified exception }
{ using Dpmi function 0203H                                          }

function SetException (Exception: Byte; Vector: Pointer): Boolean;

{ GetProtModeInt returns the contents of the given protected mode }
{ interrupt vector using Dpmi function 0204H                      }

function GetProtModeInt (Int: Byte): Pointer;

{ SetProtModeInt sets the interrupt vector for the specified protected }
{ mode interrupt using Dpmi function 0205H                             }

function SetProtModeInt (Int: Byte; Vector: Pointer): Boolean;

{ RealModeInt simulates a software interrupt instruction in real mode }
{ using Dpmi function 0300H                                           }

function RealModeInt (Int: Byte; var Regs: TRealModeRegs): Boolean;

{ RealModeCall calls a real mode procedure with a far return frame using }
{ Dpmi function 0301H                                                    }

function RealModeCall (Proc: Pointer; var Regs: TRealModeRegs): Boolean;

{ RealModeIntCall calls a real mode procedure with an interrupt return }
{ frame using Dpmi function 0302H                                      }

function RealModeIntCall (Proc: Pointer; var Regs: TRealModeRegs): Boolean;

{ AllocCallback allocates a real mode callback using Dpmi function 0303H. }
{ The return value is the real mode address of the callback, or zero if   }
{ the function is unsuccessful                                            }

function AllocCallback (Proc: Pointer; var Regs: TRealModeRegs): Pointer;

{ FreeCallback frees a real mode callback using DPMI function 0304H }

function FreeCallback (Callback: Pointer): Boolean;

{ GetVersionInfo returns Dpmi version information in the specified version }
{ information record using Dpmi function 0400H                             }

procedure GetVersionInfo (var Info: TVersionInfo);

{ SetInterruptState sets the virtual interrupt state to the specified   }
{ value and returns the previous virtual interrupt state, corresponding }
{ to Dpmi functions 0900H and 0901H                                     }

function SetInterruptState (Enable: Boolean): Boolean;

{ GetInterruptState returns the current virtual interrupt state using }
{ Dpmi function 0902H                                                 }

function GetInterruptState: Boolean;

{ AllocRealSelector allocates a new selector and maps it onto the given    }
{ real mode segment address. The return value is a selector, or zero if    }
{ the function is unsuccessful. This function corresponds to Dpmi function }
{ 0002H, except that the resulting selector can be freed (using Dpmi       }
{ function 0001H) if required                                              }

function AllocRealSelector (Segment: Word): Word;

{ AllocRealPtr corresponds to AllocRealSelector, except that it works on  }
{ pointers instead of segments and selectors. The return value is a       }
{ protected mode pointer that points to the same physical memory location }
{ as the specified real mode pointer. If the function is unsuccessful the }
{ return value is NIL                                                     }

function AllocRealPtr (RealAddr: Pointer): Pointer;

{ FreeRealPtr frees the selector used in a pointer that was allocated by }
{ AllocRealPtr                                                           }

function FreeRealPtr (RealPtr: Pointer): Boolean;

{ MemInitSwapFile opens a swapfile of size FileSize. If file exists and }
{ new size is larger, this function will grow the swap file, otherwise  }
{ the call has no effect. File size is limited to 2 gigabytes.          }
{                                                                       }
{                                                                       }
{ Returns:                                                              }
{     rtmOK           - Successful                                      }
{     rtmNoMemory     - Not enough disk space                           }
{     rtmFileIOError  - Could not open/grow file                        }

function MemInitSwapFile (FileName: PChar; FileSize: LongInt): Integer;

{ MemCloseSwapFile closes the swapfile if it was created by the current }
{ task. If Delete is non 0, the swap file is deleted.                   }
{                                                                       }
{                                                                       }
{ Returns:                                                              }
{     rtmOK           - Successful                                      }
{     rtmNoMemory     - Not enough physical memory to run without       }
{                       swap file                                       }
{     rtmFileIOError  - Could not close/delete the file                 }

function MemCloseSwapFile (Delete: Integer): Integer;

implementation

var
  VersionInfo : TVersionInfo;
  Regs        : Registers;
  RealModeRegs: TRealModeRegs;
  DPMIBits    : Integer;
  SelIncr     : Integer;

function DpmiIntr (IntNo: Byte; var Regs: Registers): Boolean;

var
  Err: Integer;

begin
  FillChar (RealModeRegs,SizeOf (TRealModeRegs),0);
  RealModeRegs.AX := Regs.AX;
  RealModeRegs.BX := Regs.BX;
  RealModeRegs.CX := Regs.CX;
  RealModeRegs.DX := Regs.DX;
  RealModeRegs.DI := Regs.DI;
  RealModeRegs.SI := Regs.SI;
  RealModeRegs.BP := Regs.BP;
  RealModeRegs.DS := Regs.DS;
  RealModeRegs.ES := Regs.ES;
  asm
        MOV     AX,SEG RealModeRegs
        MOV     ES,AX
        CMP     DPMIBits,16
        JE      @@1
        DB      66H
        MOV     DI,OFFSET RealModeRegs
        DW      0000H
        JMP     @@2
  @@1:  MOV     DI,OFFSET RealModeRegs
  @@2:  MOV     BL,IntNo
        XOR     BH,BH
        XOR     CX,CX
        MOV     AX,0300H
        INT     31H
        XOR     AX,AX
        JNC     @@3
        MOV     AX,-31
  @@3:  MOV     Err,AX
  end;
  if Err = 0 then
  begin
    Regs.AX := RealModeRegs.AX;
    Regs.BX := RealModeRegs.BX;
    Regs.CX := RealModeRegs.CX;
    Regs.DX := RealModeRegs.DX;
    Regs.DI := RealModeRegs.DI;
    Regs.SI := RealModeRegs.SI;
    Regs.BP := RealModeRegs.BP;
    Regs.DS := RealModeRegs.DS;
    Regs.ES := RealModeRegs.ES;
    Regs.Flags := RealModeRegs.Flags
  end;
  DpmiIntr := Err = 0
end;

function DpmiMsDos (var Regs: Registers): Boolean;

begin
  DpmiMsDos := DpmiIntr ($21,Regs)
end;

function DpmiGetMem (var P: Pointer; var Segment: Word;
  var Size: Longint): Boolean;

begin
  Regs.AX := $0100;
  Regs.BX := (Size + 15) div 16;
  if Regs.BX = 0 then Regs.BX := $FFFF;     { Size > $000FFFF0      }
  Size := Regs.BX;                          { calculates memory     }
  Size := Size * 16;                        { effectively allocated }
  Intr ($31,Regs);
  DpmiGetMem := Regs.Flags and fCarry = 0;
  if Regs.Flags and fCarry = 0 then
  begin
    P := Ptr (Regs.DX,0);                   { selector:offset pointer }
    Segment := Regs.AX                      { segment for real mode   }
  end
  else begin
    Size := Regs.BX;                        { size of the largest }
    Size := Size * 16                       { available block     }
  end
end;

function DpmiFreeMem (var P: Pointer): Boolean;

begin
  Regs.AX := $0101;
  Regs.DX := Seg (P^);
  Intr ($31,Regs);
  P := NIL;
  DpmiFreeMem := Regs.Flags and fCarry = 0
end;

procedure IncSelector (var Selector: Word);

begin
  Inc (Selector,SelIncr)
end;

function AllocSelectors (Count: Word): Word; assembler;

asm
      MOV     CX,Count
      MOV     AX,0000H
      INT     31H
      JNC     @@1
      XOR     AX,AX
@@1:
end;

function FreeSelector (Selector: Word): Boolean; assembler;

asm
      MOV     BX,Selector
      MOV     AX,0001H
      INT     31H
      SBB     AX, AX
      INC     AX
end;

function SegmentToSelector (Segment: Word): Word; assembler;

asm
      MOV     BX,Segment
      MOV     AX,0002H
      INT     31H
      JNC     @@1
      XOR     AX,AX
@@1:
end;

function SelectorToSegment (Selector: Word): Word; assembler;

asm
      MOV     BX,Selector
      MOV     AX,0006H
      INT     31H
      MOV     AX,DX
      OR      AX,CX
      ROR     AX,4
end;

function GetSelectorBase (Selector: Word): LongInt; assembler;

asm
      MOV     BX,Selector
      MOV     AX,0006H
      INT     31H
      JNC     @@1
      XCHG    AX,CX
      XCHG    AX,DX
      JNC     @@1
      XOR     AX,AX
      CWD
@@1:
end;

function SetSelectorBase (Selector: Word; Base: LongInt): Boolean; assembler;

asm
      MOV     BX,Selector
      MOV     DX,Base.Word[0]
      MOV     CX,Base.Word[2]
      MOV     AX,0007H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function GetSelectorLimit (Selector: Word): LongInt; assembler;

asm
      XOR     AX,AX
      LSL     AX,Selector
      XOR     DX,DX
end;

function SetSelectorLimit (Selector: Word; Limit: LongInt): Boolean; assembler;

asm
      MOV     BX,Selector
      MOV     DX,Limit.Word[0]
      MOV     CX,Limit.Word[2]
      MOV     AX,0008H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function GetAccessRights (Selector: Word): Word; assembler;

asm
      XOR     AX,AX
      LAR     AX,Selector
      XCHG    AL,AH
end;

function SetAccessRights (Selector: Word; AccessRights: Word): Boolean;
  assembler;

asm
      MOV     BX,Selector
      MOV     CX,AccessRights
      MOV     AX,0009H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function AllocSelectorAlias (Selector: Word): Word; assembler;

asm
      MOV     BX,Selector
      MOV     AX,000AH
      INT     31H
      JNC     @@1
      XOR     AX,AX
@@1:
end;

function GetDescriptor (Selector: Word; var Descriptor: TDescriptor): Boolean;
  assembler;

asm
      MOV     BX,Selector
      LES     DI,Descriptor
      MOV     AX,000BH
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function SetDescriptor (Selector: Word; var Descriptor: TDescriptor): Boolean;
  assembler;

asm
      MOV     BX,Selector
      LES     DI,Descriptor
      MOV     AX,000CH
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function AllocSpecificSelector (Selector: Word): Boolean; assembler;

asm
      MOV     BX,Selector
      MOV     AX,000DH
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function GetRealModeInt (Int: Byte): Pointer; assembler;

asm
      MOV     BL,Int
      MOV     AX,0200H
      INT     31H
      XCHG    AX,CX
      XCHG    AX,DX
      JNC     @@1
      XOR     AX,AX
      CWD
@@1:
end;

function SetRealModeInt (Int: Byte; Vector: Pointer): Boolean; assembler;

asm
      MOV     BL,Int
      MOV     DX,Vector.Word[0]
      MOV     CX,Vector.Word[2]
      MOV     AX,0201H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function GetException (Exception: Byte): Pointer; assembler;

asm
      MOV     BL,Exception
      MOV     AX,0202H
      INT     31H
      XCHG    AX,CX
      XCHG    AX,DX
      JNC     @@1
      XOR     AX,AX
      CWD
@@1:
end;

function SetException (Exception: Byte; Vector: Pointer): Boolean; assembler;

asm
      MOV     BL,Exception
      MOV     DX,Vector.Word[0]
      MOV     CX,Vector.Word[2]
      MOV     AX,0203H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function GetProtModeInt (Int: Byte): Pointer; assembler;

asm
      MOV     BL,Int
      MOV     AX,0204H
      INT     31H
      MOV     AX,DX
      MOV     DX,CX
end;

function SetProtModeInt (Int: Byte; Vector: Pointer): Boolean; assembler;

asm
      MOV     BL,Int
      MOV     DX,Vector.Word[0]
      MOV     CX,Vector.Word[2]
      MOV     AX,0205H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function RealModeInt (Int: Byte; var Regs: TRealModeRegs): Boolean; assembler;

asm
      MOV     BL,Int
      XOR     BH,BH
      XOR     CX,CX
      LES     DI,Regs
      MOV     AX,0300H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function RealModeCall (Proc: Pointer; var Regs: TRealModeRegs): Boolean;
  assembler;

asm
      XOR     BH,BH
      XOR     CX,CX
      LES     DI,Regs
      MOV     AX,Proc.Word[0]
      MOV     ES:[DI].TRealModeRegs.&IP,AX
      MOV     AX,Proc.Word[2]
      MOV     ES:[DI].TRealModeRegs.&CS,AX
      MOV     AX,0301H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function RealModeIntCall (Proc: Pointer; var Regs: TRealModeRegs): Boolean;
  assembler;

asm
      XOR     BH,BH
      XOR     CX,CX
      LES     DI,Regs
      MOV     AX,Proc.Word[0]
      MOV     ES:[DI].TRealModeRegs.&IP,AX
      MOV     AX,Proc.Word[2]
      MOV     ES:[DI].TRealModeRegs.&CS,AX
      MOV     AX,0302H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

function AllocCallback (Proc: Pointer; var Regs: TRealModeRegs): Pointer;
  assembler;

asm
      PUSH    DS
      LDS     SI,Proc
      LES     DI,Regs
      MOV     AX,0303H
      INT     31H
      POP     DS
      XCHG    AX,CX
      XCHG    AX,DX
      JNC     @@1
      XOR     AX,AX
      CWD
@@1:
end;

function FreeCallback (Callback: Pointer): Boolean; assembler;

asm
      MOV     DX,Callback.Word[0]
      MOV     CX,Callback.Word[2]
      MOV     AX,0304H
      INT     31H
      SBB     AX,AX
      INC     AX
end;

procedure GetVersionInfo (var Info: TVersionInfo); assembler;

asm
      MOV     AX,0400H
      INT     31H
      LES     DI,Info
      CLD
      STOSW
      XCHG    AX,BX
      STOSW
      XCHG    AX,CX
      STOSW
      XCHG    AX,DX
      STOSW
end;

function SetInterruptState (Enable: Boolean): Boolean; assembler;

asm
      MOV     AL,Enable
      MOV     AH,09H
      INT     31H
end;

function GetInterruptState: Boolean; assembler;

asm
      MOV     AX,0902H
      INT     31H
end;

function AllocRealSelector (Segment: Word): Word; assembler;

asm
      XOR     BX,BX
      MOV     AX,0000H
      MOV     CX,1
      INT     31H
      JC      @@1
      MOV     BX,AX
      MOV     DX,Segment
      ROL     DX,4
      MOV     CX,DX
      AND     DL,0F0H
      AND     CX,0FH
      MOV     AX,0007H
      INT     31H
      MOV     DX,0FFFFH
      XOR     CX,CX
      MOV     AX,0008H
      INT     31H
@@1:  MOV     AX,BX
end;

function AllocRealPtr (RealAddr: Pointer): Pointer; assembler;

asm
      PUSH    RealAddr.Word[2]
      CALL    AllocRealSelector
      MOV     DX,AX
      OR      AX,AX
      JE      @@1
      MOV     AX,RealAddr.Word[0]
@@1:
end;

function FreeRealPtr (RealPtr: Pointer): Boolean; assembler;

asm
      PUSH    RealPtr.Word[2]
      CALL    FreeSelector
end;

function MemInitSwapFile;  external 'RTM' index 35;
function MemCloseSwapFile; external 'RTM' index 36;

begin
  GetVersionInfo (VersionInfo);          { info on Dpmi services }
  if VersionInfo.Flags and 1 <> 0 then   { 16 or 32 bit implementation }
    DPMIBits := 32
  else DPMIBits := 16;
  Regs.AX := $0003;              { calculates the value to add to a }
  Intr ($31,Regs);               { selector if memory allocation is }
  SelIncr := Regs.AX             { greater than 64 K                }
end.

*)

{ ---------------------------- }
{ Test program for Drives unit }
{ ---------------------------- }

(*

program Test;

uses
  Dos,
  Drives;

var
  AllDrives: DriveSet;
  D        : DriveLetters;
  DriveType: LongInt;
  S        : String;

function GetVolumeLabel (Drive: Char): String;

var
  SR: SearchRec;

begin
  GetVolumeLabel := '';
  FindFirst (Drive + ':\*.*',VolumeID,SR);
  if DosError = 0 then GetVolumeLabel := SR.Name
end;

begin
  GetDrives (AllDrives);
  for D := 'A' to 'Z' do
  begin
    if NOT (D in AllDrives) then Continue;
    DriveType := GetDriveType (D);
    if DriveType = dtInvalid then Continue;
    if DriveType and dtUnknown = dtUnknown then
    begin
      S := 'unknown drive';
      if DriveType and dtRemote = dtRemote then
        S := 'remote ' + S
      else S := 'local ' + S
    end
    else if DriveType and dtAnyFloppy <> 0 then
    begin
      S := ' floppy disk';
      case DriveType and dtAnyFloppy of
        dt8Single: S := '8" single density' + S;
        dt8Double: S := '8" double density' + S;
        dt360    : S := '320/360 KB' + S;
        dt720    : S := '720 KB' + S;
        dt1200   : S := '1.2 MB' + S;
        dt1440   : S := '1.44 MB' + S;
        dt2880   : S := '2.88 MB' + S
      end
    end
    else if DriveType and dtTape = dtTape then
    begin
      S := ' tape drive';
      if DriveType and dtRemote = dtRemote then
        S := 'remote' + S
      else S := 'local' + S
    end
    else if DriveType and dtFloptical = dtFloptical then
    begin
      S := ' floptical drive';
      if DriveType and dtRemote = dtRemote then
        S := 'remote' + S
      else S := 'local' + S
    end
    else if DriveType and dtCDRom = dtCDRom then
    begin
      S := ' CD-ROM drive';
      if DriveType and dtRemote = dtRemote then
        S := 'remote' + S
      else S := 'local' + S
    end
    else if DriveType and dtIomegaZip = dtIomegaZip then
    begin
      S := ' Iomega Zip drive';
      if DriveType and dtRemote = dtRemote then
        S := 'remote' + S
      else S := 'local' + S
    end
    else begin
      if DriveType and dtRemovable = dtRemovable then
      begin
        S := ' removable media';
        if DriveType and dtRemote = dtRemote then
          S := 'remote' + S
        else S := 'local' + S
      end
      else begin
        S := 'volume ' + GetVolumeLabel (D) + ' (';
        if DriveType and dtRemote = dtRemote then
          S := S + 'remote '
        else S := S + 'local ';
        if DriveType and dtRamDisk = dtRamDisk then
        begin
          S := S + 'ram';
          if Pos ('.',S) > 0 then Delete (S,Pos ('.',S),1)
        end
        else S := S + 'hard';
        S := S + ' disk)'
      end
    end;
    S := D + ': ' + S;
    WriteLn (S)
  end
end.

*)