如何得到硬盘出厂序列号？很急！(100分)

如何得到硬盘的出厂序列号？希望有源码，正急着用到！

procedure TForm1.Button1Click(Sender: TObject);
var
SerialNum : pdword;
a, b : dword;
Buffer : array [0..255] of char;
begin

if GetVolumeInformation('c:/', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then

Label1.Caption := IntToStr(SerialNum^);
end;

To: freecom
我要的是出厂序列号，每快硬盘是唯一的，不变的。
你的程序只能读出format时的序列号。

发个源程序给你，用不了再骂我。。。
给个Email地址给我，我会在14/15号发给你，
另如还有其它需要的，请速报到，恕不重发！！！

这里有个控件完全可以满足你的需要，而且有源码的喔
http://go3.163.com/~delphi6/
SystemInformation v1.0 类型：免费 源码：√ 大小：17K ★★★★
说明：一个检测系统、CPU、显示器(卡)、主板、磁盘、网卡等各项信息的控件。

有人问过，你又亏了：），还不如查一下来得快：
来自：supershan, 时间：2001-4-13 13:43:00, ID：446271 [显示：小字体 | 大字体]
我想利用Delphi读取每台机器中都不相同的信息，曾用过这个函数GetVolumeInformation;
但它只能读取的不是真正的硬盘号，如果重装机器，它将更改，听说用汇编可以做到，
不知是否有高手可以给出源码。win98,winnt,win2000
上都适用才行。期待您的回复，急急急急急急急急急！


来自：吕雪松, 时间：2001-2-2 10:19:07, ID：446294
能不能顺便读出操作员的身份证号？


来自：pcexplorer, 时间：2001-2-2 10:26:04, ID：446307
{你可以试试以下的方法取的cpu的id,其它嘛让我想想}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
function GetCpuId:longint;assembler;register;
var
temp:longint;
begin
asm
PUSH EBX
PUSH EDI
MOV EDI,EAX
MOV EAX,1
DW $A20F
MOV TEMP,EDX
POP EDI
POP EBX
end;
result:=temp;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.Text:=IntToHex(GetCpuId,8);
end;
end.


来自：kinglaw, 时间：2001-2-2 10:55:46, ID：446362
以下例子可以读出硬盘序列号，但只能在win9x中使用。
要想在win98,winnt,win2000上都适用的话，只能编vxd了。

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
type
TGate = record
Off2,op,seg,off1:WORD;
end;
LONGDWORD = INT64;
var
IDTR: LONGDWORD;
SavedGate:TGate;
OurGate: TGate;
dd: array [0..256] of word;
dsn:array [0..20] of char;
//存放硬盘序列号
procedure Ring0Proc();
asm
// Wait for controller not busy
mov dx,01f7h
@1:in al,dx
cmp al,050h
jne @1
// Get first/second drive
dec dx
mov al,0a0h
out dx,al
// Get drive info data
inc dx
mov al,0ech
out dx,al
nop
nop
// Wait for data ready
@2:in al,dx
cmp al,058h
jne @2
nop
nop
// Read sector
xor ecx,ecx
mov dx,01f0h
@3:in ax,dx
mov word ptr dd[ecx*2],ax
inc ecx
cmp ecx,256
jne @3
iretd //中断返回
end;

procedure Change2Ring0();
begin
asm
mov eax, offset Ring0Proc
mov OurGate.off2, ax // 将 中 断 函 数 的 地 址
shr eax, 16 // 填 入 新 造 的 中 断 门
mov OurGate.off1, ax // 描 述 符
mov OurGate.op,0028h
mov OurGate.seg,0ee00h
mov ebx,offset IDTR
sidt [ebx]
// 将 中 断 描 述 符 表 寄 存 器（IDTR）的 内 容 取 出
mov ebx, dword ptr [IDTR+2]
// 取 出 中 断 描 述 符 表（IDT） 基 地 址
add ebx, 8*3
// 计 算Int 3 的 描 述 符 应 放 置 的 地 址 选 用
//Int3 是 因 为 它 在Win32 保 护 模 式 下 未 占 用
mov edi, offset SavedGate
mov esi, ebx
movsd // 保 存 原 来 的Int 9 描 述 符 到
movsd //SavedGate 以 便 恢 复
mov edi, ebx
mov esi, offset OurGate
cli
movsd // 替 换 原 来 的 中 断 门 描 述 符
movsd // 以 安 装 中 断 服 务 例 程
sti
mov eax,6200h
// 用 以 测 试 放 在EAX 中 的 数 据 能 否 正 确 传 到Ring0 中 断
mov ecx,0
// 用 以 测 试 放 在ECX 中 的 数 据
// 能 否 正 确 传 到Ring0 中 断
// 因 为 很 多VxD 服 务 都 用此二 寄 存 器 传 递 参 数
int 3h
// 人 为 触 发 中 断, 平 时 会 出 现保 护 错 误 蓝 屏 或 非 法 操
// 作 对 话 框， 现 在 安 装 了
// 中 断 服 务 例 程 后， 就 会 通 过
//VMM 在Ring0 调 用 中 断 服 务 例 程Ring0Proc
mov edi, ebx
mov esi, offset SavedGate
cli
movsd // 恢 复 原 来 的 中 断 门 描 述 符
movsd
sti
end;
asm
xor ecx,ecx
mov ebx,offset dd[10*2]
@4:mov ax,[ebx]
mov byte ptr dsn[ecx],ah
inc ecx
mov byte ptr dsn[ecx],al
inc ebx
inc ebx
inc ecx
cmp ecx,10
jne @4
end;
showmessage(dsn);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
change2ring0;
end;

end.


来自：supershan, 时间：2001-2-2 12:09:58, ID：446445
读CPU的方法我试过，在六台机器上居然得到相同ID，而且现在intel已把ID封掉了


来自：beta, 时间：2001-2-3 0:58:04, ID：447174
取得硬盘序列号：
Function GetHardDiskSerieNummer : string;
var
Teller : integer;
Lus : integer;
SerieNummer : array[0..24] of char;
begin
result := '';
Teller := 1;
for Lus := 1 to 8 do
begin
SerieNummer[Teller] := chr((HardDiskGegevens[10+Lus] div 256 ));
inc(Teller);
SerieNummer[Teller] := CHR((HardDiskGegevens[10+Lus] mod 256 ));
inc(Teller);
end;
result := SerieNummer;
end;


来自：unreal, 时间：2001-2-3 1:07:12, ID：447184
没贴全吧？HardDiskGegevens从哪来的？


来自：beta, 时间：2001-2-3 1:15:05, ID：447194
sorry,这个一定可以，我试过：
function GetHardDiskSerieNumber: string;
var
sysinfo:tsysteminfo;
lpRootPathName : PChar;
// address of root directory of the file system
lpVolumeNameBuffer : PChar;
// address of name of the volume
nVolumeNameSize : DWORD;
// length of lpVolumeNameBuffer
lpVolumeSerialNumber : DWORD;
// address of volume serial number
lpMaximumComponentLength : DWORD;
// address of system's maximum filename length
lpFileSystemFlags : DWORD;
// address of file system flags
lpFileSystemNameBuffer : PChar;
// address of name of file system
nFileSystemNameSize : DWORD;
// length of lpFileSystemNameBuffer
lpRootPathName:=pchar('c:/');
windows.GetSystemInfo(sysinfo);
GetMem( lpVolumeNameBuffer, MAX_PATH + 1 );
GetMem( lpFileSystemNameBuffer, MAX_PATH + 1 );
nVolumeNameSize := MAX_PATH + 1;
nFileSystemNameSize := MAX_PATH + 1;
Windows.GetVolumeInformation( lpRootPathName,
lpVolumeNameBuffer,
nVolumeNameSize,
@lpVolumeSerialNumber,
lpMaximumComponentLength,
lpFileSystemFlags,
lpFileSystemNameBuffer,
nFileSystemNameSize );
Result := Copy( IntToHex( lpVolumeSerialNumber, 0 ), 1, 4 ) + '-' +
Copy( IntToHex( lpVolumeSerialNumber, 0 ), 5, 4 );
end;


来自：loopy, 时间：2001-2-3 2:31:09, ID：447220
look


来自：supershan, 时间：2001-2-3 9:29:10, ID：447270
to beta:
用getvolumeinformation不行的，它得到的是逻辑盘的序列号，重装系统后，将更改


来自：supershan, 时间：2001-2-4 9:52:14, ID：448178
接着这个问题继续请教大家，如果我想把一定信息存到哪里最安全，即使格式化硬盘
也不会消失，而且要能够读和写。请高手指点！！！！！！！！！！！！！
这样的要求可能有难度，因为我要是存到注册表或INI中，用户重装机器后，
我存入的信息就没了，可能有更好的办法。


来自：Siken, 时间：2001-2-4 12:53:34, ID：448341
你可以安装lmd4.0,里面有控件


来自：angelsoft, 时间：2001-2-12 2:50:22, ID：453800
To kinglaw:
　你的程序确实可以得到硬盘的物理序列号，但是我测试发现在98,ME下使用能正常得到，
在95下使用却什么也得不到。why?
另外在２０００下使用肯定是不行的，我知道原因，所以没有测试。
　我在以前也发过征求序列号的贴子，但没有得到满意的答复，难道真的没有办法吗？

下面就是了，试试吧
Hard disk serial number
Question
Is there anyone who knows how to obtain the hard disk serial number?
Answer
I have an unit to get the Hd Name and the Hd Serial number for Borland
Pascal 7.0. I do
n't know if it's working with Delphi and the other thing is
that it is in dutch and I do
n't have time to translate it in englisch. Mayby
you can use it, otherwise drop it out of the window.
Unit HardDisk;
INTERFACE
FUNCTION GetHardDiskNaam : STRING;
FUNCTION GetHardDiskSerieNummer : STRING;
FUNCTION GetHardDiskControlleNummer : STRING;
PROCEDURE GetHardDiskGegevens;
CONST
CodeerTabel : ARRAY[0..24] OF BYTE =
(3,1,2,1,4,1,3,2,6,4,6,5,1,2,6,4,2,6,3,4,6,2,4,1,2);
TYPE
CharArray = ARRAY[0..24] OF CHAR;
VAR
HardDiskGegevens : ARRAY[1..256] OF INTEGER;
HardDiskNaam : CharArray;
SerieNummer : CharArray;
ControlleNummer : CharArray;
C_HardDiskNaam: STRING;
C_HardDiskSerieNummer : STRING;
C_HardDiskControlleNummer : STRING;
C_LicentieNaam: STRING;
IMPLEMENTATION
FUNCTION GetHardDiskNaam : STRING;
VAR
Teller : INTEGER;
Lus : INTEGER;
begin
GetHardDiskNaam := '';
Teller := 1;
FOR Lus := 1 TO 18 do
begin
HardDiskNaam[Teller] := CHR( ( HardDiskGegevens[27+Lus] DIV 256 ));
Inc(Teller);
HardDiskNaam[Teller] := CHR( ( HardDiskGegevens[27+Lus] MOD 256 ));
Inc(Teller);
end;
GetHardDiskNaam := HardDiskNaam;
end;
FUNCTION GetHardDiskSerieNummer : STRING;
VAR
Teller : INTEGER;
Lus : INTEGER;
begin
GetHardDiskSerieNummer := '';
Teller := 1;
FOR Lus := 1 TO 8 do
begin
SerieNummer[Teller] := CHR( ( HardDiskGegevens[10+Lus] DIV 256 ));
Inc(Teller);
SerieNummer[Teller] := CHR( ( HardDiskGegevens[10+Lus] MOD 256 ));
Inc(Teller);
end;
GetHardDiskSerieNummer := SerieNummer;
end;
FUNCTION GetHardDiskControlleNummer : STRING;
VAR
Teller : INTEGER;
Lus : INTEGER;
begin
GetHardDiskControlleNummer := '';
Teller := 1;
FOR Lus := 1 TO 3 do
begin
ControlleNummer[Teller] := CHR( ( HardDiskGegevens[23+Lus] DIV 256 ));
Inc(Teller);
ControlleNummer[Teller] := CHR( ( HardDiskGegevens[23+Lus] MOD 256 ));
Inc(Teller);
end;
GetHardDiskControlleNummer := ControlleNummer;
end;
PROCEDURE GetHardDiskGegevens;
VAR
Lus : INTEGER;
begin
WHILE ( Port[$1f7] <> $50) do
;
Port[$1F6] := $A0 ;
Port[$1F7] := $EC ;
WHILE ( Port[$1f7] <> $58 ) do
;
FOR Lus := 1 TO 256 do
begin
HardDiskGegevens[Lus] := Portw[$1F0] ;
end;
end;
end.

关注：

TO:WiseAnt
我的E-MAIL：superchfeng@163.com

achane:
　　源代码已发出，希查收！

WiseAnt
请再发个解压工具给我，我的WINZIP解不开。谢谢！

To:kevincsg
你的怎么用？

请给我也发一个，TKS
jrlee@21cn.com

这个太简单了，不用我教了吧！

To:kevincsh
请问PROCEDURE GetHardDiskGegevens中的Port和Portw在哪里定义的？

To:kevincsh
1、HardDiskGegevens里的值一直为0，所以函数返回值始终为空的；
2、CodeerTabel : ARRAY[0..24] OF BYTE =
(3,1,2,1,4,1,3,2,6,4,6,5,1,2,6,4,2,6,3,4,6,2,4,1,2);好象没有用到，怎么回事？

achane:
　　*.RAR为WINRAR格式的压缩文件，你可到文川阁下载：
www.wenchuan.com

unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TSrbIoControl = packed record
HeaderLength : ULONG;
Signature : Array[0..7] of Char;
Timeout : ULONG;
ControlCode : ULONG;
ReturnCode : ULONG;
Length : ULONG;
end;

SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;

TIDERegs = packed 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. Must be zero.
end;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs;

TSendCmdInParams = packed record
cBufferSize : DWORD;
irDriveRegs : TIDERegs;
bDriveNumber : Byte;
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte;
end;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;

TIdSector = packed record
wGenConfig : Word;
wNumCyls : Word;
wReserved : Word;
wNumHeads : Word;
wBytesPerTrack : Word;
wBytesPerSector : Word;
wSectorsPerTrack : Word;
wVendorUnique : Array[0..2] of Word;
sSerialNumber : Array[0..19] of Char;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev : Array[0..7] of Char;
sModelNumber : Array[0..39] of Char;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : ULONG;
wMultSectorStuff : Word;
ulTotalAddressableSectors : ULONG;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of Byte;
end;
PIdSector = ^TIdSector;

const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE = 512;
DFP_RECEIVE_DRIVE_DATA = $0007c088;
IOCTL_SCSI_MINIPORT = $0004d008;
IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;
DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
procedure ChangeByteOrder( var Data;
Size : Integer );
var ptr : PChar;
i : Integer;
c : Char;
begin
ptr := @Data;
for i := 0 to (Size shr 1)-1 do
begin
c := ptr^;
ptr^ := (ptr+1)^;
(ptr+1)^ := c;
Inc(ptr,2);
end;
end;

function GetIdeDiskSerialNumber : String;
var
hDevice : THandle;
cbBytesReturned : DWORD;
pInData : PSendCmdInParams;
pOutData : Pointer;
// PSendCmdOutParams
Buffer : Array[0..BufferSize-1] of Byte;
srbControl : TSrbIoControl absolute Buffer;
begin
Result := '';
FillChar(Buffer,BufferSize,#0);
if Win32Platform=VER_PLATFORM_WIN32_NT then
begin
// Windows NT, Windows 2000
// Get SCSI port handle
hDevice := CreateFile( '//./Scsi0:',
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then
Exit;
try
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
System.Move('SCSIDISK',srbControl.Signature,8);
srbControl.Timeout := 2;
srbControl.Length := DataSize;
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
pInData := PSendCmdInParams(PChar(@Buffer)
+SizeOf(SRB_IO_CONTROL));
pOutData := pInData;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT,
@Buffer, BufferSize, @Buffer, BufferSize,
cbBytesReturned, nil ) then
Exit;
finally
CloseHandle(hDevice);
end;
end
else
begin
// Windows 95 OSR2, Windows 98
hDevice := CreateFile( '//./SMARTVSD', 0, 0, nil,
CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then
Exit;
try
pInData := PSendCmdInParams(@Buffer);
pOutData := @pInData^.bBuffer;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,
pInData, SizeOf(TSendCmdInParams)-1, pOutData,
W9xBufferSize, cbBytesReturned, nil ) then
Exit;
finally
CloseHandle(hDevice);
end;
end;
with PIdSector(PChar(pOutData)+16)^ do
begin
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
EDIT1.TEXT:=TRIM(GetIdeDiskSerialNumber);
end;

end.

//win98要 c:/windows/system/的smartvsd.vxd
//copy to c:/windows/system/iosubsys
//reboot your computer and ok
//2000 and nt do
not need

密切注意

时间过长，斑竹代为结束！[]