Перевод с Delphi

  procedure CorrectDevInfo(Buff : PChar) ;
  var
     i,idx : LongInt ;
     x : Word;
  begin
       for i := 0 to 9 do
        begin
             idx := $14 + i + i ;
             x   := PWord(Buff + idx)^ ;   // ???
             PWord(Buff + idx)^ := swap(x);
        end;
 
       for i := 0 to $17 do
        begin
             idx := $14 + 26 + i + i ;
             x := PWord(buff + idx)^;  // ???
             PWord(buff+idx)^ := swap(x);
        end;
  end;

swap(x);

 { корректируем символы в буфере }
CorrectDevInfo(scop.scop_bBuffer);
Move(scop.scop_bBuffer, IdeInfo, 512);

var
   IdeInfo   : IDSECTOR Absolute InfoArray;//  что это такое?

unit Main;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, TypInfo ;
 
const
     { макс. число дисков в системе }
     MAX_DRIVES = 26 ;
 
type
    { типы дисковых устройств в системе }
    { перечисление строго по описанию тут:
      [url]http://msdn.microsoft.com/en-us/library/aa364939(VS.85).aspx[/url]
    }
    TDriveType = (dtUnknown, dtNoDrive, dtRemovable, dtFixed, dtNetwork, dtCDROM, dtRAM, dtVirtual);
 
type
  TFormMain = class(TForm)
    Label1: TLabel;
    DriveCB: TComboBox;
    Button1: TButton;
    Memo: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure Print(const aStr : AnsiString) ;
 
    { сканировать диски в системе }
    { Пропускать будем все, кроме Fixed и Removable }
    procedure ScanDrives ;
  end;
 
var
  FormMain: TFormMain;
 
{ вспомогательно-отладочная функция }
{ вертает имя по типу устройства }  
function DriveTypeToStr(const aDriveType : TDriveType) : AnsiString ;
 
implementation
 
{$R *.dfm}
 
const
     CDB6GENERIC_LENGTH = 6 ;
     SCSI_IOCTL_DATA_IN = 1 ;
     SCSIOP_INQUIRY     = $12 ;
 
     SMART_GET_VERSION    = $74080 ;
     SMART_RCV_DRIVE_DATA   =   $7C088 ;
 
     ATAPI_ID_CMD = $0A1 ;
     ID_CMD           = $0EC ;
     SMART_CMD    = $0B0 ;
 
     DRVERR_NO_ERROR            = 0 ;
     DRVERR_IDE_ERROR         = 1 ;
     DRVERR_INVALID_FLAG      = 2 ;
     DRVERR_INVALID_COMMAND = 3 ;
     DRVERR_INVALID_BUFFER  = 4 ;
     DRVERR_INVALID_DRIVE     = 5 ;
     DRVERR_INVALID_IOCTL     = 6 ;
     DRVERR_ERROR_NO_MEM      = 7 ;
     DRVERR_INVALID_REGISTER= 8 ;
     DRVERR_NOT_SUPPORTED     = 9 ;
     DRVERR_NO_IDE_DEVICE     = 10 ;
 
     { коды для DeviceIo }
     IOCTL_SCSI_PASS_THROUGH = $0004D004;
