unit disk;
{$IFDEF FPC}
{$CALLING oldfpccall}
{$ENDIF}

interface
uses dos{$IFDEF FPC},go32{$ENDIF};

const
      MAX_HARDDISKU = 10;
      MAX_ODDILU = 30;

type
{$IFNDEF FPC}dword = longint;{$ENDIF}


TSector = array [0..512 - 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: Word; num:byte; var Buffer):Byte;
{Precte sektory v CHS modu}
function ReadSector_LBA(dsk: Byte; LBASector: dword; num:byte; var Buffer): Byte;
{Precte sektory v LBA modu}
Function ReadSector(dsk:byte; SecPos: TSectorPos; 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}

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=haddisk}
   oddilu:byte;
   velikost:dword;       {udava se v postu sektoru, ne 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}
   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 PrectiPopisku:string;
   {precte OEM popisku oddilu}
   Function NactiSektory(i,p:dword;var buf):byte;
   {nacte P sektoru, I-tym}
   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;


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;


implementation
const
      MBR_MAGIC = $aa55;
      GPR_MAGIC:string = 'EFI PART';

      HexaNum : string[16] = '0123456789ABCDEF';

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;


  {Partition table entry}
  PartitionEntry = packed record
    Active: Byte;
    StartHead: Byte;
    StartCylSec: Word;
    Typ: Byte;
    EndHead: Byte;
    EndCylSec: Word;
    StartRelSec: dword;
    Size: dword;
  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:dword; {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; assembler;
{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}

asm
mov dl, dsk
mov bx, 55AAh
mov ah, 41h
int 13h
mov al,0
jc @1
cmp bx, $AA55
jne @1
test cl, 1
je @1
mov al,cl
@1:
end;


Function Verze_EDD_INT13(dsk:byte):byte;assembler;
asm
mov dl, dsk
mov bx, 55AAh
mov ah, 41h
int 13h
mov al,0
jc @1
cmp bx, $AA55
jne @1
mov al,ah
@1:
end;


function ReadSector_CHS(dsk: Byte; Cylinder, Head, Sector: 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

 Buffer: bude zaplnen daty ze sektoru
 Navrat funkce: 0 = vsechno v poradku
              <>0 = cislo chyby}

var r:registers;
    c:word;
begin

 asm                   {napisu to v asm, abych nemusel resit chyby z }
 mov ax,cylinder       {preteceni}
 mov cx,ax
 shl ax,8
 shr cx,10
 and cx,192
 or cx,ax
 or cx,sector
 mov c,cx
 end;

 r.cx:=c;
 r.dh:=head;
 r.dl:=dsk;
 r.ah:=$02;
 r.al:=num;
 {$IFDEF FPC}
 r.es:=tb_segment;
 r.bx:=tb_offset;
 {$ELSE}
 r.es:=seg(buffer);
 r.bx:=ofs(buffer);
 {$ENDIF}
 FillChar(buffer,sizeof(TSector),0);
 Intr($13,r);
 {$IFDEF FPC}
 CopyFromDOS(buffer,sizeof(TSector));
 {$ENDIF}
 ReadSector_CHS:=r.ah;
end;


function ReadSector_LBA(dsk: Byte; LBASector: dword; 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
 Cylinder, Head, Sector: urceni sektoru, ktery presist

 Buffer: bude zaplnen daty ze sektoru
 Navrat funkce: 0 = vsechno v poradku
              <>0 = cislo chyby}
var r:registers;
    zadanka:TExtdskFuncPack;
    LowMemPtr:dword;

begin
FillChar(zadanka,SizeOf(zadanka),0);
with zadanka do begin
   xfsize:=$10; { $18}  {Type(ExtdskFuncPack)}
   xfreserved:=0;
   xfsectornum:=num;
   {$IFDEF FPC}
   LowMemPtr:=Global_DOS_Alloc(sizeof(TSector));
   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,sizeof(TSector));
Global_DOS_Free(Word(LowMemPtr));
{$ENDIF}
ReadSector_LBA:=r.ah;
end;


Function WriteSector_CHS(dsk: Byte; Cylinder, Head, Sector: 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

 Buffer: bude zaplnen daty ze sektoru
 Navrat funkce: 0 = vsechno v poradku
              <>0 = cislo chyby}

var r:registers;
    c:word;
begin
 asm                   {napisu to v asm, abych nemusel resit chyby z }
 mov ax,cylinder       {preteceni}
 mov cx,ax
 shl ax,8
 shr cx,10
 and cx,192
 add cx,ax
 or cx,sector
 mov c,cx
 end;
 r.cx:=c;
 r.dh:=head;
 r.dl:=dsk;
 r.ah:=$03;
 r.al:=num;
 {$IFDEF FPC}
 r.es:=tb_segment;
 r.bx:=tb_offset;
 CopyToDOS(buffer,sizeof(TSector));
 {$ELSE}
 r.es:=seg(buffer);
 r.bx:=ofs(buffer);
 {$ENDIF}
 Intr($13,r);
 WriteSector_CHS:=r.ah;
