Question

asp如何读取客户端硬盘序列号

我想让ASP读取客户端电脑的机硬码，如果有人知道，请帮忙，答案满意将追加分。
是否可以通过写成dll文件进行调用,然后读取?

Answer 1

　　希望我找的这点东西对你有帮助！

　　使用以下这段代码生成dll只能读取服务器的硬盘序列号，
　　不知大家有没有什么好的方法或建议来读取客户端的！

　　[Copy to clipboard] [ - ]CODE:
　　Option Explicit
　　'以下这一行是必须的，困为要做结构复制。而结构中有数组。所以，没有它则会错位
　　Option Base 0
　　Private Const DFP_GET_VERSION = &H74080
　　Private Const DFP_SEND_DRIVE_COMMAND = &H7C084
　　Private Const DFP_RECEIVE_DRIVE_DATA = &H7C088
　　'#pragma pack(1)
　　Private Type TGETVERSIONOUTPARAMS '{
　　bVersion As Byte 'Binary driver version.
　　bRevision As Byte 'Binary driver revision.
　　bReserved As Byte 'Not used.
　　bIDEDeviceMap As Byte 'Bit map of IDE devices.
　　fCapabilities As Long 'Bit mask of driver capabilities.
　　dwReserved(4) As Long 'For future use.
　　End Type
　　Private Type TIDEREGS
　　bFeaturesReg As Byte 'Used for specifying SMART "commands".
　　bSectorCountReg As Byte 'IDE sector count register
　　bSectorNumberReg As Byte 'IDE sector number register
　　bCylLowReg As Byte 'IDE low order cylinder value
　　bCylHighReg As Byte 'IDE high order cylinder value
　　bDriveHeadReg As Byte 'IDE drive/head register
　　bCommandReg As Byte 'Actual IDE command.
　　bReserved As Byte 'reserved for future use. Must be zero.
　　End Type
　　Private Type TSENDCMDINPARAMS
　　cBufferSize As Long 'Buffer size in bytes
　　irDriveRegs As TIDEREGS 'Structure with drive register values.
　　bDriveNumber As Byte 'Physical drive number to send 'command to (0,1,2,3).
　　bReserved(2) As Byte 'Reserved for future expansion.
　　dwReserved(3) As Long 'For future use.
　　''BYTE bBuffer(1) 'Input buffer.
　　End Type
　　Private Type TDRIVERSTATUS
　　bDriverError As Byte 'Error code from driver, 'or 0 if no error.
　　bIDEStatus As Byte 'Contents of IDE Error register.
　　'Only valid when bDriverError 'is SMART_IDE_ERROR.
　　bReserved(1) As Byte 'Reserved for future expansion.
　　dwReserved(1) As Long 'Reserved for future expansion.
　　End Type
　　Private Type TSENDCMDOUTPARAMS
　　cBufferSize As Long 'Size of bBuffer in bytes
　　DRIVERSTATUS As TDRIVERSTATUS 'Driver status structure.
　　bBuffer(511) As Byte 'Buffer of arbitrary length
　　'in which to store the data read from the drive.
　　End Type
　　'下面的结构是要从另一结构复制数据过来的，所以，必须是字节数与VC的完全一致
　　'而不能用兼容变量，但这里的我们还是用了兼容变量，Integer,因为此结构中这一
　　'类型的的变量程序中没有用到，如果要用到，建议改为Byte类型。因为VB没有USHORT
　　Private Type TIDSECTOR
　　wGenConfig As Integer
　　wNumCyls As Integer
　　wReserved As Integer
　　wNumHeads As Integer
　　wBytesPerTrack As Integer
　　wBytesPerSector As Integer
　　wSectorsPerTrack As Integer
　　wVendorUnique(2) As Integer
　　sSerialNumber(19) As Byte
　　wBufferType As Integer
　　wBufferSize As Integer
　　wECCSize As Integer
　　sFirmwareRev(7) As Byte
　　sModelNumber(39) As Byte
　　wMoreVendorUnique As Integer
　　wDoubleWordIO As Integer
　　wCapabilities As Integer
　　wReserved1 As Integer
　　wPIOTiming As Integer
　　wDMATiming As Integer
　　wBS As Integer
　　wNumCurrentCyls As Integer
　　wNumCurrentHeads As Integer
　　wNumCurrentSectorsPerTrack As Integer
　　ulCurrentSectorCapacity(3) As Byte '这里只能用byte，因为VB没有无符号的LONG型变量
　　wMultSectorStuff As Integer
　　ulTotalAddressableSectors(3) As Byte '这里只能用byte，因为VB没有无符号的LONG型变量
　　wSingleWordDMA As Integer
　　wMultiWordDMA As Integer
　　bReserved(127) As Byte
　　End Type
　　'/*+++
　　'Global vars
　　'---*/
　　Private vers As TGETVERSIONOUTPARAMS
　　Private in_data As TSENDCMDINPARAMS
　　Private out_data As TSENDCMDOUTPARAMS
　　Private h As Long
　　Private i As Long
　　Private j As Byte
　　Private Type OSVERSIONINFO
　　dwOSVersionInfoSize As Long
　　dwMajorVersion As Long
　　dwMinorVersion As Long
　　dwBuildNumber As Long
　　dwPlatformId As Long
　　szCSDVersion As String * 128
　　End Type
　　Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
　　(LpVersionInformation As OSVERSIONINFO) As Long
　　Private Const VER_PLATFORM_WIN32S = 0
　　Private Const VER_PLATFORM_WIN32_WINDOWS = 1
　　Private Const VER_PLATFORM_WIN32_NT = 2
　　Private Declare Function CreateFile Lib "kernel32" _
　　Alias "CreateFileA" (ByVal lpFileName As String, _
　　ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
　　ByVal lpSecurityAttributes As Long, _
　　ByVal dwCreationDisposition As Long, _
　　ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) _
　　As Long
　　Private Const CREATE_NEW = 1
　　Private Const GENERIC_READ = &H80000000
　　Private Const GENERIC_WRITE = &H40000000
　　Private Const OPEN_EXISTING = 3
　　Private Const FILE_SHARE_READ = &H1
　　Private Const FILE_SHARE_WRITE = &H2
　　Private Type OVERLAPPED
　　Internal As Long
　　InternalHigh As Long
　　offset As Long
　　OffsetHigh As Long
　　hEvent As Long
　　End Type
　　Private Declare Function DeviceIoControl Lib "kernel32" _
　　(ByVal hDevice As Long, ByVal dwIoControlCode As Long, _
　　lpInBuffer As Any, ByVal nInBufferSize As Long, _
　　lpOutBuffer As Any, ByVal nOutBufferSize As Long, _
　　lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long
　　Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
　　Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
　　hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
　　Sub ChangeByteOrder(szString() As Byte, uscStrSize As Long)
　　Dim i As Long
　　Dim temp As String
　　For i = 0 To uscStrSize - 1 Step 2
　　temp = szString(i)
　　szString(i) = szString(i + 1)
　　szString(i + 1) = temp
　　Next i
　　End Sub
　　Private Function hdid9x() As String
　　'We start in 95/98/Me
　　h = CreateFile("\\.\Smartvsd", 0, 0, 0, CREATE_NEW, 0, 0)
　　If h = 0 Then
　　hdid9x = "open smartvsd.vxd failed"
　　Exit Function
　　End If
　　Dim olp As OVERLAPPED
　　Dim lRet As Long
　　lRet = DeviceIoControl(h, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal i, olp)
　　If lRet = 0 Then
　　hdid9x = "DeviceIoControl failed:DFP_GET_VERSION"
　　CloseHandle (h)
　　Exit Function
　　End If
　　'If IDE identify command not supported, fails
　　If (vers.fCapabilities And 1) <> 1 Then
　　hdid9x = "Error: IDE identify command not supported."
　　CloseHandle (h)
　　Exit Function
　　End If
　　'Display IDE drive number detected
　　Dim sPreOutStr As String
　　sPreOutStr = DetectIDE(vers.bIDEDeviceMap)
　　hdid9x = sPreOutStr
　　'Identify the IDE drives
　　For j = 0 To 0 '这里取1个硬盘的信息，个数随自己定，因为正常PC不超过1个硬盘：）
　　Dim phdinfo As TIDSECTOR
　　Dim s(40) As Byte

　　If (j And 1) = 1 Then
　　in_data.irDriveRegs.bDriveHeadReg = &HB0
　　Else
　　in_data.irDriveRegs.bDriveHeadReg = &HA0
　　End If
　　If (vers.fCapabilities And (16 \ (2 ^ j))) = (16 \ (2 ^ j)) Then
　　'We don't detect a ATAPI device.
　　hdid9x = "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
　　Else
　　in_data.irDriveRegs.bCommandReg = &HEC
　　in_data.bDriveNumber = j
　　in_data.irDriveRegs.bSectorCountReg = 1
　　in_data.irDriveRegs.bSectorNumberReg = 1
　　in_data.cBufferSize = 512

　　lRet = DeviceIoControl(h, DFP_RECEIVE_DRIVE_DATA, in_data, Len(in_data), out_data, Len(out_data), ByVal i, olp)

　　If lRet = 0 Then
　　hdid9x = "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
　　CloseHandle (h)
　　Exit Function
　　End If

　　Dim StrOut As String

　　CopyMemory phdinfo, out_data.bBuffer(0), Len(phdinfo)

　　'CopyMemory s(0), phdinfo.sModelNumber(0), 40
　　's(40) = 0
　　'ChangeByteOrder s, 40

　　'StrOut = ByteArrToString(s, 40)

　　' hdid9x = hdid9x & vbCrLf & "Module Number:" & StrOut
　　'CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
　　' s(8) = 0
　　'ChangeByteOrder s, 8

　　'StrOut = ByteArrToString(s, 8)

　　'hdid9x = hdid9x & vbCrLf & "Firmware rev:" & StrOut
　　CopyMemory s(0), phdinfo.sSerialNumber(0), 20
　　s(20) = 0
　　ChangeByteOrder s, 20

　　StrOut = ByteArrToString(s, 20)
　　hdid9x = StrOut
　　'hdid9x = hdid9x & vbCrLf & "Serial Number:" & StrOut

　　' CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4

　　's(5) = 0
　　'Dim dblStrOut As Double
　　'dblStrOut = ByteArrToLong(s)
　　'hdid9x = hdid9x & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M"
　　End If
　　Next j
　　'Close handle before quit
　　CloseHandle (h)
　　End Function
　　Private Function hdidnt() As String
　　Dim hd As String * 80
　　Dim phdinfo As TIDSECTOR
　　Dim s(40) As Byte
　　Dim StrOut As String
　　hdidnt = ""
　　'We start in NT/Win2000
　　For j = 0 To 0 '这里取1个硬盘的信息，个数随自己定，因为正常PC不超过1个硬盘：）
　　hd = "\\.\PhysicalDrive" & CStr(j)
　　hdidnt = hdidnt & vbCrLf & hd
　　h = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, _
　　FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)