type
    PIDSECTOR = ^IDSECTOR ;
    IDSECTOR  = packed record
      Config    : Word;
      CylsTotal : Word;
      Unused    : Word;
      HeadTotal : Word;
      BPT       : Word;
      BPS       : Word;
      SPT       : Word;
      Vendor    : array[0..2] of Word;
      Serial    : array[1..20] of AnsiChar;
      BufType   : Word;
      BufSize   : Word;
      ECC       : Word;
      Revision  : array[1..8] of AnsiChar;
      Model     : array[1..40] of AnsiChar;
      MoreVendorUnique : Word;
      DoubleWordIO     : Word;
      Capabilities     : Word;
      Reserved1        : Word;
      PIOTiming        : Word;
      DMATiming        : Word;
      BS               : Word;
      NumCurrentCyls   : Word;
      NumCurrentHeads  : Word;
      NumCurrentSectorsPerTrack : Word;
      CurrentSectorCapacity     : DWord;
      MultSectorStuff           : Word;
      LBASectors                : DWord;
      SingleWordDMA : Word;
      MultiWordDMA  : Word;
      Reserved      : array [0..127] of byte;
    end;
 
    GETVERSIONINPARAMS  = packed record
        gvip_bVersion       :   Byte;
        gvip_bRevision      :   Byte;
        gvip_bReserved      :   Byte;
        gvip_bIDEDeviceMap  :   Byte;
        gvip_dwCapabilities : Dword;
        gvip_dwReserved     : array [0..3] of DWord ;
    end;
 
    IDEREGS =   packed record
      ir_bFeaturesReg     : Byte;
      ir_bSectorCountReg  : Byte;
      ir_bSectorNumberReg : Byte;
      ir_bCylLowReg       : Byte;
      ir_bCylHighReg      : Byte;
      ir_bDriveHeadReg    : Byte;
      ir_bCommandReg      : Byte;
      ir_bReserved        : Byte;
    end;
 
    PSENDCMDINPARAMS = ^SENDCMDINPARAMS;
    SENDCMDINPARAMS = packed record
      scip_dwBufferSize : DWord;
      scip_irDriveRegs  :   IDEREGS;
      scip_bDriveNumber : Byte;
      scip_bReserved        : array [0..2] of Byte;
      scip_dwReserved       : array [0..3] of DWord;
    end;
 
    DRIVERSTATUS = packed record
      ds_bDriverError : Byte;
      ds_bIDEError    : Byte;
      ds_bReserved      : array [0..1] of   Byte;
      ds_dwReserved     : array [0..1] of DWord;
    end;
 
    PSENDCMDOUTPARAMS = ^SENDCMDOUTPARAMS;
    SENDCMDOUTPARAMS = packed record
      scop_dwBufferSize   : DWord;
      scop_dsDriverStatus : DRIVERSTATUS;
      scop_bBuffer : array [0..511] of AnsiChar;
    end;
 
    SCSIPASSTHROUGH = record
      spt_Length             : Word;
      spt_ScsiStatus         : Byte;
      spt_PathId             : Byte;
      spt_TargetId           : Byte;
      spt_Lun                : Byte;
      spt_CdbLength          : Byte;
      spt_SenseInfoLength    : Byte;
      spt_DataIn             : Byte;
      spt_DataTransferLength : ULong;
      spt_TimeOutValue       : ULong;
      spt_DataBufferOffset   : DWord;
      spt_SenseInfoOffset    : ULong;
      spt_Cdb                : array[0..15] of Byte;
    end;
 
    SCSIPASSTHROUGHWITHBUFFERS = record
      sptwb_spt       : SCSIPASSTHROUGH;
      sptwb_bSenseBuf : array[0..31]  of Byte;
      sptwb_bDataBuf  : array[0..191] of Byte;
    end;
 
var
   InfoArray : array[0..255] of Word;
   IdeInfo   : IDSECTOR Absolute InfoArray;
 
{ ======================================================================== }
procedure GetDeviceInfoByName(const aDevName : AnsiString) ;
 
  procedure CorrectDevInfo(Buff : PChar) ;
  var
     i,idx : LongInt ;
     x : Word;
  begin
       for i := 0 to 9 do
        begin
             idx := $14 + i + i ;
             x   := PWord(Buff + idx)^ ;
             PWord(Buff + idx)^ := swap(x);
        end;
 
       for i := 0 to $17 do
        begin
             idx := $14 + 26 + i + i ;
             x := PWord(buff + idx)^;
             PWord(buff+idx)^ := swap(x);
        end;
  end;
 
