в Delphi7, как я могу получить уникальный серийный номер жесткого диска?

можно использовать WMI (Windows Management Instrumentation) для получения информации, связанной с оборудованием windows.

существуют два класса wmi, которые предоставляют свойство с именем SerialNumber что в магазине the Number allocated by the manufacturer to identify the physical media. эти классы Win32_DiskDrive и Win32_PhysicalMedia.для доступа к SerialNumber свойство этих классов вы должны знать DeviceId диска, который является чем-то вроде этого \.\PHYSICALDRIVE0. Другой способ-использовать класс ассоциации, который связывает физический диск с логическим drive (C,D,E)

поэтому вы должны найти эту ссылку ранее, чтобы получить серийный номер. последовательность поиска этой ассоциации такова.

Win32_DiskPartition ->Win32_LogicalDiskToPartition ->Win32_DiskDrive

Примечание 1 : элемент SerialNumber свойство Win32_DiskDrive класс не существует в Windows Server 2003, Windows XP, Windows 2000 и Windows NT 4.0, так как вы говорите об использовании Windows Vista или Windows 7, будет работать нормально для вас.

примечание 2.: для выполнения кода не требуется учетная запись администратора.

проверить этот код

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ActiveX,
  ComObj,
  Variants;

function GetDiskSerial(const Drive:AnsiChar):string;
var
  FSWbemLocator  : OLEVariant;
  objWMIService  : OLEVariant;
  colDiskDrives  : OLEVariant;
  colLogicalDisks: OLEVariant;
  colPartitions  : OLEVariant;
  objDiskDrive   : OLEVariant;
  objPartition   : OLEVariant;
  objLogicalDisk : OLEVariant;
  oEnumDiskDrive : IEnumvariant;
  oEnumPartition : IEnumvariant;
  oEnumLogical   : IEnumvariant;
  iValue         : LongWord;
  DeviceID       : string;
begin;
  Result:='';
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  objWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', ''); //Connect to the WMI
  colDiskDrives := objWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive','WQL',0);
  oEnumDiskDrive:= IUnknown(colDiskDrives._NewEnum) as IEnumVariant;
  while oEnumDiskDrive.Next(1, objDiskDrive, iValue) = 0 do
  begin
   DeviceID        := StringReplace(objDiskDrive.DeviceID,'\','\',[rfReplaceAll]); //Escape the `\` chars in the DeviceID value because the '\' is a reserved character in WMI.
   colPartitions   := objWMIService.ExecQuery(Format('ASSOCIATORS OF {Win32_DiskDrive.DeviceID="%s"} WHERE AssocClass = Win32_DiskDriveToDiskPartition',[DeviceID]));//link the Win32_DiskDrive class with the Win32_DiskDriveToDiskPartition class
   oEnumPartition  := IUnknown(colPartitions._NewEnum) as IEnumVariant;
    while oEnumPartition.Next(1, objPartition, iValue) = 0 do
     begin
        colLogicalDisks := objWMIService.ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID="'+objPartition.DeviceID+'"} WHERE AssocClass = Win32_LogicalDiskToPartition'); //link the Win32_DiskPartition class with theWin32_LogicalDiskToPartition class.
        oEnumLogical  := IUnknown(colLogicalDisks._NewEnum) as IEnumVariant;
          while oEnumLogical.Next(1, objLogicalDisk, iValue) = 0 do
          begin
            if objLogicalDisk.DeviceID=(Drive+':')  then //compare the device id
            begin
                Result:=objDiskDrive.SerialNumber;
                Exit;
            end;
           objLogicalDisk:=Unassigned;
          end;
        objPartition:=Unassigned;
     end;
  end;
end;


begin
 try
    CoInitialize(nil);
    try
      Writeln(GetDiskSerial('C'));
      Readln;
    finally
    CoUninitialize;
    end;
 except
    on E:Exception do
    begin
        Writeln(E.Classname, ':', E.Message);
        Readln;
    end;
  end;
end.

вот еще DiskId32 перевод с C++ на Delphi Виктора Деревянко

поскольку первый метод (WithZeroRights) не работает для меня, я написал другой для метода ReadIdeDriveAsScsiDriveInNT:

