用delphi如何获得主板、硬盘的序列号（急、急、急！！！！！！）(100分)

各位大虾，有谁可以告知用delphi获得主板和硬盘的序列号（需要xp系统下面的源代码），请各位大虾们帮帮忙啊。100分可以再加。

如何得到硬盘物理序号
mysofts.51.net 2001-8-20 软件自做


unit hdid;

interface

uses
Windows, Controls,SysUtils,Forms;
//, Graphics, Dialogs, Classes, Messages,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
Thdidform = class(TForm)
private
{ Private declarations }
public

{ Public declarations }
end;

var
hdidform: Thdidform;
function GetIdeDiskSerialNumber : String;

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;

END.

//win98要 c:/windows/system/的smartvsd.vxd
//copy to c:/windows/system/iosubsys
//reboot your computer and ok
//2000 and nt do not need
得到硬盘物理序号:

uses hdid;

hdsn:=trim(GetIdeDiskSerialNumber);

function TPCInfo.GetMainboardSerialNumber: string;
begin
if GetOS = ‘9x‘ then
Result := string(Pchar(Ptr($FEC71)))
else
Result := ‘‘;
end;

仅win9x可用.

http://bbs.2ccc.com/topic.asp?topicid=58266

各位老大，主要需要的是在xp系统下面的主板序列号

取这些系列号只是作为一种号码生成的方法,并不是万全的，所以在实际应用中你还得配合其它加密手段来进行

//少花点时间在加密上，多用点时间完善软件。
98下可以直接用形如 StrPas(PChar(Ptr($FFFF5))) 取得，2000下因为权限的问题，不能直接访问
下面的程序可以直接读取物理内存，取出相应的信息

unit Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Aclapi, Accctrl, StdCtrls;

type
TMainForm = class(TForm)
InfoMemo: TMemo;
btGetInfo: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btGetInfoClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
PUnicodeString = ^TUnicodeString;
TUnicodeString = packed record
Length: Word;
MaximunLength: Word;
Buffer: PWideChar;
end;
NTSTATUS = Integer;
PObjectAttributes = ^TObjectAttributes;
TObjectAttributes = packed record
Length: DWORD;
RootDirectory: THandle;
ObjectName: PUnicodeString;
Attributes: DWORD;
SecurityDescriptor: PSecurityDescriptor;
SecurityQualityOfService: PSecurityQualityOfService;
end;
TZwOpenSection = function(var SectionHandle: THandle; DesireAccess: ACCESS_MASK;
var ObjectAttributes: TObjectAttributes): NTSTATUS; stdcall;
TZwClose = procedure(SectionHandle: THandle); stdcall;
TRtlInitUnicodeString = procedure(var DestinationString: TUnicodeString;
vSourceString: WideString); stdcall;

const
STATUS_SUCCESS = NTSTATUS(0);
STATUS_INVALID_HANDLE = NTSTATUS($C0000008);
STATUS_ACCESS_DENIED = NTSTATUS($C0000022);

OBJ_INHERIT = $00000002;
OBJ_PERMANENT = $00000010;
OBJ_EXCLUSIVE = $00000020;
OBJ_CASE_INSENSITIVE = $00000040;
OBJ_OPENIF = $00000080;
OBJ_OPENLINK = $00000100;
OBJ_KERNEL_HANDLE = $00000200;
OBJ_VALID_ATTRIBUTES = $000003F2;

ObjectPhysicalMemoryDeviceName = '/Device/Physicalmemory';
NTDLL = 'ntdll.dll';

var
ZwOpenSection: TZwOpenSection;
ZwClose: TZwClose;
RtlInitUnicodeString: TRtlInitUnicodeString;

var
MainForm: TMainForm;
NtLayer: HMODULE;

implementation

{$R *.dfm}

function NT_SUCCESS(var Status: LongInt): Boolean;
begin
Result:=LongInt(Status) >= 0;
end;

