unit disk;
{$IFDEF FPC}
{$CALLING oldfpccall}
{$ELSE}
{$F+}
{$ENDIF}

(*
{$Q-}            {These directives must be turned off}
{$R-}            {because else it would crash in the interrupt routine}
{$S-}
{$D-}
*)



interface
uses dos{$IFDEF FPC},go32{$ENDIF};

const
      MAX_HARDDISKU = 10;
      MAX_ODDILU = 30;

      BAJTU_V_SEKTORU = 512;

type
{$IFNDEF FPC}dword = longint;{$ENDIF}


TSector = array [0..BAJTU_V_SEKTORU - 1] of Byte;
TSectorPos  = packed record
  Cyl,Hla,sek:word;
  LBA:dword;
  end;
PSectorPos = ^TSectorPos;


Function Existuje_Floppy_mechanika(disk:byte):boolean;
{Zjisti, zda je zapojena disketova mechanika 0 nebo 1}
function ReadSector_CHS(dsk: Byte; Cylinder, Head, Sector, BajtSekt: Word; num:byte; var Buffer):Byte;
{Precte sektory v CHS modu}
function ReadSector_LBA(dsk: Byte; LBASector: dword; BajtSekt:word; num:byte; var Buffer): Byte;
{Precte sektory v LBA modu}
Function ReadSector(dsk:byte; SecPos: TSectorPos; BajtSekt:Word; num:byte;var Buffer):Byte;
{Precte sektory v CHS nebo LBA modu}
Procedure Get_Extended_parameters(dsk: Byte; var Buffer);
{vrati rozsirene info pro disky co umi LBA adresaci}

Function Zjisti_BajtSekt_pres_DOS(dsk:char):word;
{kolik bajtu na sektor se uklada na DOSove jednotce DSK?}

Function Nacti_Sektory_pres_DOS(dsk:char;i,p:dword;kontrola:boolean;var pristup:byte;var buf):longint;
{z DOSove jednotky DSK nacte P sektoru, I-tym pocinaje, kontrola - zkontroluj, je-li jednotka pripravena
 "prostup" - jakou funkci prostupovat k disku: 0 = autodetect, 1 = disk(eta) do 20MB (FAT12), 2 = disk do 2GB (FAT16),
 3 = disky nad 2GB, resp. disky s FAT32}

Function Zapis_Sektory_pres_DOS(dsk:char;i,p:dword;kontrola:boolean;var pristup:byte;var buf):longint;
{To same, ale jedna se o zapis}

type

TDskInfo = object
   disk:byte;            {na kterem BIOSovem disku se nachazi ($80,$81...)}
   LBA:boolean;          {je na disku podporujicim LBA?}
   EDD:byte;             {jaka verze EDD je podporovana? (dulezite pro zapis)}
   MBR:boolean;          {je na disku MBR record?}
   hlav:byte;            {geometrie disku - hlavy}
   sekt:word;            {geometrie disku - sektory}
   cyli:word;            {geometrie disku - cylindry}
   {HLAV, SEKT a CYLI v LBA rezimu neodpovidaji hodnotam, ktere by se pouzily
    v CHS rezimu. Tzn. v pripade disku s LBA tyto udaje nejdou pouzit pro
    alternativni CHS pristup}
   typ:byte;             {0=chyba, 1,2=disketa, 3=harddisk}
   oddilu:byte;
   velikost:dword;       {udava se v poctu sektoru, ne bajtu}
   bajtsekt:word;        {velikost sektoru. Prakticky vzdy 512 bajtu}
   Procedure Init(dsk:byte);
   Function NactiMBR(var buf:TSector):byte;
   Function NactiSektor(poz:TSectorPos;var buf:TSector):byte;
   Function DetekceMBR(var buf:TSector):boolean;
   Function Je_GPR_Record:boolean;
   Procedure PoziceOblasti(parent:TSectorPos;slot:byte;var buf:TSector;var novy:TSectorPos);
   Function ShodaPozic(iparent,istart:TSectorPos):boolean;
   Procedure ZjistiGeometrii; {naplni promenne HLAV, SEKT, CYLI, BAJTSEKT}
   Function Dej_Velikost_citelne:string;
   {Vygeneruje dobre citelny retezec popisujici velikost disku}
   Function ZjistiParametry_IDE(var ideport:word;var master:boolean):boolean;
   {Zjisti, z ktereho IDE portu je disk ovladany a zda je master nebo slave}
   Function ZjistiTypDisku:string;
   {Zjisti typ disku, napr: "ST380011A"}
   Function ZjistiSerioveCislo:string;
   {Zjisti seriove cislo fyzicke jednotky}
   end;
PDskInfo = ^TDskInfo;


