转帖:
博士网(http://www.helpwork.net)问答区--Delphi版作者:kongfang(bnnay)    来源:210.28.70.67
标题:如何获得硬盘的序列号-程序清单
声明:不能用于NT
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
  Button1: TButton;
  Label0: TLabel;
  Label1: TLabel;
  Label2: TLabel;
  Label3: TLabel;
  Label4: TLabel;
  procedure Button1Click(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
end;
const
hookexceptionno = 5;
ErrNo : integer =0;
var
pw : array [0..255] of WORD;//    pw[256];
idtr_1 : array [0..5] of byte; //保存中断描述符表寄存器
oldexceptionhook : dword;      //保存原先的中断入口地址
IdeBase : word;
SelectDisk: integer;
var
Form1: TForm1;
implementation
{$R *.DFM}
function  inp(rdx:word) : byte;
asm
  mov dx, rdx
  in al, dx
end;
function inpw(rdx: word) : word;
asm
  mov dx, rdx
  in  ax, dx
end;
procedure outp(ral : byte; rdx : word);
asm
  mov dx, rdx
  mov al, ral
  out dx, al
end;
function WaitIde:byte;
var
al:byte;
begin
repeat
  al:=inp(IdeBase+7);
until (al<$80) or (al=$a0); //$a0可能就没有硬盘
WaitIde := al;
end;
procedure ReadIDE;
var
al : byte;
i : integer;
begin
WaitIde;
outp(SelectDisk,IdeBase+6);
al := WaitIde;
if ((al and $50) <>$50) then
begin
  ErrNo:=1;
  exit;
end;
outp(SelectDisk,IdeBase+6);
outp($EC,IdeBase+7);
al := WaitIde;
if ((al and $58)<>$58) then
begin
  ErrNo:=2;
  exit;
end;
for i:=0 to 255 do
begin
  pw[i] := inpw(IdeBase);
end;
end;
// 新的中断处理程序
procedure ReadIt; assembler;
asm
  push eax
  push ebx
  push ecx
  push edx
  push esi
  push edi
  // 在这里写读程序
  call ReadIDE
  pop edi
  pop esi
  pop edx
  pop ecx
  pop ebx
  pop eax
  iretd
end;
procedure GetSerialNo; assembler;
begin
asm
  push eax
  // 获取修改的中断的中断描述符(中断门)地址
  sidt idtr_1
  mov eax,dword ptr idtr_1+02h
  add eax,hookexceptionno*08h+04h
  // 保存原先的中断入口地址
  cli
  push ecx
  mov ecx,dword ptr [eax]
  mov cx,word ptr [eax-04h]
  mov dword ptr oldexceptionhook,ecx
  pop ecx
  // 设置修改的中断入口地址为新的中断处理程序入口地址
  push ebx
  lea ebx,ReadIt
  mov word ptr [eax-04h],bx
  shr ebx,10h
  mov word ptr [eax+02h],bx
  pop ebx
  // 执行中断,转到ring 0(与cih 病毒原理相似!)
  push ebx
  int hookexceptionno
  pop ebx
  // 恢复原先的中断入口地址
  push ecx
  mov ecx,dword ptr oldexceptionhook
  mov word ptr [eax-04h],cx
  shr ecx,10h
  mov word ptr [eax+02h],cx
  pop ecx
  // 结束
  sti
  pop eax
  ret
end;
end;
procedure GetPN(DriveNo: integer; var s:string);
var
i : integer;
begin
//  asm int 3 end;
ErrNo:=0;
fillchar(pw,sizeof(pw),0);
s:='';
case DriveNo of      //设置基址
  0,1:IdeBase:= $1f0;
  2,3:IdeBase:= $170;
end;
case DriveNo of      //指定主从
  0,2:SelectDisk:=$A0;
  1,3:SelectDisk:=$B0;
end;
GetSerialNo;
if ErrNo<>0 then
  exit;      //读错误
if (pw[0]=0) then
  s := '没有序列号:('
else
  for i:=10 to 20 do
  begin
    s := s+ char(pw[i] shr 8) + char(pw[i] and $ff);
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
i:integer;
begin
for i:=0 to 3 do
begin
  GetPN(i, s);
  if (s<>'') then
  case i of
    0:  Label1.Caption := 'IDE1 主盘' +s;
    1:  Label2.Caption := 'IDE1 从盘' +s;
    2:  Label3.Caption := 'IDE2 主盘' +s;
    3:  Label3.Caption := 'IDE2 从盘' +s;
  end;
end;
end;
end.