Question

关于delphi 获取硬盘唯一序列号

如何用delphi获取硬盘唯一序列号（SN号码）

Answer 1

前面给出的是volume ID， 逻辑序号， 不是真正意思的物理硬盘序列号。
下面这个才是：
////////////////////////////////////////////////////////////////////////////
// Source code from w w w。delphipraxis。net

////////////////////////////////////////////////////////////////////////////

unit hddinfo;

interface

uses Windows, SysUtils, Classes;

const
IOCTL_STORAGE_QUERY_PROPERTY = $2D1400;

type
THDDInfo = class (TObject)
private
FDriveNumber: Byte;
FFileHandle: Cardinal;
FInfoAvailable: Boolean;
FProductRevision: string;
FProductId: string;
FSerialNumber: string;
FVendorId: string;
procedure ReadInfo;
procedure SetDriveNumber(const Value: Byte);
public
constructor Create;
property DriveNumber: Byte read FDriveNumber write SetDriveNumber;
property VendorId: string read FVendorId;
property ProductId: string read FProductId;
property ProductRevision: string read FProductRevision;
property SerialNumber: string read FSerialNumber;
function SerialNumberInt: Cardinal;
function SerialNumberText: string;
function IsInfoAvailable: Boolean;
end;

implementation

type
STORAGE_PROPERTY_QUERY = packed record
PropertyId: DWORD;
QueryType: DWORD;
AdditionalParameters: array[0..3] of Byte;
end;

STORAGE_DEVICE_DESCRIPTOR = packed record
Version: ULONG;
Size: ULONG;
DeviceType: Byte;
DeviceTypeModifier: Byte;
RemovableMedia: Boolean;
CommandQueueing: Boolean;
VendorIdOffset: ULONG;
ProductIdOffset: ULONG;
ProductRevisionOffset: ULONG;
SerialNumberOffset: ULONG;
STORAGE_BUS_TYPE: DWORD;
RawPropertiesLength: ULONG;
RawDeviceProperties: array[0..511] of Byte;
end;

function ByteToChar(const B: Byte): Char;
begin
Result := Chr(B + $30)
end;

function SerialNumberToCardinal (SerNum: String): Cardinal;
begin
HexToBin(PChar(SerNum), PChar(@Result), SizeOf(Cardinal));
end;

function SerialNumberToString(SerNum: String): String;
var
I, StrLen: Integer;
Pair: string;
B: Byte;
Ch: Char absolute B;

begin
Result := '';
StrLen := Length(SerNum);

if Odd(StrLen) then Exit;

I := 1;

while I < StrLen do
begin
Pair := Copy (SerNum, I, 2);
HexToBin(PChar(Pair), PChar(@B), 1);
Result := Result + Chr(B);
Inc(I, 2);
end;

I := 1;

while I < Length(Result) do
begin
Ch := Result[I];
Result[I] := Result[I + 1];
Result[I + 1] := Ch;
Inc(I, 2);
end;
end;

constructor THddInfo.Create;
begin
inherited;

SetDriveNumber(0);
end;

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

procedure THDDInfo.ReadInfo;
type
PCharArray = ^TCharArray;
TCharArray = array[0..32767] of Char;

var
Returned: Cardinal;
Status: LongBool;
PropQuery: STORAGE_PROPERTY_QUERY;
DeviceDescriptor: STORAGE_DEVICE_DESCRIPTOR;
PCh: PChar;

begin
FInfoAvailable := False;
FProductRevision := '';
FProductId := '';
FSerialNumber := '';
FVendorId := '';

try
FFileHandle := CreateFile(
PChar('\\.\PhysicalDrive' + ByteToChar(FDriveNumber)),
0,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
0,
0
);

if FFileHandle = INVALID_HANDLE_VALUE then
RaiseLastOSError;

ZeroMemory(@PropQuery, SizeOf(PropQuery));
ZeroMemory(@DeviceDescriptor, SizeOf(DeviceDescriptor));

DeviceDescriptor.Size := SizeOf(DeviceDescriptor);

