盒子论坛 v2.1

unit DiskSN;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, nb30;

type

  TDISKSN = class(TComponent)
  private
     FActive:Boolean;
     FIDE0SN:string;
     FIDE1SN:string;
     FSCSI0SN:string;
     FSCSI1SN:string;
     FCardAddr0:string;
     FCardAddr1:string;
     FCardAddr2:string;
     FCardAddr3:string;
     FCardAddr4:string;
     FCPUSpeedMHz:string;
     function Change2Ring0:string;
     function NBGetAdapterAddress(a:integer):string;
     procedure SetActive(Val:Boolean);
    { Protected declarations }
  public

    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    function GetCPUSpeed: Double;  protected
    function ScsiHddSerialNumber(i:smallint) : String;
    function GetIdeSerialNumber(i:smallint): pchar;
  published
     property Active:Boolean read FActive Write SetActive;
     property IDE0SN:string read FIDE0SN write FIDE0SN;
     property IDE1SN:string read FIDE1SN write FIDE1SN;
     property SCSI0SN:string read FSCSI0SN write FSCSI0SN;
     property SCSI1SN:string read FSCSI1SN write FSCSI1SN;
     property CardAddr0:string read FCardAddr0 write FCardAddr0;
     property CardAddr1:string read FCardAddr1 write FCardAddr1;
     property CardAddr2:string read FCardAddr2 write FCardAddr2;
     property CardAddr3:string read FCardAddr3 write FCardAddr3;
     property CardAddr4:string read FCardAddr4 write FCardAddr4;
     property CPUSpeedMHz:string read FCPUSpeedMHz write FCPUSpeedMHz;
  end;
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;
  var
    HVxDHandle:thandle;
    str1,str2,str3:string;//win98,winnt/2000,scsi
    type
   TGate = record
     Off2,op,seg1,off1:WORD;
   end;
   LONGDWORD = INT64;

  var
  IDTR: LONGDWORD;
  SavedGate:TGate;
  OurGate: TGate;
  dd1: array [0..256] of word;
  dsn:array [0..20] of char; //存放硬盘序列号

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TDISKSN]);
end;

constructor TDISKSN.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FActive:=false;
  FCardAddr0:='';
  FCardAddr1:='';
  FCardAddr2:='';
  FCardAddr3:='';
  FCardAddr4:='';
  FSCSI0SN:='';
  FSCSI1SN:='';
  FIDE0SN:='';
  FIDE1SN:='';
  FCPUSpeedMHz:='';
end;

destructor TDISKSN.Destroy;
begin
  inherited Destroy;
end;

procedure TDISKSN.SetActive(Val:Boolean);
begin
   FActive:=Val;
   FCardAddr0:='';
   FCardAddr1:='';
   FCardAddr2:='';
   FCardAddr3:='';
   FCardAddr4:='';
   FSCSI0SN:='';
   FSCSI1SN:='';
   FIDE0SN:='';
   FIDE1SN:='';
   FCPUSpeedMHz:='';
   if Val=true then
   begin
      FCardAddr0:=NBGetAdapterAddress(0);
      FCardAddr1:=NBGetAdapterAddress(1);
      FCardAddr2:=NBGetAdapterAddress(2);
      FCardAddr3:=NBGetAdapterAddress(3);
      FCardAddr4:=NBGetAdapterAddress(4);
      FSCSI0SN:=trim(ScsiHddSerialNumber(0));
      FSCSI1SN:=trim(ScsiHddSerialNumber(1));
      FIDE0SN:=trim(GetIdeSerialNumber(0));
      FIDE1SN:=trim(GetIdeSerialNumber(1));
      FCPUSpeedMHz:=formatfloat('0.00',getcpuspeed());
   end;
end;