procedure InitializeObjectAttributes(var p: TObjectAttributes; n: PUnicodeString;
a: DWORD; r: THandle; s: PSecurityDescriptor);
begin
p.Length:=SizeOf(TObjectAttributes);
p.RootDirectory:=r;
p.Attributes:=a;
p.ObjectName:=n;
p.SecurityDescriptor:=s;
p.SecurityQualityOfService:=Nil;
end;

function SetPhysicalMemorySectionCanBeWrited(hSection: THandle): Boolean;
var
pDacl: PACL;
pNewDacl: PACL;
pSD: PPSECURITY_DESCRIPTOR;
dwRes: Cardinal;
ea: EXPLICIT_ACCESS_A;
label CleanUp;
begin
Result:=False;

pDacl:=Nil;
pNewDacl:=Nil;
pSD:=Nil;

dwres:=GetSecurityInfo(hSection,SE_KERNEL_OBJECT,DACL_SECURITY_INFORMATION,nil,
nil,@pDacl,nil,pSD);
try
if dwres<>ERROR_SUCCESS then
Exit;

FillChar(ea,SizeOf(EXPLICIT_ACCESS),0);
ea.grfAccessPermissions:=SECTION_MAP_WRITE;
ea.grfAccessMode:=GRANT_ACCESS;
ea.grfInheritance:=NO_INHERITANCE;
ea.Trustee.TrusteeForm:=TRUSTEE_IS_NAME;
ea.Trustee.TrusteeType:=TRUSTEE_IS_USER;
ea.Trustee.ptstrName:='CURRENT_USER';
SetEntriesInAcl(1,@ea,Nil,pNewDacl);

dwRes:=SetSecurityInfo(hSection,SE_KERNEL_OBJECT,DACL_SECURITY_INFORMATION,
Nil,Nil,pNewDacl,Nil);
if dwRes=ERROR_SUCCESS then
Exit;

Result:=True;
finally
if pSD<>Nil then
LocalFree(Cardinal(pSD^));
if pNewDacl<>Nil then
LocalFree(Cardinal(pSD^));
end;
end;

function OpenPhysicalMemory(ReadOrNot: Boolean): THandle;
var
Status: NTSTATUS;
PhysMem: THandle;
PhysMemString: TUnicodeString;
Attributes: TObjectAttributes;
SectionAttrib: Integer;
PhysMemName: WideString;
begin
Result:=0;
PhysMemName:=ObjectPhysicalMemoryDeviceName;
RtlInitUnicodeString(PhysMemString,PhysMemName);
InitializeObjectAttributes(Attributes,@PhysMemString,OBJ_CASE_INSENSITIVE
or OBJ_KERNEL_HANDLE,0,Nil);
if ReadOrNot then
SectionAttrib:=SECTION_MAP_READ
else
SectionAttrib:=SECTION_MAP_READ or SECTION_MAP_WRITE;
Status:=ZwOpenSection(PhysMem,SectionAttrib,Attributes);
if not ReadOrNot then
begin
if Status=STATUS_ACCESS_DENIED then
begin
Status:=ZwOpenSection(PhysMem,READ_CONTROL or WRITE_DAC,Attributes);
SetPhysicalMemorySectionCanBeWrited(PhysMem);
ZwClose(PhysMem);
Status:=ZwOpenSection(PhysMem,SectionAttrib,Attributes);
end;
end;
if not NT_SUCCESS(Status) then
Exit;

Result:=PhysMem;
end;

function MapPhysicalMemory(ReadOrNot: Boolean; PhysicalMemory: THandle;
Address: DWORD; Length: DWORD; var VirtualAddress: PChar): Boolean;
var
Access: Cardinal;
begin
if ReadOrNot then
Access:=FILE_MAP_READ
else
Access:=FILE_MAP_READ or FILE_MAP_WRITE;

VirtualAddress:=MapViewOfFile(PhysicalMemory,Access,0,Address,Length);
Inc(DWORD(VirtualAddress),Address Mod $1000);
Result:=True;
end;

procedure UnMapPhysicalMemory(Address: Pointer);
begin
UnMapViewOfFile(Address);
end;

