home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / IDEDIAGP.ZIP / IDEDIAG.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-03-02  |  7.8 KB  |  263 lines
  1. (*******************************************************************
  2.     idediag
  3.     shows characteristics of IDE hard disks.
  4.     Public Domain by Paolo Bevilacqua, Rome.
  5.     Rewritten from C to Turbo Pascal 7.0 by Ivan Peev, Sofia.
  6.     You can add more disk type to the idetypes[]
  7.     table, and distribuite freely.
  8. ********************************************************************)
  9.  
  10. {$I IDEDIAG.INC}
  11.  
  12. type
  13.    TIdeTypes = record
  14.       Cylinders,
  15.       Heads,
  16.       Sectors: Word;
  17.       Name: String[38];
  18.    end;
  19.  
  20.    PIdeInfo = ^TIdeInfo;
  21.    TIdeInfo = record
  22.       genconf,
  23.       fixcyls,
  24.       remcyls,
  25.       heads,
  26.       bytetrack,                     { bytes per track }
  27.       bytesector,                    { bytes per sector }
  28.       sectors,                         { sectors per track }
  29.       byteisg,                         { bytes intesector gap }
  30.       byteplo,                         { bytes in sync }
  31.       worduniq: Word;                { words unique status }
  32.       serial: array[1..20] of Char;
  33.       contype,                       { controller type }
  34.       bufsiz,                         { buffer size in 512 byte blocks }
  35.       byteecc: Word;                 { ECC bytes trasferred in read/write long }
  36.       firmware: array[1..8] of Char; { firmware revision }
  37.       model: array[1..40] of Char;   { model ID }
  38.       secsint,                         { number of sectors transferred per interrupt }
  39.       dblword,                         { double word transfer flag }
  40.       writepro: Word;                { write protect }
  41.    end;
  42.  
  43. const
  44.    IdesInDataBase = 17;
  45.  
  46.    IdeTypes: array[1..IdesInDataBase] of TIdeTypes =
  47.    ((Cylinders:667;  Heads:4;  Sectors:33; Name:'Fujitsu M2611T (42.9 MB)'),
  48.     (Cylinders:667;  Heads:8;  Sectors:33; Name:'Fujitsu M2612T (85.9 MB)'),
  49.     (Cylinders:667;  Heads:12; Sectors:33; Name:'Fujitsu M2613T (128.9 MB)'),
  50.     (Cylinders:667;  Heads:16; Sectors:33; Name:'Fujitsu M2614T (171.9 MB)'),
  51.     (Cylinders:782;  Heads:2;  Sectors:27; Name:'Western Digital WD93024-A (20.6 MB)'),
  52.     (Cylinders:782;  Heads:4;  Sectors:27; Name:'Western Digital WD93044-A (41.2 MB)'),
  53.     (Cylinders:845;  Heads:3;  Sectors:35; Name:'Toshiba MK232FC (45.4 MB'),
  54.     (Cylinders:845;  Heads:7;  Sectors:35; Name:'Toshiba MK234FC (106 MB'),
  55.     (Cylinders:965;  Heads:5;  Sectors:17; Name:'Quantum ProDrive 40AT (40 MB)'),
  56.     (Cylinders:965;  Heads:10; Sectors:17; Name:'Quantum ProDrive 80AT (80 MB)'),
  57.     (Cylinders:1050; Heads:2;  Sectors:40; Name:'Teac SD-340 (41 MB)'),
  58.     (Cylinders:776;  Heads:8;  Sectors:33; Name:'Conner CP-3104 (100 MB)'),
  59.     (Cylinders:745;  Heads:4;  Sectors:28; Name:'Priam 3804M (40.7 MB)'),
  60.     (Cylinders:980;  Heads:10; Sectors:17; Name:'Western Digitial Caviar AC280 (81 MB)'),
  61.     (Cylinders:560;  Heads:6;  Sectors:26; Name:'Seagate ST157A (42 MB)'),
  62.     (Cylinders:732;  Heads:8;  Sectors:35; Name:'ALPS ELECTRIC Co.,LTD. DR311C (102 MB)'),
  63.     (Cylinders:0;    Heads:0;  Sectors:0;  Name:''));
  64.  
  65. type
  66.    parray = ^tarray;
  67.    tarray = array[1..256] of Word;
  68.  
  69. var
  70.    secbuf: parray;
  71.    drive: Byte;
  72.    drv: String[1];
  73.  
  74. procedure printinfo;
  75.  
  76. var
  77.    id: TIdeInfo;
  78.    capacity: Word;
  79.    types: String;
  80.    i: Integer;
  81.  
  82.    function zo(const value: Byte): String;
  83.    begin
  84.       if Boolean(value) then
  85.          zo := ''
  86.       else
  87.          zo := 'not';
  88.    end;
  89.  
  90.    function ToStr(value: LongInt): String;
  91.    var
  92.       S: String;
  93.    begin
  94.       Str(value, S);
  95.       ToStr := S;
  96.    end;
  97.  
  98.    function ConvertHex(Value: Word): String;
  99.  
  100.    const
  101.       hexTable: array[0..15] of Char = '0123456789ABCDEF';
  102.  
  103.    begin
  104.       ConvertHex := hexTable[Hi(Value) shr 4] + hexTable[Hi(Value) and $f] +
  105.                     hexTable[Lo(Value) shr 4] + hexTable[Lo(Value) and $f];
  106.    end;
  107.  
  108.    procedure SwapBytes(var Source, Dest; Len: Byte); assembler;
  109.    asm
  110.        push  ds
  111.  
  112.        lds   si, Source
  113.        les   di, Dest
  114.        mov   cl, len
  115.        xor   ch, ch
  116.  
  117.    @1: mov   ax, ds:[si]
  118.        xchg  ah, al
  119.        mov   es:[di], ax
  120.        inc   si
  121.        inc   si
  122.        inc   di
  123.        inc   di
  124.        loop  @1
  125.  
  126.        pop    ds
  127.    end;
  128.  
  129. begin
  130.    id := PIdeInfo(secbuf)^;
  131.  
  132.    { get disk type by characteristics }
  133.    i := 1;
  134.    while IdeTypes[i].Cylinders <> 0 do
  135.       Begin
  136.      if (IdeTypes[i].cylinders = id.fixcyls) and
  137.         (IdeTypes[i].heads = id.heads) and
  138.         (IdeTypes[i].sectors = id.sectors) then
  139.             Begin
  140.                types := IdeTypes[i].name;
  141.                break;
  142.             end;
  143.          inc(i);
  144.       end;
  145.  
  146.    { unknown disk }
  147.    if (IdeTypes[i].cylinders = 0) then
  148.       Begin
  149.          types := 'Unknown ';
  150.  
  151.          { calculate capacity in MB }
  152.      capacity := (LongInt(id.fixcyls) * id.heads * id.sectors) div 2048;
  153.          types := types + ToStr(capacity);
  154.          types := types + ' Mbytes';
  155.       end;
  156.  
  157.    { swap bytes in ASCII fields except for WD disks }
  158.  
  159.    if (i <> 4) and (i <> 5) then
  160.       Begin
  161.          SwapBytes(id.serial, id.serial, 10);
  162.          SwapBytes(id.firmware, id.firmware, 4);
  163.          SwapBytes(id.model, id.model, 20);
  164.       end;
  165.  
  166.    WriteLn('Informations for drive ', drive-2, ', ', types);
  167.    WriteLn('Drive ID ', ConvertHex(id.genconf));
  168.    WriteLn(id.fixcyls, ' fixed cylinders, ', id.remcyls, ' removables');
  169.    WriteLn(id.heads, ' heads, ', id.sectors, ' sectors');
  170.    WriteLn('Serial number: ', id.serial);
  171.    WriteLn('Controller firmware: ', id.firmware);
  172.    WriteLn('Controller model: ', id.model);
  173.    WriteLn(id.bytetrack, ' bytes per track, ', id.bytesector, ' per sector');
  174.    WriteLn(id.byteisg, ' bytes of intersector gap, ', id.byteplo, ' of sync');
  175.    WriteLn('Controller type ', id.contype, ', buffer ', id.bufsiz div 2, ' KBytes');
  176.    WriteLn(id.byteecc, ' bytes of ECC, ', id.secsint, ' sector(s) transferred per interrupt');
  177.    WriteLn('Double word transfer ', zo(id.dblword), ' allowed, ', zo(id.writepro), 'write protected.');
  178. end;
  179.  
  180. procedure readsect; assembler;
  181. asm
  182. { poll DRQ }
  183. @1: mov   dx, HDC_STATUS
  184.     in    al, dx
  185.     and   al, HDC_STATUS_BUSY
  186.     or    al, al
  187.     jne   @1
  188.  
  189. { read up sector }
  190.     mov   cx, 256
  191.     mov   dx, HDC_DATA
  192.     les   di, secbuf
  193. @2: in    ax, dx
  194.     mov   es:[di], ax
  195.     inc   di
  196.     inc   di
  197.     loop  @2
  198. end;
  199.  
  200. function DriveValid(Drive: Char; var Drv: Byte): Boolean; assembler;
  201. asm
  202.     mov   ah, 19h      { Save the current drive in BL }
  203.     int   21h
  204.     mov   bl, al
  205.     mov   dl, Drive    { Select the given drive }
  206.     sub   dl, 'A'
  207.     les   di, DRV
  208.     mov   es:[di], dl
  209.     mov   ah, 0Eh
  210.     int   21h
  211.     mov   ah, 19h      { Retrieve what DOS thinks is current }
  212.     int   21h
  213.     mov   cx, 0        { Assume false }
  214.     cmp   al, dl       { Is the current drive the given drive? }
  215.     jne   @1
  216.     mov   cx, 1        { It is, so the drive is valid }
  217.     mov   dl, bl       { Restore the old drive }
  218.     mov   ah, 0eh
  219.     int   21h
  220. @1: xchg  ax, cx       { Put the return value into AX }
  221. end;
  222.  
  223. function CurDisk: Byte; assembler;
  224. { Returns current drive }
  225. asm
  226.     mov   ah, 19h
  227.     int   21h
  228. end;
  229.  
  230. begin
  231.    if ParamCount > 0 then
  232.       Begin
  233.          drv := ParamStr(1);
  234.          drv[1] := UpCase(drv[1]);
  235.          if not DriveValid(drv[1], Drive) or not (drv[1] in ['C'..'Z']) then
  236.             Begin
  237.                WriteLn('There isn''t such drive or drive invalid!');
  238.                Halt(1);
  239.             end;
  240.       end
  241.    else
  242.       drive := CurDisk;
  243.  
  244.    { disable interrupt from drive }
  245.    Port[HDC_FIXED] := HDC_FIXED_IRQ;
  246.  
  247.    { set up task file parameter }
  248.    Port[HDC_SDH] := $A0 + (drive shl 4);
  249.  
  250.    { issue read parameters }
  251.    Port[HDC_COMMAND] := HDC_COMMAND_READPAR;
  252.  
  253.    GetMem(secbuf, SizeOf(secbuf));
  254.  
  255.    { read up sector }
  256.    readsect;
  257.  
  258.    { print out info }
  259.    printinfo;
  260.  
  261.    FreeMem(secbuf, SizeOf(secbuf));
  262. end.
  263.