www.pudn.com > DriveRescuev1.8.zip > pdiskio.pas


{ 
  Physical Disk Access for Delphi 
  (physical disk read/write under Windows 95/98/ME and NT/2000/XP) 
  Written 2001 by Alexander Grau 
 
  Contact: alexander_grau@web.de 
 
} 
 
unit pdiskio; 
 
interface 
 
const 
  { Media types } 
  PMEDIA_TYPE_UNKNOWN   = 0; 
  PMEDIA_TYPE_FLOPPY    = 1; 
  PMEDIA_TYPE_REMOVABLE = 2; 
  PMEDIA_TYPE_FIXED     = 3; 
 
  { Media attributes } 
  PMEDIA_ATTR_REMOVABLE = 1; 
 
type 
  PPhysDriveParams = ^TPhysDriveParams; 
  TPhysDriveParams = record 
    MediaType        : word;       { see equals above } 
    MediaAttr        : word;       { see equals above } 
    Heads            : longword; 
    TracksPerHead    : longword; 
    SectorsPerTrack  : longword; 
    BytesPerSector   : longword; 
    TotalPhysSec     : longword; 
  end; 
 
 
(* -------------- published functions --------------------------------- *) 
 
(* drv: the INT13 drive,   0=first floppy 
                           1=second floppy 
                           ... 
                         80h=first fixed/removable disk 
                         81h=second fixed/removable disk 
                           ... *) 
 
function ReadPhysicalSectors(drv: byte; LBA: longword; blocks: word; buf: pointer; ErrorDlg: boolean): boolean; 
function WritePhysicalSectors(drv: byte; LBA: longword; blocks: word; buf: pointer; 
  verify: boolean; ErrorDlg: boolean): boolean; 
function GetPhysDriveParams(drv: byte; resultbuf: PPhysDriveParams): boolean; 
 
var 
  OptUseINT13: boolean; 
  OptUseINT13EXT: boolean; 
 
implementation 
 
uses sysutils, windows, helpers; 
 
 
// --------------- INT13 Extensions specific... ---------------------------------------------------- 
const 
  IFLAG_HANDLES_DMA_BOUNDARY = 1; 
  IFLAG_GEOMETRY_VALID       = 2; 
  IFLAG_REMOVABLE            = 4; 
  IFLAG_VERIFY_SUPPORT       = 8; 
  IFLAG_CHANGE_LINE_SUPPORT  = 16; 
  IFLAG_IS_LOCKABLE          = 32; 
  IFLAG_NO_MEDIA_PRESENT     = 64; 
 
type 
  PDriveParams = ^TDriveParams; 
  TDriveParams = packed record { used by GetDriveParams } 
     bufsize    : word; 
     infoflags  : word; 
     physcyl    : longword; 
     physheads  : longword; 
     physsecptrk: longword; 
     physsecLO  : longword; 
     physsecHI  : longword; 
     bytesPerSec: word; 
     EDDptr     : pointer; 
    { DevPathInfoFlag: word; 
     DevPathInfoLen : byte; 
     res0           : byte; 
     res1           : word; 
     HostBusType    : array[0..3] of char; 
     InterfaceType  : array[0..7] of char; 
     InterfacePath  : Qword; 
     DevicePath     : Qword; 
     res2           : byte; 
     DevPathInfoChksum: byte; } 
  end; 
 
 
  // --------- Windows NT specific... ------------------------------------------------------------- 
 
