这里有一个例子'通过硬盘序列号和文本文件获得到机器码 Public Function MachineID() As String
Dim MachId As Long Dim txtname As String Dim TempStr1 As String * 256 Dim TempStr2 As String * 256 Dim TempLon1 As Long Dim TempLon2 As Long textname = App.Path & "\filereg.asp"
to lilaclone(~~阿九~~) : [email protected] 谢谢先!to sinom(毛毛.小狮子) : 哈哈,是啊.老搞不出来.
Public Declare Function GetVolumeInformation Lib "kernel32" _ Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _ ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _ lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _ lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _ ByVal nFileSystemNameSize As Long) As Long '得到某一磁盘分区的信息,如C: 窗体代码如下: Option Explicit Private Regid, Localid As Long Private Sub CmdLocalID_Click() '根据C盘序列号得到原ID Dim Driver, VolName, Fsys As String Dim volNumber, MCM, FSF As Long Driver = "c:\" Dim res As Long res = GetVolumeInformation(Driver, VolName, 127, volNumber, MCM, FSF, Fsys, 127) 'volNumber是C盘序列号 Text1.Text = VolName End Sub
'-------------------------------------------------------------------------- ' 模 块: 取磁盘硬件信息处理类 ' 文件名: CDiskInfo.cls ' 作者: 林天炮 ' 注意事项:支持Windows 95 OSR2, Windows 98, Windows NT, Windows 2000 ' Windows XP,在Win9X下必须保证存在SMARTVSD.vxd,不支持SCSI硬盘 '-------------------------------------------------------------------------- Private Const MAX_IDE_DRIVES As Long = 4 ' Max number of drives assuming primary/secondary, master/slave topology Private Const READ_ATTRIBUTE_BUFFER_SIZE As Long = 512 Private Const IDENTIFY_BUFFER_SIZE As Long = 512 Private Const READ_THRESHOLD_BUFFER_SIZE As Long = 512Private Const DFP_GET_VERSION As Long = &H74080 Private Const DFP_SEND_DRIVE_COMMAND As Long = &H7C084 Private Const DFP_RECEIVE_DRIVE_DATA As Long = &H7C088Private Type GETVERSIONOUTPARAMS 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(3) As Long ' For future use. End TypePrivate Const CAP_IDE_ID_FUNCTION As Long = 1 ' ATA ID command supported Private Const CAP_IDE_ATAPI_ID As Long = 2 ' ATAPI ID command supported Private Const CAP_IDE_EXECUTE_SMART_FUNCTION As Long = 4 ' SMART commannds supported Private Type IDEREGS 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 TypePrivate Type SENDCMDINPARAMS cBufferSize As Long ' Buffer size in bytes irDriveRegs As IDEREGS ' 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. bBuffer(0) As Byte ' Input buffer. End TypePrivate Const IDE_ATAPI_ID As Long = &HA1 ' Returns ID sector for ATAPI. Private Const IDE_ID_FUNCTION As Long = &HEC ' Returns ID sector for ATA. Private Const IDE_EXECUTE_SMART_FUNCTION As Long = &HB0 ' Performs SMART cmd. Private Const SMART_CYL_LOW As Long = &H4F Private Const SMART_CYL_HI As Long = &HC2Private Type DRIVERSTATUS bDriverError As Byte ' Error code from driver, ' or 0 if no error. bIDEStatus As Byte ' Contents of IDE Error register. bReserved(1) As Byte ' Reserved for future expansion. dwReserved(1) As Long ' Reserved for future expansion. End Type Private Const SMART_NO_ERROR As Long = 0 ' No error Private Const SMART_IDE_ERROR As Long = 1 ' Error from IDE controller Private Const SMART_INVALID_FLAG As Long = 2 ' Invalid command flag Private Const SMART_INVALID_COMMAND As Long = 3 ' Invalid command byte Private Const SMART_INVALID_BUFFER As Long = 4 ' Bad buffer (null, invalid addr..) Private Const SMART_INVALID_DRIVE As Long = 5 ' Drive number not valid Private Const SMART_INVALID_IOCTL As Long = 6 ' Invalid IOCTL Private Const SMART_ERROR_NO_MEM As Long = 7 ' Could not lock user's buffer Private Const SMART_INVALID_REGISTER As Long = 8 ' Some IDE Register not valid Private Const SMART_NOT_SUPPORTED As Long = 9 ' Invalid cmd flag set Private Const SMART_NO_IDE_DEVICE As Long = 10 ' Cmd issued to device not present Private Type SENDCMDOUTPARAMS cBufferSize As Long ' Size of bBuffer in bytes drvStatus As DRIVERSTATUS ' Driver status structure. bBuffer(0) As Byte ' Buffer of arbitrary length in which to store the data read from the ' drive. End Type Private Const SMART_READ_ATTRIBUTE_VALUES As Long = &HD0 ' ATA4: Renamed ' SMART READ DATA Private Const SMART_READ_ATTRIBUTE_THRESHOLDS As Long = &HD1 ' Obsoleted in ATA4! Private Const SMART_ENABLE_DISABLE_ATTRIBUTE_AUTOSAVE As Long = &HD2 Private Const SMART_SAVE_ATTRIBUTE_VALUES As Long = &HD3 Private Const SMART_EXECUTE_OFFLINE_IMMEDIATE As Long = &HD4 ' ATA4 ' Vendor specific commands: Private Const SMART_ENABLE_SMART_OPERATIONS As Long = &HD8 Private Const SMART_DISABLE_SMART_OPERATIONS As Long = &HD9 Private Const SMART_RETURN_SMART_STATUS As Long = &HDA Private Type DRIVEATTRIBUTE bAttrID As Byte ' Identifies which attribute wStatusFlags As Integer ' see bit definitions below bAttrValue As Byte ' Current normalized value bWorstValue As Byte ' How bad has it ever been? bRawValue(5) As Byte ' Un-normalized value bReserved As Byte ' ... End TypePrivate Type ATTRTHRESHOLD bAttrID As Byte ' Identifies which attribute bWarrantyThreshold As Byte ' Triggering value bReserved(9) As Byte ' ... End Type'-------------------------------------------------------- Private Type IDSECTOR 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 TypePrivate Const ATTR_INVALID As Long = 0 Private Const ATTR_READ_ERROR_RATE As Long = 1 Private Const ATTR_THROUGHPUT_PERF As Long = 2 Private Const ATTR_SPIN_UP_TIME As Long = 3 Private Const ATTR_START_STOP_COUNT As Long = 4 Private Const ATTR_REALLOC_SECTOR_COUNT As Long = 5 Private Const ATTR_READ_CHANNEL_MARGIN As Long = 6 Private Const ATTR_SEEK_ERROR_RATE As Long = 7 Private Const ATTR_SEEK_TIME_PERF As Long = 8 Private Const ATTR_POWER_ON_HRS_COUNT As Long = 9 Private Const ATTR_SPIN_RETRY_COUNT As Long = 10 Private Const ATTR_CALIBRATION_RETRY_COUNT As Long = 11 Private Const ATTR_POWER_CYCLE_COUNT As Long = 12 Private Const PRE_FAILURE_WARRANTY As Long = &H1 Private Const ON_LINE_COLLECTION As Long = &H2 Private Const PERFORMANCE_ATTRIBUTE As Long = &H4 Private Const ERROR_RATE_ATTRIBUTE As Long = &H8 Private Const EVENT_COUNT_ATTRIBUTE As Long = &H10 Private Const SELF_PRESERVING_ATTRIBUTE As Long = &H20Private Const NUM_ATTRIBUTE_STRUCTS As Long = 30Private Const INVALID_HANDLE_VALUE As Long = -1Private Const VER_PLATFORM_WIN32s As Long = 0 Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1 Private Const VER_PLATFORM_WIN32_NT As Long = 2 Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 ' Maintenance string for PSS usage End Type Private Declare Function GetVersionEx Lib "KERNEL32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
接上////////////////////////Private Const CREATE_NEW As Long = 1 Private Const GENERIC_READ As Long = &H80000000 Private Const GENERIC_WRITE As Long = &H40000000 Private Const FILE_SHARE_READ As Long = &H1 Private Const FILE_SHARE_WRITE As Long = &H2 Private Const OPEN_EXISTING As Long = 3 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 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, ByVal lpOverlapped As Long) As Long Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long Private m_DiskInfo As IDSECTOR Private Function OpenSMART(ByVal nDrive As Byte) As Long Dim hSMARTIOCTL As Long Dim hd As String Dim VersionInfo As OSVERSIONINFO hSMARTIOCTL = INVALID_HANDLE_VALUE VersionInfo.dwOSVersionInfoSize = Len(VersionInfo) GetVersionEx VersionInfo Select Case VersionInfo.dwPlatformId Case VER_PLATFORM_WIN32s OpenSMART = hSMARTIOCTL Case VER_PLATFORM_WIN32_WINDOWS ' Version Windows 95 OSR2, Windows 98 hSMARTIOCTL = CreateFile("\\.\SMARTVSD", 0, 0, 0, CREATE_NEW, 0, 0) Case VER_PLATFORM_WIN32_NT ' Windows NT, Windows 2000 If nDrive < MAX_IDE_DRIVES Then hd = "\\.\PhysicalDrive" & nDrive hSMARTIOCTL = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0) End If End Select OpenSMART = hSMARTIOCTLEnd Function Private Function DoIDENTIFY(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP() As Byte, ByVal bIDCmd As Byte, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE pSCIP.irDriveRegs.bFeaturesReg = 0 pSCIP.irDriveRegs.bSectorCountReg = 1 pSCIP.irDriveRegs.bSectorNumberReg = 1 pSCIP.irDriveRegs.bCylLowReg = 0 pSCIP.irDriveRegs.bCylHighReg = 0 ' ' Compute the drive number. ' pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4) ' ' The command can either be IDE identify or ATAPI identify. ' pSCIP.irDriveRegs.bCommandReg = bIDCmd pSCIP.bDriveNumber = bDriveNum pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE DoIDENTIFY = CBool(DeviceIoControl(hSMARTIOCTL, DFP_RECEIVE_DRIVE_DATA, _ pSCIP, 32, _ pSCOP(0), 528, _ lpcbBytesReturned, 0))End Function '------------------------------------------ Private Function DoEnableSMART(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP As SENDCMDOUTPARAMS, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean pSCIP.cBufferSize = 0 pSCIP.irDriveRegs.bFeaturesReg = SMART_ENABLE_SMART_OPERATIONS pSCIP.irDriveRegs.bSectorCountReg = 1 pSCIP.irDriveRegs.bSectorNumberReg = 1 pSCIP.irDriveRegs.bCylLowReg = SMART_CYL_LOW pSCIP.irDriveRegs.bCylHighReg = SMART_CYL_HI ' ' Compute the drive number. ' pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4) pSCIP.irDriveRegs.bCommandReg = IDE_EXECUTE_SMART_FUNCTION pSCIP.bDriveNumber = bDriveNum DoEnableSMART = CBool(DeviceIoControl(hSMARTIOCTL, DFP_SEND_DRIVE_COMMAND, _ pSCIP, LenB(pSCIP) - 1, _ pSCOP, LenB(pSCOP) - 1, _ lpcbBytesReturned, 0))End Function Private Sub ChangeByteOrder(szString() As Byte, ByVal uscStrSize As Integer) Dim i As Integer Dim bTemp As Byte For i = 0 To uscStrSize - 1 Step 2 bTemp = szString(i) szString(i) = szString(i + 1) szString(i + 1) = bTemp Next iEnd Sub Private Sub DisplayIdInfo(pids As IDSECTOR, pSCIP As SENDCMDINPARAMS, ByVal bIDCmd As Byte, ByVal bDfpDriveMap As Byte, ByVal bDriveNum As Byte) ChangeByteOrder pids.sModelNumber, UBound(pids.sModelNumber) + 1 ChangeByteOrder pids.sFirmwareRev, UBound(pids.sFirmwareRev) + 1 ChangeByteOrder pids.sSerialNumber, UBound(pids.sSerialNumber) + 1End SubPublic Function GetDiskInfo(ByVal nDrive As Byte) As Long Dim hSMARTIOCTL As Long Dim cbBytesReturned As Long Dim VersionParams As GETVERSIONOUTPARAMS Dim scip As SENDCMDINPARAMS Dim scop() As Byte Dim OutCmd As SENDCMDOUTPARAMS Dim bDfpDriveMap As Byte Dim bIDCmd As Byte ' IDE or ATAPI IDENTIFY cmd Dim uDisk As IDSECTOR m_DiskInfo = uDisk hSMARTIOCTL = OpenSMART(nDrive) If hSMARTIOCTL <> INVALID_HANDLE_VALUE Then Call DeviceIoControl(hSMARTIOCTL, DFP_GET_VERSION, ByVal 0, 0, VersionParams, Len(VersionParams), cbBytesReturned, 0) If Not (VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10) Then If DoEnableSMART(hSMARTIOCTL, scip, OutCmd, nDrive, cbBytesReturned) Then bDfpDriveMap = bDfpDriveMap Or 2 ^ nDrive End If End If bIDCmd = IIf((VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10), IDE_ATAPI_ID, IDE_ID_FUNCTION) ReDim scop(LenB(OutCmd) + IDENTIFY_BUFFER_SIZE - 1) As Byte If DoIDENTIFY(hSMARTIOCTL, scip, scop, bIDCmd, nDrive, cbBytesReturned) Then CopyMemory m_DiskInfo, scop(LenB(OutCmd) - 4), LenB(m_DiskInfo) Call DisplayIdInfo(m_DiskInfo, scip, bIDCmd, bDfpDriveMap, nDrive) CloseHandle hSMARTIOCTL GetDiskInfo = 1 Exit Function '>---> Bottom End If CloseHandle hSMARTIOCTL GetDiskInfo = 0 Else 'NOT HSMARTIOCTL... GetDiskInfo = -1 End IfEnd Function '--------------------------------------------- '硬盘生产厂/型号 Public Property Get pSerialNumber() As String pSerialNumber = StrConv(m_DiskInfo.sSerialNumber, vbUnicode) End Property'硬盘序列号 Public Property Get pModelNumber() As String pModelNumber = StrConv(m_DiskInfo.sModelNumber, vbUnicode) End Property
to :somecom(我承认都是月饼惹的祸 谢谢您,以前这种方法我也试过,但是在98下有时不行,不知你有没有碰到过.to 阿九: 谢谢,我已经收到了,正在测试中.
to 阿九:在一些还是只能取出一个ASC码为127与255的不可见字符串。 to somecom(我承认都是月饼惹的祸) (: 您的这个类我以前也用过,在win98下,就算有SMARTVSD.vxd也还是基本上取不到序列号。 to online(龙卷风V2.0--再战江湖) : 根据您提供的网址上找到的diskid32.dll和diskid.dll在98下有些机器也还是取不到。后来我想过取CPU的序列号,但是网上说只有P3的能取到。 网卡的MAC地址,找了很多方法,但是在98下有时也会失败,在2K下,如果存在多个连接的情况,有时出现取出的都为0的情况。 难道真的没有方法取到一台机器不变一唯一标识吗?期待......散分!
Public Function MachineID() As String
Dim MachId As Long
Dim txtname As String
Dim TempStr1 As String * 256
Dim TempStr2 As String * 256
Dim TempLon1 As Long
Dim TempLon2 As Long
textname = App.Path & "\filereg.asp"
If Dir(textname) = "" Then Exit Function
Call GetVolumeInformation("C:\", TempStr1, 256, Getval, TempLon1, TempLon2, TempStr2, 256)
MachId = Getval
'KeyGen为加密算法,你可以自己设计
MachineID = KeyGen(str(Abs(MachId)), ReadTxt(textname))
End Function
能否请您发这个DLL给我呢?我想在VB中应该是可以使用这个DLL的吧.
转自网上取得硬盘的出厂序列号:
http://www.csdn.net/Develop/read_article.asp?id=23995一个利用DLL实现获得CPU信息的代码,十分专业,不但可以获得CPU的速度、型号等,而且可以获得CPU的缓存大小、流水线数等等30多项CPU的特性,而且,带了DLL的VC源程序。推荐下载:
http://www.applevb.com/sourcecode/GetCPU.zip
在CSDN中也有提到.
如果你没有..给我EMAIL.我给你一个完整的例子[email protected]
注明:硬盘序列号.
[email protected] 谢谢先!to sinom(毛毛.小狮子) :
哈哈,是啊.老搞不出来.
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
'得到某一磁盘分区的信息,如C: 窗体代码如下:
Option Explicit
Private Regid, Localid As Long Private Sub CmdLocalID_Click()
'根据C盘序列号得到原ID
Dim Driver, VolName, Fsys As String
Dim volNumber, MCM, FSF As Long
Driver = "c:\"
Dim res As Long
res = GetVolumeInformation(Driver, VolName, 127, volNumber, MCM, FSF, Fsys, 127)
'volNumber是C盘序列号
Text1.Text = VolName
End Sub
已经给您发信,我的E妹:[email protected]
请也发一份给我,谢了!!
[email protected]
这个是一个利用微软提供的WMI实现获取系统信息的代码集合,包括获得系统信息、主板信息、BIOS信息等10个单独的源程序,推荐下载使用wmi试试
我要,请发一个给我看看,[email protected]
如果格式化后,这个结果值就会变的.
http://soft.winzheng.com/infoView/Article_1059.htm
' 模 块: 取磁盘硬件信息处理类
' 文件名: CDiskInfo.cls
' 作者: 林天炮
' 注意事项:支持Windows 95 OSR2, Windows 98, Windows NT, Windows 2000
' Windows XP,在Win9X下必须保证存在SMARTVSD.vxd,不支持SCSI硬盘
'--------------------------------------------------------------------------
Private Const MAX_IDE_DRIVES As Long = 4 ' Max number of drives assuming primary/secondary, master/slave topology
Private Const READ_ATTRIBUTE_BUFFER_SIZE As Long = 512
Private Const IDENTIFY_BUFFER_SIZE As Long = 512
Private Const READ_THRESHOLD_BUFFER_SIZE As Long = 512Private Const DFP_GET_VERSION As Long = &H74080
Private Const DFP_SEND_DRIVE_COMMAND As Long = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA As Long = &H7C088Private Type GETVERSIONOUTPARAMS
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(3) As Long ' For future use.
End TypePrivate Const CAP_IDE_ID_FUNCTION As Long = 1 ' ATA ID command supported
Private Const CAP_IDE_ATAPI_ID As Long = 2 ' ATAPI ID command supported
Private Const CAP_IDE_EXECUTE_SMART_FUNCTION As Long = 4 ' SMART commannds supported
Private Type IDEREGS
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 TypePrivate Type SENDCMDINPARAMS
cBufferSize As Long ' Buffer size in bytes
irDriveRegs As IDEREGS ' 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.
bBuffer(0) As Byte ' Input buffer.
End TypePrivate Const IDE_ATAPI_ID As Long = &HA1 ' Returns ID sector for ATAPI.
Private Const IDE_ID_FUNCTION As Long = &HEC ' Returns ID sector for ATA.
Private Const IDE_EXECUTE_SMART_FUNCTION As Long = &HB0 ' Performs SMART cmd.
Private Const SMART_CYL_LOW As Long = &H4F
Private Const SMART_CYL_HI As Long = &HC2Private Type DRIVERSTATUS
bDriverError As Byte ' Error code from driver,
' or 0 if no error.
bIDEStatus As Byte ' Contents of IDE Error register.
bReserved(1) As Byte ' Reserved for future expansion.
dwReserved(1) As Long ' Reserved for future expansion.
End Type
Private Const SMART_NO_ERROR As Long = 0 ' No error
Private Const SMART_IDE_ERROR As Long = 1 ' Error from IDE controller
Private Const SMART_INVALID_FLAG As Long = 2 ' Invalid command flag
Private Const SMART_INVALID_COMMAND As Long = 3 ' Invalid command byte
Private Const SMART_INVALID_BUFFER As Long = 4 ' Bad buffer (null, invalid addr..)
Private Const SMART_INVALID_DRIVE As Long = 5 ' Drive number not valid
Private Const SMART_INVALID_IOCTL As Long = 6 ' Invalid IOCTL
Private Const SMART_ERROR_NO_MEM As Long = 7 ' Could not lock user's buffer
Private Const SMART_INVALID_REGISTER As Long = 8 ' Some IDE Register not valid
Private Const SMART_NOT_SUPPORTED As Long = 9 ' Invalid cmd flag set
Private Const SMART_NO_IDE_DEVICE As Long = 10 ' Cmd issued to device not present
Private Type SENDCMDOUTPARAMS
cBufferSize As Long ' Size of bBuffer in bytes
drvStatus As DRIVERSTATUS ' Driver status structure.
bBuffer(0) As Byte ' Buffer of arbitrary length in which to store the data read from the ' drive.
End Type
Private Const SMART_READ_ATTRIBUTE_VALUES As Long = &HD0 ' ATA4: Renamed
' SMART READ DATA
Private Const SMART_READ_ATTRIBUTE_THRESHOLDS As Long = &HD1 ' Obsoleted in ATA4!
Private Const SMART_ENABLE_DISABLE_ATTRIBUTE_AUTOSAVE As Long = &HD2
Private Const SMART_SAVE_ATTRIBUTE_VALUES As Long = &HD3
Private Const SMART_EXECUTE_OFFLINE_IMMEDIATE As Long = &HD4 ' ATA4
' Vendor specific commands:
Private Const SMART_ENABLE_SMART_OPERATIONS As Long = &HD8
Private Const SMART_DISABLE_SMART_OPERATIONS As Long = &HD9
Private Const SMART_RETURN_SMART_STATUS As Long = &HDA
Private Type DRIVEATTRIBUTE
bAttrID As Byte ' Identifies which attribute
wStatusFlags As Integer ' see bit definitions below
bAttrValue As Byte ' Current normalized value
bWorstValue As Byte ' How bad has it ever been?
bRawValue(5) As Byte ' Un-normalized value
bReserved As Byte ' ...
End TypePrivate Type ATTRTHRESHOLD
bAttrID As Byte ' Identifies which attribute
bWarrantyThreshold As Byte ' Triggering value
bReserved(9) As Byte ' ...
End Type'--------------------------------------------------------
Private Type IDSECTOR
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 TypePrivate Const ATTR_INVALID As Long = 0
Private Const ATTR_READ_ERROR_RATE As Long = 1
Private Const ATTR_THROUGHPUT_PERF As Long = 2
Private Const ATTR_SPIN_UP_TIME As Long = 3
Private Const ATTR_START_STOP_COUNT As Long = 4
Private Const ATTR_REALLOC_SECTOR_COUNT As Long = 5
Private Const ATTR_READ_CHANNEL_MARGIN As Long = 6
Private Const ATTR_SEEK_ERROR_RATE As Long = 7
Private Const ATTR_SEEK_TIME_PERF As Long = 8
Private Const ATTR_POWER_ON_HRS_COUNT As Long = 9
Private Const ATTR_SPIN_RETRY_COUNT As Long = 10
Private Const ATTR_CALIBRATION_RETRY_COUNT As Long = 11
Private Const ATTR_POWER_CYCLE_COUNT As Long = 12
Private Const PRE_FAILURE_WARRANTY As Long = &H1
Private Const ON_LINE_COLLECTION As Long = &H2
Private Const PERFORMANCE_ATTRIBUTE As Long = &H4
Private Const ERROR_RATE_ATTRIBUTE As Long = &H8
Private Const EVENT_COUNT_ATTRIBUTE As Long = &H10
Private Const SELF_PRESERVING_ATTRIBUTE As Long = &H20Private Const NUM_ATTRIBUTE_STRUCTS As Long = 30Private Const INVALID_HANDLE_VALUE As Long = -1Private Const VER_PLATFORM_WIN32s As Long = 0
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Declare Function GetVersionEx Lib "KERNEL32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const OPEN_EXISTING As Long = 3
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 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, ByVal lpOverlapped As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private m_DiskInfo As IDSECTOR
Private Function OpenSMART(ByVal nDrive As Byte) As Long Dim hSMARTIOCTL As Long
Dim hd As String
Dim VersionInfo As OSVERSIONINFO hSMARTIOCTL = INVALID_HANDLE_VALUE
VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
GetVersionEx VersionInfo
Select Case VersionInfo.dwPlatformId
Case VER_PLATFORM_WIN32s
OpenSMART = hSMARTIOCTL
Case VER_PLATFORM_WIN32_WINDOWS
' Version Windows 95 OSR2, Windows 98
hSMARTIOCTL = CreateFile("\\.\SMARTVSD", 0, 0, 0, CREATE_NEW, 0, 0)
Case VER_PLATFORM_WIN32_NT
' Windows NT, Windows 2000
If nDrive < MAX_IDE_DRIVES Then
hd = "\\.\PhysicalDrive" & nDrive
hSMARTIOCTL = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
End If
End Select
OpenSMART = hSMARTIOCTLEnd Function
Private Function DoIDENTIFY(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP() As Byte, ByVal bIDCmd As Byte, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE pSCIP.irDriveRegs.bFeaturesReg = 0
pSCIP.irDriveRegs.bSectorCountReg = 1
pSCIP.irDriveRegs.bSectorNumberReg = 1
pSCIP.irDriveRegs.bCylLowReg = 0
pSCIP.irDriveRegs.bCylHighReg = 0 '
' Compute the drive number.
'
pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4) '
' The command can either be IDE identify or ATAPI identify.
'
pSCIP.irDriveRegs.bCommandReg = bIDCmd
pSCIP.bDriveNumber = bDriveNum
pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE DoIDENTIFY = CBool(DeviceIoControl(hSMARTIOCTL, DFP_RECEIVE_DRIVE_DATA, _
pSCIP, 32, _
pSCOP(0), 528, _
lpcbBytesReturned, 0))End Function
'------------------------------------------
Private Function DoEnableSMART(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP As SENDCMDOUTPARAMS, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean pSCIP.cBufferSize = 0 pSCIP.irDriveRegs.bFeaturesReg = SMART_ENABLE_SMART_OPERATIONS
pSCIP.irDriveRegs.bSectorCountReg = 1
pSCIP.irDriveRegs.bSectorNumberReg = 1
pSCIP.irDriveRegs.bCylLowReg = SMART_CYL_LOW
pSCIP.irDriveRegs.bCylHighReg = SMART_CYL_HI '
' Compute the drive number.
'
pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)
pSCIP.irDriveRegs.bCommandReg = IDE_EXECUTE_SMART_FUNCTION
pSCIP.bDriveNumber = bDriveNum DoEnableSMART = CBool(DeviceIoControl(hSMARTIOCTL, DFP_SEND_DRIVE_COMMAND, _
pSCIP, LenB(pSCIP) - 1, _
pSCOP, LenB(pSCOP) - 1, _
lpcbBytesReturned, 0))End Function
Private Sub ChangeByteOrder(szString() As Byte, ByVal uscStrSize As Integer) Dim i As Integer
Dim bTemp As Byte For i = 0 To uscStrSize - 1 Step 2
bTemp = szString(i)
szString(i) = szString(i + 1)
szString(i + 1) = bTemp
Next iEnd Sub
Private Sub DisplayIdInfo(pids As IDSECTOR, pSCIP As SENDCMDINPARAMS, ByVal bIDCmd As Byte, ByVal bDfpDriveMap As Byte, ByVal bDriveNum As Byte) ChangeByteOrder pids.sModelNumber, UBound(pids.sModelNumber) + 1 ChangeByteOrder pids.sFirmwareRev, UBound(pids.sFirmwareRev) + 1 ChangeByteOrder pids.sSerialNumber, UBound(pids.sSerialNumber) + 1End SubPublic Function GetDiskInfo(ByVal nDrive As Byte) As Long Dim hSMARTIOCTL As Long
Dim cbBytesReturned As Long
Dim VersionParams As GETVERSIONOUTPARAMS
Dim scip As SENDCMDINPARAMS
Dim scop() As Byte
Dim OutCmd As SENDCMDOUTPARAMS
Dim bDfpDriveMap As Byte
Dim bIDCmd As Byte ' IDE or ATAPI IDENTIFY cmd
Dim uDisk As IDSECTOR m_DiskInfo = uDisk
hSMARTIOCTL = OpenSMART(nDrive)
If hSMARTIOCTL <> INVALID_HANDLE_VALUE Then
Call DeviceIoControl(hSMARTIOCTL, DFP_GET_VERSION, ByVal 0, 0, VersionParams, Len(VersionParams), cbBytesReturned, 0)
If Not (VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10) Then
If DoEnableSMART(hSMARTIOCTL, scip, OutCmd, nDrive, cbBytesReturned) Then
bDfpDriveMap = bDfpDriveMap Or 2 ^ nDrive
End If
End If bIDCmd = IIf((VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10), IDE_ATAPI_ID, IDE_ID_FUNCTION) ReDim scop(LenB(OutCmd) + IDENTIFY_BUFFER_SIZE - 1) As Byte
If DoIDENTIFY(hSMARTIOCTL, scip, scop, bIDCmd, nDrive, cbBytesReturned) Then
CopyMemory m_DiskInfo, scop(LenB(OutCmd) - 4), LenB(m_DiskInfo)
Call DisplayIdInfo(m_DiskInfo, scip, bIDCmd, bDfpDriveMap, nDrive)
CloseHandle hSMARTIOCTL
GetDiskInfo = 1
Exit Function '>---> Bottom
End If
CloseHandle hSMARTIOCTL
GetDiskInfo = 0
Else 'NOT HSMARTIOCTL...
GetDiskInfo = -1
End IfEnd Function
'---------------------------------------------
'硬盘生产厂/型号
Public Property Get pSerialNumber() As String
pSerialNumber = StrConv(m_DiskInfo.sSerialNumber, vbUnicode)
End Property'硬盘序列号
Public Property Get pModelNumber() As String
pModelNumber = StrConv(m_DiskInfo.sModelNumber, vbUnicode)
End Property
谢谢您,以前这种方法我也试过,但是在98下有时不行,不知你有没有碰到过.to 阿九:
谢谢,我已经收到了,正在测试中.
to somecom(我承认都是月饼惹的祸) (:
您的这个类我以前也用过,在win98下,就算有SMARTVSD.vxd也还是基本上取不到序列号。
to online(龙卷风V2.0--再战江湖) :
根据您提供的网址上找到的diskid32.dll和diskid.dll在98下有些机器也还是取不到。后来我想过取CPU的序列号,但是网上说只有P3的能取到。
网卡的MAC地址,找了很多方法,但是在98下有时也会失败,在2K下,如果存在多个连接的情况,有时出现取出的都为0的情况。
难道真的没有方法取到一台机器不变一唯一标识吗?期待......散分!