　　Dim olpv As OVERLAPPED

　　Dim lRet As Long
　　lRet = DeviceIoControl(h, DFP_GET_VERSION, ByVal 0&, 0, vers, Len(vers), ByVal i, olpv)

　　If lRet = 0 Then
　　CloseHandle (h)
　　Else
　　'If IDE identify command not supported, fails
　　If (vers.fCapabilities And 1) <> 1 Then
　　hdidnt = "Error: IDE identify command not supported."
　　CloseHandle (h)
　　Exit Function
　　End If
　　'Identify the IDE drives
　　If (j And 1) = 1 Then
　　in_data.irDriveRegs.bDriveHeadReg = &HB0
　　Else
　　in_data.irDriveRegs.bDriveHeadReg = &HA0
　　End If
　　If (vers.fCapabilities And (16 \ (2 ^ j))) <> 0 Then
　　'We don't detect a ATAPI device.
　　hdidnt = hdidnt & vbCrLf & "Drive " & CStr(j + 1) & " is a ATAPI device, we don't detect it"
　　Else

　　in_data.irDriveRegs.bCommandReg = &HEC
　　in_data.bDriveNumber = j
　　in_data.irDriveRegs.bSectorCountReg = 1
　　in_data.irDriveRegs.bSectorNumberReg = 1
　　in_data.cBufferSize = 512

