{********************Определение переменных***************************}

uses crt;

const

  reg_data      = 0;    { r/w  } { Для каждого регистра задаем смещение от базового порта}
  reg_error     = 1;    { read }
  reg_wpc       = 1;    { write}
  reg_sec_count = 2;    { r/w  }
  reg_sec_num   = 3;    { r/w  }
  reg_cyl_lo    = 4;    { r/w  }
  reg_cyl_hi    = 5;    { r/w  }
  reg_drv_head  = 6;    { r/w  }
  reg_status    = 7;    { read }
  reg_command   = 7;    { write}

var

  port_base   :integer;
  buf : array [0..512] of byte;
  buf1 : array [0..512] of byte;
  bufw : array [0..255] of word absolute buf;


{****************Преобразование в символьные переменные в буфере*****************}

Function HexB (B : Byte) : String;

Const
  HC : Array [0..15] of Char = '0123456789ABCDEF';
Begin
  HexB :=HC[B shr 4]+ HC[B and 15]
End;

{*********Преобразование символьных переменных в паспорте жесткого диска*********}

Function getascii (in_data : array of word; off_start, off_end : word) : String;

var
  wk : array[0..511] of char;
    ret_val : string;
    loop, loop1 : word;

    begin
      loop1 := 1;
        for loop := off_start to off_end do
            begin
                  ret_val[loop1] := char(hi(in_data[loop]));
                  inc (loop1);
                  ret_val[loop1] := char(lo(in_data[loop]));
                  inc (loop1);
            end;
        ret_val[0] := char(succ(off_end-off_start)*2);
        getascii := ret_val;
    end;

{******************Вывод на экран паспорта жесткого диска*************************}

procedure passport;

begin
    writeln ('DRIVE ','1',hexb(port_base),'h');
    writeln ('Model Number______________________: ', getascii (bufw, 27, 46));
    writeln ('Serial Number_____________________: ', getascii (bufw, 10, 19));
    writeln ('Controller Revision Number________: ', getascii (bufw, 23, 26));
    writeln;
    write ('Able to do Double Word Transfer_____: ');
    if bufw[48]=0 then writeln ('No')
    else writeln ('Yes');
    writeln ('Controller type___________________: ', bufw[20]);
    writeln ('Controller buffer size (bytes)____: ', longint(bufw[21])*512);
    writeln ('Number of ECC bytes transferred___: ', bufw[22]);
    writeln ('Number of sectors per interrupt___: ', bufw[47]);
    writeln;
    writeln ('Hard Disk Reports');
    writeln ('Number of Cylinders_______________: ', bufw[1]);
    writeln ('Number of Heads___________________: ', bufw[3]);
    writeln ('Number of Sectors per Track_______: ', bufw[6]);
    writeln;
    writeln (' HDD CHS_Gbt______________________: ',((longint(bufw[58] shl 8)) shl 8+bufw[57])*0.000000512);
    writeln ('Number of Cylinders_______________: ', bufw[54]);
    writeln ('Number of Heads___________________: ', bufw[55]);
    writeln ('Number of Sectors per Track_______: ', bufw[56]);
    writeln;
    writeln ('HDD LBA_Gbt_______________________: ',(longint((longint(bufw[61] shl 4)) shl 4) shl 8+bufw[60])*0.000000512);
    writeln ('Nomber of HDD LBA sectors_________: ',longint((longint(bufw[61] shl 4)) shl 4) shl 8+bufw[60]);
    writeln;
 end;

{***********Вывод на экран содержимого буфера 512 байт****************}

procedure outbuf;
var i,j,k:byte;
   begin

  for j:=0 to 31 do {Это строки}
    for i:=0 to 15 do begin   {Это столбцы}
      gotoxy (2+i*3, 2+j);
      write (hexb(buf1[j*16+i]));
                         if i= 14 then begin
                               gotoxy (50, 2+j);
                               write (chr(124));
                         end;
      gotoxy (52+i, 2+j);
            if buf[j*16+i] >= 32 then
            write (char(buf1[j*16+i]))
    end;
  writeln
end;

{*****************************Команда в HDD*****************************}

Function Command (a,b,c,d,e,f,g:integer):integer;

const

        reg_data      = 0;    { r/w }
        reg_error     = 1;    { read }
        reg_wpc       = 1;    { write }
        reg_sec_count = 2;    { r/w }
        reg_sec_num   = 3;    { r/w }
        reg_cyl_lo    = 4;    { r/w }
        reg_cyl_hi    = 5;    { r/w }
        reg_drv_head  = 6;    { r/w }
        reg_status    = 7;    { read }
        reg_command   = 7;    { write }

var
        port_base:integer;

   begin
             { Проверка готовности жесткого диска  }
            while port[port_base+reg_status] and $40 <> $40 do;
             

             port_base:=a;
             port[port_base+reg_sec_count] :=b ;
             port[port_base+reg_sec_num] := c;
             port[port_base+reg_cyl_hi] := d;
             port[port_base+reg_cyl_lo] := e;
             port[port_base+reg_drv_head] := f;

            { writing  command }
            port[port_base+reg_command] := g;


             { Проверка  DRQ }
           while port[port_base+reg_status] and $08 <> $08 do;

         Command:=port_base;
    end;

{******************Считывание буфера 512 жесткого диска*******************}

procedure  in_buf(port_base,reg_data:integer);

var
  addr, val : word;

 begin

  { read 512 bytes (actually it reads 256 words) of a sector to the buffer }
  addr := 0;
  repeat
    bufw[addr] := portw[port_base+reg_data];
    inc (addr);
  until addr >= 256;

 { перестановка байтов }
addr := 0;
 repeat
    if addr mod 2 = 0 then buf1[addr] := buf[addr+1] else buf1[addr] := buf[addr-1];
    {writeln(hexb(buf1[addr]),addr);}
    inc (addr);
  until addr >= 512;

 end;


{*************************Основная программа*******************************}

begin
{Определяем - какой диск подключен к секондари порту}
  port_base:=  Command ($170,0,0,0,0,$a0,$ec) ;{ $EC Подаем команду IDENTIFY DEVICE }
  {fillchar (buf, 512, 0);}
  in_buf(port_base,reg_data);{читаем буфер жесткого диска }
  textmode (co80 or font8x8);{установка параметров вывода на экран}
  outbuf;{вывод на экран содержимого буфера }
  writeln ('error:  ',hexb(port[port_base+reg_error]),'h');
  writeln ('status: ',hexb(port[port_base+reg_status]),'h');
  write ('press any key...');
  readkey;
  textmode (co80 or font8x8);
  passport;{Выводим на экран данные жесткого диска }
  write ('press any key...');
  readkey;
  textmode (co80 or font8x8);


{Читаем нулевой сектор жесткого диска}
  port_base:=  Command ($170,1,1,0,0,$a0,$21) ;{ $21 READ SECTOR чтение секторов без повторов }
  textmode (co80 or font8x8);
  writeln ('error:  ',hexb(port[port_base+reg_error]),'h');
  writeln ('status: ',hexb(port[port_base+reg_status]),'h');
  write ('press any key...');
  readkey;
  in_buf(port_base,reg_data);
  textmode (co80 or font8x8);
  outbuf;
  writeln ('error:  ',hexb(port[port_base+reg_error]),'h');
  writeln ('status: ',hexb(port[port_base+reg_status]),'h');
  write ('press any key...');
  readkey;
  textmode (co80)
end.
{*********************Конец основной программы******************************}