Status := DeviceIoControl(
FFileHandle,
IOCTL_STORAGE_QUERY_PROPERTY,
@PropQuery,
SizeOf(PropQuery),
@DeviceDescriptor,
DeviceDescriptor.Size,
Returned,
nil
);

if not Status then
RaiseLastOSError;

if DeviceDescriptor.VendorIdOffset <> 0 then
begin
PCh := @PCharArray(@DeviceDescriptor)^[DeviceDescriptor.VendorIdOffset];
FVendorId := PCh;
end;

if DeviceDescriptor.ProductIdOffset <> 0 then
begin
PCh := @PCharArray(@DeviceDescriptor)^[DeviceDescriptor.ProductIdOffset];
FProductId := PCh;
end;

if DeviceDescriptor.ProductRevisionOffset <> 0 then
begin
PCh := @PCharArray(@DeviceDescriptor)^[DeviceDescriptor.ProductRevisionOffset];
FProductRevision := PCh;
end;

if DeviceDescriptor.SerialNumberOffset <> 0 then
begin
PCh := @PCharArray(@DeviceDescriptor)^[DeviceDescriptor.SerialNumberOffset];
FSerialNumber := PCh;
end;

FInfoAvailable := True;
finally
if FFileHandle <> INVALID_HANDLE_VALUE then
CloseHandle(FFileHandle);
end;
end;

function THDDInfo.SerialNumberInt: Cardinal;
begin
Result := 0;
if ((IsInfoAvailable = True) and (FSerialNumber <> '')) then Result := SerialNumberToCardinal(FSerialNumber)
end;

function THDDInfo.SerialNumberText: string;
begin
Result := '';
if ((IsInfoAvailable = True) and (FSerialNumber <> '')) then Result := SerialNumberToString(FSerialNumber)
end;

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

end.

//----------------------------------------------------------------------------------------
// 例子如下：

//----------------------------------------------------------------------------------------
program DiskDriveSerialConsoleProject;

{$APPTYPE CONSOLE}

uses
Windows,
SysUtils,
hddinfo in 'hddinfo.pas';

const
// Max number of drives assuming primary/secondary, master/slave topology
MAX_IDE_DRIVES = 16;

procedure ReadPhysicalDriveInNTWithZeroRights ();
var
DriveNumber: Byte;
HDDInfo: THDDInfo;
begin
HDDInfo := THDDInfo.Create();
try
for DriveNumber := 0 to MAX_IDE_DRIVES - 1 do
try
HDDInfo.DriveNumber := DriveNumber;
if HDDInfo.IsInfoAvailable then
begin
Writeln('VendorId: ', HDDInfo.VendorId);
Writeln('ProductId: ', HDDInfo.ProductId);
Writeln('ProductRevision: ', HDDInfo.ProductRevision);
Writeln('SerialNumber: ', HDDInfo.SerialNumber);
Writeln('SerialNumberInt: ', HDDInfo.SerialNumberInt);
Writeln('SerialNumberText: ', HDDInfo.SerialNumberText);
end;
except
on E: Exception do
Writeln(Format('DriveNumber %d, %s: %s', [DriveNumber, E.ClassName, E.Message]));
end;
finally
HDDInfo.Free;
end;
end;

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

Answer 2

http://zhidao.baidu.com/question/124371576.html
function GetVolumeID : string;
var
vVolumeNameBuffer: array[0..255]of Char;
vVolumeSerialNumber: DWORD;
vMaximumComponentLength: DWORD;
vFileSystemFlags: DWORD;
vFileSystemNameBuffer: array[0..255]of Char;
begin
if GetVolumeInformation('C:\', vVolumeNameBuffer, SizeOf(vVolumeNameBuffer),
@vVolumeSerialNumber, vMaximumComponentLength, vFileSystemFlags,
vFileSystemNameBuffer, SizeOf(vFileSystemNameBuffer)) then
begin
Result := IntToHex(vVolumeSerialNumber, 8);
end;
end;