　　Dim olpr As OVERLAPPED

　　lRet = DeviceIoControl(h, DFP_RECEIVE_DRIVE_DATA, in_data, Len(in_data), out_data, Len(out_data), ByVal i, olpr)
　　If lRet <= 0 Then
　　hdidnt = hdidnt & vbCrLf & "DeviceIoControl failed:DFP_RECEIVE_DRIVE_DATA"
　　CloseHandle (h)

　　Else

　　'**************************************************************
　　'******为了得到硬盘序列号，所以把其余的硬盘信息去掉了***********
　　'***************************************************************
　　CopyMemory phdinfo, out_data.bBuffer(0), Len(phdinfo)

　　' CopyMemory s(0), phdinfo.sModelNumber(0), 40
　　's(40) = 0
　　'ChangeByteOrder s, 40

　　'StrOut = ByteArrToString(s, 40)

　　'hdidnt = hdidnt & vbCrLf & "Module Number:" & StrOut
　　'CopyMemory s(0), phdinfo.sFirmwareRev(0), 8
　　's(8) = 0
　　'ChangeByteOrder s, 8

　　'StrOut = ByteArrToString(s, 8)

　　'hdidnt = hdidnt & vbCrLf & "Firmware rev:" & StrOut
　　CopyMemory s(0), phdinfo.sSerialNumber(0), 20
　　s(20) = 0
　　ChangeByteOrder s, 20