function LocateNtdllEntryPoints: Boolean;
begin
NtLayer:=GetModuleHandle(NTDLL);
if NtLayer=0 then
begin
SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
Result:=False;
Exit;
end
else
begin
if not Assigned(ZwOpenSection) then
ZwOpenSection:=GetProcAddress(NtLayer,'ZwOpenSection');
if not Assigned(ZwClose) then
ZwClose:=GetProcAddress(NtLayer,'ZwClose');
if not Assigned(RtlInitUnicodeString) then
RtlInitUnicodeString:=GetProcAddress(NtLayer,'RtlInitUnicodeString');
end;

Result:=True;
end;

function ReadWritePhyMem(Address: DWORD; Length: DWORD; Buffer: PChar;
ReadOrNot: Boolean = True): Boolean;
var
PhysMem: THandle;
vAddress: PChar;
begin
Result:=False;

if not Assigned(ZwOpenSection) then
Exit;

PhysMem:=OpenPhysicalMemory(ReadOrNot);
if PhysMem=0 then
Exit;

if not MapPhysicalMemory(ReadOrNot,PhysMem,Address,Length,vAddress) then
Exit;

try
if ReadOrNot then
Move(vAddress^,Buffer^,Length)
else
Move(Buffer^,vAddress^,Length);

Result:=True;
except
on E: Exception do
MessageBox(Application.Handle,PChar('缓冲区长度不足或内存跨段。'#13+
'每个内存段为 4KB 的整数倍，每次读写不能跨越多个不同的内存段。'),
'错误',MB_ICONERROR+MB_OK+MB_SYSTEMMODAL);
end;

UnMapPhysicalMemory(vAddress);
ZwClose(PhysMem);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
if not LocateNtdllEntryPoints then
begin
MessageBox(Application.Handle,'无法加载 NTDLL.dll！','错误',MB_ICONERROR+
MB_OK+MB_SYSTEMMODAL);
Close;
end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
FreeLibrary(NtLayer);
end;

procedure TMainForm.btGetInfoClick(Sender: TObject);
var
Buffer: PChar;
Length: Integer;
i: Integer;
begin
with InfoMemo do
begin
Clear;

Length:=$30;
GetMem(Buffer,Length);
try
if ReadWritePhyMem($FE061,Length,Buffer) then
Lines.Add('BIOS 版本： '+StrPas(Buffer));
finally
FreeMem(Buffer);
end;

Length:=$FF;
GetMem(Buffer,Length);
try
if ReadWritePhyMem($FE091,Length,Buffer) then
Lines.Add('BIOS 版权信息： '+StrPas(Buffer));
finally
FreeMem(Buffer);
end;

Length:=$B;
GetMem(Buffer,Length);
try
if ReadWritePhyMem($FFFF5,Length,Buffer) then
Lines.Add('BIOS 日期： '+StrPas(Buffer));
finally
FreeMem(Buffer);
end;

Length:=$FF;
GetMem(Buffer,Length);
try
if ReadWritePhyMem($FE0C1,Length,Buffer) then
Lines.Add('名称： '+StrPas(Buffer));
finally
FreeMem(Buffer);
end;

Length:=$FF;
GetMem(Buffer,Length);
try
if ReadWritePhyMem($FEC71,Length,Buffer) then
Lines.Add('主板序列号： '+StrPas(Buffer));
finally
FreeMem(Buffer);
end;

Lines.Add('');

Length:=$E;
GetMem(Buffer,Length);
try
if ReadWritePhyMem($400,Length,Buffer) then
begin
for i:=0 to 3 do
Lines.Add(Format('串口 %d 输入/输出范围： %x',[i+1,PWORD(@Buffer[i*2])^]));
Lines.Add('');
for i:=0 to 2 do
Lines.Add(Format('并口 %d 输入/输出范围： %x',[i+1,PWORD(@Buffer[8+i*2])^]));
end;
finally
FreeMem(Buffer);
end;
end;
end;

end.

2ccc.com首页上有个控件，取得系统信息用的，可以试试。

少花点时间在加密上，多用点时间完善软件。
而且现在开始用SATA的硬盘，你如何解决呢