var
   gvip : GETVERSIONINPARAMS;
     scip : SENDCMDINPARAMS;
   scop : SENDCMDOUTPARAMS;
   devno,cmd : Byte ;
     dwBytesReturned : DWord ;
   h    : Cardinal;
   len  : DWord;
   i,j  : integer;
   sptwbuffer : array[0..SizeOf(SCSIPASSTHROUGHWITHBUFFERS)+SizeOf(SCSIPASSTHROUGH)-1] of Byte;
     sptwb : SCSIPASSTHROUGHWITHBUFFERS absolute sptwbuffer;
begin
     h := CreateFile (PChar('\\.\'+aDevName),
                      GENERIC_READ or GENERIC_WRITE,
                      FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
                      OPEN_EXISTING, 0, 0);
     if h = INVALID_HANDLE_VALUE then
      begin
           raise Exception.Create('Не могу получить хендл !');
      end ;
 
     try
        { заполняем для начала структурки }
        FillChar(InfoArray,Sizeof(InfoArray),$00);
          FillChar(sptwbuffer,SizeOf(sptwbuffer),$00);
          sptwb.sptwb_spt.spt_Length             := sizeof(SCSIPASSTHROUGH);
        sptwb.sptwb_spt.spt_TargetId           := 1;
        sptwb.sptwb_spt.spt_CdbLength          := CDB6GENERIC_LENGTH;
          sptwb.sptwb_spt.spt_SenseInfoLength    := 24;
          sptwb.sptwb_spt.spt_DataIn             := SCSI_IOCTL_DATA_IN;
          sptwb.sptwb_spt.spt_DataTransferLength := 192;
          sptwb.sptwb_spt.spt_TimeOutValue       := 2;
          sptwb.sptwb_spt.spt_DataBufferOffset   := PChar(@sptwb.sptwb_bDataBuf)-PChar(@sptwb);
          sptwb.sptwb_spt.spt_SenseInfoOffset    := PChar(@sptwb.sptwb_bSenseBuf)-PChar(@sptwb);
          sptwb.sptwb_spt.spt_Cdb[0] := SCSIOP_INQUIRY;
          sptwb.sptwb_spt.spt_Cdb[4] := 192;
          Len := sptwb.sptwb_spt.spt_DataBufferOffset+sptwb.sptwb_spt.spt_DataTransferLength;
 
        if DeviceIoControl(h,IOCTL_SCSI_PASS_THROUGH,@sptwb,SizeOf(SCSIPASSTHROUGH),
                           @sptwb,len,dwBytesReturned,nil) then
         begin
              IdeInfo.Config := sptwb.sptwb_bDataBuf[0];
              j := 1;
              for i := 8 to 15 do
               begin
                    if sptwb.sptwb_bDataBuf[i] = 0 then break;
                    if sptwb.sptwb_bDataBuf[i] > 32 then
                     begin
                          Ideinfo.Model[j] := char(sptwb.sptwb_bDataBuf[i]);
                          inc(j);
                     end;
               end;
              IdeInfo.Model[j] := ' ';
              Inc(j);
              for i := 16 to 31 do
               begin
                    if sptwb.sptwb_bDataBuf[i] = 0 then break;
                    if sptwb.sptwb_bDataBuf[i] > 32 then
                     begin
                          IdeInfo.Model[j] := char(sptwb.sptwb_bDataBuf[i]);
                          Inc(j);
                     end;
               end;
 
              for i := 32 to 35 do
               begin
                    if sptwb.sptwb_bDataBuf[i] = 0 then break;
                    IdeInfo.Revision[i-31] := char(sptwb.sptwb_bDataBuf[i]);
               end;
 
              for i := 36 to 55 do
               begin
                    if sptwb.sptwb_bDataBuf[i] = 0 then break;
                    Ideinfo.Serial[i-35] := char(sptwb.sptwb_bDataBuf[i]);
               end;
         end;
 
        DevNo := 255;
        if LowerCase(Copy(aDevName,1,Length(aDevName)-1)) = 'physicaldrive' then
         DevNo := Ord(aDevName[Length(aDevName)])-Ord('0');
 
        //if (DevNo >= 0) and (DevNo <= 3) then
        if DevNo in [0..3] then
         begin
              FillChar(gvip,SizeOf(GETVERSIONINPARAMS),$00);
              FillChar(scip,SizeOf(SENDCMDINPARAMS),$00);
              FillChar(scop,SizeOf(SENDCMDOUTPARAMS),$00);
 
              if not DeviceIoControl(h,SMART_GET_VERSION,nil,0,@gvip,
                                     SizeOf(GETVERSIONINPARAMS),dwBytesReturned,nil) then
               begin
                    if IdeInfo.Model[1] = #0 then
                     raise Exception.Create('Не удалось получить данные DeviceIoControl[1] !')
                    else Exit ;
               end else
                begin
                     cmd := ID_CMD;
 
                     scip.scip_dwBufferSize := 512;
                     scip.scip_bDriveNumber := devno;
                     scip.scip_irDriveRegs.ir_bSectorCountReg := 1;
                     scip.scip_irDriveRegs.ir_bSectorNumberReg := 1;
                     scip.scip_irDriveRegs.ir_bDriveHeadReg := ((devno + 1) shl 4) or $a0;
                     scip.scip_irDriveRegs.ir_bCommandReg := cmd;
 
                     if not DeviceIoControl(h,SMART_RCV_DRIVE_DATA,@scip,sizeof(SENDCMDINPARAMS),
                                            @scop,sizeof(SENDCMDOUTPARAMS),dwBytesReturned,nil)
                      then raise Exception.Create('Не удалось получить данные DeviceIoControl[2] !') ;
 
                     if scop.scop_dsDriverStatus.ds_bDriverError <> DRVERR_NO_ERROR
                      then raise Exception.Create('DeviceIoControl[2] вернул ошибку !');
 
                     { корректируем символы в буфере }
                     CorrectDevInfo(scop.scop_bBuffer);
                     Move(scop.scop_bBuffer, IdeInfo, 512);
                end
         end else
          if IdeInfo.Model[1] = #0 then
           raise Exception.Create('Ошибка получения данных устройства !');
     finally
       CloseHandle(h);
     end;
end;
{ ======================================================================== }
procedure GetDriveInfo(const aDrive : AnsiString) ;
begin
     FillChar(IdeInfo,SizeOf(IdeInfo),$00) ;
 
     GetDeviceInfoByName(aDrive) ;
end ;
 
{ ======================================================================== }
{ ======================================================================== }
 
{ вспомогательно-отладочная функция }
{ вертает имя по типу устройства }
function DriveTypeToStr(const aDriveType : TDriveType) : AnsiString ;
begin
     Result := GetEnumName(TypeInfo(TDriveType),Integer(aDriveType));
end ;
 
{ сканировать диски в системе }
{ Пропускать будем все, кроме Fixed и Removable }
procedure TFormMain.ScanDrives ;
 
  { получение перечисления доступных дисков в системе }
  function GetAvailableDrives : AnsiString;
  var
     Sel : Byte ;
     DriveBits : Set Of 0..(MAX_DRIVES-1);
  begin
       Result := '';
       Integer(DriveBits) := GetLogicalDrives ;
       for Sel := 0 to 25 do
        if not (Sel in DriveBits) then Continue
         else Result := Result + AnsiChar(Sel + Byte('A'));
  end;
 
  { получение типа указанного устройства }
  function GetDriveType(aDrive : AnsiChar) : TDriveType ;
  var
     RootPath    : array[0..4] of AnsiChar;
     RootPtr     : PAnsiChar;
     VolumeLabel : array[0..MAX_PATH] of AnsiChar;
     VDrive      : array[0..2] of AnsiChar ;
     Test        : LongInt ;     
  begin
       Result := dtUnknown ;
 
       aDrive := UpCase(aDrive) ;
       if not (aDrive in ['A'..'Z']) then Exit ;
 
       VDrive[0] := aDrive ;
       VDrive[1] := ':'  ;
       VDrive[2] := #0  ;
 
       RootPath[0] := aDrive ;
       RootPath[1] := ':';
       RootPath[2] := '\';
       RootPath[3] := #0;
       RootPtr := RootPath;
 
       { описание GetDriveType тут (чтобы пояснить смысл приведения к типу):
         [url]http://msdn.microsoft.com/en-us/library/aa364939(VS.85).aspx[/url]
       }
       Result := TDriveType(Windows.GetDriveType(RootPtr));
 
       { проверка, а не виртуальный ли это диск ? }
       Test := QueryDOSDevice(VDrive, VolumeLabel, MAX_PATH);
       if not ((Test < 3) or { на Win9x используется идентификатор "x:" для нормальных устройств }
          ((VolumeLabel[0] = '\') and (VolumeLabel[1] <> '?'))) { WinNT использует идентификаторы, начинающиеся с символов "\", например: "\Device\HarddiskVolume1" }
        then
         begin
              Result := dtVirtual;
              Exit ;
         end ;
  end ;
 
 
var
   Drives : AnsiString ;
   Ch     : AnsiChar ;
   Sel    : LongInt ;
   DriveType : TDriveType ;
begin
     { получить список дисков в системе }
     Drives := GetAvailableDrives ;
     if Length(Drives) = 0 then
      begin
           Print('Дисков в системе не обнаружено или ошибка GetLogicalDrives') ;
           Exit ;
      end ;
 
     { поехали по всем дискам }
     for Sel := 1 to Length(Drives) do
      begin
           Ch := Drives[Sel] ;
           { пропускаем }
           if Ch in ['A','B'] then Continue ;
 
           { получить тип диска }
           DriveType := GetDriveType(Ch) ;
           if DriveType in [dtFixed,dtRemovable] then DriveCB.Items.Add(Ch) ;
      end ;
 
     if DriveCB.Items.Count > 0 then DriveCB.ItemIndex := 0 ;
end ;
 
procedure TFormMain.Print(const aStr : AnsiString) ;
begin
     if Memo.Lines.Count > 20 then Memo.Lines.Delete(0) ;
 
     Memo.Lines.Add(aStr) ;
     Memo.Invalidate ;
end ;
 
procedure TFormMain.FormCreate(Sender: TObject);
begin
     Memo.Lines.Clear ;
     ScanDrives ;
end;
 
procedure TFormMain.Button1Click(Sender: TObject);
 
  function myTrim(const aStr : AnsiString) : String ;
  var
     a,b : LongInt ;
  begin
       a := 1; b := Length(aStr);
 
       while (ord(aStr[a]) < 33) and (a <= b) do inc(a);
       while (ord(aStr[b]) < 33) and (b >= a) do dec(b);
       
       Result := copy(aStr,a,b-a+1);
  end;
 
var
   DriveChar : AnsiString ;
   Index : LongInt ;
   Serial,Revision,Model : AnsiString ;
begin
     if DriveCB.Items.Count = 0 then Exit ;
 
     Index := DriveCB.ItemIndex ;
     if Index < 0 then Exit ;
 
     DriveChar := DriveCB.Items[Index] ;
 
     GetDriveInfo(DriveChar[1]+':') ;
 
     { выводим информацию }
    Serial    := IdeInfo.Serial;
    Revision  := IdeInfo.Revision;
    Model     := IdeInfo.Model;
 
    Print('Model: '+MyTrim(Model)) ;
    Print('Serial: '+MyTrim(Serial)) ;
    Print('Revision: '+MyTrim(Revision)) ;
    Print('===============') ;
end;
 
end.