const 
  FILE_DEVICE_DISK               =  $00000007; 
  FILE_DEVICE_MASS_STORAGE       =  $0000002d; 
  FILE_ANY_ACCESS                =  0; 
  FILE_READ_ACCESS               =  $0001;     // file & pipe 
 
  METHOD_BUFFERED                =  0; 
 
  IOCTL_DISK_BASE                = FILE_DEVICE_DISK; 
  IOCTL_STORAGE_BASE             = FILE_DEVICE_MASS_STORAGE; 
  IOCTL_DISK_GET_DRIVE_GEOMETRY  = ( ((IOCTL_DISK_BASE) SHL 16) OR ((FILE_ANY_ACCESS) SHL 14) OR (($0000) SHL 2) OR (METHOD_BUFFERED) ); 
  IOCTL_DISK_CHECK_VERIFY        = ( ((IOCTL_DISK_BASE) SHL 16) OR ((FILE_READ_ACCESS) SHL 14)OR (($0200) SHL 2) OR (METHOD_BUFFERED) ); 
  IOCTL_STORAGE_CHECK_VERIFY     = ( ((IOCTL_STORAGE_BASE) SHL 16)OR((FILE_READ_ACCESS)SHL 14)OR (($0200) SHL 2)   OR (METHOD_BUFFERED) ); 
 
  (*typedef enum _MEDIA_TYPE { 
     Unknown,                // Format is unknown 
     F5_1Pt2_512,            // 5.25", 1.2MB,  512 bytes/sector 
     F3_1Pt44_512,           // 3.5",  1.44MB, 512 bytes/sector 
     F3_2Pt88_512,           // 3.5",  2.88MB, 512 bytes/sector 
     F3_20Pt8_512,           // 3.5",  20.8MB, 512 bytes/sector 
     F3_720_512,             // 3.5",  720KB,  512 bytes/sector 
     F5_360_512,             // 5.25", 360KB,  512 bytes/sector 
     F5_320_512,             // 5.25", 320KB,  512 bytes/sector 
     F5_320_1024,            // 5.25", 320KB,  1024 bytes/sector 
     F5_180_512,             // 5.25", 180KB,  512 bytes/sector 
     F5_160_512,             // 5.25", 160KB,  512 bytes/sector 
     RemovableMedia,         // Removable media other than floppy 
     FixedMedia,             // Fixed hard disk media 
     F3_120M_512,            // 3.5", 120M Floppy 
     F3_640_512,             // 3.5" ,  640KB,  512 bytes/sector 
     F5_640_512,             // 5.25",  640KB,  512 bytes/sector 
     F5_720_512,             // 5.25",  720KB,  512 bytes/sector 
     F3_1Pt2_512,            // 3.5" ,  1.2Mb,  512 bytes/sector 
     F3_1Pt23_1024,          // 3.5" ,  1.23Mb, 1024 bytes/sector 
     F5_1Pt23_1024,          // 5.25",  1.23MB, 1024 bytes/sector 
     F3_128Mb_512,           // 3.5" MO 128Mb   512 bytes/sector 
     F3_230Mb_512,           // 3.5" MO 230Mb   512 bytes/sector 
     F8_256_128              // 8",     256KB,  128 bytes/sector 
  } MEDIA_TYPE, *PMEDIA_TYPE;*) 
 
type 
  PLARGE_INTEGER = ^LARGE_INTEGER; 
  LARGE_INTEGER = packed record 
	LowPart: dword; 
	HighPart: dword; 
  end; 
 
  PDISK_GEOMETRY = ^TDISK_GEOMETRY; 
  TDISK_GEOMETRY = packed record 
    Cylinders: LARGE_INTEGER; 
    MediaType: dword; 
    TracksPerCylinder: dword; 
    SectorsPerTrack: dword; 
    BytesPerSector: dword; 
  end; 
 
 
  // ------ INT13EXT.VXD specific... ------------------------------------------------ 
const 
    DIOC_CHECKEXTENSIONS = 1; 
    DIOC_EXTENDEDREAD    = 2; 
    DIOC_EXTENDEDWRITE   = 3; 
    DIOC_GETDRIVEPARAMS  = 4; 
 
 
type 
    extstruc = packed record  { Important! Delphi is not allowed to align to 32-Bit here! 
                               (otherwise something goes wrong...) } 
      drv   : byte; 
      LBA   : longword; 
      blocks: byte; 
      buf   : pointer; 
      verify: byte; 
    end; 
 
 
  // -------------------------------------------------------------------------------- 
const 
  TEMPSECTORS = 128; 
 
var 
  W95Handle:   thandle;    // Win9X/ME only: current handle 
  NTHandle:    thandle;    // WinNT only: current handle 
  NTDrive:     byte;       // WinNT only: drive currently opened 
 
  ExitSave: Pointer; 
  winNTflag: boolean; 
  i: integer; 
  disk_geometry: tdisk_geometry; 
  tempbuf: array[0..512*TEMPSECTORS-1] of byte; 
 
 
 
   