TOddInfo = object
   DI:PDskInfo;
   kodFS:byte;           {kod filesystemu oblasti}
   active:boolean;       {je oblast oznacena jako aktivni? (t.j. bootovaci?)}
   Start:TSectorPos;     {umisteni bootsectoru oblasti}
   Velikost:dword;       {velikost (udava se v poctu sektoru, ne bajtu)}
   ParentSec:TSectorPos; {sektor, ze ktereho je oblast definovana (MBR ci EMBR}
   ParentSlot:byte;      {rodicovsky slot, ve kterem je oblast definovana}
   Procedure Init(iDI:PDskInfo;iparent,istart:TSectorPos);
   Function Dej_Velikost_citelne:string;
   {Vygeneruje dobre citelny retezec popisujici velikost oddilu}
   Function PrectiPopisku:string;
   {precte OEM popisku oddilu}
   Function NactiSektory(i,p:dword;var buf):byte;
   {nacte P sektoru, I-tym pocinaje}
   Function NactiBootSector(var buf:TSector):byte;
   {nacte bootsector oddilu}
   Procedure UlozBootSectorDosouboru(s:string);
   {ulozi bootsector do souboru}
   Procedure UlozSektoryDoSouboru(i,p:dword;s:string);
   {ulozi P sektoru, I-tym pocinaje do souboru}
   Function ZjistiTypFAT:byte;
   {0=nejde o FAT, 1=FAT12, 2=FAT16, 3=FAT32}
   Function NTFS_exFAT_jina:byte;
   {V oddilech kde kodFS=7 odlisi NTFS, HPFS a exFAT}
   {1=NTFS, 2=exFAT, 0=jina (nejspis HPFS)}
   Procedure NatahniInfoOblasti(b:byte;var mbrec:TSector); {interni procedura}
   end;
POddInfo = ^TOddInfo;


TBIOSdisk = object
   oddl:array[1..MAX_ODDILU] of TOddInfo;
   oddlnum:byte;
   disk:array[1..MAX_HARDDISKU] of TDskInfo;
   disknum:byte;
   disketovek:byte;
   Procedure Init;   {provede scan pocitace a najde vsechny BIOSove disky a}
                     {na nich najde vsechny oddily}
   {procedury nize jsou chapany jako interni}
   Procedure PridejOddil(dsk:byte;iparent,istart:TSectorPos);
   Procedure PridejDisketovku(a:byte);
   Procedure ZpracujEMBR(puvod:TSectorPos;var sector:TSector;slot:byte);
   Procedure PridejDisk(a:byte);
   end;
PBIOSdisk = ^TBIOSdisk;


TFAT_Driver = object
   oddl:POddInfo;
   typ:byte;        {0=neni FAT, 1=FAT12, 2=FAT16, 3=FAT32}
   boot:TSector;
   f32_infloblock_magic:dword;  {jen pro FAT32 - melo by byt $61417272}
   f32_VolnychClusteru:dword;          {pouzitelne jen pro FAT32 oblasti}
   f32_DalsiVolny:dword;               {pouzitelne jen pro FAT32 oblasti}
   Procedure Init(iodd:TOddInfo);
   Function Vrat_SerioveCislo:string;
   Function Vrat_VolumeLabel:string;
   {POZOR - nemusi byt nastaven. Tzn. v root muze existovat VolumeID soubor aniz}
   {by bylo vyplneno pole v Boot recordu}
   end;

TNTFS_Driver = object
   oddl:POddInfo;
   typ:byte;
   boot:TSector;
   Procedure Init(iodd:TOddInfo);
   Function Vrat_SerioveCislo:string;
   Function Vrat_UplneSerioveCislo:string;
   end;


Function MapovaniDiskuDOSu(disk:char;var bd:TBIOSdisk):byte;
{vrati index v BIOSdisk, do ktereho je mapovana jednotka DOSu}
{pokud je jednotka DOSu mapovana jinam nez na BIOSovy disk, vrati 0}

type type_info_ide = procedure(idep:word;idem,cd_mode:boolean;data:pointer);
var  Proc_Info_z_IDE:type_info_ide;


{procSaveHeaderOfMyData:procedure(f:PBufStream);}

implementation
uses crt;

const
      MBR_MAGIC = $aa55;
      GPR_MAGIC:string = 'EFI PART';

      HexaNum : string[16] = '0123456789ABCDEF';

var   _zachyt13h:byte;
      __adr:dword;
      __dsk:byte;
      {$IFDEF FPC}
      regs13h:trealregs; external name '___v2prt0_rmcb_regs';
      {$ENDIF}

type
{Data structure for extended dsk read/write functions}
  TExtdskFuncPack = packed record
    xfSize: Byte;
    xfReserved: Byte;
    xfSectorNum: Word;
    xfDataBuffer_ofs:word;
    xfDataBuffer_seg:word;
    xfLBASector: packed array[0..1] of dword;
  end;


  TDOSdskNumInfo=packed record
    Level:word;
    SerialNum:longint;
    VolumeLabel:array[0..10] of char;
    FatType:array[0..7] of char;
    end;

  {Partition table entry}
  PartitionEntry = packed record
    Active: Byte;
    StartHead: Byte;
    StartCylSec: Word;
    Typ: Byte;
    EndHead: Byte;
    EndCylSec: Word;
    StartRelSec: dword;
    Size: dword;
  end;

  TdskNumInfo=packed record
    Level:word;
    SerialNum:longint;
    VolumeLabel:array[0..10] of char;
    FatType:array[0..7] of char;
    end;


  TMBR_Record = packed record
    bootcode: array[0..445] of byte;
    PartTable: array [0..3] of PartitionEntry;
    BootSignature: Word;
  end;
  PMBR_Record   = ^TMBR_Record;

  TEMBR_Record = packed record
    { $00 }bootcode:packed array[0..445] of byte;  {posl. 9 bajtu teto oblasti si}
                                            {nekdy pouzivaji bootmanagery}
    { $1be}PartTable:packed array[0..1] of PartitionEntry;
    { $1de}unused:packed array[0..31] of byte;
    { $1fe}BootSignature:word;
    end;
  PEMBR_Record = ^TEMBR_Record;

  TFAT12a16Boot_Record = packed record
    { $0 }JumpToExec: array [0..2] of Byte;
    { $3 }OEMNameVer: array [0..7] of Char;
    { $0B}BytePerSector: Word;
    { $0D}SectorPerClus: Byte;
    { $0E}ResSectorNum: Word;
    { $10}FATNum: Byte;
    { $11}RootDirLen: Word;
    { $13}SectorNum: Word;
    { $15}MediaID: Byte;
    { $16}SectorPerFAT: Word;
    { $18}SecPerTrack: Word;
    { $1A}HeadNum: Word;
    { $1C}HiddenSecNum: dword;
    { $20}BigTotNumSec:dword;
    { $24}Phdrv:word;   {BIOSove cislo disku?}
    { $26}ExtSign:byte; {priznak rozsireneho bootsectoru}

    { $27}SerialNum:dword;
    { $2B}VolumeLabel:array[0..10] of char;
    { $36}FATtype:array[0..7] of char;
  end;
  PFAT12a16Boot_Record = ^TFAT12a16Boot_Record;

  TFAT32Boot_Record = packed record
    { $0 }JumpToExec: array [0..2] of Byte;
    { $3 }OEMNameVer: array [0..7] of Char;
    { $0B}BytePerSector: Word;
    { $0D}SectorPerClus: Byte;
    { $0E}ResSectorNum: Word;
    { $10}FATNum: Byte;
    { $11}RootDirLen: Word;
    { $13}SectorNum: Word;
    { $15}MediaID: Byte;
    { $16}SectorPerFAT: Word;  {na rozdil od FAT12/16 je zde 0}
    { $18}SecPerTrack: Word;
    { $1A}HeadNum: Word;
    { $1C}HiddenSecNum: dword;
    { $20}BigTotNumSec:dword;
    { $24}BigSectorPerFAT:dword;
    { $28}ExtFlags:word;
    { $2A}FSversion:word;
    { $2C}RootStart:dword;
    { $30}FSinfoSector:word; {odkaz na sektor, kde jsou informace o filesyst}
    { $32}BackupBootSector:word;
    { $34}Reserved1:array[0..11] of byte;
    { $40}Phdrv:byte;   {BIOSove cislo disku?}
    { $41}Reserved2:byte; {priznak rozsireneho bootsectoru}
    { $42}ExtSign:byte;
    { $43}SerialNum:dword;
    { $47}VolumeLabel:array[0..10] of char;
    { $52}FATtype:array[0..7] of char;
  end;
  PFAT32Boot_Record = ^TFAT32Boot_Record;

  TNTFSBoot_Record = packed record
    { $0 }JumpToExec: array [0..2] of Byte;
    { $3 }OEMNameVer: array [0..7] of Char;
    { $0B}BytePerSector: Word;
    { $0D}SectorPerClus: Byte;
    { $0E}ResSectorNum: Word;
    { $10}reserved1: array[0..2] of Byte;
    { $13}unused1: Word;
    { $15}MediaID: Byte;
    { $16}reserved2:Word;
    { $18}SecPerTrack: Word;
    { $1A}HeadNum: Word;
    { $1C}HiddenSecNum: dword;
    { $20}unused2:array [0..7] of byte;
    { $28}BigTotSecNum:array[0..1] of dword;
    { $30}MFT_start_cluster:array[0..1] of dword; { $MFT start cluster}
    { $38}MFTmir_start_cluster:array[0..1] of dword;
    { $40}Clusters_per_FRS:dword;
    { $44}Clusters_per_index:dword;
    { $48}SerialNum:array[0..1] of dword;
    { $50}CRC:dword;
  end;
  PNTFSBoot_Record = ^TNTFSBoot_Record;

  TExFATBoot_Record = packed record
    { $0 }JumpToExec: array [0..2] of Byte;
    { $3 }OEMNameVer: array [0..7] of Char;
    { $0B}zeroes: array [0..52] of byte;
    { $40}SectorAddress:array[0..1] of dword;
    { $48}BigTotSecNum:array[0..1] of dword;
    { $50}FAT1addr:dword;
    { $54}FATlength:dword;    {velikost FAT v sektorech}
    { $58}CluHeapOfs:dword;   {pocatecni adresa datove oblasti}
    { $5D}CluCount:dword;     {pocet clusteru v "cluster heap"}
    { $61}RootFirstClu:dword; {prvni cluster hlavniho adresare}
    { $65}SerialNum:dword;
    { $69}RevizeExFAT:word;     {zatim je definovane jenom 01.00}
    { $6B}Flags:word;     {0.bit - aktivni FAT (0=prvni, 1=druha)}
                          {1.bit - "volume dirty" (0=clean, 1=dirty)}
                          {2.bit - chyba media (0=bez chyb, 1=pritomny chyby)}
                          {3.bit - vzdy nula}
                          {4.-15.bit - rezervovano}

    { $6D}BytePerSector:byte; {uklada se, o kterou mocninu 2 jde, rozsah je}
                              {9 (2^9=512) az 12 (2^12=4096)}
    { $6E}SectorPerClus:byte;     {taky je to ulozeno jako exponent 2}
    { $6F}FATnum:byte;
    { $70}DriveSelect:byte;
    { $71}PercentInUse:byte;
    { $72}Reserved:array [0..6] of byte;
    end;
    PExFATBoot_Record = ^TExFATBoot_Record;


    TExtParam = packed record
    { $00}BufSize:word;
    { $02}InfoFlags:word; {0: transparentni obsluha DMA}
                          {1: geometrie disku v bajtech 4-15 je skutecna}
                          {2: medium je vymenitelne}
                          {3: jednotka podporuje verifikaci zapisu}
                          {4: jednotka umi detekovat vymenu media}
                          {5: medium je uzamykatelne}
                          {6: ???}
                          {7: BIOS pristupuje na disk pres sluzbu 50h}
                          {8-15: reservovano}
    { $04}Cylindry:dword;
    { $08}Hlavy:dword;
    { $0C}SektoruNaStopu:dword;
    { $10}PocetSektoru:array[0..1] of dword;
    { $18}BajtuNaSektor:word;
    {-------EDD 2.0+--------}
    { $1a}DPTE_pointer_ofs:word;
    { $1c}DPTE_pointer_seg:word; {ukazatel na tabulku
                                 Device Parameter Table Extension (DPTE)
                                 DPTE je dostupna, jenom je-li 2.bit CX
                                 ve sluzbe 41h. ukazatel je ve formatu seg:ofs
                                 Ukazatel ma docasnou platnost (do pristiho
                                 INT 13h}
    {-------EDD 3.0+--------}
    { $1E}Device_Path_info_magic:word;     { $BEDD znaci pritomnost}

    { $20}Device_Path_Length:byte;         {ma byt $2C}
    { $21}Reserved1:array[0..3] of byte;
    { $24}BusType:array[0..3] of byte; {"PCI,"ISA","XPRS",... v ASCII kodu}
    { $28}IntType:array[0..7] of byte; {"ATA","ATAPI",... v ASCII kodu}
    { $30}IntPath:array[0..7] of byte;
    { $38}DevPath:array[0..15] of byte;
    { $48}Reserved2:byte;
    { $49}Checksum:byte;
  end;
  PExtParam = ^TExtParam;

Function chary_na_string(t:array of char;max:byte):string;
var s:string;
    a:byte;
begin
s:='';
for a:=0 to max do
   if t[a]<>#0 then s:=s+t[a] else Break;
chary_na_string:=s;
end;


function MyStr(Cislo:dword):string;
var Vysledek : string;
begin
Str (Cislo, Vysledek);
MyStr := Vysledek;
end;


function HexaStr(D:Dword;L:Byte):string;
var I:Byte;
    S:string;
begin
S:='';
for I:=L-1 downto 0 do S:=S+HexaNum[(D shr (I*4) and $0F) + 1];
HexaStr:=S;
end;


Function IsExtdskFunc(dsk: Byte):byte;
{Zjisti, jestli dsk podporuje rozsirene funkce INT13h
 dsk = BIOSove urceni disku (0 = 1.FDD, 1 = 2.FDD, 80h = 1.HDD, 81h = 2.HDD
 0 = nepodporuje nic, jinak:
     0.bit = podpora pevnych disku: AH=42h-44h,47h,48h
     1.bit = funkce vymenitelnych jednotek
     2.bit = diskova rozsireni (enhanced disk drive support) (???)
     3.bit = 64.bitova rozsireni}
var r:registers;
begin
r.dl:=dsk;
r.bx:=$55aa;
r.ah:=$41;
Intr($13,r);
IsExtdskFunc:=0;

if not odd(r.flags) then
   if r.bx=$aa55 then
      if odd(r.cl) then IsExtdskFunc:=r.cl;
end;



Function Verze_EDD_INT13(dsk:byte):byte;
var r:registers;
begin
r.dl:=dsk;
r.bx:=$55aa;
r.ah:=$41;
Intr($13,r);
Verze_EDD_INT13:=0;

if not odd(r.flags) then
   if r.bx=$aa55 then Verze_EDD_INT13:=r.ah;
end;


Function Verze_EDD_priznaky(dsk:byte):byte;
var r:registers;
begin
r.dl:=dsk;
r.bx:=$55aa;
r.ah:=$41;
Intr($13,r);
Verze_EDD_priznaky:=r.cl;
end;


Function CompressCS(cyl,sek:word):word;assembler;
asm
 mov ax,cyl            {napsano v assembleru, abych nemusel resit chyby}
 mov cx,ax             {z preteceni}
 shl ax,8
 shr cx,10
 and cx,192
 or cx,ax
 or cx,sek
 mov ax,cx
end;


Procedure DecompressCS(cylsek:word;var cyl,sek:word);
begin
sek:=cylsek and 63;
cyl:=(cylsek shr 8) or ((cylsek and 192) shl 2);
end;


function ReadSector_CHS(dsk: Byte; Cylinder, Head, Sector, BajtSekt: Word; num:byte; var Buffer):Byte;
{Precte sektor v CHS modu.
 dsk = BIOSove urceni disku (0 = 1.FDD, 1 = 2.FDD, 80h = 1.HDD, 81h = 2.HDD
 Cylinder, Head, Sector: urceni sektoru, ktery presist
 Num: pocet sektoru k precteni. Nejlepe jedna.
 BajtSekt: pocet bajru na sektor. Prakticky vzdy 512
 Buffer: bude zaplnen daty ze sektoru
 Navrat funkce: 0 = vsechno v poradku
              <>0 = cislo chyby}

var r:registers;
    c:word;
    w:word;

begin
 c:=CompressCS(cylinder,sector);
 r.cx:=c;
 r.dh:=head;
 r.dl:=dsk;
 r.ah:=$02;
 r.al:=num;
 w:=num*BajtSekt;
 {$IFDEF FPC}
 r.es:=tb_segment;
 r.bx:=tb_offset;
 {$ELSE}
 r.es:=seg(buffer);
 r.bx:=ofs(buffer);
 {$ENDIF}
 {FillChar(buffer,w,0);}
 Intr($13,r);
 {$IFDEF FPC}
 CopyFromDOS(buffer,w);
 {$ENDIF}

 if odd(r.flags) then ReadSector_CHS:=r.ah else ReadSector_CHS:=0;
end;


function ReadSector_LBA(dsk: Byte; LBASector: dword; BajtSekt:word; num:byte; var Buffer): Byte;
{Precte sektor v LBA modu.
 dsk = BIOSove urceni disku (0 = 1.FDD, 1 = 2.FDD, 80h = 1.HDD, 81h = 2.HDD
 LBASector: linearni (t.j. LBA) adresa bloku
 BajtSekt: pocet bajru na sektor. Prakticky vzdy 512
 Num: pocetsektoru k precteni. Nejlepe jedna
 Buffer: bude zaplnen daty ze sektoru
 Navrat funkce: 0 = vsechno v poradku
              <>0 = cislo chyby}
var r:registers;
    zadanka:TExtdskFuncPack;
    LowMemPtr:dword;
    w:word;

begin
FillChar(zadanka,SizeOf(zadanka),0);
w:=BajtSekt*num;
with zadanka do begin
   xfsize:=$10; { $18}  {Type(ExtdskFuncPack)}
   xfreserved:=0;
   xfsectornum:=num;
   {$IFDEF FPC}
   LowMemPtr:=Global_DOS_Alloc(w);
   xfDataBuffer_seg:=Word(LowMemPtr shr 16);
   xfDataBuffer_ofs:=0;
   {$ELSE}
   xfDataBuffer_seg:=seg(buffer);
   xfDataBuffer_ofs:=ofs(buffer);
   {$ENDIF}
   xfLBAsector[0]:=LBAsector;
   end;
r.dl:=dsk;
r.ax:=$4200;
{$IFDEF FPC}
CopyToDOS(zadanka,sizeof(zadanka));
r.ds:=tb_segment;
r.si:=tb_offset;
{$ELSE}
r.ds:=seg(zadanka);
r.si:=ofs(zadanka);
{$ENDIF}
Intr($13,r);
{$IFDEF FPC}
DOSmemGet(Word(LowMemPtr shr 16),0,buffer,w);
Global_DOS_Free(Word(LowMemPtr));
{$ENDIF}
if odd(r.flags) then ReadSector_LBA:=r.ah else ReadSector_LBA:=0;
end;


Function WriteSector_CHS(dsk: Byte; Cylinder, Head, Sector, BajtSekt: Word; num:byte; var Buffer):Byte;
{Zapise sektor v CHS modu.
 dsk = BIOSove urceni disku (0 = 1.FDD, 1 = 2.FDD, 80h = 1.HDD, 81h = 2.HDD
 Cylinder, Head, Sector: urceni sektoru, ktery zapsat
 BajtSekt: pocet bajtu na sektor (prakticky vzdy 512)
 Num: pocet sektoru k zapisu
 Buffer: bude zaplnen daty ze sektoru
 Navrat funkce: 0 = vsechno v poradku
              <>0 = cislo chyby}

var r:registers;
    c,w:word;
begin
 c:=CompressCS(cylinder,sector);
 r.cx:=c;
 r.dh:=head;
 r.dl:=dsk;
 r.ah:=$03;
 r.al:=num;
 w:=num*bajtsekt;
 {$IFDEF FPC}
 r.es:=tb_segment;
 r.bx:=tb_offset;
 CopyToDOS(buffer,w);
 {$ELSE}
 r.es:=seg(buffer);
 r.bx:=ofs(buffer);
 {$ENDIF}
 Intr($13,r);

if odd(r.flags) then WriteSector_CHS:=r.ah else WriteSector_CHS:=0;
end;


Function WriteSector_LBA(dsk: Byte; LBASector: dword; BajtSekt:word; num:byte; flags:byte; var Buffer): Byte;
{Zapise sektor v LBA modu.
 dsk = BIOSove urceni disku (0 = 1.FDD, 1 = 2.FDD, 80h = 1.HDD, 81h = 2.HDD
 LBASector: linearni (t.j. LBA) adresa sektoru k zapisu
 BajtSekt: pocet bajtu na sektor (prakticky vzdy 512)
 Num: pocet sektoru k zapisu
 Buffer: bude zaplnen daty ze sektoru
 Navrat funkce: 0 = vsechno v poradku
              <>0 = cislo chyby}
var r:registers;
    zadanka:TExtdskFuncPack;
    LowMemPtr:dword;
    w:word;

begin
FillChar(zadanka,SizeOf(zadanka),0);
w:=num*BajtSekt;
with zadanka do begin
   xfsize:=$10; { $18}  {Type(ExtdskFuncPack)}
   xfreserved:=0;
   xfsectornum:=num;
   {$IFDEF FPC}
   LowMemPtr:=Global_DOS_Alloc(w);
   xfDataBuffer_seg:=Word(LowMemPtr shr 16);
   xfDataBuffer_ofs:=0;
   {$ELSE}
   xfDataBuffer_seg:=seg(buffer);
   xfDataBuffer_ofs:=ofs(buffer);
   {$ENDIF}
   xfLBAsector[0]:=LBAsector;
   end;
r.dl:=dsk;
r.ah:=$43;
r.al:=flags;
{$IFDEF FPC}
CopyToDOS(zadanka,sizeof(zadanka));
r.ds:=tb_segment;
r.si:=tb_offset;
DOSmemPut(Word(LowMemPtr shr 16),0,buffer,w);
{$ELSE}
r.ds:=seg(zadanka);
r.si:=ofs(zadanka);
{$ENDIF}
Intr($13,r);
{$IFDEF FPC}
Global_DOS_Free(Word(LowMemPtr));
{$ENDIF}
if odd(r.flags) then WriteSector_LBA:=r.ah else WriteSector_LBA:=0;
end;


Procedure Get_Extended_parameters(dsk: Byte; var Buffer);
var r:registers;
    info:PExtParam;

begin
TextParam(buffer).bufsize:=SizeOf(TExtParam);

r.dl:=dsk;
r.ax:=$4800;
{$IFDEF FPC}
CopyToDOS(buffer,sizeof(TExtParam));
r.ds:=tb_segment;
r.si:=tb_offset;
{$ELSE}
r.ds:=seg(buffer);
r.si:=ofs(buffer);
{$ENDIF}
Intr($13,r);
if (r.flags and fCarry)<>0 then FillChar(buffer,SizeOf(TExtParam),0)
   else begin
   {$IFDEF FPC}
   CopyFromDOS(buffer,sizeof(TExtParam));
   {$ENDIF}
   end;
end;


Function IS_DOS_drive_ready(dsk:char):boolean;
{Vrati FALSE i v pripade, ze disk je fyzicky pripraeven, ale neni naformatovan
 na system FAT}
var di:SearchRec;
    de:longint;
begin {dskReady}
FindFirst(dsk+':\*.*',sysfile+hidden+archive+directory,di);
de:=DosError;
IS_DOS_drive_ready:=de in [0,18,2];
{$IFDEF FPC}
FindClose(di);
{$ENDIF}
end;


Procedure NatahniTDOSdskNumInfo(dsk:char;var t:TDOSdskNumInfo);
var l:dword;
    a,b:word;
    c:byte;
    r:registers;

begin
 {TAKTO NE: "c:=Pos(UpCase(dsk),Logdisk);" (nechavam to tu jako vystrahu)}
 c:=byte(UpCase(dsk))-64;  {Takto je to spravne}
 {$IFDEF FPC}
 CopyToDOS(t,SizeOf(TdskNumInfo));
 r.ax:=$6900;
 r.bx:=c;
 r.ds:=tb_segment;
 r.dx:=tb_offset;
 MsDOS(r);
 CopyFromDOS(t,sizeof(TdskNumInfo));
 {$ELSE}
 asm
 mov ax,6900h
 mov bl,c
 xor bh,bh
 push si
 push ds
 lds di,t
 mov dx,di
 int 21h
 pop ds
 pop si
 end;
 {$ENDIF}
end;


{$IFDEF FPC}
Function CallRealModeFar(var regs : TRealRegs) : Boolean;assembler;
asm
   mov ax,301h
   xor ecx, ecx
   xor ebx,ebx
   mov edi,regs
   int 31h
   xor eax, eax
end;
{$ENDIF}


Function NactiSektory_pres_int25(dsk:char;i,p:dword;var buf):longint;
{Pro diskety a harddisky do 20MB, resp. pro oblasti s FAT12}
{Pozor! Pri programovan je treba mit na zreteli, ze preruseni 25h a 26h nechavaji
 po skonceni viset na zasobniku jeden word. Ten musime manualne odstranit.}

var {$IFDEF FPC}r:TRealregs;{$ELSE}r:registers;{$ENDIF}
    c:byte;
    ax_reg:word;

{$IFDEF FPC}
const
    code16_int25:array[0..9] of byte = ($90,
    {jde o 16-bit wrapper, ktery}       $55,       { push bp   }
    {obaluje INT 25h a vyzvedava word}  $8B, $EC,  { mov bp,sp }
    {ze zasobniku}                      $CD, $25,  { int 25h   }
                                        $8B, $E5,  { mov sp,bp }
                                        $5D,       { pop bp    }
                                        $CB);      { retf      }
{$ENDIF}

begin
c:=byte(UpCase(dsk))-64-1; {Pozor - 0 neni default drive, ale A:\}

{$IFDEF FPC}
DOSmemPut(tb_segment,tb_offset,code16_int25,10); {umistim kod wrapperu do konv. pameti}

r.al:=c;
r.cx:=p;
r.dx:=i;
r.ds:=tb_segment;
r.bx:=tb_offset+16;
r.cs:=tb_segment;
r.ip:=tb_offset;
r.sp:=0;
r.ss:=0;

CallRealModeFar(r); {zavola INT25h prostrednictvim 16-bit wrapperru, protoze}
                    {neni jina moznost jak z DPMI bezprostredne po INT 25h}
                    {vyzvednout "zapomenuty" word ze zasobniku}

DOSmemGet(tb_segment,16,buf,p*512);
if odd(r.Flags) then ax_reg:=r.ax else ax_reg:=0;
{$ELSE}
asm
xor ax,ax
mov al,c
mov cx,p.word
mov dx,i.word
push es
push ds
push bp
push sp
push di
push si

lds bx,buf
int 25h
{}pop bx      {vyzvedavam word ze zasobniku "zapomenuty" prerusenim}
pop si
pop di
pop sp
pop bp
pop ds
pop es

mov bx,0    {nikoliv XOR, protoze nechci menit priznaky}
jnc @vse_ok
mov bx,ax
@vse_ok:
mov ax_reg,bx
end;
{$ENDIF}

NactiSektory_pres_int25:=ax_reg;
end;


Function NactiSektory_pres_int25_ffff(dsk:char;i,p:dword;var buf):longint;
{Pro harddisky do 2GB, resp. pro oblasti s FAT16}
{Pozor! Pri programovan je treba mit na zreteli, ze preruseni 25h a 26h nechavaji
 po skonceni viset na zasobniku jeden word. Ten musime manualne odstranit.}

var r:registers;
    c:byte;
    ax_reg:word;
    zadanka:packed record
       sektor:dword;
       num:word;
       adrofs:word;
       adrseg:word;
       end;

{$IFDEF FPC}
const
    code16_int25:array[0..9] of byte = ($90,
    {jde o 16-bit wrapper, ktery}       $55,       { push bp   }
    {obaluje INT 25h a vyzvedava word}  $8B, $EC,  { mov bp,sp }
    {ze zasobniku}                      $CD, $25,  { int 25h   }
                                        $8B, $E5,  { mov sp,bp }
                                        $5D,       { pop bp    }
                                        $CB);      { retf      }
{$ENDIF}

begin
c:=byte(UpCase(dsk))-64-1;  {Pozor - 0 neni default drive, ale A:\}
fillchar(r,sizeof(registers),0);
zadanka.sektor:=i;
zadanka.num:=p;

{$IFDEF FPC}
DOSmemPut(tb_segment,tb_offset,code16_int25,10); {umistim kod wrapperu do konv. pameti}

r.al:=c;
r.cx:=$FFFF;
r.ds:=tb_segment;
r.bx:=tb_offset+16;
r.cs:=tb_segment;
r.ip:=tb_offset;
r.sp:=0;
r.ss:=0;

zadanka.adrseg:=tb_segment;
zadanka.adrofs:=tb_offset+32; {za wrapper a za zadanku}

DOSmemPut(tb_segment,tb_offset+16,zadanka,sizeof(zadanka));

{situace v TB_segment:TB_offset
   0-15.  bajt je rezervovany pro wrapper
   16-31. bajt je pro zadanku
   32. a dale je pro prenasena data
}

CallRealModeFar(r); {zavola INT25h prostrednictvim 16-bit wrapperru, protoze}
                    {neni jina moznost jak z DPMI bezprostredne po INT 25h}
                    {vyzvednout "zapomenuty" word ze zasobniku}

DOSmemGet(tb_segment,tb_offset+32,buf,p*512);
if odd(r.Flags) then ax_reg:=r.ax else ax_reg:=0;
if odd(r.Flags) then ax_reg:=r.ax else ax_reg:=0;

{$ELSE}
zadanka.adrseg:=seg(buf);
zadanka.adrofs:=ofs(buf);
asm
xor ax,ax
mov al,c
mov cx,$ffff
push es
push ds
push bp
push di
push si

lea bx,zadanka  {nahraju offset zaznamu "zadanka"}
push ss         {jenze ten je vztazen ke segmentu zasobniku, nikoliv k DS}
pop ds          {takze musime provest DS:=SS}

int 25h
{}pop bx      {vyzvedavam word ze zasobniku "zapomenuty" prerusenim}
pop si
pop di
pop bp
pop ds
pop es

mov bx,0    {nikoliv XOR, protoze nechci menit priznaky}
jnc @vse_ok
mov bx,ax
@vse_ok:
mov ax_reg,bx
end;
{$ENDIF}

NactiSektory_pres_int25_ffff:=ax_reg;
end;


Function NactiSektory_pres_int21_7305(dsk:char;i,p:dword;var buf):longint;
{Pro harddisky nad 2GB, resp. pro oblasti s FAT32}
var r:registers;
    ax_reg:word;
    c:byte;
    zadanka:packed record
       sektor:dword;
       num:word;
       adrofs:word;
       adrseg:word;
       end;

begin
c:=byte(UpCase(dsk))-64;
fillchar(r,sizeof(registers),0);
r.ax:=$7305;
r.cx:=$ffff;
r.dl:=c;
r.si:=0;    {cteni}
zadanka.sektor:=i;
zadanka.num:=p;

{$IFDEF FPC}
r.ds:=tb_segment;
r.bx:=tb_offset;
zadanka.adrseg:=tb_segment;
zadanka.adrofs:=tb_offset+16;
CopyToDOS(zadanka,sizeof(zadanka));
Intr($21,r);

DosMemGet(tb_segment,tb_offset+16,buf,p*512);
if odd(r.Flags) then ax_reg:=r.ax else ax_reg:=0;

{$ELSE}
zadanka.adrseg:=seg(buf);
zadanka.adrofs:=ofs(buf);
r.ds:=seg(zadanka);
r.bx:=ofs(zadanka);
Intr($21,r);
if odd(r.Flags) then ax_reg:=r.ax else ax_reg:=0;
{$ENDIF}

NactiSektory_pres_int21_7305:=ax_reg;
end;



Function ZapisSektory_pres_int26(dsk:char;i,p:dword;var buf):longint;
{Pro diskety a harddisky do 20MB, resp. pro oblasti s FAT12}
{Pozor! Pri programovan je treba mit na zreteli, ze preruseni 25h a 26h nechavaji
 po skonceni viset na zasobniku jeden word. Ten musime manualne odstranit.}

var r:registers;
    c:byte;
    ax_reg:word;

{$IFDEF FPC}
const
    code16_int26:array[0..9] of byte = ($90,
    {jde o 16-bit wrapper, ktery}       $55,       { push bp   }
    {obaluje INT 26h a vyzvedava word}  $8B, $EC,  { mov bp,sp }
    {ze zasobniku}                      $CD, $26,  { int 25h   }
                                        $8B, $E5,  { mov sp,bp }
                                        $5D,       { pop bp    }
                                        $CB);      { retf      }
{$ENDIF}

begin
c:=byte(UpCase(dsk))-64-1; {Pozor - 0 neni default drive, ale A:\}

{$IFDEF FPC}
fillchar(r,sizeof(registers),0);
DOSmemPut(tb_segment,tb_offset,code16_int26,10); {umistim kod wrapperu do konv. pameti}

r.al:=c;
r.cx:=p;
r.dx:=i;
r.ds:=tb_segment;
r.bx:=tb_offset+16;
r.cs:=tb_segment;
r.ip:=tb_offset;
r.sp:=0;
r.ss:=0;

DOSmemPut(tb_segment,tb_offset+16,buf,p*512);
CallRealModeFar(r); {zavola INT25h prostrednictvim 16-but wrapperru, protoze}
                    {neni jina moznost jak z DPMI bezprostredne po INT 25h}
                    {vyzvednout "zapomenuty" word ze zasobniku}
if odd(r.Flags) then ax_reg:=r.ax else ax_reg:=0;
{$ELSE}
asm
xor ax,ax
mov al,c
mov cx,p.word
mov dx,i.word
push es
push ds
push bp
push di
push si

lds bx,buf
int 26h
{}pop bx      {vyzvedavam word ze zasobniku "zapomenuty" prerusenim}
pop si
pop di
pop bp
pop ds
pop es

mov bx,0    {nikoliv XOR, protoze nechci menit priznaky}
jnc @vse_ok
mov bx,ax
@vse_ok:
mov ax_reg,bx
end;
{$ENDIF}

ZapisSektory_pres_int26:=ax_reg;
end;


Function ZapisSektory_pres_int26_ffff(dsk:char;i,p:dword;var buf):longint;
{Pro harddisky do 2GB, resp. pro oblasti s FAT16}
{Pozor! Pri programovan je treba mit na zreteli, ze preruseni 25h a 26h nechavaji
 po skonceni viset na zasobniku jeden word. Ten musime manualne odstranit.}

var r:registers;
    c:byte;
    ax_reg:word;
    zadanka:packed record
       sektor:dword;
       num:word;
       adrofs:word;
       adrseg:word;
       end;

{$IFDEF FPC}
const
    code16_int26:array[0..9] of byte = ($90,
    {jde o 16-bit wrapper, ktery}       $55,       { push bp   }
    {obaluje INT 26h a vyzvedava word}  $8B, $EC,  { mov bp,sp }
    {ze zasobniku}                      $CD, $26,  { int 25h   }
                                        $8B, $E5,  { mov sp,bp }
                                        $5D,       { pop bp    }
                                        $CB);      { retf      }
{$ENDIF}

begin
c:=byte(UpCase(dsk))-64-1;  {Pozor - 0 neni default drive, ale A:\}
zadanka.sektor:=i;
zadanka.num:=p;

{$IFDEF FPC}
fillchar(r,sizeof(registers),0);
DOSmemPut(tb_segment,tb_offset,code16_int26,10); {umistim kod wrapperu do konv. pameti}

r.al:=c;
r.cx:=$FFFF;
r.ds:=tb_segment;
r.bx:=tb_offset+16;
r.cs:=tb_segment;
r.ip:=tb_offset;
r.sp:=0;
r.ss:=0;

zadanka.adrseg:=tb_segment;
zadanka.adrofs:=tb_offset+32; {za wrapper a za zadanku}

DOSmemPut(tb_segment,tb_offset+16,zadanka,sizeof(zadanka));

{situace v TB_segment:TB_offset
   0-15.  bajt je rezervovany pro wrapper
   16-31. bajt je pro zadanku
   32. a dale je pro zapisovana data
}

DOSmemPut(tb_segment,tb_offset+32,buf,p*512);
CallRealModeFar(r); {zavola INT25h prostrednictvim 16-bit wrapperru, protoze}
                    {neni jina moznost jak z DPMI bezprostredne po INT 25h}
                    {vyzvednout "zapomenuty" word ze zasobniku}


if odd(r.Flags) then ax_reg:=r.ax else ax_reg:=0;
{$ELSE}
zadanka.adrseg:=seg(buf);
zadanka.adrofs:=ofs(buf);
asm
xor ax,ax
mov al,c
mov cx,$ffff
push es
push ds
push bp
push di
push si

lea bx,zadanka  {nahraju offset zaznamu "zadanka"}
push ss         {jenze ten je vztazen ke segmentu zasobniku, nikoliv k DS}
pop ds          {takze musime provest DS:=SS}

int 26h
{}pop bx      {vyzvedavam word ze zasobniku "zapomenuty" prerusenim}
pop si
pop di
pop bp
pop ds
pop es

mov bx,0    {nikoliv XOR, protoze nechci menit priznaky}
jnc @vse_ok
mov bx,ax
@vse_ok:
mov ax_reg,bx
end;
{$ENDIF}

ZapisSektory_pres_int26_ffff:=ax_reg;
end;


Function ZapisSektory_pres_int21_7305(dsk:char;i,p:dword;var buf):longint;
var r:registers;
    c:byte;
    ax_reg:word;
    zadanka:packed record
       sektor:dword;
       num:word;
       adrofs:word;
       adrseg:word;
       end;

begin
c:=byte(UpCase(dsk))-64;
fillchar(r,sizeof(registers),0);
r.ax:=$7305;
r.cx:=$ffff;
r.dl:=c;
r.si:=1;       {zapis}
zadanka.sektor:=i;
zadanka.num:=p;

{$IFDEF FPC}
r.ds:=tb_segment;
r.bx:=tb_offset;
zadanka.adrseg:=tb_segment;
zadanka.adrofs:=tb_offset;
CopyToDOS(zadanka,sizeof(zadanka));
DosMemPut(tb_segment,tb_offset+16,buf,p*512);
Intr($21,r);
if odd(r.Flags) then ax_reg:=r.ax else ax_reg:=0;
{$ELSE}
zadanka.adrseg:=seg(buf);
zadanka.adrofs:=ofs(buf);
r.ds:=seg(zadanka);
r.bx:=ofs(zadanka);
Intr($21,r);
if odd(r.Flags) then ax_reg:=r.ax else ax_reg:=0;
{$ENDIF}

ZapisSektory_pres_int21_7305:=ax_reg;
end;


Function Zjisti_z_bootsectoru_typ_FAT(data:pointer):byte;
{0 = neplatna FAT}
{1 = FAT12}
{2 = FAT16}
{3 = FAT32}
var fat:PFAT12a16Boot_Record;
    bad:boolean;
    rd:dword;

begin
fat:=data;
bad:=false;

rd:=fat^.BytePerSector;
if (rd<>512) and (rd<>1024) and (rd<>2048) and (rd<>4096) then bad:=true;
if bad then begin Zjisti_z_bootsectoru_typ_FAT:=0;Exit;end;

rd:=fat^.SectorPerClus;
if not (rd in [1,2,4,8,16,32,64,128]) then begin Zjisti_z_bootsectoru_typ_FAT:=0;Exit;end;

rd:=fat^.ResSectorNum;
if rd=32 then begin Zjisti_z_bootsectoru_typ_FAT:=3;Exit;end;
if not (rd in [1,32]) then begin Zjisti_z_bootsectoru_typ_FAT:=0;Exit;end;

{Ted vime, ze FAT boot sector je platny a ze je to bud FAT12 nebo FAT16}

if fat^.SectorNum<>0 then rd:=fat^.SectorNum else rd:=fat^.BigTotNumSec;

if rd>20740
   then Zjisti_z_bootsectoru_typ_FAT:=2
   else Zjisti_z_bootsectoru_typ_FAT:=1;
end;



Function FATtype(drive:char):byte;
{0 = neplatna FAT}
{1 = FAT12}
{2 = FAT16}
{3 = FAT32}

var _data:array[0..4095] of byte;
    l:longint;
    data:pointer;
    reserved_sec:longint;


begin
data:=@_data;
l:=NactiSektory_pres_int25(drive,0,1,_data);

if l<>0 {"Neplatna jednotka" pro vyse pouzity pristup k disku?}
   then     {tak to zkusime jeste takhle}
   l:=NactiSektory_pres_int21_7305(drive,0,1,_data);

if l=0
   then FATtype:=Zjisti_z_bootsectoru_typ_FAT(data)
   else FATtype:=0;
end;


Function Zjisti_BajtSekt_pres_DOS(dsk:char):word;
var w:word;
    c:byte;
    r:registers;
begin
c:=byte(UpCase(dsk))-64;
r.ah:=$36;
r.dl:=c;
Intr($21,r);
if r.ax<>$FFFF then w:=r.cx else w:=0;
Zjisti_BajtSekt_pres_DOS:=w;
end;


Function Nacti_Sektory_pres_DOS(dsk:char;i,p:dword;kontrola:boolean;var pristup:byte; var buf):longint;
{z DOSove jednotky DSK nacte P sektoru, I-tym pocinaje, kontrola - zkontroluj, je-li jednotka pripravena
 "prostup" - jakou funkci prostupovat k disku: 0 = autodetect, 1 = disk(eta) do 20MB (FAT12), 2 = disk do 2GB (FAT16),
 3 = disky nad 2GB, resp. disky s FAT32.

 Pozor, predpoklada, ze sektory maji veliksot 512 bajtu}
var s:string;
begin
if kontrola then
   if not IS_dos_drive_ready(dsk) then
      begin
      Nacti_Sektory_pres_DOS:=$80;
      Exit;
      end;

if (pristup=0) or (pristup>3) then
   begin
   pristup:=FATtype(dsk);
   if pristup=0 then begin Nacti_Sektory_pres_DOS:=$81;Exit;end;
   end;

if pristup=1
   then Nacti_Sektory_pres_DOS:=NactiSektory_pres_int25(dsk,i,p,buf) else

if pristup=2
   then Nacti_Sektory_pres_DOS:=NactiSektory_pres_int25_ffff(dsk,i,p,buf) else

if pristup=3
   then Nacti_Sektory_pres_DOS:=NactiSektory_pres_int21_7305(dsk,i,p,buf)

else Nacti_Sektory_pres_DOS:=$81;
end;


Function Zapis_Sektory_pres_DOS(dsk:char;i,p:dword;kontrola:boolean;var pristup:byte;var buf):longint;
{z DOSove jednotky DSK nacte P sektoru, I-tym pocinaje, kontrola - zkontroluj, je-li jednotka pripravena
 "prostup" - jakou funkci prostupovat k disku: 0 = autodetect, 1 = disk(eta) do 20MB (FAT12), 2 = disk do 2GB (FAT16),
 3 = disky nad 2GB, resp. disky s FAT32.

 Pozor, predpoklada, ze sektory maji veliksot 512 bajtu }
var s:string;
begin
if kontrola then
   if not IS_dos_drive_ready(dsk) then
      begin
      Zapis_Sektory_pres_DOS:=$80;
      Exit;
      end;

if (pristup=0) or (pristup>3) then
   begin
   pristup:=FATtype(dsk);
   if pristup=0 then begin Zapis_Sektory_pres_DOS:=$81;Exit;end;
   end;

if pristup=1
   then Zapis_Sektory_pres_DOS:=ZapisSektory_pres_int26(dsk,i,p,buf) else

if pristup=2
   then Zapis_Sektory_pres_DOS:=ZapisSektory_pres_int26_ffff(dsk,i,p,buf) else

if pristup=3
   then Zapis_Sektory_pres_DOS:=ZapisSektory_pres_int21_7305(dsk,i,p,buf)

else Zapis_Sektory_pres_DOS:=$81;
end;



Function ReadSector(dsk:byte; SecPos: TSectorPos; BajtSekt:Word; num:byte;var Buffer):Byte;
{Cteni pres INT13h}
begin
if IsExtdskFunc(dsk)<>0
   then ReadSector:=ReadSector_LBA(dsk, SecPos.LBA, BajtSekt, num,Buffer)
   else ReadSector:=ReadSector_CHS(dsk, SecPos.Cyl,SecPos.Hla,SecPos.Sek, BajtSekt, num,Buffer);
end;


Procedure PrvniSektor(var sec:TSectorPos);
begin
sec.LBA:=0;
sec.cyl:=0;
sec.hla:=0;
sec.sek:=1;
end;


Function Existuje_Floppy_mechanika(disk:byte):boolean;
{Zjisti, zda je zapojena disketova mechanika 0 nebo 1}
var r:registers;
begin
if disk>1 then Existuje_Floppy_mechanika:=false
   else begin
   r.ah:=$15;
   r.dl:=disk;
   Intr($13,r);
   Existuje_Floppy_mechanika:=not(odd(r.flags)) and (r.ah in [1,2]);
   {pozn: r.AH = 1: nepodporuje indikaci zmeny media
          r.AH = 2: podporuje indikaci zmeny media}
   end;
end;


Function UrciDisk(disk:byte):byte;
{0 = neexistuje
 1 = disketa bez indikace zmeny media
 2 = disketa s indikaci zmeny media
 3 = harddisk}
var r:registers;
begin
r.ah:=$15;
r.dl:=disk;
Intr($13,r);
if odd(r.flags) then UrciDisk:=0 else UrciDisk:=r.ah;
end;



Function PocetSektoru(disk:byte):dword;
{Urci pocet sektoru na disku. Umi obslouzit disky do 2TB}
var r:registers;
    d:dword;
begin
r.ah:=$15;
r.dl:=disk;
Intr($13,r);
d:=r.cx;
d:=d shl 16+r.dx;
end;


Function TDskInfo.DetekceMBR(var buf:TSector):boolean;
{TRUE - disk obsahuje validni tabulku disku s alespon jednou definovanou oblasti}
{FALSE - bud tabulka rozdeleni disku chybi (jako u vetsiny USB disku
         (oznacovano jako "superfloppy")) nebo nejaka je, ale je defektni}
var a,b,c:byte;
    pcyl,phla,psek:word;
    bf:PMBR_record;
    i:dword;
    ok,byla_oblast:boolean;
begin
bf:=@buf;
a:=0;
for b:=0 to 3 do
{1.test - oblasti s oznacenim "active" musi byt 0 nebo 1 a v tomto miste
 tabulky se muze vyskytovat pouze hodnota 0 nebo $80.}
    if bf^.PartTable[b].active=$80 then a:=a+1
       else if bf^.PartTable[b].active<>0 then a:=a+10;
if a>1 then begin DetekceMBR:=false;Exit;end;

{2.test - zkontroluji kody fajlsystemu. Pokud je kod 0, tak velikost oblasti
 musi byt 0, pokud kod fajlsystemu neni 0, tak velikost oblasti naopak nesmi
 byt 0}

ok:=true;   {predpokladame, ze vsechny podminky jsou splneny}
byla_oblast:=false;
for b:=0 to 3 do
    if bf^.PartTable[b].typ<>0
       then if bf^.PartTable[b].size=0 then ok:=false else byla_oblast:=true
       else if bf^.PartTable[b].size<>0 then ok:=false;

if not ok then begin DetekceMBR:=false;Exit;end;

{3.test - vse je sice validni, ale nalezli jsme vlastne nejakou oblast? }
DetekceMBR:=byla_oblast;
end;


Procedure TDskInfo.Init(dsk:byte);
var buf:TSector;
    r:registers;

begin
disk:=dsk;
MBR:=false;
LBA:=false;
typ:=UrciDisk(dsk);
oddilu:=0;
bajtsekt:=512;    {predpokladam 512 bajtove sektory}
if dsk>=$80{typ=3} then
   begin
   LBA:=IsExtdskFunc(disk)<>0;
   EDD:=Verze_EDD_INT13(disk);
   ZjistiGeometrii;
   NactiMBR(buf);
   MBR:=DetekceMBR(buf);
   end;
end;


Function Zformatuj_info_o_velikosti(d:dword):string;
var e:extended;
    s:string;
begin
if d=2400 then s:='1.20MB' else
if d=2948 then s:='1.44MB' else
   begin
   e:=d;
   e:=e/2048;   {velikost v MB}
   if e<1 then begin Str(e*1024:1:0,s);s:=s+'KB';end else
   if e>1000 then begin Str(e/1024:1:2,s);s:=s+'GB';end
   else begin Str(e:1:2,s);s:=s+'MB';end;
   end;
Zformatuj_info_o_velikosti:=s;
end;


Function TDskInfo.Dej_Velikost_citelne:string;
{Z tezko interpretovatelneho cisla prehledne zjisti kapacitu disku (diskety)}
begin
Dej_Velikost_citelne:=Zformatuj_info_o_velikosti(velikost);
end;


Function TDskInfo.Je_GPR_Record:boolean;
{Zjisti, ma-li disk GPR sektor}
var buf:TSector;
    b:byte;
    sec:TsectorPos;
begin
if LBA=false then Je_GPR_Record:=false
   else begin
   sec.LBA:=1;
   b:=ReadSector_LBA(disk,sec.LBA,bajtsekt,1,buf);
   if b<>0 then Je_GPR_Record:=false
      else begin
      for b:=0 to Length(GPR_MAGIC)-1 do
          if char(buf[b])<>GPR_MAGIC[b+1] then
             begin
             Je_GPR_Record:=false;
             Exit;
             end;
      Je_GPR_Record:=true;
      end;
   end;
end;


Procedure TDskInfo.ZjistiGeometrii;
{naplni promenne HLAV, SEKT, CYLI}
var r:registers;
    buf:TExtParam;
begin
if LBA then
   begin
   Get_Extended_parameters(disk,buf);
   hlav:=buf.hlavy;
   sekt:=buf.SektoruNaStopu;
   cyli:=buf.cylindry;
   velikost:=buf.PocetSektoru[0];
   bajtsekt:=buf.BajtuNaSektor;       {pocet bajtu na sektor}
   end
   else begin
   r.ah:=8;        {zjisti geometrii disku}
   r.dl:=disk;
   Intr($13,r);
   hlav:=r.dh+1;
   sekt:=r.cx and 63;
   cyli:=(r.cx shr 8) + ((r.cx and 192) shl 2)+1;
   velikost:=cyli*hlav*sekt;
   end;
end;


Function Je_Dostupne_DPTE(disk:byte):boolean;
var a,b:byte;
begin
Je_Dostupne_DPTE:=false;
a:=verze_edd_int13(disk);
if a<$20 then Exit; {prilis nizka verze rozhrani}
b:=Verze_EDD_priznaky(disk);
if (b and 4)=0 then
   begin
   Je_Dostupne_DPTE:=false;
   Exit;               {neni k dispozici EDPT}
   end;
Je_Dostupne_DPTE:=true;
end;


Function TDskInfo.ZjistiParametry_IDE(var ideport:word;var master:boolean):boolean;
var buf:array[0..255] of byte;
    segm,offs:word;
    b1:byte;
begin
if Je_dostupne_DPTE(disk)=false then
   begin
   ideport:=0;
   master:=false;
   ZjistiParametry_IDE:=false;
   Exit;
   end;

Get_Extended_parameters(disk, buf);
segm:=PExtParam(@buf)^.DPTE_pointer_seg;
offs:=PExtParam(@buf)^.DPTE_pointer_ofs;

ideport:=MemW[segm:offs];
{ctrlport:=MemW[segm:offs+2];}

b1:=Mem[segm:offs+4];
master:=(b1 and 16)=0;
ZjistiParametry_IDE:=true;
end;


Function Prohod_Endianitu_Retezce(s:string):string;
{prohodi 1.znak s druhym, 3.znak se ctvrtym, 5.znak s sestym, a tak dale}
var a,b:byte;
    c:char;
begin
for a:=1 to Length(s) div 2 do
    begin
    b:=a*2;
    c:=s[b-1];
    s[b-1]:=s[b];
    s[b]:=c;
    end;
Prohod_Endianitu_Retezce:=s;
end;


Function Trim(s:string):string;
{usekne pocatecni a koncove mezery}
var a,b:byte;
begin
for a:=1 to Length(s) do
    if not (s[a] in [' ',#0]) then
       begin
       delete(s,1,a-1);
       for b:=Length(s) downto 1 do
           if not (s[b] in [' ',#0]) then
              begin
              delete(s,b+1,255);
              Trim:=s;
              Exit;
              end;
       end;
Trim:='';
end;


Procedure Dummy_Info_z_IDE(idep:word;idem,cd_mode:boolean;data:pointer);
begin
{normalne by se buffer daplnil daty z IDE radice, ale tohle je pahyl, proto
 ho zkratka vynuluju}
FillChar(data^,512,0);
end;


Function TDskInfo.ZjistiTypDisku:string;
var idep:word;
    idem:boolean;
    data:array[0..255] of word;
    datap:^byte;
    s:string;

begin
if ZjistiParametry_IDE(idep,idem)=false
   then begin ZjistiTypDisku:='';Exit;end;

data[0]:=65;
Proc_Info_z_IDE(idep,idem,false,@data);

datap:=@data;
inc(datap,27*2); {jde o wordy, proto nasobim dvema}
Move(datap^,s[1],40);

s[0]:=#40;
ZjistiTypDisku:=Trim(Prohod_Endianitu_Retezce(s));
end;


Function TDskInfo.ZjistiSerioveCislo:string;
var idep:word;
    idem:boolean;
    data:array[0..255] of word;
    datap:^byte;
    s:string;

begin
if ZjistiParametry_IDE(idep,idem)=false
   then begin ZjistiSerioveCislo:='';Exit;end;
Proc_Info_z_IDE(idep,idem,false,@data);
datap:=@data;
inc(datap,10*2); {jde o wordy, proto nasobim dvema}
Move(datap^,s[1],10);
s[0]:=#10;
ZjistiSerioveCislo:=Trim(Prohod_Endianitu_Retezce(s));
end;


Procedure TDskInfo.PoziceOblasti(parent:TSectorPos;slot:byte;var buf:TSector;var novy:TSectorPos);
var bf:PMBR_record;
begin
if LBA then novy.LBA:=parent.LBA+TMBR_Record(buf).PartTable[slot].StartRelSec
   else begin
   bf:=@buf;
   novy.LBA:=parent.LBA+bf^.PartTable[slot].StartRelSec; {debug}
   novy.hla:=bf^.PartTable[slot].StartHead;
   DecompressCS(bf^.PartTable[slot].StartCylSec,novy.cyl,novy.sek);
   end;
end;


Function TDskInfo.NactiMBR(var buf:TSector):byte;
begin
if LBA then NactiMBR:=ReadSector_LBA(disk,0,bajtsekt,1,buf)
       else NactiMBR:=ReadSector_CHS(disk,0,0,1,bajtsekt,1,buf);
end;

Function TDskInfo.ShodaPozic(iparent,istart:TSectorPos):boolean;
begin
if LBA then ShodaPozic:=iparent.LBA=istart.LBA
       else ShodaPozic:=(iparent.cyl=istart.cyl) and (iparent.hla=istart.hla)
                        and (iparent.sek=istart.sek);
end;


Function TDskInfo.NactiSektor(poz:TSectorPos;var buf:TSector):byte;
begin
if LBA then NactiSektor:=ReadSector_LBA(disk,poz.LBA,bajtsekt,1,buf)
       else NactiSektor:=ReadSector_CHS(disk,poz.cyl,poz.hla,poz.sek,bajtsekt,1,buf);
end;


Procedure TOddInfo.Init(iDI:PDskInfo;iparent,istart:TSectorPos);
var s:TSectorPos;
begin
DI:=iDI;
start:=istart;
ParentSec:=iparent;
if DI^.ShodaPozic(iparent,istart) then
   begin
   active:=true;
   if DI^.disk>=$80 then
      case ZjistiTypFAT of
      0:kodFS:=0;
      1:kodFS:=1;
      2:kodFS:=$0E;
      3:kodFS:=$0C;
      end{case}
      else kodFS:=0; {if...>=$80}
   velikost:=di^.velikost;
   end;
end;


Function TOddInfo.Dej_Velikost_citelne:string;
{Vygeneruje dobre citelny retezec popisujici velikost oddilu}
begin
Dej_Velikost_citelne:=Zformatuj_info_o_velikosti(velikost);
end;

Function TOddInfo.NactiSektory(i,p:dword;var buf):byte;
var j:dword;
    cy,hl,se:word;
begin
if DI^.LBA then
   begin
   i:=i+start.LBA;
   NactiSektory:=ReadSector_LBA(di^.disk,i,di^.bajtsekt,p,buf);
   end
   else begin
   j:=(dword(start.cyl)*di^.hlav+start.hla)*dword(di^.sekt)+start.sek-1;
   j:=j+i;
   cy:=j div (di^.hlav*di^.sekt);
   hl:=j mod (di^.hlav*di^.sekt) div di^.sekt;
   se:=j mod (di^.sekt)+1;
   NactiSektory:=ReadSector_CHS(di^.disk,cy,hl,se,di^.bajtsekt,p,buf);
   end;
end;


Function TOddInfo.NactiBootSector(var buf:TSector):byte;
begin
NactiBootSector:=NactiSektory(0,1,buf);
end;

Procedure TOddInfo.NatahniInfoOblasti(b:byte;var mbrec:TSector);
var bf:PMBR_record;
begin
bf:=@mbrec;
kodFS:=TMBR_Record(mbrec).parttable[b].typ;
active:=TMBR_Record(mbrec).parttable[b].active=$80;
velikost:=TMBR_Record(mbrec).parttable[b].size;
ParentSlot:=b;
end;


Function TOddInfo.PrectiPopisku:string;
var buf:TSector;
    Pb:PFAT12a16Boot_Record;
begin
if NactiBootSector(buf)=0 then
   begin
   Pb:=@buf;
   PrectiPopisku:=chary_na_string(Pb^.OemNameVer,7);
   end
   else PrectiPopisku:='';
end;


Procedure TOddInfo.UlozBootSectorDosouboru(s:string);
{ulozi bootsector do souboru}
var f:file;
    buf:TSector;
begin
NactiBootSector(buf);
Assign(f,s);
Rewrite(f,1);
BlockWrite(f,buf,sizeof(TSector));
Close(f);
end;


Procedure TOddInfo.UlozSektoryDoSouboru(i,p:dword;s:string);
{ulozi P sektoru, I-tym pocinaje do souboru}
var f:file;
    buf:TSector;
    j:dword;
begin
Assign(f,s);
Rewrite(f,1);
for j:=i to i+p-1 do
    begin
    NactiSektory(j,1,buf);
    BlockWrite(f,buf,sizeof(TSector));
    end;
Close(f);
end;


Function TOddInfo.ZjistiTypFAT:byte;
{0=nejde o FAT, 1=FAT12, 2=FAT16, 3=FAT32}
var bf:TSector;
begin
NactiBootSector(bf);
ZjistiTypFAT:=Zjisti_z_bootsectoru_typ_FAT(@bf);
end;


Function TOddInfo.NTFS_exFAT_jina:byte;
{V oddilech kde kodFS=7 odlisi NTFS, HPFS a exFAT
0=FAT, 1=NTFS, 2=exFAT, 3=jina (nejspis HPFS)}
var sector:TSector;
    a,b:byte;
    p:PNTFSBoot_record;

begin
NactiBootSector(sector);
if di^.MBR=false then  {kdyz disk nema MBR oblast, tak to nemuze byt NTFS...}
   begin
   if ZjistiTypFAT<>0 then {ale za to to muze byt FAT}
      begin NTFS_exFAT_jina:=0;Exit;end
      else begin
      for a:=$0B to $39 do {exFAT ma v teto oblasti nuly}
          if sector[a]<>0 then
             begin {naslo se neco jineho nez 0, takze asi jsme na HPFS}
             NTFS_exFAT_jina:=3;
             Exit;
             end;
      NTFS_exFAT_jina:=2;
      Exit;
      end;
   end;

if kodFS<>7 then {kdyz kod oblasti<>7, tak proverime, nejde-li o FAT}
   if ZjistiTypFAT<>0 then NTFS_exFAT_jina:=0 else NTFS_exFAT_jina:=3
   else begin
   {jsme na oddilu definovanem v (E)MBR a ma kod 7}
   b:=0;
   for a:=$0B to $39 do
       if sector[a]<>0 then begin b:=1;Break;end;
   if b=0 then NTFS_exFAT_jina:=2 {jestlize v cele projete oblasti byly 0}
      else                        {tak jsme asi na exFAT}
      begin
      if (sector[$10]=0) and (sector[$11]=0) and (sector[$12]=0) then
         NTFS_exFAT_jina:=1       {nuly jsou jenom zde - jsme na NTFS}
         else NTFS_exFAT_jina:=3; {jsme na necem neznamem, asi na HPFS}
      end;
   end;
end;


Procedure TBIOSdisk.PridejOddil(dsk:byte;iparent,istart:TSectorPos);
begin
inc(oddlnum);
oddl[oddlnum].Init(@disk[dsk],iparent,istart);
inc(disk[disknum].oddilu);
end;


Function ZjistiVelikostDiskety(a:byte):dword;
{vrati typ istalovane disketove jednotky. Kapacitu neudava v kilobajtech, ale}
{v poctu 512 bajtovych sektoru}
var r:registers;
begin
r.ah:=$08;
r.dl:=a;
Intr($13,r);
case r.bl of
  1:{360KB} ZjistiVelikostDiskety:=360*2;
  2:{1,2MB} ZjistiVelikostDiskety:=1200*2;
  3:{720KB} ZjistiVelikostDiskety:=720*2;
  4:{1,44MB}ZjistiVelikostDiskety:=1474*2;
  5,6:{2,88MB} ZjistiVelikostDiskety:=2880*2;
  else ZjistiVelikostDiskety:=0;
end{case}
end;


Procedure TBIOSdisk.PridejDisketovku(a:byte);
var sec:TSectorPos;
begin
inc(disknum);
inc(disketovek);
disk[disknum].Init(a);
disk[disknum].velikost:=ZjistiVelikostDiskety(a);
PrvniSektor(sec);
PridejOddil(disknum,sec,sec);
end;


Procedure TBIOSdisk.ZpracujEMBR(puvod:TSectorPos;var sector:TSector;slot:byte);
var b:byte;
    p,nov:TSectorPos;
    buf:TSector;
begin
if disk[disknum].LBA
   then begin
   p.lba:=puvod.LBA+TMBR_Record(sector).PartTable[slot].StartRelSec;
   if puvod.LBA=0 then puvod:=p;
   end
   else begin
   p.hla:=TMBR_Record(sector).PartTable[slot].StartHead;
   DecompressCS(TMBR_Record(sector).PartTable[slot].StartCylSec,p.cyl,p.sek);
   if puvod.lba+puvod.cyl+puvod.sek=0 then puvod:=p;
   end;

disk[disknum].NactiSektor(p,buf);
for b:=0 to 1 do
    case TEMBR_record(buf).parttable[b].typ of
         5,$F:begin ZpracujEMBR(puvod,buf,b);end;
         0:begin end;
         else begin
         disk[disknum].PoziceOblasti(p,b,buf,nov);
         PridejOddil(disknum,p,nov);
         oddl[oddlnum].NatahniInfoOblasti(b,buf);
         end;
    end;{case}
end;

Procedure TBIOSdisk.PridejDisk(a:byte);
var sec,nov:TSectorPos;
    buf:TSector;
    mbrec:TMBR_Record;
    b:byte;
begin
inc(disknum);
disk[disknum].Init(a);
PrvniSektor(sec);
if disk[disknum].mbr=false then
   begin
   PridejOddil(disknum,sec,sec);
   Exit;
   end
   else begin
   disk[disknum].NactiMBR(TSector(mbrec));
   for b:=0 to 3 do
       case mbrec.parttable[b].typ of
         5,$f:begin
              ZpracujEMBR(sec,TSector(mbrec),b);
              end;
         0:begin end;
         else begin
         disk[disknum].PoziceOblasti(sec,b,TSector(mbrec),nov);
         PridejOddil(disknum,sec,nov);
         oddl[oddlnum].NatahniInfoOblasti(b,TSector(mbrec));
         end;

       end; {case}
   end;
end;


Procedure TBIOSdisk.Init;
var a,b:byte;
begin
oddlnum:=0;
disknum:=0;
disketovek:=0;
if Existuje_Floppy_mechanika(0) then PridejDisketovku(0);
if Existuje_Floppy_mechanika(1) then PridejDisketovku(1);

for a:=$80 to $80+MAX_HARDDISKU-1 do
    begin
    b:=UrciDisk(a);
    if b<>0 then PridejDisk(a);
    end;
end;


{$IFDEF FPC}
Procedure Int13hGate;
begin
if ((regs13h.ah=$42) or (regs13h.ah=$2)) and (_zachyt13h=0) then
   begin
   __dsk:=regs13h.DL;
   if regs13h.ah=$42 then
      begin
      _zachyt13h:=2;
      __adr:=MemL[regs13h.DS:regs13h.SI+8];
      end
      else begin
      _zachyt13h:=1;
      __adr:=(regs13h.DH shl 16) or regs13h.CX;
      end;
   end;
end;

procedure Int13hHandler; assembler;
{Pri vstupu plati, ze:
 DS:SI = realmodovy SS:SP
 ES:DI = zaloha realmodovych registru
 zakazana hardwarova reruseni}
 asm

 push ds
 push eax
 mov ax,es
 mov ds,ax


  pushad
 mov ax,DOSmemSelector
 mov fs,ax
 call Int13hGate
 popad

 pop eax
 pop ds

 cld
 lodsd;mov es:[edi+2Ah],eax                 {obnova CS:IP}
 lodsw;mov es:[edi+20h],ax                  {obnova priznaku}
 add word ptr es:[edi+2Eh],6                {aktualizace SP}
 iret
 end;
procedure Int13hHandler_Dummy;
begin end;



{$ELSE}
Procedure Int13hGate(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);interrupt;
begin
if ((Hi(ax)=$42) or (Hi(ax)=$2)) and (_zachyt13h=0) then
   begin
   __dsk:=Lo(DX);
   if Hi(AX)=$42 then
      begin
      _zachyt13h:=2;
      __adr:=MemL[DS:SI+8];
      end
      else begin
      _zachyt13h:=1;
      __adr:=(Hi(DX) shl 16) or CX;
      end;
   end;
end;
{$ENDIF}


Function MapovaniDiskuDOSu(disk:char;var bd:TBIOSdisk):byte;
var p:pointer;
    r:registers;
    adr:dword;
    b:byte;
    t:string;
    v:pchar;
    s:array[1..4096] of byte;

{$IFDEF FPC}
old13h:TsegInfo;
new13h:TsegInfo;
{$ENDIF}

begin
{$IFDEF FPC}

get_rm_callback(@Int13hHandler, regs13h, new13h);

Get_rm_interrupt($13,old13h);
Set_rm_interrupt($13,new13h);
Lock_Code(@Int13hGate,longint(@Int13hHandler_Dummy)-longint(@Int13hGate));
{$ELSE}
GetIntVec($13,p);
SetIntVec($13,@Int13hGate);
{$ENDIF}
_zachyt13h:=0;
b:=byte(UpCase(disk))-64;
asm
push ds
mov ah,032h
mov dl,b
int 21h
pop ds
end;


{$IFDEF FPC}
Set_rm_interrupt($13,old13h);
Unlock_Code(@Int13hGate,longint(@Int13hHandler_Dummy)-longint(@Int13hGate));
{$ELSE}
SetIntVec($13,p);
{$ENDIF}
MapovaniDiskuDOSu:=0;
if _zachyt13h=0 then Exit
   else begin
   if _zachyt13h=2 then   {pro LBA adresovane disky}
      for b:=1 to bd.oddlnum do
          if (__dsk=bd.oddl[b].DI^.disk) and
             (__adr=bd.oddl[b].start.lba)
             then begin MapovaniDiskuDOSu:=b;Break;end;


   if _zachyt13h=1 then   {pro CHS adresovane disky}
      for b:=1 to bd.oddlnum do
          begin
          adr:=bd.oddl[b].start.hla shl 16;
          adr:=adr or CompressCS(bd.oddl[b].start.cyl,bd.oddl[b].start.sek);
          if (__dsk=bd.oddl[b].DI^.disk) and (__adr=adr) then
             begin MapovaniDiskuDOSu:=b;Break;end;
          end;
   end;
end;




Procedure TFAT_Driver.Init(iodd:TOddInfo);
var buf:TSector;
begin
oddl:=@iodd;
typ:=oddl^.ZjistiTypFAT;
oddl^.NactiBootSector(boot);

if typ=3 then
   begin
   oddl^.NactiSektory(PFAT32Boot_record(@boot)^.FSinfoSector,1,buf);
   move(buf[$1E4],f32_infloblock_magic,4);
   move(buf[$1E8],f32_VolnychClusteru,4);
   move(buf[$1EC],f32_DalsiVolny,4);
   end
   else begin
   f32_infloblock_magic:=dword(-1);
   f32_VolnychClusteru:=dword(-1);
   f32_DalsiVolny:=dword(-1);
   end;
end;


Function TFAT_Driver.Vrat_SerioveCislo:string;
var i:dword;
    s:string;
begin
case typ of
   1,2:i:=PFAT12a16Boot_Record(@boot)^.SerialNum;
   3:i:=PFAT32Boot_Record(@boot)^.SerialNum;
   else i:=0;
end; {case}
s:=HexaStr(i,8);
Insert('-',s,5);
Vrat_SerioveCislo:=s;
end;


Function TFAT_Driver.Vrat_VolumeLabel:string;
{POZOR - nemusi byt nastaven. Tzn. v root muze existovat VolumeID soubor aniz}
{by bylo vyplneno pole v Boot recordu}
begin
case typ of
   1,2:Vrat_VolumeLabel:=chary_na_string(PFAT12a16Boot_Record(@boot)^.VolumeLabel,10);
   3:Vrat_VolumeLabel:=chary_na_string(PFAT32Boot_Record(@boot)^.VolumeLabel,10);
   else Vrat_VolumeLabel:='';
end; {case}
end;


Procedure TNTFS_Driver.Init(iodd:TOddInfo);
var buf:TSector;
begin
oddl:=@iodd;
typ:=oddl^.NTFS_exFAT_jina;
oddl^.NactiBootSector(boot);
end;

Function TNTFS_Driver.Vrat_SerioveCislo:string;
var i:dword;
    s:string;
begin
if typ=1 then
   begin
   i:=PNTFSBoot_Record(@boot)^.SerialNum[0];
   end else i:=0;
s:=HexaStr(i,8);
Insert('-',s,5);
Vrat_SerioveCislo:=s;
end;

Function TNTFS_Driver.Vrat_UplneSerioveCislo:string;
var i,j:dword;
    s,t:string;
begin
if typ=1 then
   begin
   i:=PNTFSBoot_Record(@boot)^.SerialNum[0];
   j:=PNTFSBoot_Record(@boot)^.SerialNum[1];
   end else begin i:=0;j:=0;end;
s:=HexaStr(i,8);
t:=HexaStr(j,8);
Insert('-',s,5);
Insert('-',t,5);
s:=s+t;
Insert('-',s,10);
Vrat_UplneSerioveCislo:=s;
end;


{Inicializacni cast jednotky}

begin
{$IFDEF FPC}
Proc_Info_z_IDE:=@Dummy_info_z_IDE;
{$ELSE}
Proc_Info_z_IDE:=Dummy_info_z_IDE;
{$ENDIF}
END.