//获取IDE驱动器的序列号
function TDISKSN.GetIdeSerialNumber(i:smallint) : pchar;
const IDENTIFY_BUFFER_SIZE = 512;
type
   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 for future use.  Must be zero.
  end;
  TSendCmdInParams = packed record
    // Buffer size in bytes
    cBufferSize  : DWORD;
    // Structure with drive register values.
    irDriveRegs  : TIDERegs;
    // Physical drive number to send command to (0,1,2,3).
    bDriveNumber : BYTE;
    bReserved    : Array[0..2] of Byte;
    dwReserved   : Array[0..3] of DWORD;
    bBuffer      : Array[0..0] of Byte;  // Input buffer.
  end;
  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    : DWORD;
    wMultSectorStuff          : Word;
    ulTotalAddressableSectors  : DWORD;
    wSingleWordDMA          : Word;
    wMultiWordDMA          : Word;
    bReserved          : Array[0..127] of BYTE;
  end;
  PIdSector = ^TIdSector;
  TDriverStatus = packed record
    // 驱动器返回的错误代码，无错则返回0
    bDriverError : Byte;
    // IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
    bIDEStatus   : Byte;
    bReserved    : Array[0..1] of Byte;
    dwReserved   : Array[0..1] of DWORD;
  end;
  TSendCmdOutParams = packed record
    // bBuffer的大小
    cBufferSize  : DWORD;
    // 驱动器状态
    DriverStatus : TDriverStatus;
    // 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
    bBuffer      : Array[0..0] of BYTE;
  end;
  var hDevice : THandle;
      cbBytesReturned : DWORD;
      ptr : PChar;
      SCIP : TSendCmdInParams;
      aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
      IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;
  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;
