Program BIOSCOPY Version 3

Kategorija: Pridaňa

Program: Bioscopy.pas, U_disket.pas, A_rename.pas, P_bios.pas
Subor exe: Bioscopy.exe
Mušiš mac: U_tokno.tpu
Program BIOSCOPY Version 3.1 na scahovaňe glupych suboroch zos diskety do terazky adresara.
{ U_DISKET.PAS                                                       }
{                                                                    }
{ Soucast programu BIOSCOPY na kopirovani vadnych souboru z diskety  }
{ do aktualniho adresare.                                            }
{                                                                    }
{ Datum:21.06.2002                              http://www.trsek.com }
 
{$D-,E-,G+,I-,L-,N-,P+,Q-,R-,S-,T-,V-,Y- exe}
{B+,D+,L+,I+,Q+,R+,S+,T+,V+,Y+ ladici}
{$G+,I-,T-}
Unit U_Disket;
Interface
Const
	MaxSizeSektor = 1024;
 
Type
	TypBuf = Array[1..MaxSizeSektor] of Byte;
 
{Poznamky
AbsSektor(0..2879 24-bit), optimalizovano na 16-bit
 
BiosPar:
	Strana.....(0..1   8-bit) na disku
	Stopa......(0..79 10-bit) na strane, optimalizovano na 8-bit
	Sektor.....(1..18  6-bit) na stope, optimalizovano na 8-bit
   u Harddisku se Stopa jmenuje Cylindr a a vsechny hodnoty nemusi odpovidat
   skutecnosti, protoze nektere harddisky maji vetsi pocet Cylindru nez 1024
   a pak se tvari Harddisk Stran:8 Cylindru:2048 jako Stran:16 Cylindru:1024
 
FatCluster(2..4095) 12-bit, optimalizovano na 16-bit}
 
 
TypBoot = record
	JMP:Array[0..2] of Byte;  {jmp integer nebo jmp short + byte}
   Sys:Array[0..7] of Char;  {Kecy formatovaciho programu nebo vyrobce co ji formatoval (PC Tools,IBM 3.2)}
   Size:Word;        {bajtu v sektoru}
   SizeCluster:Byte; {sektoru v clusteru}
   SizeBoot:Word;    {pocet sektoru v bootu}
   SumFAT:Byte;      {pocet tabulek}
   SizeRoot:Word;    {32bajtovych zaznamu v Rootu}
   AllSektor:Word;   {pocet sektoru na disku}
   ID:Byte;
   SizeFAT:Word;     {sektoru v jedne FAT}
   SizeStopa:Word;   {sektoru na stopu}
   SumStran:Word;    {pocet povrchu}
   SumHide:Word;     {pocet skrytych sektoru}
(* 3 varianta *)
	x:array[30..511] of Byte;
 
(* 1 varianta
   SpecHide:LongInt;    {? pocet specialnich skrytych sektoru}
   BigAllSektor:LongInt;{? pocet skrytych sektoru}
   TypDisk:Byte;        {cislo disku 0=floppy,80h hard disk}
   ExtSign:Byte;        {signatura rozsireni boot-sektoru}
   NumDisk:LongInt;     {Volume Serial No.,cislo diskety}
   VolLab:Array[0..10] of Char; {nazev diskety}
(* 2 varianta
   AA55:Word;        {= $aa55 kdyz dale nejsou jen nuly(od DOS 4.0)}
   ShortJMP:Byte;
   SSkok:Byte;
   NOP:Byte;
   Podpis:Array[0..7] of Char; {podpis systemu}
   Fil:Array[0..$18] of Byte;
   TypDisk:Byte;     {cislo disku 0=floppy,80h hard disk}
   Rezerve1:Byte;
   Mark:Char;        {= ')'}
   NumDisk:LongInt;  {cislo diskety}
   VolLab:Array[0..10] of Char; {nazev diskety}
   Rezerve2:Array[0..7] of Byte;
   {a dal je kod ktery vypise ze disketa neni bootovaci...}
*)
 
End;
 
TypFind =  (_Prazdny,
				_Smazany,
            _SmazPom,{smazany pomocny}
				_Pomocny,{obsahuje cast dlouheho nazvu}
				_Normal  {soubor});
 
TypRoot = Record
  Name: Array[0..7] of Char;
  Prip: Array[0..2] of Char;
  Attr: Byte;
  Fill: array[0..9] of Char; {Rezervovano MSDOS ma zde nuly,DRDOS ma zde heslo a prvni znak smazaneho souboru}
  Time: Word;
  Date: Word;
  FirstCluster: Word;
  Size: LongInt;
End;
 
TypSFile = Record
   TRoot:TypRoot;
   Smazany:Boolean;
	LName:String;
   Index:Word;
End;
 
 
TypCluster = (cPrazdny,cJednotkovy,cNormal,cRezervovany,cVadny,cPosledni);
 
TypDisketa = record
	MaxFAT:Byte;       {pocet FAT tabulek}
   SizeSektor:Word;   {Byte}
   SizeStopa:Byte;    {sektoru na stopu}
	SumStran:Byte;
   SumStop:Word;      {stop na stranu}
   RootPolozek:Byte;  {pocet 32bytovych polozek v Rootu}
   SumHide:Word;
   AllSektor:Word;
	FindBoot:Word;     {AbsSektor}
	SizeBoot:Word;     {SumSektor}
	FindFirstFAT:Word; {AbsSektor}
	SizeOneFAT:Word;   {SumSektor}
   FindRoot:Word;     {AbsSektor}
   SizeRoot:Word;     {SumSektor}
	FindData:Word;     {AbsSektor}
	SizeData:Word;     {SumSektor}
   SizeCluster:Word;  {SumSektor}
{   MaxCluster:Word;}
End;
 
Var
	DiskError:Byte;
   Disk:TypDisketa;
   TedFind:Integer; {0..aktualni cislo hledane polozky}
 
Procedure ReadBuffer(Var Buffer;AbsSektor:Word;ErrorInfo:String);
 
Function UnPackHour(Time:Word):Byte;
Function UnPackMin(Time:Word):Byte;
Function UnPackSec(Time:Word):Byte;
Function UnPackYear(Date:Word):Word;
Function UnPackMonth(Date:Word):Byte;
Function UnPackDay(Date:Word):Byte;
Function StringDate(Date:Word):String;
Function StringTime(Time:Word):String;
 
Function Otazka(Text:String):Boolean;
 
Function DOSNameFiltr(S:String):String;
 
Function ReadSektor(Strana,Stopa,Sektor:Byte;P:Pointer):Boolean;
 
Function WriteSektor(Strana,Stopa,Sektor:Byte;P:Pointer):Boolean;
 
procedure InfoMechanika;
 
Function WritediskError(Text:String):Boolean;
 
procedure InitDisk;
{Poznamka
Musi byt vzdy prvni!!! Neni nutna jen u InfoMechanika
Nastavi DISK promenou hodnotami z Bootu a naplni FATWord pole}
 
 
Procedure DiskInfo;
{Poznamka
Musi predchazet InitDisk}
 
 
 
procedure InitRoot(ClusterRoot:Word;Smazany:Boolean);
{Poznamka
Musi byt druhy! Neni nutna jen u InfoMechanika
Nahraje do ROOT prvni sektor a nastavi promnenou TetRoot na nulu}
 
 
 
Function ReadRoot({Vstup:}Pozice:Word{0..?};{Vystup:}Var Search:TypRoot):TypFind;
{Poznamka
Musi predchazet InitDisk a pak InitRoot
Udela Search := Root[Polozka]}
 
 
Procedure ViewAndCopy(ClusterRoot:Word;Smazany:Boolean);
{Poznamka
Musi predchazet InitDisk
Procedure prohlizi Root a nabizi soubory ke kopirovani do aktualniho adresare na disku}
 
 
procedure FindFirst(ClusterRoot: Word; SmazanyAdr: Boolean; var F: TypSFile);
{Pozn mky
Musi predchazet InitDisk!!! (nebudu nacitat neustale BOOT a FATku..)
Hled  v zadanm (nebo aktu lnĄm) adres ri prvnĄ polozku, kter  odpovĄd 
urcenmu jmnu souboru a sade atributu.}
 
procedure FindNext(var F: TypSFile);
{Pozn mky
musi nasledovat az po FindFirst
Chyby jsou hl seny v promenn DosError; jediny mozny chybovy k˘d je 18
(z dn dalsĄ soubory).}
 
 
procedure FindBack(var F: TypSFile);
{Pozn mky
musi nasledovat az po FindFirst
Chyby jsou hl seny v promenn DosError; jediny mozny chybovy k˘d je 18
(z dn dalsĄ soubory).}
 
 
procedure CopyFile(Name:String;Smazany:Boolean;TRoot:TypRoot);
{Poznamky
Musi predchazet InitDisk
Kopiruje(zapis je klasickymi PASCAL rutinami) soubor z Diskety do aktualniho adresare}
 
 
 
 
 
 
 
Implementation
Uses P_Bios,Dos{SetFTime,SetFAttr};
Var
	FATWord:Array[0..4095{12-bit}] of Word; {prvni FATka je v pameti kvuli rychlosti}
{Aktualni ROOT}
	DirClustr:Word;
   DirMaxPol:Word; {pocet polozek}
   DirTedSek:Word; {aktualni relativni sektor; 0..(Disk.SizeRoot/SizeDir-1)}
	{ROOT ma sektory za sebou, ale DIRROOT je ma po clusterech ruznych velikosti}
   DirFATSek:Array[0..4095{12-bit * SizeSektor, u disket mensi jak 2880}] of Word; {Abs. sektory adresare}
	Root:Array[0..(MaxSizeSektor Div 32)-1] of TypRoot;
 
 
 
 
 
 
 
Function DejHexByte(b:Byte):String;
Const
	Hex:Array[0..15] of Char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
Var
   S:String;
Begin
   S := Hex[b Shr 4];
   S := S + Hex[b And $F];
   DejHexByte := S;
End;
 
 
Procedure HexString(Delka:Byte;Var CharArray);
Var
	a:Byte;
   Pole:Array[1..255] of Byte Absolute CharArray;
Begin
   _Locate(40,WhereY);
   Write('= $');
	For a := 1 To Delka Do
   Begin
   	Write(DejHexByte(Pole[a]));
      IF a < Delka Then Write(',');
   End;
   WriteLn;
End;
 
 
 
 
 
Function ErrorOtazka(Text:String):Boolean;
{Poznamka
Kdyz kurzor dorazi az dolu tak vznikne chyba :(, prepne to stranku???}
Var
	Old:Byte;
Begin
	Old := Stranka;
	Stranka := (Stranka + 1) Mod 2;
	_AktStr(Stranka);
   IF WhereX <> 0 Then WriteLn;
   ErrorOtazka := Otazka(Text);
	Stranka := Old;
	_AktStr(Stranka);
End;
 
 
 
 
 
Function Otazka(Text:String):Boolean;
Var
	x:Byte;
Begin
   Write(Text + ' [A/N/Esc]');
   Repeat
		Case ReadKey Of
         #0: ReadKey;
			'A','a':
         Begin
         	Otazka := True;
				Break;
         End;
			'N','n':
         Begin
         	Otazka := False;
				Break;
         End;
			#27:Halt;
		End;
   Until False;
   x := 80;
   While x > 0 Do
   Begin
      Dec(x);
	   _PisXYACode(x,WhereY,7,32);
   End;
End;
 
 
 
 
 
Function UnPackHour(Time:Word):Byte;
Begin
	UnPackHour := (Time And $F800) Shr 11;
End;
 
Function UnPackMin(Time:Word):Byte;
Begin
   UnPackMin  := (Time And $07E0) Shr  5;
End;
 
Function UnPackSec(Time:Word):Byte;
Begin
	UnPackSec  := (Time And $001F) Shl  1;
End;
 
Function UnPackYear(Date:Word):Word;
Begin
   UnPackYear := (Date And $FE00) Shr 9 + 1980;
End;
 
Function UnPackMonth(Date:Word):Byte;
Begin
   UnPackMonth:= (Date And $01E0) Shr 5;
End;
 
Function UnPackDay(Date:Word):Byte;
Begin
	UnPackDay  := Date And $001F;
End;
 
Function StringDate(Date:Word):String;
Var
	Year:String[4];
	Month,Day:String[2];
Begin
	Str(UnPackDay(Date):2,Day);
	Str(UnPackMonth(Date),Month);
   IF Length(Month) = 1 Then Month := '0' + Month;
	Str(UnPackYear(Date),Year);
   StringDate := Day + '-' + Month + '/' + Year;
End;
 
Function StringTime(Time:Word):String;
Var
	Hour,Min,Sec:String[2];
Begin
	Str(UnPackHour(Time):2,Hour);
	Str(UnPackMin(Time),Min);
   IF Length(Min) = 1 Then Min := '0' + Min;
	Str(UnPackSec(Time),Sec);
   IF Length(Sec) = 1 Then Sec := '0' + Sec;
   StringTime := Hour + ':' + Min + ':' + Sec;
End;
 
 
 
Function TestCluster(Cluster:Word):TypCluster;
Begin
	Case FATWord[Cluster] of
   	0: TestCluster := cPrazdny;
		1: TestCluster := cJednotkovy;
$FF0..$FF6: TestCluster := cRezervovany;
      $FF7: TestCluster := cVadny;
$FF8..$FFF: TestCluster := cPosledni;
		Else TestCluster  := cNormal;
	End;
End;
 
 
 
Procedure NextCluster(Var Cluster:Word;Smazany:Boolean);
{Poznamka
Cluster musi byt na vstupu $2..$FEF tzn. normalni
Na vystupu bude taky takovy, tzn. nebude obsahovat "stav" ale ukazatel}
Label Xakru;
Const
	Name:Array[TypCluster] of String = ('prazdny(smazany)','jednotkovy','normalni','rezervovany','vadny','posledni');
Var
	S:String;
   Old:Byte;
   Typ:TypCluster;
Begin
	S   := '';
   Typ := TestCluster(Cluster);
   IF Smazany Then
   Begin
   	IF Typ = cNormal Then Cluster := FATWord[Cluster] {nasleduji kratsi(doufejme) soubor ktery castecne prepsal delsi}
		Else
      Begin
         Inc(Cluster);
         Typ := TestCluster(Cluster);
      	S := 'Chyba pri cteni smazaneho souboru: V ceste je ';
         Case Typ Of
         	cPrazdny:; {v poradku}
				cJednotkovy,cRezervovany,cVadny:
            Begin
Xakru:
					S := S + Name[Typ] + ' cluster!'#13#10;
					IF ErrorOtazka(S + 'Mam preskocit vsechny stejneho typu? (jinak se pouzije)') Then
               Begin
               	While TestCluster(Cluster) = Typ Do Inc(Cluster); {nejblizsi dalsi nulovy}
                  Dec(Cluster);
                  NextCluster(Cluster,Smazany);
               End;
				End;
            cNormal,cPosledni{kratky soubor}:
            Begin
{Ted by to chtelo prosmejdit celou FAT a najit pocatecni cluster a
pak prosmejdit vsechny adresare a tak zjisit jak se ten soubor jmenuje, uff!}
					IF Typ = cPosledni Then S := S + 'maly ';
               S := S + 'nesmazany soubor!'#13#10;
					IF ErrorOtazka(S + 'Byl tu pred smazanim? Tzn. mam ho preskocit? (jinak prepsal cast dat)') Then
               Begin
               	While Typ = cNormal Do {dokud neni konec nebo chyba}
                  Begin
							Inc(Cluster); {nejblizsi dalsi nulovy}
                     Typ := TestCluster(Cluster);
                  End;
                  IF Typ = cPosledni Then NextCluster(Cluster,Smazany) {muze prijit cokoliv}
                  Else IF Typ <> cPrazdny Then Goto Xakru;
	               {zbyva cPrazdny = ok, ale kde je cPosledni?}
               End;
            End;
			End;{Case}
      End;
	End {Smazany}
   Else IF Typ = cNormal Then Cluster := FATWord[Cluster]
   Else {...problemy, nemam odkaz}
   Begin
   	S := 'Chyba! Aktualni cluster je ' + Name[Typ] + ', tzn. neznam pokracovani.'#13#10;
   	Inc(Cluster);
      Typ := TypCluster(Cluster);
      S := S + 'Nasleduje ' + Name[Typ] + '. Pouzit? (jinak se hleda nejblizsi jiny)';
{Nasleduje prazdny(smazany). Pouzit? (jinak se hleda nejblizsi jiny) [A/N/Esc]}
		IF Not ErrorOtazka(S) Then
      Begin
      	While TestCluster(Cluster) = Typ Do Inc(Cluster); {nejblizsi dalsi nulovy}
         Dec(Cluster);
         NextCluster(Cluster,Smazany);
      End;
	End;
End;
 
 
 
Function WriteDiskError(Text:String):Boolean;
{Pozn mky
True = opakovat}
Var
	S:String;
Begin
	Case DiskError of
   	$00:S := 'pri posledni operaci nedoslo k zadne chybe';
      $01:S := 'spatny prikaz: neplatny pozadavek na radic';
      $02:S := 'spatne oznaceni adresy';
      $03:S := 'pokus o zapis na disketu chranenou proti zapisu';
      $04:S := 'spatna identifikace sektoru nebo sektor nenalezen';
      $05:S := 'neuspesny reset (AT)';
      $06:S := 'priznak vymeny diskety aktivni (floppy)';
      $07:S := 'drive parametr activity failed (harddisk)';
      $08:S := 'chyba DMA';
      $09:S := 'preteceni DMA: pokus o zapis pres 64Kb hranici';
      $0a:S := 'zjistena spatna sektorova vlajka (harddisk)';
      $0b:S := 'spatny priznak stopy (AT)';
      $0c:S := 'typ media nenalezen (floppy)';
      $0d:S := 'spatny pocet sektoru pri formatu hardisku (harddisk)';
      $0e:S := 'zjistena Control Address Mark';
      $0f:S := 'DMA arbitration level out of range (harddisk)';
      $10:S := 'spatny CRC';
      $11:S := 'data opravena: byla nalezena chyba odstranitelna algoritmem ECC (AT)';
      $20:S := 'chyba radice';
      $40:S := 'spatne vystaveni: pozadovana stopa nebyla nalezena';
      $80:S := 'prekroceni casu: drive neodpovida';
      $bb:S := 'nedefinovana chyba (AT)';
      $cc:S := 'chyba zapisu (AT)';
      $e0:S := 'status error';
      $ff:S := 'sence operation failed (AT, harddisk)';
      Else S := 'neznama chyba!';
   End;
   WriteDiskError := ErrorOtazka('Bios chyba: ' + DejHexByte(DiskError) + 'h; ' + S + #13#10 + Text);
End;
 
 
 
Procedure Konvert_AbsSektor_BiosPar(AbsSektor:Word;Var Strana,Stopa,Sektor:Byte);
{Pozn mky
Konvertuje AbsSektor(0..?) na Bios parametry: Strana(0..?),Stopa(0..?),Sektor(1..?)}
Begin
   Sektor   := AbsSektor Mod Disk.SizeStopa + 1;
   AbsSektor:= AbsSektor Div Disk.SizeStopa;
	Strana   := AbsSektor Mod Disk.SumStran;
   Stopa    := AbsSektor Div Disk.SumStran;
End;
 
 
Function Konvert_BiosPar_AbsSektor(Strana,Stopa,Sektor:Byte):Word;
{Pozn mky
Konvertuje Bios parametry: Strana(0..?),Stopa(0..?),Sektor(1..?) na AbsSektor(0..?)}
Begin
	Konvert_BiosPar_AbsSektor := ((Stopa * Disk.SumStran) + Strana) * Disk.SizeStopa + Sektor - 1;
End;
 
 
Function Konvert_FatCluster_AbsSektor(Cluster:Word):Word;
{Pozn mky
Konvertuje FatCluster na AbsSektor(0..?)}
Begin
   IF Cluster = 0 Then {odkaz na Root v "..     "}
		Konvert_FatCluster_AbsSektor := Disk.FindRoot
   Else
		Konvert_FatCluster_AbsSektor := (Cluster - 2) * Disk.SizeCluster + Disk.FindData;
End;
 
 
 
 
Function ReadSektor(Strana,Stopa,Sektor:Byte;P:Pointer):Boolean; Assembler;
{optimalizovano na disketu; stopa=byte!}
Asm
	mov ah,$02  {fce cti}
   mov dl,0    {drive a:}
   mov dh,Strana
   mov ch,Stopa
   mov cl,Sektor
   mov al,1    {pocet ctenych sektoru, ne vice nez sektoru na stopu}
   les bx,P
   int $13
   mov DiskError,ah
   mov al,1
   jnc @Exit
   mov al,0
@Exit:
End;
 
 
 
 
Function WriteSektor(Strana,Stopa,Sektor:Byte;P:Pointer):Boolean; Assembler;
{optimalizovano na disketu; stopa=byte!}
Asm
	mov ah,$03	{fce pis}
   mov dl,0	   {drive a:}
   mov dh,Strana
   mov ch,Stopa
   mov cl,Sektor
   mov al,1	   {pocet ctenych sektoru, ne vice nez sektoru na stopu}
   les bx,P
   int $13
   mov DiskError,ah
   mov al,1
   jnc @Exit
   mov al,0
@Exit:
End;
 
 
 
Procedure InitFATWord;
Var
	FAT12bit:Array[0..(4096{12bit}*12{bit} Div 8{bit})-1] of Byte;
	Posun:Byte;
   Offset,Cluster:Word;
Begin
	FillChar(FATWord,SizeOf(FATWord),0);
	FillChar(FAT12bit,SizeOf(FAT12bit),0);
   For Posun := 0 To Disk.SizeOneFAT - 1 Do
      ReadBuffer(Fat12bit[Posun * Disk.SizeSektor],Disk.FindFirstFAT + Posun,'Opakovat cteni FAT tabulky?');
   For Cluster := 0 To (Disk.SizeData Div Disk.SizeCluster) - 1{aby to zacalo od nuly} + 2{prvni 2 jsou nevyuzity} Do
   Begin
		Offset:= (Cluster * 3) Div 2;
	   IF Odd(Cluster) Then
			FATWord[Cluster] := (Fat12bit[Offset+1] Shl 4) + (Fat12bit[Offset] Shr 4)
	   Else
			FATWord[Cluster] := ((Fat12bit[Offset+1] And $0F) Shl 8) + Fat12bit[Offset];
   End;
End;
 
 
Procedure DiskInfo;
Begin
   With Disk Do
   Begin
{
		WriteLn('  +------+------------------+------+------+');
	   Writeln('  | BOOT | FAT(1) .. FAT(x) | ROOT | DATA |');
		WriteLn('  +------+------------------+------+------+');
}
	   Writeln('BOOT info:');
{		WriteLn(' - Podpis format. programu: "',Boot.Sys,'"');}
	   WriteLn(' - Pocet stran  : ',SumStran);
	   WriteLn(' - Pocet stop   : ',SumStop);
	   WriteLn(' - Pocet sektoru: ',SizeStopa);
	   WriteLn(' - Sektor       : ',SizeSektor,' bajtu');
	   WriteLn(' - Cluster      : ',SizeCluster,' sekt.');
	   WriteLn(' - Struktura  Zacatek  Delka');
	   WriteLn('   Boot  :',    FindBoot:11,  SizeBoot:7,' sekt.');
	   WriteLn('   FAT   :',FindFirstFAT:11,SizeOneFat*MaxFAT:7,' sekt. (',SizeOneFAT,' sekt. * ',MaxFAT,' FAT tab.) ');
	   WriteLn('   Root  :',    FindRoot:11,  SizeRoot:7,' sekt. (',RootPolozek,' Polozek * 32 bajtu)');
	   WriteLn('   Data  :',    FindData:11,  SizeData:7,' sekt. z toho: ',SumHide,' skrytych');
		WriteLn('              Celkem:', AllSektor:7,' sekt.');
	End;
End;
 
 
 
 
 
Procedure InitDisk;
Var
	Buf:TypBuf;
	Boot:TypBoot Absolute Buf;
Begin
   While Not ReadSektor(0,0,1,@Buf) Do
   IF Not WriteDiskError('Opakovat cteni BOOT tabulky?') Then Break;
   With Disk Do
   Begin
		MaxFAT      := Boot.SumFAT;
	   SizeSektor  := Boot.Size;                 {Byte}
	   SizeStopa   := Boot.SizeStopa;
		SumStran    := Boot.SumStran;
      SumStop     := Boot.AllSektor Div (SumStran*SizeStopa);
      RootPolozek := Boot.SizeRoot;
      SumHide     := Boot.SumHide;
      AllSektor   := Boot.AllSektor;
		FindBoot    := 0;                         {AbsSektor}
		SizeBoot    := Boot.SizeBoot;             {SumSektor}
		FindFirstFAT:= FindBoot + SizeBoot;       {AbsSektor}
		SizeOneFAT  := Boot.SizeFAT;              {SumSektor}
	   FindRoot    := FindFirstFAT + SizeOneFAT * MaxFAT;               {AbsSektor}
	   SizeRoot    := (32*RootPolozek + (SizeSektor-1)) Div SizeSektor; {SumSektor}
		FindData    := FindRoot + SizeRoot;       {AbsSektor}
		SizeData    := Boot.AllSektor - FindData; {SumSektor}
	   SizeCluster := Boot.SizeCluster;          {SumSektor}
 
		IF SizeSektor > MaxSizeSektor Then
      Begin
      	Writeln('Chyba programu, sektor je vetsi nez ',MaxSizeSektor,' bajtu!');
         Halt;
      End;
      IF Boot.AllSektor Mod (SumStran*SizeStopa) > 0 Then
      Begin
      	Writeln('Chyba programu, pocet vsech sektoru neni nasobkem Strany * SektoruNaStopu!');
         Halt;
      End;
   End;
	InitFATWord;
End;
 
 
 
 
 
 
Procedure ReadBuffer(Var Buffer;AbsSektor:Word;ErrorInfo:String);
{Poznamka
Pouziva Fci Konvert_AbsSektor_BiosPar, tzn. musi byt uz inicializovan DISK = nejde pouzit na cteni BOOTu}
Var
   Strana,Stopa,Sektor:Byte;
Begin
   Konvert_AbsSektor_BiosPar(AbsSektor,Strana,Stopa,Sektor);
	While Not ReadSektor(Strana,Stopa,Sektor,@Buffer) Do
	IF Not WriteDiskError(ErrorInfo) Then Break;
End;
 
 
 
 
 
Function DOSNameFiltr(S:String):String;
{Poznamka
Bacha na '.       ' nebo '..      '}
Var
	a:Byte;
Begin
   a := Length(S);
   While S[a] = ' ' Do Dec(a);
	For a := a DownTo 1 Do
   Case S[a] of
   	''..'˙','A'..'Z','0'..'9','_','^','$','~','!','#','%','&','-','{','}','(',')','@','''','`':;
      'a'..'z': S[a] := Chr(Ord(S[a]) + Ord('A') - Ord('a'));
      Else S[a] := '_';
	End;
   DOSNameFiltr := S;
End;
 
 
 
Function TestDirCluster(Cluster:Word;First:Boolean):Word;
Var
	a,b:Byte;
   Error:Word;
	MainRoot:Array[0..(MaxSizeSektor Div 32)-1] of TypRoot;
Begin
	Error := 0;
	For a := 1 To Disk.SizeCluster Do
   Begin
   	ReadBuffer(MainRoot,Konvert_FatCluster_AbsSektor(Cluster)+a-1,'Opakovat testovaci cteni ROOT?');
      IF a = 1 Then
      Begin
			IF (MainRoot[0].Name = '.       ') And (MainRoot[0].Attr = $10) And
				(MainRoot[1].Name = '..      ') And (MainRoot[1].Attr = $10) Then
         Begin
         	IF Not First Then Inc(Error,100);
         End
         Else IF First Then Inc(Error,100);
      End;
		For b := 0 To Disk.SizeSektor Div 32 - 1 Do
		Begin
			IF (MainRoot[b].Attr <> $0F) Or (MainRoot[b].FirstCluster <> 0) Then
	      IF MainRoot[b].Name[0] <> #0 Then
         Begin
	      	IF MainRoot[b].Name = '        ' Then Inc(Error,1)
	      	Else IF (a = 1) And (b = 0) And (MainRoot[b].Name = '.       ') Then
	      	Else IF (a = 1) And (b = 1) And (MainRoot[b].Name = '..      ') Then
	      	Else IF MainRoot[b].Name <> DOSNameFiltr(MainRoot[b].Name) Then Inc(Error,1);
	      	IF MainRoot[b].Attr And $C0 <> 0 Then Inc(Error,1);
         End;
		End;
   End;
   TestDirCluster := Error;
End;
 
 
 
Procedure InitRoot(ClusterRoot:Word;Smazany:Boolean);
Var
	Sum:Integer;
   Poskozen:Boolean;
   OldClustr:Word;
 
   Procedure MakeCluster;
   Var w:Word;
   Begin
   	DirFATSek[Sum] := Konvert_FatCluster_AbsSektor(ClusterRoot);
      w := Disk.SizeCluster;
      While w > 1 Do
      Begin
      	Dec(w);
			DirFATSek[Sum + 1] := DirFATSek[Sum] + 1;
         Inc(Sum)
      End;
   End;
Begin
   OldClustr := DirClustr;
   DirClustr := ClusterRoot;
	DirTedSek := 0;
	ReadBuffer(Root,Konvert_FatCluster_AbsSektor(ClusterRoot),'Opakovat cteni ROOT zacatku?');
 
	IF ClusterRoot = 0 Then
   Begin
	   DirMaxPol := Disk.RootPolozek;
      For Sum := 0 To Disk.SizeRoot - 1 Do DirFATSek[Sum] := Disk.FindRoot + Sum;
   End
   Else IF Smazany Then
   Begin
   	Sum := 0;
      Repeat
         MakeCluster;
			IF TestDirCluster(ClusterRoot,Sum = 0) > 0 Then
         Begin
         	IF Sum = 0 Then
            Begin
		      	FillChar(Root,SizeOf(Root),0);
					Root[0].Name := '.       ';
		         Root[0].Prip := '   ';
		         Root[0].Attr := $10;
		         Root[0].FirstCluster := DirClustr;
					Root[1].Name := '..      ';
		         Root[1].Prip := '   ';
		         Root[1].Attr := $10;
		         Root[1].FirstCluster := OldClustr;
					Root[2].Name := 'DESTROYE';
		         Root[2].Prip := 'D! ';
		         Root[2].Attr := $08;
            End
            Else Dec(Sum);
				Break;
         End;
         IF TestCluster(ClusterRoot + 1) <> cPrazdny Then
         IF ErrorOtazka('Dalsi cluster neni smazany! Ukoncit cteni smazaneho adresare?') Then Break;
			NextCluster(ClusterRoot,Smazany);
         Inc(Sum);
      Until False;
      DirMaxPol := (Sum + 1) * (Disk.SizeSektor Div 32);
   End
   Else
   Begin
   	Sum := 0;
      Poskozen := False;
      Repeat
         MakeCluster;
         Case TestCluster(ClusterRoot) of
         	cPosledni: Break;
            cNormal:;
            Else Poskozen := True;
         End;
{$B-}		IF Poskozen And ErrorOtazka('Ukoncit cteni poskozeneho adresare?') Then Break;
      	NextCluster(ClusterRoot,Smazany);
         Inc(Sum);
      Until False;
      DirMaxPol := (Sum + 1) * (Disk.SizeSektor Div 32);
   End;
End;
 
 
 
 
 
Function ReadRoot({Vstup:}Pozice:Word{0..?};{Vystup:}Var Search:TypRoot):TypFind;
Var
   SubPoz,MaxRoot,Posun:Word;
Begin
   MaxRoot := Disk.SizeSektor Div 32;
   SubPoz  := Pozice Mod MaxRoot;
   Posun   := Pozice Div MaxRoot;
   IF Posun <> DirTedSek Then
   Begin
      DirTedSek := Posun;
      ReadBuffer(Root,DirFATSek[Posun],'Opakovat cteni ROOT?');
   End;
	Search := Root[SubPoz];
	IF Search.Name[0] = #0 Then ReadRoot := _Prazdny
	Else IF (Search.Attr = $0F) And (Search.FirstCluster = 0) Then
   Begin
		IF Search.Name[0] = 'ĺ' Then ReadRoot := _SmazPom Else ReadRoot := _Pomocny;
   End
	Else IF Search.Name[0] = 'ĺ' Then ReadRoot := _Smazany
   Else ReadRoot := _Normal;
End;
 
 
 
Function LongName(TRoot:TypRoot):String;
{Poznamka
Nahraje 13 pismen z dlouheho nazvu a transformuje je z Unicode do Latin2 pokud to jde jinak je nahradi otaznikem}
Const
   UniLatin2:Array[128..255] of Word = (
	$00C7,	{C,	 (LATIN CAPITAL LETTER C WITH CEDILLA)}
	$00FC,	{u:	 (LATIN SMALL LETTER U WITH DIAERESIS)}
	$00E9,	{e'	 (LATIN SMALL LETTER E WITH ACUTE)}
	$00E2,	{a/>	 (LATIN SMALL LETTER A WITH CIRCUMFLEX)}
	$00E4,	{a:	 (LATIN SMALL LETTER A WITH DIAERESIS)}
	$016F,	{u0	 (LATIN SMALL LETTER U WITH RING ABOVE)}
	$0107,	{c'	 (LATIN SMALL LETTER C WITH ACUTE)}
	$00E7,	{c,	 (LATIN SMALL LETTER C WITH CEDILLA)}
	$0142,	{l//	 (LATIN SMALL LETTER L WITH STROKE)}
	$00EB,	{e:	 (LATIN SMALL LETTER E WITH DIAERESIS)}
	$0150,	{O"	 (LATIN CAPITAL LETTER O WITH DOUBLE ACUTE)}
	$0151,	{o"	 (LATIN SMALL LETTER O WITH DOUBLE ACUTE)}
	$00EE,	{i/>	 (LATIN SMALL LETTER I WITH CIRCUMFLEX)}
	$0179,	{Z'	 (LATIN CAPITAL LETTER Z WITH ACUTE)}
	$00C4,	{A:	 (LATIN CAPITAL LETTER A WITH DIAERESIS)}
	$0106,	{C'	 (LATIN CAPITAL LETTER C WITH ACUTE)}
	$00C9,	{E'	 (LATIN CAPITAL LETTER E WITH ACUTE)}
	$0139,	{L'	 (LATIN CAPITAL LETTER L WITH ACUTE)}
	$013A,	{l'	 (LATIN SMALL LETTER L WITH ACUTE)}
	$00F4,	{o/>	 (LATIN SMALL LETTER O WITH CIRCUMFLEX)}
	$00F6,	{o:	 (LATIN SMALL LETTER O WITH DIAERESIS)}
	$013D,	{L<	 (LATIN CAPITAL LETTER L WITH CARON)}
	$013E,	{l<	 (LATIN SMALL LETTER L WITH CARON)}
	$015A,	{S'	 (LATIN CAPITAL LETTER S WITH ACUTE)}
	$015B,	{s'	 (LATIN SMALL LETTER S WITH ACUTE)}
	$00D6,	{O:	 (LATIN CAPITAL LETTER O WITH DIAERESIS)}
	$00DC,	{U:	 (LATIN CAPITAL LETTER U WITH DIAERESIS)}
	$0164,	{T<	 (LATIN CAPITAL LETTER T WITH CARON)}
	$0165,	{t<	 (LATIN SMALL LETTER T WITH CARON)}
	$0141,	{L//	 (LATIN CAPITAL LETTER L WITH STROKE)}
	$00D7,	{*X	 (MULTIPLICATION SIGN)}
	$010D,	{c<	 (LATIN SMALL LETTER C WITH CARON)}
	$00E1,	{a'	 (LATIN SMALL LETTER A WITH ACUTE)}
	$00ED,	{i'	 (LATIN SMALL LETTER I WITH ACUTE)}
	$00F3,	{o'	 (LATIN SMALL LETTER O WITH ACUTE)}
	$00FA,	{u'	 (LATIN SMALL LETTER U WITH ACUTE)}
	$0104,	{A;	 (LATIN CAPITAL LETTER A WITH OGONEK)}
	$0105,	{a;	 (LATIN SMALL LETTER A WITH OGONEK)}
	$017D,	{Z<	 (LATIN CAPITAL LETTER Z WITH CARON)}
	$017E,	{z<	 (LATIN SMALL LETTER Z WITH CARON)}
	$0118,	{E;	 (LATIN CAPITAL LETTER E WITH OGONEK)}
	$0119,	{e;	 (LATIN SMALL LETTER E WITH OGONEK)}
	$00AC,	{NO	 (NOT SIGN)}
	$017A,	{z'	 (LATIN SMALL LETTER Z WITH ACUTE)}
	$010C,	{C<	 (LATIN CAPITAL LETTER C WITH CARON)}
	$015F,	{s,	 (LATIN SMALL LETTER S WITH CEDILLA)}
	$00AB,	{<<	 (LEFT-POINTING DOUBLE ANGLE QUOTATION MARK)}
	$00BB,	{/>/>	 (RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK)}
	$2591,	{.S	 (LIGHT SHADE)}
	$2592,	{:S	 (MEDIUM SHADE)}
	$2593,	{?S	 (DARK SHADE)}
	$2502,	{vv	 (BOX DRAWINGS LIGHT VERTICAL)}
	$2524,	{vl	 (BOX DRAWINGS LIGHT VERTICAL AND LEFT)}
	$00C1,	{A'	 (LATIN CAPITAL LETTER A WITH ACUTE)}
	$00C2,	{A/>	 (LATIN CAPITAL LETTER A WITH CIRCUMFLEX)}
	$011A,	{E<	 (LATIN CAPITAL LETTER E WITH CARON)}
	$015E,	{S,	 (LATIN CAPITAL LETTER S WITH CEDILLA)}
	$2563,	{VL	 (BOX DRAWINGS DOUBLE VERTICAL AND LEFT)}
	$2551,	{VV	 (BOX DRAWINGS DOUBLE VERTICAL)}
	$2557,	{LD	 (BOX DRAWINGS DOUBLE DOWN AND LEFT)}
	$255D,	{UL	 (BOX DRAWINGS DOUBLE UP AND LEFT)}
	$017B,	{Z.	 (LATIN CAPITAL LETTER Z WITH DOT ABOVE)}
	$017C,	{z.	 (LATIN SMALL LETTER Z WITH DOT ABOVE)}
	$2510,	{dl	 (BOX DRAWINGS LIGHT DOWN AND LEFT)}
	$2514,	{ur	 (BOX DRAWINGS LIGHT UP AND RIGHT)}
	$2534,	{uh	 (BOX DRAWINGS LIGHT UP AND HORIZONTAL)}
	$252C,	{dh	 (BOX DRAWINGS LIGHT DOWN AND HORIZONTAL)}
	$251C,	{vr	 (BOX DRAWINGS LIGHT VERTICAL AND RIGHT)}
	$2500,	{hh	 (BOX DRAWINGS LIGHT HORIZONTAL)}
	$253C,	{vh	 (BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL)}
	$0102,	{A(	 (LATIN CAPITAL LETTER A WITH BREVE)}
	$0103,	{a(	 (LATIN SMALL LETTER A WITH BREVE)}
	$255A,	{UR	 (BOX DRAWINGS DOUBLE UP AND RIGHT)}
	$2554,	{DR	 (BOX DRAWINGS DOUBLE DOWN AND RIGHT)}
	$2569,	{UH	 (BOX DRAWINGS DOUBLE UP AND HORIZONTAL)}
	$2566,	{DH	 (BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL)}
	$2560,	{VR	 (BOX DRAWINGS DOUBLE VERTICAL AND RIGHT)}
	$2550,	{HH	 (BOX DRAWINGS DOUBLE HORIZONTAL)}
	$256C,	{VH	 (BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL)}
	$00A4,	{Cu	 (CURRENCY SIGN)}
	$0111,	{d//	 (LATIN SMALL LETTER D WITH STROKE)}
	$0110,	{D//	 (LATIN CAPITAL LETTER D WITH STROKE)}
	$010E,	{D<	 (LATIN CAPITAL LETTER D WITH CARON)}
	$00CB,	{E:	 (LATIN CAPITAL LETTER E WITH DIAERESIS)}
	$010F,	{d<	 (LATIN SMALL LETTER D WITH CARON)}
	$0147,	{N<	 (LATIN CAPITAL LETTER N WITH CARON)}
	$00CD,	{I'	 (LATIN CAPITAL LETTER I WITH ACUTE)}
	$00CE,	{I/>	 (LATIN CAPITAL LETTER I WITH CIRCUMFLEX)}
	$011B,	{e<	 (LATIN SMALL LETTER E WITH CARON)}
	$2518,	{ul	 (BOX DRAWINGS LIGHT UP AND LEFT)}
	$250C,	{dr	 (BOX DRAWINGS LIGHT DOWN AND RIGHT)}
	$2588,	{FB	 (FULL BLOCK)}
	$2584,	{LB	 (LOWER HALF BLOCK)}
	$0162,	{T,	 (LATIN CAPITAL LETTER T WITH CEDILLA)}
	$016E,	{U0	 (LATIN CAPITAL LETTER U WITH RING ABOVE)}
	$2580,	{TB	 (UPPER HALF BLOCK)}
	$00D3,	{O'	 (LATIN CAPITAL LETTER O WITH ACUTE)}
	$00DF,	{ss	 (LATIN SMALL LETTER SHARP S (German))}
	$00D4,	{O/>	 (LATIN CAPITAL LETTER O WITH CIRCUMFLEX)}
	$0143,	{N'	 (LATIN CAPITAL LETTER N WITH ACUTE)}
	$0144,	{n'	 (LATIN SMALL LETTER N WITH ACUTE)}
	$0148,	{n<	 (LATIN SMALL LETTER N WITH CARON)}
	$0160,	{S<	 (LATIN CAPITAL LETTER S WITH CARON)}
	$0161,	{s<	 (LATIN SMALL LETTER S WITH CARON)}
	$0154,	{R'	 (LATIN CAPITAL LETTER R WITH ACUTE)}
	$00DA,	{U'	 (LATIN CAPITAL LETTER U WITH ACUTE)}
	$0155,	{r'	 (LATIN SMALL LETTER R WITH ACUTE)}
	$0170,	{U"	 (LATIN CAPITAL LETTER U WITH DOUBLE ACUTE)}
	$00FD,	{y'	 (LATIN SMALL LETTER Y WITH ACUTE)}
	$00DD,	{Y'	 (LATIN CAPITAL LETTER Y WITH ACUTE)}
	$0163,	{t,	 (LATIN SMALL LETTER T WITH CEDILLA)}
	$00B4,	{''	 (ACUTE ACCENT)}
	$00AD,	{--	 (SOFT HYPHEN)}
	$02DD,	{'"	 (DOUBLE ACUTE ACCENT)}
	$02DB,	{';	 (OGONEK)}
	$02C7,	{'<	 (CARON (Mandarin Chinese third tone))}
	$02D8,	{'(	 (BREVE)}
	$00A7,	{SE	 (SECTION SIGN)}
	$00F7,	{-:	 (DIVISION SIGN)}
	$00B8,	{',	 (CEDILLA)}
	$00B0,	{DG	 (DEGREE SIGN)}
	$00A8,	{':	 (DIAERESIS)}
	$02D9,	{'.	 (DOT ABOVE (Mandarin Chinese light tone))}
	$0171,	{u"	 (LATIN SMALL LETTER U WITH DOUBLE ACUTE)}
	$0158,	{R<	 (LATIN CAPITAL LETTER R WITH CARON)}
	$0159,	{r<	 (LATIN SMALL LETTER R WITH CARON)}
	$25A0,	{fS	 (BLACK SQUARE)}
	$00A0);	{NS	 (NO-BREAK SPACE)}
 
Var
   Pole:Array[0..31] of Char Absolute TRoot;
   i,a:Integer;
   PUni:^Word;
   S:String;
   Pis:Char;
Begin
	i := 1;
   S := '';
	Repeat
   	PUni := @Pole[i];
      IF PUni^ = 0 Then Break; { = konec pak nasleduji $FFFF (ASCIZ)}
      IF (PUni^ < $0080) Then Pis := Pole[i] Else
      Begin
			Pis := '?';
	      For a := 128 To 255 Do
			IF PUni^ = UniLatin2[a] Then
	      Begin
				Pis := Char(a);
	         Break;
	      End;
      End;
      S := S + Pis;
		Inc(i,2);
		IF i = 11 Then i := 14;
		IF i = 26 Then i := 28;
	Until i > 30;
   LongName := S;
End;
 
 
 
Procedure ViewAndCopy(ClusterRoot:Word;Smazany:Boolean);
Var
   Polozka:Word;
   F:TypRoot;
   LName:String;
   Ukaz,Pomoc:Boolean;
   a:Byte;
Begin
   LName := '';
   InitRoot(ClusterRoot,Smazany);
   Writeln('Soubory na diskete:');
   For Polozka := 0 To DirMaxPol - 1 Do
   Begin
      _Locate(0,WhereY);
      Write(' - Polozka adresare: ',Polozka:3,' (0..',DirMaxPol-1,') ');
      Pomoc := False;
   	Case ReadRoot(Polozka,F) Of
         _Normal:  Ukaz := True;
	   	_Prazdny: Ukaz := Otazka('$00 = prazdna, zobrazit?');
			_Smazany: Ukaz := Otazka('$E5 = smazana, zobrazit?');
	      _Pomocny,_SmazPom:
         Begin
         	Pomoc := True;
            LName := LongName(F) + LName;
				Ukaz := Otazka('$'+DejHexByte(Ord(F.Name[0]))+' = pomocna, zobrazit?');
         End;
		End;
		IF Ukaz Then
      With F Do
      Begin
         Writeln;
         IF LName <> '' Then
         Begin
         Write('     LongName: "');
         	{Soucasti jmena muze byt i znak #13!!!}
            For a := 1 To Length(LName) Do _PisXYACode(15+a,WhereY,2,Ord(LName[a]));
            _Locate(16+Length(LName),WhereY);
         WriteLn('"');
         End;
			Write('        Jmeno: "'+Name+'"');         HexString( 8,Name);
			Write('      Pripona: "'+Prip+'"');         HexString( 3,Prip);
			Write('      Atribut: ', Attr);             HexString( 1,Attr);
			Write('         Fill: "'+Fill+'"');         HexString(10,Fill);
			Write('          Cas: ', StringTime(Time)); HexString( 2,Time);
			Write('        Datum: ', StringDate(Date)); HexString( 2,Date);
			Write('Prvni Cluster: ', FirstCluster);     HexString( 2,FirstCluster);
			Write('        Delka: ', Size);             HexString( 4,Size);
 
	      IF Size > 0 Then
	      Begin
				IF Otazka('Kopirovat?') Then CopyFile(Name + '.' + Prip,F.Name[0] = 'ĺ',F);
	      End
	      Else IF (Attr And 16) > 0 Then
	      Begin
				IF Otazka('Vstoupit?') Then ViewAndCopy(FirstCluster,F.Name[0] = 'ĺ');
            {Re}InitRoot(ClusterRoot,Smazany);
	      End
		End;
      IF Not Pomoc Then LName := '';
   End;
End;
 
 
 
procedure FindFirst(ClusterRoot: Word; SmazanyAdr: Boolean; var F: TypSFile);
Begin
   InitRoot(ClusterRoot,SmazanyAdr);
   TedFind := -1;
   FindNext(F);
End;
 
 
 
 
 
procedure FindNext(var F: TypSFile);
Var
	S:String;
Begin
   F.LName := '';
   For TedFind := TedFind + 1 To DirMaxPol - 1 Do
   Case ReadRoot(TedFind,F.TRoot) of
   	_Prazdny: F.LName := '';
      _Normal,_Smazany:
      Begin
			F.Index  := TedFind;
         F.Smazany:=	F.TRoot.Name[0] = 'ĺ';
	      IF DiskError = 18 Then DiskError := 0; {!!! pri vnejsi modifikaci TedFind}
	      Exit;
		End;
      _Pomocny,_SmazPom:
      Begin
      	S := LongName(F.TRoot);
         IF Length(S) = 13 Then F.LName := S + F.LName
         Else F.LName := S; {nechci nabalit nejaky ztraceny Pomocny}
      End;
   End;
   DiskError := 18; {Zadne dalsi soubory}
End;
 
 
 
procedure FindBack(var F: TypSFile);
Var
	Pomoc:TypRoot;
   S:String;
Begin
   F.LName := '';
   For TedFind := TedFind - 1 DownTo 0 Do
   Begin
   	Case ReadRoot(TedFind,F.TRoot) of
			_Normal,_Smazany:
         Begin
	         F.Index := TedFind;
	         F.Smazany:=	F.TRoot.Name[0] = 'ĺ';
			   For TedFind := TedFind - 1 DownTo 0 Do
			   Case ReadRoot(TedFind,Pomoc) of
					_Pomocny,_SmazPom:
               Begin
			      	S := LongName(Pomoc);
                  F.LName := F.LName + S;
			         IF Length(S) < 13 Then Break; {nechci nabalit nejaky ztraceny Pomocny}
               End;
               Else Break;
            End;
            TedFind := F.Index;
		      IF DiskError = 18 Then DiskError := 0; {!!! pri vnejsi modifikaci TedFind}
		      Exit;
			End;
      End;
	End;
   DiskError := 18; {Zadne dalsi soubory}
End;
 
 
 
 
procedure CopyFile(Name:String;Smazany:Boolean;TRoot:TypRoot);
Label Vyskoc;
Var
	F:File;
   Cluster,AbsSektor,NumRead,NumWritten:Word;
	SizeCluster,Strana,Stopa,Sektor:Byte;
   Buf:TypBuf;
   Konec:Boolean;
   L:^LongInt;
   Nacteno:LongInt;
Begin
	Cluster := TRoot.FirstCluster;
   IF Smazany And (FATWord[Cluster] <> 0) Then IF Not ErrorOtazka('Soubor byl prepsan! Pokracovat?') Then Exit;
	Filemode := 1;
	Assign(F,Name);	{ Otevri vystupnĄ soubor }
   Reset(F,1);
	IF IOResult = 0 Then { vse v poradku = uz existuje! }
   IF Not Otazka('Soubor uz existuje! Prepast?') Then
   Begin
      Close(F);
		Exit;
   End;
	ReWrite(F, 1);
   Nacteno := 0;
   While TRoot.Size > 0 Do
   Begin
		AbsSektor := Konvert_FatCluster_AbsSektor(Cluster);
      For SizeCluster := 0 To Disk.SizeCluster - 1 Do
      Begin
	      Konvert_AbsSektor_BiosPar(AbsSektor + SizeCluster,Strana,Stopa,Sektor);
	   	_Locate(0,WhereY);
			Write('Abs. Sektor:',AbsSektor + SizeCluster:4,' <0,',Disk.AllSektor-1,'>');
			Write(' { Stopa:',Stopa:2,' <0,',Disk.SumStop-1,'>');
			Write('; Strana:',Strana:1,' <0,',Disk.SumStran-1,'>');
			Write('; Sektor:',Sektor:2,' <1,',Disk.SizeStopa,'> }');
			While Not ReadSektor(Strana,Stopa,Sektor,@Buf) Do
	      IF Not WriteDiskError('Opakovat cteni sektoru?') Then
         Begin
				Write(#13#10' - Bios chyba Int 13h/Fce 02h: ' + DejHexByte(DiskError),'h');
				Writeln('; Vadne bajty: ',Nacteno,'..',Nacteno + Disk.SizeSektor);
				Break;
         End;
         Inc(Nacteno,Disk.SizeSektor);
         Konec := TRoot.Size <= Disk.SizeSektor;
			IF Konec Then NumRead := TRoot.Size Else NumRead := Disk.SizeSektor;
	      Dec(TRoot.Size,Disk.SizeSektor);
			BlockWrite(F, Buf, NumRead, NumWritten);
	   	IF IOResult <> 0 Then
         Begin
			   IF WhereX <> 0 Then WriteLn;
				Writeln(' - Chyba pri zapisu na pozici: ',FilePos(F));
         End;
	      IF NumWritten < NumRead Then
	      Begin
			   IF WhereX <> 0 Then WriteLn;
				Writeln(' - Nelze zapisovat nebo plny disk');
            Goto Vyskoc;
	      End;
	      IF Konec Then Goto Vyskoc;
      End;
   	NextCluster(Cluster,Smazany);
   End;
Vyskoc:
   IF WhereX <> 0 Then WriteLn;
   L := @TRoot.Time;
   SetFTime(F,L^);
   Close(F);
	SetFAttr(F,TRoot.Attr);
End;
 
 
procedure InfoMechanika;
Var
	Buf:TypBuf;
	SumHardDisk:Byte;
	MaxStran:Byte;		{ 0+	0,1 u Disk.mech; Alias Povrchu,Hlav(Head) }
	MaxStop:Byte;		{ 0+	39,79 u Disk.mech; Alias Stopa(Track) u Disk.mech nebo Valec(Cylinder) u Hardisku }
	MaxSektoru:Byte; 	{ 1+	8,9,15,(18?) u Disk.mech }
	Mechanika:Byte;	{ 1+  1,2,3,4 viz Disk.mech }
 
{Function BiosReadInfo:Boolean; Assembler;}
 
Const
	DiskMech:Array[1..4] of String[7] = (
	'360 KB',
	'1.2 MB',
	'720 KB',
	'1.44 MB');
Begin
	Asm
		mov ah,$08   {fce}
	   mov dl,0     {drive a:}
		int $13
	   mov SumHardDisk,dl
	   mov MaxStran,dh
	   mov MaxSektoru,cl
	   mov MaxStop,ch
	   mov Mechanika,bl
	End;
   Write(' - mechanika: ');
   IF (Mechanika >= 1) And (Mechanika <= 4) Then Writeln(diskMech[Mechanika])
   Else Writeln('neznamy typ c. ',Mechanika);
   Writeln('   pocet stran: ',MaxStran+1);
   Writeln('   pocet stop (soustrednych kruznic): ',MaxStop+1);
   Writeln('   pocet sektoru (vyseci na stope): ',MaxSektoru);
End;
 
 
{------- navic, dodelat! ----------}
 
 
 
Procedure ResetDrive; Assembler;
Asm
	mov ah,$00
   mov dl,0	{drive a:}
	int $13
End;
 
 
 
Procedure ReadErrorSektor(AbsSektor:Word;Var Buf:TypBuf);
Var
	Strana,Stopa,Sektor:Byte;
   MaxOpak,Opak,Celkem,Vaha:Word;
   Pole:Array[1..MaxSizeSektor,0..7,0..1] Of Byte;
 
   Procedure MakePole;
   Var
		a:Byte;
      i:Word;
   Begin
   	Inc(Celkem);
   	For i := 1 To Disk.SizeSektor Do
      For a := 0 To 7 do
      IF (Buf[i] And (1 shl a)) = 0 Then Inc(Pole[i,a,0])
      Else Inc(Pole[i,a,1])
   End;
 
   Function MakeByte(i:Word;Var Vysledek:Byte;Var Procenta:Real):Boolean;
   Var
		a:Byte;
	   Bit:Array[0..7] Of Boolean;
   Begin
   	MakeByte := True;
      Vysledek := 0;
      Procenta := 1;
      For a := 0 To 7 do
      Begin
      	IF Pole[i,a,0] > Pole[i,a,1] Then {zero}
         Begin
         	IF Pole[i,a,1] <> 0 Then
            Begin
					MakeByte := False;
               Procenta := Procenta * Pole[i,a,0]/Celkem;
            End;
         End
         Else
         Begin
         	IF Pole[i,a,0] <> 0 Then
            Begin
					MakeByte := False;
               Procenta := Procenta * Pole[i,a,1]/Celkem;
            End;
            Vysledek := Vysledek Or (1 Shl a);
         End;
      End;
   End;
Label Go;
Var
   Procenta:Real;
Begin
	FillChar(Pole,SizeOf(Pole),0);
   Celkem := 0;
   MakePole;
	Write('Vadny sektor, zadej pocet opakovani: ');
   ReadLn(MaxOpak);
   Konvert_AbsSektor_BiosPar(AbsSektor,Strana,Stopa,Sektor);
   For Opak := 1 To MaxOpak Do
   Begin
   	_Locate(0,WhereY);
      Write('Opakuji:',Opak:4,'x ');
      IF Not ReadSektor(Strana,Stopa,Sektor,@Buf) Then
      Begin
         IF DiskError <> $10 {vadny crc} Then
         Begin
		   	Write(', Chybovy kod Int 13h/Fce 02h: ',DiskError);
		      ResetDrive;
         End;
      End
      Else
      Begin
         Writeln(', Bez chyby! Pouzit pouze posledni cteni [A/N/Esc]');
         Case ReadKey Of
         	'A','a':Exit;
            #27:Halt;
         End;
         Write('Vahu kolikati cteni mam mu priradit: ');
         ReadLn(Vaha);
         For Vaha := Vaha DownTo 2 Do MakePole;
      End;
      MakePole;
   End;
   IF Celkem >= 2 Then
   Begin
   	Writeln;
      Writeln('Statistiky zmen z ',Celkem,' cteni:');
      For Opak := 1 To Disk.SizeSektor Do
      Begin
      	MakeByte(Opak,Buf[Opak],Procenta);
         Writeln('Bajt ',Opak:3,' = ',Buf[Opak]:3,' na ',100*Procenta:6:2,'% ');
         IF Opak Mod 23 = 0 Then
         Begin
         	Write('Press any key...');
				Pause;
            Writeln;
         End;
      End;
 
   End;
 
End;
 
 
Procedure CopyImage;
{Poznamka
Kopiruje obraz diskety do aktualniho adresare}
Var
	ToF:File;
   Stopa,Strana,Sektor:Byte;
   NumRead,NumWritten:Word;
   Buf:TypBuf;
Begin
	Filemode := 1;
 	Assign(ToF,'disketa.img');  { Otevri vystupnĄ soubor }
	Rewrite(ToF, 1);
   InitDisk;
   For Stopa  := 0 To Disk.SumStop - 1 Do {prehozeno aby se setrila hlavicka}
   For Strana := 0 To Disk.SumStran - 1 Do
   For Sektor := 1 To Disk.SizeStopa Do
   Begin
   	_Locate(0,WhereY);
      Write('Stopa:',Stopa:3,', Strana:',Strana:2,', Sektor:',Sektor:3,' ');
      IF Not ReadSektor(Strana,Stopa,Sektor,@Buf) Then
      Begin
	   	Writeln(#13#10' - chyba pri cteni sektoru');
         While WriteDiskError('Opakovat cteni?') Do ReadSektor(Strana,Stopa,Sektor,@Buf);
      End;
		NumRead := Disk.SizeSektor;
	   BlockWrite(ToF, Buf, NumRead, NumWritten);
	   IF IOResult <> 0 Then Writeln(#13#10' - Chyba pri zapisu na pozici: ',FilePos(ToF));
	   IF NumWritten < NumRead Then
	   Begin
			Writeln(#13#10' - Nelze zapisovat nebo plny disk');
	      Close(ToF);
	      Halt;
	   End;
   End;
   Writeln;
   Close(ToF);
End;
 
 
 
Procedure SaveImage;
{Poznamka
Ulozi obraz z aktualniho adresare na disketu}
Var
	FromF:File;
   Stopa,Strana,Sektor:Byte;
   NumRead:Word;
   Buf:TypBuf;
Begin
	Filemode := 0;
	Assign(FromF,'disketa.img');  { Otevri vystupnĄ soubor }
	Reset(FromF, 1);
   InitDisk;
   For Stopa  := 0 To Disk.SumStop - 1 Do {prehozeno aby se setrila hlavicka}
   For Strana := 0 To Disk.SumStran - 1 Do
   For Sektor := 1 To Disk.SizeStopa Do
   Begin
	   BlockRead(FromF, Buf, Disk.SizeSektor, NumRead);
	   IF IOResult <> 0 Then Writeln(#13#10' - Chyba pri cteni na pozici: ',FilePos(FromF));
	   IF NumRead < Disk.SizeSektor Then
	   Begin
			Writeln(#13#10' - Nelze cist?');
	      Close(FromF);
	      Halt;
	   End;
   	_Locate(0,WhereY);
      Write('Stopa:',Stopa:3,', Strana:',Strana:2,', Sektor:',Sektor:3,' ');
      IF Not WriteSektor(Strana,Stopa,Sektor,@Buf) Then
      Begin
	   	Writeln(#13#10' - chyba pri zapisu sektoru');
         While WriteDiskError('Opakovat zapis?') Do WriteSektor(Strana,Stopa,Sektor,@Buf);
      End;
   End;
   Writeln;
   Close(FromF);
End;
 
 
End.
Program BIOSCOPY Version 3

Navigační menu

Osobní nástroje

Hledat

Pascal programy

Pascal Wiki

Daco vecej

Kontakty

Vof daľšich rečoch
