disksn.pas

读硬盘出厂序列号控件,适合 DELPHI4,D5,D6,CB4,CB5或更高版本。 支持WIN9X/ME/NT/2K/XP下盘出厂序列号的读取,可做程序加密使用。

unit DiskSN;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,DsgnIntf;
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

  TDISKSN = class(TComponent)
  private
    FAbout  : string;
    FSerialNumber: string;
    { Private declarations }
  protected
    { Protected declarations }
  public
     
    constructor Create(AOwner:TComponent); override;
    procedure Loaded; override;
    destructor Destroy; override;
    procedure ShowAbout;
    { Public declarations }
  published
        { Published declarations }
  property About: string read FAbout write FAbout stored False;
  property GetDiskSN :string read FSerialNumber;
  end;

procedure Register;

implementation
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();
var i :integer;
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,20
jne @4
end;
for i:=0 to 10 do
dsn[i]:=dsn[i+10];
end;
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
//通过MS的S.M.A.R.T.接口,直接从RING3调用
//API DeviceIoControl()来获取硬盘信息
// 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;
with PIdSector(PChar(pOutData)+16)^ do
begin
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
end;
end
else
begin // Windows 95 OSR2, Windows 98
//使用类似CIH利用中断异常方法从Ring3转入Ring0层读取DiskSN
change2ring0;
Result:=dsn;
end;
end;
type
  TAboutProperty = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue:string; override;
  end;

procedure Register;
begin
  RegisterComponents('Samples', [TDISKSN]);
    RegisterPropertyEditor (TypeInfo (String), TDISKSN,
                         'About', TAboutProperty);
end;

constructor TDISKSN.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);

end;

procedure TDISKSN.Loaded;
begin
  FSerialNumber:=TRIM(GetIdeDiskSerialNumber);
  FAbout:='读硬盘出厂序列号控件,张阳制作,必属精品';
  inherited Loaded;	{ always call the inherited Loaded first! }
  end;

destructor TDISKSN.Destroy;
begin
  inherited Destroy;
end;
procedure TAboutProperty.Edit;
begin
  TDISKSN(GetComponent(0)).ShowAbout;
end;
function TAboutProperty.GetAttributes: TPropertyAttributes;
begin
  GetAttributes := [paDialog, paReadOnly];
end;

function TAboutProperty.GetValue: String;
begin
  GetValue := '(About)';
end;
 procedure TDISKSN.ShowAbout;
var
  msg : string;
const
  cr = chr (13);
begin
  msg  := '读硬盘出厂序列号控件' + cr + 'FOR D4,D5,D6,CB4,CB5' + cr;
  msg  := msg + 'WIN9X/ME/NT/2K/XP' + cr + cr;
  msg  := msg + 'Copyright 2001 MoonSoft' + cr+'   张阳制作,必属精品!' + cr;
  msg  := msg + 'E-mail:[e-mail]' + cr;
  Application.Messagebox(pchar(msg ),'版本提示(最终版)',MB_OK );
end;
end.