begin
    Result := ''; // 如果出错则返回空串
    if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000
    begin
        // 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '\\.\PhysicalDrive1\'
       if i=0 then
         hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
          FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 )
       else hDevice := CreateFile( '\\.\PhysicalDrive1', GENERIC_READ or GENERIC_WRITE,
          FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 )
    end
    else if SysUtils.Win32Platform=1 then// Version Windows 95 OSR2, Windows 98
      //hDevice := CreateFile( '\\.\SMARTVSD', 0,0, nil, CREATE_NEW , 0, 0 );
    begin //Windows98，只获取第一个驱动器的，其他的我也不知道怎么获取，
          //如果你知道的话，请告诉我,谢谢。
       result:=pchar(Change2Ring0());
       exit;
    end;
    if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
      FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
      FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
      cbBytesReturned := 0;
      // Set up data structures for IDENTIFY command.
      with SCIP do begin
        cBufferSize  := IDENTIFY_BUFFER_SIZE;
  //      bDriveNumber := 0;
        with irDriveRegs do begin
          bSectorCountReg  := 1;
          bSectorNumberReg := 1;
  //      if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
  //      else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
          bDriveHeadReg    := $A0;
          bCommandReg      := $EC;
        end;
      end;
      if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
        @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
    finally
      CloseHandle(hDevice);
    end;
    with PIdSector(@IdOutCmd.bBuffer)^ do begin
      ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
      (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
      Result := PChar(@sSerialNumber);
    end;
end;

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 dd1[ecx*2],ax
  inc ecx
  cmp ecx,256
  jne @3

  iretd  //中断返回
end;

function TDISKSN.Change2Ring0:string;
begin
  result:='';
  try
  asm
      mov   eax, offset Ring0Proc
      mov   OurGate.off2, ax  // 将中断函数的地址
      shr   eax, 16   // 填入新造的中断门
      mov   OurGate.off1, ax // 描述符
      mov   OurGate.op,0028h
      mov   OurGate.seg1,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 dd1[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;
   result:=dsn;
   except
   end;
end;

function TDISKSN.ScsiHddSerialNumber(i:smallint) : String;
{$ALIGN ON}
type
TScsiPassThrough = record
Length          : Word;
ScsiStatus         : Byte;
PathId          : Byte;
TargetId          : Byte;
Lun          : Byte;
CdbLength          : Byte;
SenseInfoLength    : Byte;
DataIn          : Byte;
DataTransferLength : ULONG;
TimeOutValue       : ULONG;
DataBufferOffset   : DWORD;
SenseInfoOffset    : ULONG;
Cdb          : Array[0..15] of Byte;
end;
TScsiPassThroughWithBuffers = record
spt : TScsiPassThrough;
bSenseBuf : Array[0..31] of Byte;
bDataBuf : Array[0..191] of Byte;
end;
{ALIGN OFF}
var dwReturned : DWORD;
    len : DWORD;
    Buffer : Array[0..SizeOf(TScsiPassThroughWithBuffers)+SizeOf(TScsiPassThrough)-1] of Byte;
    sptwb : TScsiPassThroughWithBuffers absolute Buffer;
    hDevice:thandle;
begin
   if SysUtils.win32Platform=2 then
   begin
      if i=0 then hDevice := CreateFile( '\\.\PhysicalDrive0',
        GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ or FILE_SHARE_WRITE,
        nil, OPEN_EXISTING, 0, 0 )
      else hDevice := CreateFile( '\\.\PhysicalDrive1',
        GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ or FILE_SHARE_WRITE,
        nil, OPEN_EXISTING, 0, 0 );
   end
   else exit;
   if hDevice=invalid_handle_value then exit;
   Result := '';
   try
FillChar(Buffer,SizeOf(Buffer),#0);
with sptwb.spt do
begin
Length   := SizeOf(TScsiPassThrough);
CdbLength := 6; // CDB6GENERIC_LENGTH
SenseInfoLength := 24;
DataIn := 1; // SCSI_IOCTL_DATA_IN
DataTransferLength := 192;
TimeOutValue := 2;
DataBufferOffset := PChar(@sptwb.bDataBuf)-PChar(@sptwb);
SenseInfoOffset := PChar(@sptwb.bSenseBuf)-PChar(@sptwb);
Cdb[0] := $12; // OperationCode := SCSIOP_INQUIRY;
Cdb[1] := $01; // Flags := CDB_INQUIRY_EVPD;  Vital product data
Cdb[2] := $80; // PageCode          Unit serial number
Cdb[4] := 192; // AllocationLength
end;
len := sptwb.spt.DataBufferOffset+sptwb.spt.DataTransferLength;
if DeviceIoControl( hDevice, $0004d004, @sptwb, SizeOf(TScsiPassThrough), @sptwb, len, dwReturned, nil )
and ((PChar(@sptwb.bDataBuf)+1)^=#$80)
then SetString( Result, PChar(@sptwb.bDataBuf)+4, Ord((PChar(@sptwb.bDataBuf)+3)^) );
   except
   end;
end;

function TDISKSN.GetCPUSpeed: Double;
const
  DelayTime = 500; // 时间单位是毫秒
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
     PriorityClass := GetPriorityClass(GetCurrentProcess);
     Priority := GetThreadPriority(GetCurrentThread);
     SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
     SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
     Sleep(10);
     asm
        dw 310Fh // rdtsc
        mov TimerLo, eax
        mov TimerHi, edx
     end;
     Sleep(DelayTime);
     asm
        dw 310Fh // rdtsc
        sub eax, TimerLo
        sbb edx, TimerHi
        mov TimerLo, eax
        mov TimerHi, edx
     end;

     SetThreadPriority(GetCurrentThread, Priority);
     SetPriorityClass(GetCurrentProcess, PriorityClass);
     Result := TimerLo / (1000.0 * DelayTime);
end;

function TDISKSN.NBGetAdapterAddress(a: integer): string;
//a指定多个网卡适配器中的哪一个0,1,2...
var NCB: TNCB; // Netbios control block file ://NetBios控制块
    ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取网卡状态
    LANAENUM: TLANAENUM;     // Netbios lana
    intIdx: Integer;         // Temporary work value//临时变量
    cRC: Char;          // Netbios return code//NetBios返回值
    strTemp: string;         // Temporary string//临时变量
begin
    // Initialize
    Result := '';
    try
       // Zero control blocl
       ZeroMemory(@NCB,SizeOf(NCB));
       // Issue enum command
       NCB.ncb_command := Chr(NCBENUM);
       cRC := NetBios(@NCB);
       // Reissue enum command
       NCB.ncb_buffer := @LANAENUM;
       NCB.ncb_length := SizeOf(LANAENUM);
       cRC := NetBios(@NCB);
       if Ord(cRC) <> 0 then exit;
       // Reset adapter
       ZeroMemory(@NCB,SizeOf(NCB));
       NCB.ncb_command := Chr(NCBRESET);
       NCB.ncb_lana_num := LANAENUM.lana[a];
       cRC := NetBios(@NCB);
       if Ord(cRC) <> 0 then exit;
       // Get adapter address
       ZeroMemory(@NCB,sizeOf(NCB));
       NCB.ncb_command := Chr(NCBASTAT);
       NCB.ncb_lana_num := LANAENUM.lana[a];
       StrPCopy(NCB.ncb_callname,'*');
       NCB.ncb_buffer := @ADAPTER;
       NCB.ncb_length := SizeOf(ADAPTER);
       cRC := NetBios(@NCB);
      // Convert it to string
       strTemp := '';
       for intIdx := 0 to 5 do
         strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]),2);
       Result := strTemp;
   finally
   end;
end;

end.
----------------------------------------------
-

作者：

sjh2003 (单翼天使)	★☆☆☆☆	-
	普通会员

2005/7/12 3:08:38

7楼：

下载了看看，谢谢楼主
----------------------------------------------
学海无涯，苦作舟；苦海无边，回头是岸？

信息

登陆以后才能回复