unit HDScsiInfo;

interface

uses
  Windows, SysUtils;

const
  IDENTIFY_BUFFER_SIZE = 512;
  FILE_DEVICE_SCSI = 00001b;
  IOCTL_SCSI_MINIPORT_IDENTIFY = ((FILE_DEVICE_SCSI shl 16) + 01);
  IDE_ATA_IDENTIFY = $EC;  //  Returns ID sector for ATA.
  IOCTL_SCSI_MINIPORT = 04D008;  //  see NTDDSCSI.H for definition

type
  TDiskData = array [0..256-1] of DWORD;
  TDriveInfo = record
    ControllerType: Integer; //0 - primary, 1 - secondary, 2 - Tertiary, 3 - Quaternary
    DriveMS: Integer; //0 - master, 1 - slave
    DriveModelNumber: String;
    DriveSerialNumber: String;
    DriveControllerRevisionNumber: String;
    ControllerBufferSizeOnDrive: Int64;
    DriveType: String; //fixed or removable or unknown
    DriveSizeBytes: Int64;
  end;

  THDScsiInfo = class (TObject)
  private
    FDriveNumber: Byte;
    FFileHandle: Cardinal;
    FInfoAvailable: Boolean;
    FProductRevision: string;
    FSerialNumber: string;
    FControllerType: Integer;
    FDriveMS: Integer;
    FDriveModelNumber: string;
    FControllerBufferSizeOnDrive: Int64;
    FDriveType: string;
    FDriveSizeBytes: Int64;
    procedure ReadInfo;
    procedure SetDriveNumber(const Value: Byte);
    procedure PrintIdeInfo(DiskData: TDiskData);
  public
    constructor Create;
    property DriveNumber: Byte read FDriveNumber write SetDriveNumber;
    property ProductRevision: string read FProductRevision;
    property SerialNumber: string read FSerialNumber;
    property ControllerType: Integer read FControllerType;
    property DriveMS: Integer read FDriveMS;
    property DriveModelNumber: string read FDriveModelNumber;
    property ControllerBufferSizeOnDrive: Int64 read FControllerBufferSizeOnDrive;
    property DriveType: string read FDriveType;
    property DriveSizeBytes: Int64 read FDriveSizeBytes;
    function IsInfoAvailable: Boolean;
  end;

implementation

type

  SRB_IO_CONTROL = record
   HeaderLength: Cardinal;
   Signature: array [0..8-1] of Byte;
   Timeout: Cardinal;
   ControlCode: Cardinal;
   ReturnCode: Cardinal;
   Length: Cardinal;
  end;
  PSRB_IO_CONTROL = ^SRB_IO_CONTROL;

  DRIVERSTATUS = record
   bDriverError: Byte;//  Error code from driver, or 0 if no error.
   bIDEStatus: Byte;//  Contents of IDE Error register.
                        //  Only valid when bDriverError is SMART_IDE_ERROR.
   bReserved: array [0..1] of Byte;//  Reserved for future expansion.
   dwReserved: array [0..1] of Longword;//  Reserved for future expansion.
  end;

  SENDCMDOUTPARAMS = record
   cBufferSize: Longword;//  Size of bBuffer in bytes
   DriverStatus: DRIVERSTATUS;//  Driver status structure.
   bBuffer: array [0..0] of Byte;//  Buffer of arbitrary length in which to store the data read from the                                                       // drive.
  end;
  IDEREGS = record
   bFeaturesReg: Byte;// Used for specifying SMART "commands".
   bSectorCountReg: Byte;// IDE sector count register
   bSectorNumberReg: Byte;// IDE sector number register
   bCylLowReg: Byte;// IDE low order cylinder value
   bCylHighReg: Byte;// IDE high order cylinder value
   bDriveHeadReg: Byte;// IDE drive/head register
   bCommandReg: Byte;// Actual IDE command.
   bReserved: Byte;// reserved for future use.  Must be zero.
  end;
  SENDCMDINPARAMS = record
   cBufferSize: Longword;//  Buffer size in bytes
   irDriveRegs: IDEREGS;   //  Structure with drive register values.
   bDriveNumber: Byte;//  Physical drive number to send
                            //  command to (0,1,2,3).
   bReserved: array[0..2] of Byte;//  Reserved for future expansion.
   dwReserved: array [0..3] of Longword;//  For future use.
   bBuffer: array [0..0] of Byte;//  Input buffer.     //!TODO: this is array of single element
  end;
  PSENDCMDINPARAMS = ^SENDCMDINPARAMS;

  PSENDCMDOUTPARAMS = ^SENDCMDOUTPARAMS;
  IDSECTOR = record
   wGenConfig: Word;
   wNumCyls: Word;
   wReserved: Word;
   wNumHeads: Word;
   wBytesPerTrack: Word;
   wBytesPerSector: Word;
   wSectorsPerTrack: Word;
   wVendorUnique: array [0..3-1] of Word;
   sSerialNumber: array [0..20-1] of AnsiChar;
   wBufferType: Word;
   wBufferSize: Word;
   wECCSize: Word;
   sFirmwareRev: array [0..8-1] of AnsiChar;
   sModelNumber: array [0..40-1] of AnsiChar;
   wMoreVendorUnique: Word;
   wDoubleWordIO: Word;
   wCapabilities: Word;
   wReserved1: Word;
   wPIOTiming: Word;
   wDMATiming: Word;
   wBS: Word;
   wNumCurrentCyls: Word;
   wNumCurrentHeads: Word;
   wNumCurrentSectorsPerTrack: Word;
   ulCurrentSectorCapacity: Cardinal;
   wMultSectorStuff: Word;
   ulTotalAddressableSectors: Cardinal;
   wSingleWordDMA: Word;
   wMultiWordDMA: Word;
   bReserved: array [0..128-1] of Byte;
  end;
  PIDSECTOR = ^IDSECTOR;

  TArrayDriveInfo = array of TDriveInfo;

