program O_diskety;
{Udela obraz diskety}

uses Disk;

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

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;


Procedure Zapis_Obraz_Diskety_Do_Souboru(a_ci_b:char;obraz:string);
{Create diskette image and writes it into file}
var f:file;
    b,d:byte;
    c,i:longint;
    s:string;
    konec:boolean;
    a,aa:array[0..511] of byte;


begin
s:=obraz;
FillChar(aa,512,0);
c:=0;
d:=1;
c:=Nacti_Sektory_Pres_DOS(a_ci_b,0,1,true,d,a);
{read sector(s) using DOS}
if c<>0 then
   begin
   writeln('Error n.',HexaStr(c,4),#13#10,'Can''t continue.');
   exit;
   end;

Assign(f,s);
Rewrite(f,1);
i:=0;
c:=0;
konec:=false;
while konec=false do
    begin
    c:=Nacti_Sektory_Pres_DOS(a_ci_b,i,1,{true}false,d,a);
    {read sector(s) using DOS}
    if (c=0) then
       begin
       BlockWrite(f,a,512);
       if (i mod 10)=0 then write(#13,i,'   ');
       end
       else begin
       if (c and $1000<>0) or (c=$810c) or (c=$800c) or (c=$8104) or (c=$8004)
          or (c=$020c) then
          begin
          writeln(#13#10'Diskette reading error (n.',HexaStr(c,4),') in sector n.',i,' (sector will be filled with zeroes)');
          BlockWrite(f,aa,512);
          end
          else

       if (c=$0408) then
          begin
          writeln(#13#10'Written sector n.',i-1,' and finished.');
          konec:=true;
          end
          else
          begin
          writeln('Error n.',HexaStr(c,4),' in sector n.',i,' - quit.');
          konec:=true;
          end;
       end;
    inc(i);
    end;
close(f);
end;


Procedure Zapis_Disketu_Z_obrazu(a_ci_b:char;obraz:string);
{Writes image file into diskette}
var f:file;
    b,d:byte;
    r:integer;
    c,i:longint;
    s:string;
    konec:boolean;
    a:array[0..511] of byte;


begin
s:=obraz;
c:=0;
d:=1;

c:=Nacti_Sektory_Pres_DOS(a_ci_b,0,1,true,d,a);
{read sector(s) using DOS}
if c<>0 then
   begin
   writeln('Error n.',HexaStr(c,4),#13#10,'Can''t continue.');
   exit;
   end;

Assign(f,s);
Reset(f,1);
i:=0;
c:=0;
konec:=false;
while konec=false do
    begin
    FillChar(a,512,0);
    BlockRead(f,a,512,r);
    c:=Zapis_Sektory_Pres_DOS(a_ci_b,i,1,{true}false,d,a);
    if (c=0) then
       begin
       if (i mod 10)=0 then write(#13,i,'   ');
       end
       else begin
       if (c and $1000<>0) or (c=$810c) or (c=$800c) or (c=$8104) or (c=$8004)
          or (c=$020c) then
          begin
          writeln(#13#10'Write error (n.',hexastr(c,4),') to diskette in sector n.',i);
          end
          else

       if (c=$0408) or (r<>512) then
          begin
          writeln(#13#10'Loaded sector n.',i-1,' and finished.');
          konec:=true;
          end
          else
          begin
          writeln('Error n.',HexaStr(c,4),' in sector n.',i,' - quit.');
          konec:=true;
          end;
       end;
    inc(i);
    end;
close(f);
end;


begin
Zapis_Obraz_Diskety_Do_Souboru('A','disketa.img');
{Zapis_Disketu_Z_obrazu('A','disketa.img');}
{Zapis_Disketu_Z_obrazu('A','disketa.img');}
end.