// ----------------------------------------------------------------------------------- 
//     Windows NT specific... 
// ----------------------------------------------------------------------------------- 
 
 
function NT_changedrive(drv: byte; ReadOnly: boolean): boolean; 
var 
  hDevice: thandle; 
begin 
  if NThandle <> INVALID_HANDLE_VALUE then 
  begin 
    if NTdrive = drv then 
    begin 
      result:=true; 
      exit; 
    end else 
    begin 
      CloseHandle(NThandle); 
    end; 
  end; 
 
  { handle drive numbers like INT13 Extensions! 0..$7f are removable, $80 and above are fixed } 
 
  if drv IN [0..$7f] then 
  begin 
    if (drv IN [0..1]) then 
    begin 
      if ReadOnly then 
        hDevice := CreateFile(pchar('\\.\'+chr(ord('A')+drv)+':'), GENERIC_READ, FILE_SHARE_READ OR FILE_SHARE_WRITE, 
          nil, OPEN_EXISTING, FILE_FLAG_WRITE_THROUGH, 0) 
      else 
        hDevice := CreateFile(pchar('\\.\'+chr(ord('A')+drv)+':'), GENERIC_WRITE, FILE_SHARE_WRITE, 
          nil, OPEN_EXISTING, FILE_FLAG_WRITE_THROUGH, 0) 
    end; 
  end 
  else begin 
    if ReadOnly then 
      hDevice:=CreateFile(pchar('\\.\PhysicalDrive'+inttostr(drv-$80)), GENERIC_READ, FILE_SHARE_READ OR FILE_SHARE_WRITE, 
        nil, OPEN_EXISTING, FILE_FLAG_WRITE_THROUGH, 0) 
    else 
      hDevice:=CreateFile(pchar('\\.\PhysicalDrive'+inttostr(drv-$80)), GENERIC_WRITE, FILE_SHARE_WRITE, 
        nil, OPEN_EXISTING, FILE_FLAG_WRITE_THROUGH, 0); 
  end; 
 
  NThandle:=hDevice; 
  NTdrive:=drv; 
  result:=(hDevice <> INVALID_HANDLE_VALUE); 
end; 
 
 
function NT_CheckMedia(hDev: thandle): boolean; 
var 
  cb: DWORD; 
begin 
  cb:=0; 
  result := DeviceIoControl(hDev, 
        IOCTL_STORAGE_CHECK_VERIFY, nil, 0, 
        nil, 0, cb, nil); 
  // here's something wrong with floppy disks... 
  result:=true; 
end; 
 
function NT_GetDriveGeometry(drv: byte; dg: PDISK_GEOMETRY): boolean; 
var 
  hDevice: thandle; 
  fResult: boolean; 
  cb: DWORD; 
begin 
    fResult:=false; hDevice:=INVALID_HANDLE_VALUE; 
 
    { handle drive numbers like INT13 Extensions! 0..$7f are removable, $80 and above are fixed } 
    if drv IN [0..$7f] then 
    begin 
      if (drv IN [0..1]) then 
      hDevice := CreateFile(pchar('\\.\'+chr(ord('A')+drv)+':'), 
        0, FILE_SHARE_READ OR FILE_SHARE_WRITE, 
        nil, OPEN_EXISTING, 0, 0); 
      if (hDevice <> INVALID_HANDLE_VALUE) then 
      begin 
        if NOT (NT_CheckMedia(hDevice)) then 
        begin 
          CloseHandle(hDevice); 
          hDevice:=INVALID_HANDLE_VALUE; 
        end; 
      end; 
    end 
    else 
      hDevice := CreateFile(pchar('\\.\PhysicalDrive'+inttostr(drv-$80)), 
        0, FILE_SHARE_READ OR FILE_SHARE_WRITE, 
        nil, OPEN_EXISTING, 0, 0); 
 
    if (hDevice <> INVALID_HANDLE_VALUE) then 
    begin 
      fResult := DeviceIoControl(hDevice, 
        IOCTL_DISK_GET_DRIVE_GEOMETRY, nil, 0, 
        dg, sizeof(TDISK_GEOMETRY), cb, nil); 
      CloseHandle(hDevice); 
    end; 
 
    NT_GetDriveGeometry:=fResult; 
end; 
 
 
function NT_Read(drv: byte; LBA: longword; blocks: word; buf: pointer; ErrorDlg: boolean): boolean; 
var 
  res: boolean; 
  bytestoread, numread, transfer: longword; 
  err: dword; 
  i: integer; 
  dwpointer: dword; 
  ldistancelow, ldistancehigh: dword; 
  msgRes: integer; 
begin 
  res:=false; 
  if NT_changedrive(drv, true) then 
  begin 
    ldistanceLow:=dword(LBA SHL 9); 
    ldistanceHigh:=dword(LBA SHR (32-9)); 
    dwpointer:=SetFilePointer(NThandle, ldistancelow, @ldistancehigh, FILE_BEGIN); 
    if dwPointer <> $FFFFFFFF then 
    begin 
      bytestoread:=blocks*512; 
      repeat 
        transfer:=bytestoread; 
        if (transfer > TEMPSECTORS * 512) then transfer:=TEMPSECTORS * 512; 
        repeat 
          res:=ReadFile(NThandle, tempbuf, transfer, numread, nil); 
          if res then res:=boolean(numread=transfer); 
          msgRes := id_abort; 
          if (NOT res) AND (ErrorDlg) then 
          begin 
            err:=GetLastError; 
            msgRes:=messagebox(0, pchar('error no.'+inttostr(err)+#13#10+'drv:'+inttostr(drv)+' LBA:'+inttostr(LBA) 
              +' blocks:'+inttostr(blocks)+#13#10#13#10 
              +'Abort, Retry or Ignore?'), 'NT_read error', mb_applmodal or mb_iconwarning or mb_abortretryignore); 
          end; 
        until NOT ((ErrorDlg) AND (msgRes = id_Retry)); 
        if (NOT res) AND (ErrorDlg) AND (msgRes = id_ignore) then res:=true; 
        if res then move(tempbuf, buf^, transfer); 
        inc(longword(buf),transfer); 
        dec(bytestoread, transfer); 
      until (NOT res) OR (bytestoread = 0); 
    end; 
  end; 
  NT_Read:=(res); // AND (numread=blocks*512); 
end; 
 
 
function NT_Write(drv: byte; LBA: longword; blocks: word; buf: pointer; ErrorDlg: boolean): boolean; 
var 
  res: boolean; 
  bytestowrite, numwritten, transfer: longword; 
  err: dword; 
  i: integer; 
  bufp: ^byte; 
  dwpointer: dword; 
  ldistancelow, ldistancehigh: dword; 
  msgRes: integer; 
begin 
  res:=false; 
  if NT_changedrive(drv, false) then 
  begin 
    ldistanceLow:=dword(LBA SHL 9); 
    ldistanceHigh:=dword(LBA SHR (32-9)); 
    dwpointer:=SetFilePointer(NThandle, ldistancelow, @ldistancehigh, FILE_BEGIN); 
    if dwPointer <> $FFFFFFFF then 
    begin 
      bytestowrite:=blocks*512; 
      repeat 
        transfer:=bytestowrite; 
        if (transfer > TEMPSECTORS * 512) then transfer:=TEMPSECTORS * 512; 
        move(buf^, tempbuf, transfer); 
        repeat 
          res:=WriteFile(NThandle, tempbuf, transfer, numwritten, nil); 
          if res then res:=boolean(numwritten=transfer); 
          msgRes := id_abort; 
          if (NOT res) AND (ErrorDlg) then 
          begin 
            err:=GetLastError; 
            msgRes:=messagebox(0, pchar('error no.'+inttostr(err)+#13#10+'drv:'+inttostr(drv)+' LBA:'+inttostr(LBA) 
              +' blocks:'+inttostr(blocks)+#13#10#13#10 
              +'Abort, Retry or Ignore?'), 'NT_write error',  mb_applmodal or mb_iconwarning or mb_abortretryignore); 
          end; 
        until NOT ((ErrorDlg) AND (msgRes = id_Retry)); 
        if (NOT res) AND (ErrorDlg) AND (msgRes = id_ignore) then res:=true; 
        inc(longword(buf),transfer); 
        dec(bytestowrite, transfer); 
      until (NOT res) OR (bytestowrite = 0); 
    end; 
  end; 
  NT_write:=(res); // AND (numread=blocks*512); 
end; 
 
 
// ----------------------------------------------------------------------------------- 
//     legacy INT13 functions... 
// ----------------------------------------------------------------------------------- 
 
const 
  VWIN32_DIOC_DOS_IOCTL = 1; 
  VWIN32_DIOC_DOS_INT13 = 4; 
 
  CARRY_FLAG            = $0001; // Intel x86 processor status flags 
 
type 
  PLegacyDriveParams = ^TLegacyDriveParams; 
  TLegacyDriveParams = record 
    status         : byte; 
    CMOS_DriveType : byte; 
    cylinders      : word; 
    secpertrack    : byte; 
    heads          : byte; 
    drives         : byte; 
  end; 
 
 
  DEVIOCTL_REGISTERS=record 
    case Integer of 
    0: ( 
      bl, bh, bl2, bh2: byte; 
      dl, dh, dl2, dh2: byte; 
      cl, ch, cl2, ch2: byte; 
      al, ah, al2, ah2: byte); 
    1: ( 
      bx, bx2         : word; 
      dx, dx2         : word; 
      cx, cx2         : word; 
      ax, ax2         : word; 
      di, di2         : word; 
      si, si2         : word); 
    2: ( 
      ebx: longword; 
      edx: longword; 
      ecx: longword; 
      eax: longword; 
      edi: longword; 
      esi: longword; 
      flags: longword); 
  end; 
  PDEVIOCTL_REGISTERS = ^DEVIOCTL_REGISTERS; 
 
 
function DoINT13(preg: PDEVIOCTL_REGISTERS): boolean; 
var 
  res: boolean; 
  cb: dword; 
  hDevice: thandle; 
begin 
  res:=false; 
  preg.flags := CARRY_FLAG; { assume error (carry flag set) } 
 
  hDevice := CreateFile('\\.\vwin32', 
        GENERIC_READ, FILE_SHARE_READ OR FILE_SHARE_WRITE, 
        NIL, OPEN_EXISTING, 
        FILE_ATTRIBUTE_NORMAL, 0); 
 
  if (hDevice <> INVALID_HANDLE_VALUE) then 
  begin 
    res:=DeviceIoControl(hDevice, VWIN32_DIOC_DOS_INT13, 
      preg, sizeof(DEVIOCTL_REGISTERS), 
      preg, sizeof(DEVIOCTL_REGISTERS), cb, nil); 
    CloseHandle(hDevice); 
  end; 
  DoINT13:=res; 
end; 
 
 
function INT13_reset(drv: byte): boolean; 
var 
  r: DEVIOCTL_registers; 
  res: boolean; 
begin 
  res:=false; 
  fillchar(r, sizeof(DEVIOCTL_REGISTERS), 0); 
  r.ah:=0; 
  r.dl:=drv; 
  res:=DoINT13(@r); 
  if res then 
  begin 
    res:=((r.flags and CARRY_FLAG) = 0); 
  end; 
  INT13_reset:=res; 
end; 
 
{ Get sector and cylinder number from combined sector/cylinder-code 
  (e.g. found in partition sector) } 
procedure CnvSecCyl(SecCyl: word; var sector: byte; var cylinder: word); 
begin 
  sector:=seccyl and 63; 
  cylinder:=hi(seccyl) + (lo(seccyl) and 192) shl 2; 
end; 
 
function INT13_GetDriveParams(drv: byte; params: PLegacyDriveParams): boolean; 
var 
  r: DEVIOCTL_registers; 
  res: boolean; 
  cb: integer; 
  sec: byte; 
  cyl: word; 
 
begin 
  res:=false; 
  fillchar(r, sizeof(DEVIOCTL_REGISTERS), 0); 
  r.ah:=8; 
  r.dl:=drv; 
  res:=DoINT13(@r); 
  if res then 
  begin 
    res:=((r.flags and CARRY_FLAG) = 0); 
    if res then 
    begin 
      CnvSecCyl(r.cx, sec, cyl); 
      params^.cylinders:=cyl+1; 
      params^.secpertrack:=sec; 
      params^.status:=r.ah; 
      params^.CMOS_DriveType:=r.bl; 
      params^.heads:=r.dh+1; 
      params^.drives:=r.dl; 
    end; 
  end; 
  INT13_GetDriveParams:=res; 
end; 
 
{ counterpart to CnvSecCyl } 
procedure SetCnvSecCyl(sector, cylinder: word; var SecCyl: word); 
begin 
  SecCyl:=WORD((LO(cylinder) SHL 8) OR ((HI(cylinder) AND 3) SHL 6) OR (sector AND 63)); 
end; 
 
{ legacy read sector: returns number of sectors read } 
function INT13_ReadSec(drv: byte; count: byte; cyl: word; sec: byte; head: byte; buf: pointer): byte; 
var 
  r: DEVIOCTL_registers; 
  res: byte; 
  cb: integer; 
  SecCyl: word; 
  retry: byte; 
begin 
  res:=0; 
  retry:=0; 
  repeat 
    SetCnvSecCyl(sec, cyl, SecCyl); 
    fillchar(r, sizeof(DEVIOCTL_REGISTERS), 0); 
    r.ah:=2; 
    r.al:=count; 
    r.cx:=SecCyl; 
    r.dh:=head; 
    r.dl:=drv; 
    r.ebx:=longword(@buf); 
    if (DoINT13(@r)) AND ((r.flags and CARRY_FLAG) = 0) then 
    begin 
      res:=r.al;  
    end; 
    inc(retry); 
  until (retry >= 3) OR (res > 0); 
  INT13_ReadSec:=res; 
end; 
 
 
// ----------------------------------------------------------------------------------- 
//     INT13 Extensions... 
// ----------------------------------------------------------------------------------- 
 
 
function CheckExtensions(drv: byte; var ver:byte; var subsets: word):Boolean; 
var 
  res: boolean; 
  outbuf: array[0..3] of byte; 
  cb: dword; 
begin 
  outbuf[0]:=0; 
  res:=DeviceIoControl(W95handle, DIOC_CHECKEXTENSIONS, 
      @drv, 1, 
      @outbuf, 1, cb, nil); 
  ver:=outbuf[1]; 
  subsets:=(outbuf[2] SHL 8) OR outbuf[3]; 
 
  CheckExtensions:=res AND (outbuf[0]=1); 
end; 
 
 
function ReadPhysicalSectors(drv: byte; LBA: longword; blocks: word; buf: pointer; ErrorDlg: boolean): boolean; 
var 
  res: boolean; 
  struc: extstruc; 
  cb: dword; 
  tempbuf: array[0..511] of byte; 
  count: integer; 
  msgRes: integer; 
 
begin 
  res:=FALSE; 
  if winNTflag then 
    res:=NT_Read(drv,  LBA, blocks, buf, ErrorDlg) 
  else begin 
    if optUseINT13EXT then 
    begin 
      count:=0; 
 
      struc.Drv    := drv; 
      struc.LBA    := LBA; 
      struc.blocks := 1; //blocks; 
      struc.buf    := {buf;} @tempbuf; 
      repeat 
        repeat 
          res:=DeviceIoControl(W95handle, DIOC_EXTENDEDREAD, 
              @struc, sizeof(extstruc), 
              nil, 0, cb, nil); 
          msgRes := id_abort; 
          if (NOT res) AND (ErrorDlg) then 
          begin 
            msgRes:=messagebox(0, pchar('Error reading sector, '+#13#10+'drv:'+inttostr(drv)+' LBA:'+inttostr(LBA) 
              +' blocks:'+inttostr(blocks) +#13#10#13#10 
              +' Abort, Retry or Ignore?'), 'ExtendedRead error',  mb_applmodal or mb_iconwarning or mb_abortretryignore); 
            if msgRes = id_Retry then 
            begin 
              // try to reset controller... 
              INT13_reset(drv); 
            end; 
          end; 
        until NOT ((ErrorDlg) AND (msgRes = id_Retry)); 
        if (NOT res) AND (ErrorDlg) AND (msgRes = id_ignore) then res:=true; 
        if res then move(tempbuf, buf^, 512); 
 
        inc(longword(buf),512); 
        inc(count); 
        inc(struc.LBA); 
      until (NOT res) OR (count >= blocks); 
    end; 
  end; 
 
  result:=res; 
end; 
 
 
function WritePhysicalSectors(drv: byte; LBA: longword; blocks: word; buf: pointer; 
  verify: boolean; ErrorDlg: boolean): boolean; 
var 
  res: boolean; 
  struc: extstruc; 
  cb: dword; 
  count: integer; 
  tempbuf: array[0..511] of byte; 
  msgRes: integer; 
 
begin 
  res:=FALSE; 
  if winNTflag then 
    res:=NT_Write(drv,  LBA, blocks, buf, ErrorDlg) 
  else begin 
    if optUseINT13EXT then 
    begin 
      count:=0; 
 
      struc.Drv    := drv; 
      struc.LBA    := LBA; 
      struc.blocks := 1; //blocks; 
      struc.buf    := @tempbuf; //buf; 
      struc.verify := byte(verify); 
 
      repeat 
        move(buf^, tempbuf, 512); 
        repeat 
          res:=DeviceIoControl(W95handle, DIOC_EXTENDEDWRITE, 
              @struc, sizeof(extstruc), 
              nil, 0, cb, nil); 
          msgRes := id_abort; 
          if (NOT res) AND (ErrorDlg) then 
          begin 
            msgRes:=messagebox(0, pchar('Error writing sector, '+#13#10+'drv:'+inttostr(drv)+' LBA:'+inttostr(LBA) 
              +' blocks:'+inttostr(blocks) +#13#10#13#10 
              +' Abort, Retry or Ignore?'), 'ExtendedWrite error',  mb_applmodal or mb_iconwarning or mb_abortretryignore); 
          end; 
        until NOT ((ErrorDlg) AND (msgRes = id_Retry)); 
        if (NOT res) AND (ErrorDlg) AND (msgRes = id_ignore) then res:=true; 
 
        inc(longword(buf),512); 
        inc(struc.LBA); 
        inc(count); 
      until (NOT res) OR (count >= blocks); 
    end; 
  end; 
 
  result:=res; 
end; 
 
 
function GetPhysDriveParams(drv: byte; resultbuf: PPhysDriveParams): boolean; 
var 
  res: boolean; 
  struc: extstruc; 
  cb: dword; 
  dg: TDisk_Geometry; 
  ver: byte; 
  subsets: word; 
  legacy: TLegacyDriveParams; 
  dp: TDriveParams; 
begin 
  res:=false; 
  if WinNTflag then 
  begin 
    // Windows NT... 
       
    res:=NT_GetDriveGeometry(drv, @dg); 
    if res then 
    begin 
      resultbuf^.MediaAttr:=0; 
      resultbuf^.Heads:=dg.cylinders.lowpart; 
      resultbuf^.TracksPerHead:=dg.trackspercylinder; 
      resultbuf^.SectorsPerTrack:=dg.sectorspertrack; 
      resultbuf.BytesPerSector:=dg.bytespersector; 
      resultbuf^.TotalPhysSec:=dg.cylinders.lowpart * dg.TracksPerCylinder * dg.SectorsPerTrack; 
      case dg.MediaType of 
        0:             resultbuf^.MediaType:=PMEDIA_TYPE_UNKNOWN; 
        1..10, 13..22: begin 
                         resultbuf^.MediaType:=PMEDIA_TYPE_FLOPPY; 
                         resultbuf^.MediaAttr:=PMEDIA_ATTR_REMOVABLE; 
                       end; 
        11:            begin 
                         resultbuf^.MediaType:=PMEDIA_TYPE_REMOVABLE; 
                         resultbuf^.MediaAttr:=PMEDIA_ATTR_REMOVABLE; 
                       end; 
        12:            resultbuf^.MediaType:=PMEDIA_TYPE_FIXED; 
      end; 
    end; 
  end else 
  begin 
    // Windows 9X... 
 
    //INT13_reset(drv); 
    if drv < $80 then 
    begin 
      if OptUseINT13 then 
      begin 
        // legacy INT13... 
        res:=INT13_GetDriveParams(drv, @legacy); 
        if (res) AND (legacy.secpertrack = 0) then res:=false; 
        if (res) then 
        begin 
          if drv IN [0,1] then resultbuf^.MediaType:=PMEDIA_TYPE_FLOPPY 
            else resultbuf^.MediaType:=PMEDIA_TYPE_REMOVABLE; // ?? 
          resultbuf^.MediaAttr:=PMEDIA_ATTR_REMOVABLE; 
          resultbuf^.Heads:=legacy.heads; 
          resultbuf^.TracksPerHead:=legacy.cylinders; 
          resultbuf^.SectorsPerTrack:=legacy.secpertrack; 
          resultbuf^.BytesPerSector:=512; 
          resultbuf^.TotalPhysSec:=legacy.cylinders * legacy.heads * legacy.secpertrack; 
        end; 
      end; 
    end else 
    begin 
      if OptUseINT13EXT then 
      begin 
        // INT13 Extensions... 
        struc.Drv    := drv; 
        struc.buf    := @dp; 
        dp.bufsize:=30; 
 
        res:=DeviceIoControl(W95handle, DIOC_GETDRIVEPARAMS, 
          @struc, sizeof(extstruc), 
          nil, 0, cb, nil); 
        if res then 
        begin 
          resultbuf^.MediaAttr:=0; 
          if (dp.infoflags AND IFLAG_REMOVABLE) <> 0 then 
          begin 
            resultbuf^.MediaType:=PMEDIA_TYPE_REMOVABLE; 
            resultbuf^.MediaAttr:=PMEDIA_ATTR_REMOVABLE; 
          end else resultbuf^.MediaType:=PMEDIA_TYPE_FIXED; 
          resultbuf^.Heads:=dp.physheads; 
          resultbuf^.TracksPerHead:=dp.physcyl; 
          resultbuf^.SectorsPerTrack:=dp.physsecptrk; 
          resultbuf^.BytesPerSector:=dp.bytesPerSec; 
          resultbuf^.TotalPhysSec:=dp.physsecLO; 
        end; 
      end; 
    end; 
  end; 
 
  result:=res; 
end; 
 
 
// ----------------------------------------------------------------------------------- 
//     Main... 
// ----------------------------------------------------------------------------------- 
 
 
procedure MyExit; 
begin 
  ExitProc := ExitSave;            { first restore old vector } 
 
  if NOT (winNTflag) then 
  begin 
    // Win9X... 
    if (W95handle <> INVALID_HANDLE_VALUE) then 
    begin 
      // CloseHandle(hDevice); 
      DeleteFile('\\.\INT13EXT'); 
    end; 
  end else 
  begin 
    // WinNT... 
    if (NThandle <> INVALID_HANDLE_VALUE) then CloseHandle(NThandle); 
  end; 
end; 
 
 
begin 
  OptUseINT13:=TRUE; 
  OptUseINT13EXT:=TRUE; 
   
  W95handle:=INVALID_HANDLE_VALUE; 
  NThandle:=INVALID_HANDLE_VALUE; 
  winNTflag:=IsWinNT; 
 
  ExitSave := ExitProc; 
  ExitProc := @MyExit; 
 
 
  if NOT winNTflag then 
  begin 
    W95handle:=CreateFile('\\.\INT13EXT.VXD', 0, 0, nil, 0, 
      FILE_FLAG_DELETE_ON_CLOSE, 0); 
 
    if W95handle = INVALID_HANDLE_VALUE then 
    begin 
      MessageBox(0, 'Error loading "INT13EXT.VXD"', 'Error', mb_IconExclamation + mb_ok); 
    end; 
  end; 
end.