type
  DeviceQuery = record
   HeaderLength: Cardinal;
   Signature: array [0..8-1] of Byte;
   Timeout: Cardinal;
   ControlCode: Cardinal;
   ReturnCode: Cardinal;
   Length: Cardinal;
   cBufferSize: Longword;//  Buffer size in bytes
   irDriveRegs: IDEREGS;   //  Structure with drive register values.
   bDriveNumber: Byte;//  Physical drive number to send
   bReserved: array[0..2] of Byte;//  Reserved for future expansion.
   dwReserved: array [0..3] of Longword;//  For future use.
   bBuffer: array [0..0] of Byte;//  Input buffer.     //!TODO: this is array of single element
  end;

function ConvertToString (diskdata: TDiskData;
               firstIndex: Integer;
               lastIndex: Integer;
               buf: PAnsiChar): PAnsiChar;
var
   index: Integer;
   position: Integer;
begin
   position := 0;
      //  each integer has two characters stored in it backwards
   for index := firstIndex to lastIndex do begin
         //  get high byte for 1st character
      buf[position] := AnsiChar(Chr(diskdata [index] div 256));
      inc(position);
         //  get low byte for 2nd character
      buf [position] := AnsiChar(Chr(diskdata [index] mod 256));
      inc(position);
   end;
      //  end the string
   buf[position] := Chr(0);

      //  cut off the trailing blanks
   index := position - 1;
   while (index >0) do begin
//      if not IsSpace(AnsiChar(buf[index]))
      if (AnsiChar(buf[index]) <> ' ')
        then break;
      buf [index] := Chr(0);
      dec(index);
   end;

   Result := buf;
end;

constructor THDScsiInfo.Create;
begin
  inherited;
  SetDriveNumber(0);
end;

function THDScsiInfo.IsInfoAvailable: Boolean;
begin
  Result := FInfoAvailable
end;

procedure THDScsiInfo.PrintIdeInfo (DiskData: TDiskData);
var
  nSectors: Int64;
  serialNumber: array [0..1024-1] of AnsiChar;
  modelNumber: array [0..1024-1] of AnsiChar;
  revisionNumber: array [0..1024-1] of AnsiChar;