end;


Function WriteSector_LBA(dsk: Byte; LBASector: dword; 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
 Cylinder, Head, Sector: urceni sektoru, ktery presist

 Buffer: bude zaplnen daty ze sektoru
 Navrat funkce: 0 = vsechno v poradku
              <>0 = cislo chyby}
var r:registers;
    zadanka:TExtdskFuncPack;
    LowMemPtr:dword;

begin
FillChar(zadanka,SizeOf(zadanka),0);
with zadanka do begin
   xfsize:=$10; { $18}  {Type(ExtdskFuncPack)}
   xfreserved:=0;
   xfsectornum:=num;
   {$IFDEF FPC}
   LowMemPtr:=Global_DOS_Alloc(sizeof(TSector));
   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,sizeof(TSector));
{$ELSE}
r.ds:=seg(zadanka);
r.si:=ofs(zadanka);
{$ENDIF}
Intr($13,r);
{$IFDEF FPC}
Global_DOS_Free(Word(LowMemPtr));
{$ENDIF}
WriteSector_LBA:=r.ah;
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 ReadSector(dsk:byte; SecPos: TSectorPos;num:byte;var Buffer):Byte;
begin
if IsExtdskFunc(dsk)<>0
   then ReadSector:=ReadSector_LBA(dsk, SecPos.LBA,num,Buffer)
   else ReadSector:=ReadSector_CHS(dsk, SecPos.Cyl,SecPos.Hla,SecPos.Sek,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]);
   end;
end;


Function UrciDisk(disk:byte):byte;assembler;
{0 = neexistuje, jinak vraci typ disku}
asm
mov ah,15h
mov dl,disk
int 13h
mov al,0
jc @konec
mov al,ah
@konec:
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;
var a,b,c:byte;
    pcyl,phla,psek:dword;
    bf:PMBR_record;
    i:dword;
begin
bf:=@buf;
a:=0;
for b:=0 to 3 do
    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 DetekceMBR:=true else
if a>1 then DetekceMBR:=false else
   begin
   c:=255;
   for b:=0 to 3 do if bf^.PartTable[b].typ<>0 then begin c:=b;Break;end;
   if c=255 then DetekceMBR:=false
      else begin
      phla:=bf^.PartTable[c].StartHead;
      psek:=bf^.PartTable[c].StartCylSec and 63;
      pcyl:=(bf^.PartTable[c].StartCylSec shr 8) or ((bf^.PartTable[c].StartCylSec and 192) shl 2);
      DetekceMBR:=bf^.PartTable[c].StartRelSec=i;
      end;
   end;
end;



Procedure TDskInfo.Init(dsk:byte);
var buf:TSector;
    r:registers;

begin
disk:=dsk;
MBR:=false;
LBA:=false;
typ:=UrciDisk(dsk);
oddilu:=0;
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 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,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];
   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;


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;
   novy.sek:=bf^.PartTable[slot].StartCylSec and 63;

   novy.cyl:=(bf^.PartTable[slot].StartCylSec shr 8)
             or
             ((bf^.PartTable[slot].StartCylSec and 192) shl 2);
   end;
end;


Function TDskInfo.NactiMBR(var buf:TSector):byte;
begin
if LBA then NactiMBR:=ReadSector_LBA(disk,0,1,buf)
       else NactiMBR:=ReadSector_CHS(disk,0,0,1,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,1,buf)
       else NactiSektor:=ReadSector_CHS(disk,poz.cyl,poz.hla,poz.sek,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.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,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,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 f1:PFAT12a16Boot_record;
    f2:PFAT32Boot_record;
    bf:TSector;
    s:string;
begin
NactiBootSector(bf);
f2:=@bf;
s:=chary_na_string(f2^.FATtype,4);
if s<>'FAT32' then
   begin
   f1:=@bf;
   s:=chary_na_string(f1^.FATtype,4);
   if s='FAT12' then ZjistiTypFAT:=1 else
   if s='FAT16' then ZjistiTypFAT:=2 else
      ZjistiTypFAT:=0;
   end else ZjistiTypFAT:=3;
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;
   p.sek:=TMBR_Record(sector).PartTable[slot].StartCylSec and 63;

   p.cyl:=(TMBR_Record(sector).PartTable[slot].StartCylSec shr 8) or
           ((TMBR_Record(sector).PartTable[slot].StartCylSec and 192) shl 2);
   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;


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;



END.