　　StrOut = ByteArrToString(s, 20)
　　hdidnt = StrOut
　　'hdidnt = hdidnt & vbCrLf & "Serial Number:" & StrOut

　　'CopyMemory s(0), phdinfo.ulTotalAddressableSectors(0), 4
　　's(5) = 0
　　'Dim dblStrOut As Double
　　'dblStrOut = ByteArrToLong(s)

　　' hdidnt = hdidnt & vbCrLf & "Capacity:" & dblStrOut / 2 / 1024 & "M"
　　CloseHandle (h)
　　End If
　　End If
　　End If
　　Next j
　　End Function
　　Public Function GetDiskID() ' As String
　　Dim verinfo As OSVERSIONINFO
　　Dim Ret As Long
　　verinfo.dwOSVersionInfoSize = Len(verinfo)
　　Ret = GetVersionEx(verinfo)
　　Dim OutStr As String
　　Select Case verinfo.dwPlatformId
　　Case VER_PLATFORM_WIN32S
　　GetDiskID = "Win32s is not supported by this programm."
　　'MsgBox "Win32s is not supported by this programm."
　　'End
　　Case VER_PLATFORM_WIN32_WINDOWS
　　GetDiskID = hdid9x
　　'OutStr = hdid9x
　　'MsgBox OutStr
　　'End
　　Case VER_PLATFORM_WIN32_NT
　　GetDiskID = hdidnt
　　'OutStr = hdidnt
　　'MsgBox OutStr
　　'End
　　End Select
　　End Function
　　Private Function DetectIDE(bIDEDeviceMap As Byte) As String
　　If (bIDEDeviceMap And 1) Then
　　If (bIDEDeviceMap And 16) Then
　　DetectIDE = DetectIDE & "ATAPI device is attached to primary controller, drive 0."
　　Else
　　DetectIDE = DetectIDE & "IDE device is attached to primary controller, drive 0."
　　End If
　　End If
　　If (bIDEDeviceMap And 2) Then
　　If (bIDEDeviceMap And 32) Then
　　DetectIDE = DetectIDE & "ATAPI device is attached to primary controller, drive 1."
　　Else
　　DetectIDE = DetectIDE & "IDE device is attached to primary controller, drive 1."
　　End If
　　End If
　　If (bIDEDeviceMap And 4) Then
　　If (bIDEDeviceMap And 64) Then
　　DetectIDE = DetectIDE & "ATAPI device is attached to secondary controller, drive 0."
　　Else
　　DetectIDE = DetectIDE & "IDE device is attached to secondary controller, drive 0."
　　End If
　　End If
　　If (bIDEDeviceMap And 8) Then
　　If (bIDEDeviceMap And 128) Then
　　DetectIDE = DetectIDE & "ATAPI device is attached to secondary controller, drive 1."
　　Else
　　DetectIDE = DetectIDE & "IDE device is attached to secondary controller, drive 1."
　　End If
　　End If
　　End Function
　　Private Function ByteArrToString(inByte() As Byte, ByVal strlen As Integer) As String
　　Dim i As Integer
　　For i = 0 To strlen
　　If inByte(i) = 0 Then
　　Exit For
　　End If
　　ByteArrToString = ByteArrToString & Chr(inByte(i))
　　Next i
　　End Function
　　Private Function ByteArrToLong(inByte() As Byte) As Double
　　Dim i As Integer
　　For i = 0 To 3
　　ByteArrToLong = ByteArrToLong + CDbl(inByte(i)) * (256 ^ i)
　　Next i

　　End Function