begin
      //  copy the hard drive serial number to the buffer
   ConvertToString (DiskData, 10, 19, @serialNumber);
   ConvertToString (DiskData, 27, 46, @modelNumber);
   ConvertToString (DiskData, 23, 26, @revisionNumber);
   FControllerType := FDriveNumber div 2;
   FDriveMS := FDriveNumber mod 2;
   FDriveModelNumber := modelNumber;
   FSerialNumber := serialNumber;
   FProductRevision := revisionNumber;
   FControllerBufferSizeOnDrive := DiskData [21] * 512;
   if ((DiskData [0] and 80) <> 0)
      then FDriveType := 'Removable'
      else if ((DiskData [0] and 40) <> 0)
          then FDriveType := 'Fixed'
          else FDriveType := 'Unknown';
//  calculate size based on 28 bit or 48 bit addressing
//  48 bit addressing is reflected by bit 10 of word 83
  if ((DiskData[83] and 0) <> 0) then begin
      nSectors := DiskData[103] * Int64(65536) * Int64(65536) * Int64(65536) +
                    DiskData[102] * Int64(65536) * Int64(65536) +
                    DiskData[101] * Int64(65536) +
                    DiskData[100];
  end else begin
        nSectors := DiskData [61] * 65536 + DiskData [60];
  end;
//  there are 512 bytes in a sector
  FDriveSizeBytes := nSectors * 512;
end;

procedure THDScsiInfo.ReadInfo;
type
  DataArry = array [0..256-1] of WORD;
  PDataArray = ^DataArry;
const
  SENDIDLENGTH = sizeof (SENDCMDOUTPARAMS) + IDENTIFY_BUFFER_SIZE;
var
  I: Integer;
  buffer: array [0..sizeof (SRB_IO_CONTROL) + SENDIDLENGTH - 1] of AnsiChar;
  dQuery: DeviceQuery;
  dummy: DWORD;
  pOut: PSENDCMDOUTPARAMS;
  pId: PIDSECTOR;
  DiskData: TDiskData;
  pIdSectorPtr: PWord;
begin
  FInfoAvailable := False;
  FFileHandle := CreateFile (PChar(Format('\.\Scsi%d:', [FDriveNumber])),
                             GENERIC_READ or GENERIC_WRITE,
                             FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
                             OPEN_EXISTING, 0, 0);
  if (FFileHandle <> INVALID_HANDLE_VALUE) then begin
        ZeroMemory(@dQuery, SizeOf(dQuery));
        dQuery.HeaderLength := sizeof (SRB_IO_CONTROL);
        dQuery.Timeout := 10000;
        dQuery.Length := SENDIDLENGTH;
        dQuery.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
        StrLCopy(@dQuery.Signature, 'SCSIDISK', 8);
        dQuery.irDriveRegs.bCommandReg := IDE_ATA_IDENTIFY;
        dQuery.bDriveNumber := FDriveNumber;
        if (DeviceIoControl (FFileHandle, IOCTL_SCSI_MINIPORT,
                             @dQuery,
                             SizeOf(dQuery),
                             @buffer,
                             sizeof (SRB_IO_CONTROL) + SENDIDLENGTH,
                             dummy, nil))
        then begin
           pOut := PSENDCMDOUTPARAMS(buffer + sizeof (SRB_IO_CONTROL)); //!TOCHECK
           pId := PIDSECTOR(@pOut^.bBuffer[0]);
           if (pId^.sModelNumber[0] <> Chr(0) ) then begin
              pIdSectorPtr := PWord(pId);
              for I := 0 to 256-1 do
                 DiskData[I] := PDataArray(pIdSectorPtr)[I];
              PrintIdeInfo (DiskData);
              FInfoAvailable := True;
           end;

     end;
     CloseHandle(FFileHandle);
  end;
end;

procedure THDScsiInfo.SetDriveNumber(const Value: Byte);
begin
  FDriveNumber := Value;
  ReadInfo;
end;

end.

пример использования:

procedure ReadIdeDriveAsScsiDriveInNT;
var
  DriveNumber: Byte;
  HDDInfo: THDScsiInfo;
begin
  HDDInfo := THDScsiInfo.Create();
  try
    for DriveNumber := 0 to MAX_IDE_DRIVES - 1 do
    try
      HDDInfo.DriveNumber := DriveNumber;
      if HDDInfo.IsInfoAvailable then begin
        Writeln('Available Drive: ', HDDInfo.DriveNumber);
        Writeln('ControllerType: ', HDDInfo.ControllerType);
        Writeln('DriveMS: ', HDDInfo.DriveMS);
        Writeln('DriveModelNumber: ', HDDInfo.DriveModelNumber);
        Writeln('ControllerBufferSizeOnDrive: ', HDDInfo.ControllerBufferSizeOnDrive);
        Writeln('DriveType: ', HDDInfo.DriveType);
        Writeln('DriveSizeBytes: ', HDDInfo.DriveSizeBytes);
        Writeln('ProductRevision: ', HDDInfo.ProductRevision);
        Writeln('SerialNumber: ', HDDInfo.SerialNumber);
      end;
    except
      on E: Exception do
        Writeln(Format('DriveNumber %d, %s: %s', [DriveNumber, E.ClassName, E.Message]));
    end;
  finally
    HDDInfo.Free;
  end;
end;

begin
  ReadIdeDriveAsScsiDriveInNT;
  Write('Press <Enter>');
end.

это отлично работает с моим диском WD.

Я нашел этот код, он исправлен и отлично работает со мной на windows 7 64

https://code.google.com/p/dvsrc/downloads/detail?name=20120116DiskId32Port_fixed.7z&can=2&q=

и это вся его работа

https://code.google.com/p/dvsrc/downloads/list

публикация этого исключительно для полноты ради, и, возможно, удовлетворить тех, кто заинтересован или умереть жесткий аппаратных фанатиков.

в моем распоряжении нет компилятора Pascal для тестирования этих процедур в текущих системах Windows, но я знаю, что этот код работал еще в эпоху DOS. Может быть, он все еще работает из командной строки.

Pascal код:

uses
  Dos, Crt;

type
  SerNoType = record
    case Integer of
      0: (SerNo1, SerNo2: Word);
      1: (SerNo: Longint);
  end;

  DiskSerNoInfoType = record
    Infolevel: Word;
    VolSerNo: SerNoType;
    VolLabel: array[1..11] of Char;
    FileSys: array[1..8] of Char;
  end;

function HexDigit(N: Byte): Char;
begin
  if N < 10 then
    HexDigit := Chr(Ord('0') + N)
  else
    HexDigit := Chr(Ord('A') + (N - 10));
end;

function GetVolSerialNo(DriveNo: Byte): String;
var
  ReturnArray: DiskSerNoInfoType;
  Regs: Registers;
begin
  with Regs do
  begin
    AX := 0d;
    BL := DriveNo;
    CH := ;
    CL := ;
    DS := Seg(ReturnArray);
    DX := Ofs(ReturnArray);
    Intr(, Regs);
    if (Flags and FCarry) <> 0 then
      GetVolSerialNo := ''
    else
      with ReturnArray.VolSerNo do
        GetVolSerialNo :=
          HexDigit(Hi(SerNo2) div 16) + HexDigit(Hi(SerNo2) mod 16) +
          HexDigit(Lo(SerNo2) div 16) + HexDigit(Lo(SerNo2) mod 16) +
          HexDigit(Hi(SerNo1) div 16) + HexDigit(Hi(SerNo1) mod 16) +
          HexDigit(Lo(SerNo1) div 16) + HexDigit(Lo(SerNo1) mod 16);
  end;
end;

procedure PutVolSerialNo(DriveNo: Byte; SerialNo: Longint);
var
  ReturnArray: DiskSerNoInfoType;
  Regs: Registers;
begin
  with Regs do
  begin
    AX := 0d;
    BL := DriveNo;
    CH := ;
    CL := ;
    DS := Seg(ReturnArray);
    DX := Ofs(ReturnArray);
    Intr(, Regs);
    if (Flags and FCarry) = 0 then
    begin
      ReturnArray.VolSerNo.SerNo := SerialNo;
      AH := ;
      BL := DriveNo;
      AL := ;
      DS := Seg(ReturnArray);
      DX := Ofs(ReturnArray);
      Intr(, Regs);
    end;
  end;
end;

пожалуйста, не стесняйтесь обновлять этот ответ, чтобы заставить его работать (если это возможно вообще) в Дельфи.