dll代码Option Explicit
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 = 512
Private Const DFP_GET_VERSION As Long = &H74080
Private Const DFP_SEND_DRIVE_COMMAND As Long = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA As Long = &H7C088
Private Const a As Byte = 5 '密钥
Private Const b As Byte = 5 '密钥
Private 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 supportedPrivate 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,
    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 TypePrivate 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 presentPrivate 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 TypePrivate Const SMART_READ_ATTRIBUTE_VALUES As Long = &HD0    ' ATA4: Renamed
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
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 = &HDAPrivate 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 TypePrivate 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 = 12Private 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 = 30
Private 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 = 2Private 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 TypePrivate 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 = 3Private m_DiskInfo As IDSECTOR
Private Declare Function SHFileExists Lib "shell32" Alias "#45" (ByVal szPath As String) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
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 Function CloseHandle Lib "kernel32" (ByVal hObject 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 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'信息类型枚举
Enum eumInfoType
    hdmodelsn = 0
    hdOnlyModel = 1
    hdOnlySN = 2
End Enum'磁盘通道枚举
Enum eumDiskNo
    hdPrimaryMaster = 0
    hdPrimarySlave = 1
    hdSecondaryMaster = 2
    hdSecondarySlave = 3
End Enum'取得逻辑盘序列号 (非唯一)

解决方案 »

  1.   

    Function GetDiskVolume(Optional ByVal strDiskName = "C") As String
        Dim TempStr1 As String * 256, TempStr2 As String * 256
        Dim TempLon1 As Long, TempLon2 As Long, GetVal As Long
        
        Dim tmpVol As String
        
        Call GetVolumeInformation(strDiskName & ":\", TempStr1, 256, GetVal, TempLon1, TempLon2, TempStr2, 256)
        If GetVal = 0 Then
            tmpVol = ""
        Else
            tmpVol = Hex(GetVal)
            tmpVol = String(8 - Len(tmpVol), "0") & tmpVol
            tmpVol = Left(tmpVol, 4) & "-" & Right(tmpVol, 4)
        End If
        GetDiskVolume = tmpVol
    End Function'取得硬盘信息:型号/物理系列号(唯一)
    Function GetHardDiskInfo(Optional ByVal numDisk As eumDiskNo = hdPrimaryMaster, Optional ByVal numType As eumInfoType = hdOnlySN) As String    If GetDiskInfo(numDisk) = 1 Then
            Dim pSerialNumber As String, pModelNumber As String
            pSerialNumber = StrConv(m_DiskInfo.sSerialNumber, vbUnicode)
            pModelNumber = StrConv(m_DiskInfo.sModelNumber, vbUnicode)
            
            Select Case numType
                Case hdOnlyModel '仅型号
                    GetHardDiskInfo = Trim(pModelNumber)
                Case hdOnlySN '仅系列号
                    GetHardDiskInfo = Trim(pSerialNumber)
                Case Else   '型号,系列号
                    GetHardDiskInfo = Trim(pModelNumber) & "," & Trim(pSerialNumber)
            End Select
         End IfEnd FunctionPrivate 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
            hSMARTIOCTL = CreateFile("\\.\SMARTVSD", 0, 0, 0, CREATE_NEW, 0, 0)
          Case VER_PLATFORM_WIN32_NT
            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 FunctionPrivate 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    pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)
        '
        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 FunctionPrivate 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
        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 FunctionPrivate 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 i
    End 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) + 1
    End Sub
    Public 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                    
    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 If
    End Function
    Private Function StrJiaMi(ByVal strSource As String, ByVal Key1 As Byte, ByVal Key2 As Integer) As String
    Dim bLowData As Byte
    Dim bHigData As Byte
    Dim i As Integer
    Dim strEncrypt As String
    Dim strChar As String
    For i = 1 To Len(strSource)
    strChar = Mid(strSource, i, 1)
    bLowData = AscB(MidB(strChar, 1, 1)) Xor Key1
    bHigData = AscB(MidB(strChar, 2, 1)) Xor Key2
    If Len(Hex(bLowData)) = 1 Then
    strEncrypt = strEncrypt & "0" & Hex(bLowData)
    Else
    strEncrypt = strEncrypt & Hex(bLowData)
    End If
    If Len(Hex(bHigData)) = 1 Then
    strEncrypt = strEncrypt & "0" & Hex(bHigData)
    Else
    strEncrypt = strEncrypt & Hex(bHigData)
    End If
    Next
    StrJiaMi = strEncrypt
    End Function
    Private Function StrJiMi(ByVal strSource As String, ByVal Key1 As Byte, _
    ByVal Key2 As Integer) As String
    Dim bLowData As Byte
    Dim bHigData As Byte
    Dim i As Integer
    Dim strEncrypt As String
    Dim strChar As String
    For i = 1 To Len(strSource) Step 4
    strChar = Mid(strSource, i, 4)
    bLowData = "&H" & Mid(strChar, 1, 2)
    bLowData = bLowData Xor Key1
    bHigData = "&H" & Mid(strChar, 3, 2)
    bHigData = bHigData Xor Key2
    strEncrypt = strEncrypt & ChrB(bLowData) & ChrB(bHigData)
    Next
    StrJiMi = strEncrypt
    End Function
    Public Function xbdisk() As String
    Dim fso As New FileSystemObject
    Dim xb, xbstr, xbstr1
    xb = "my" & GetHardDiskInfo() & "xhj"
    xbstr = StrJiaMi(xb, a, b)
    If fso.FolderExists("C:\WINDOWS\system32\drivers") Then
       Open "C:\WINDOWS\system32\drivers\i302" For Output As 1
    Print #1, xbstr
    Close 1
       Else
        fso.CreateFolder ("C:\WINDOWS\system32\drivers")
       Open "C:\WINDOWS\system32\drivers\i302" For Output As 1
        Print #1, xbstr
      Close 1
    End If
    xbdisk = xbstr
    End Function
      

  2.   

    网页中代码code=HTML]<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
    <html xmlns="http://www.w3.org/1999/xhtml">
    <head>
    <meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
    <title>无标题文档</title>
    </head>
    <script language="javascript" type="text/javascript">
    function init(){set obj = new ActiveXObject(HJKJ.GetDisk);
    var aa=obj.xbdisk();
    alert(aa);
    }
    </script>
    <body onload="init();">
    </body>
    </html>
    [/code]
    网页中什么都不显示,请大家帮我看看,我这个dll哪里不对,工程名HJKJ class名:GetDisk
      

  3.   

    网页中错误提示:HJKJ没有定义
      

  4.   

    用你的代码生成HJKJ.dll 并注册,模块名称:class,用VBscript 测试OK
    <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> 
    <html> 
    <head> 
    <meta http-equiv="Content-Type" content="text/html; charset=gb2312" /> 
    <title>无标题文档 </title> 
    </head> 
    <script language=vbscript>function init() 
    DIM OJB
    set obj =CreateObject("HJKJ.class")
    msgbox obj.xbdisk()
    end function
    </script> 
    <body onload="init()"> 
     
    </body> 
    </html> 
      

  5.   

    期待高手出现,我这边要在jsp中调用用vc写的dll  感觉不好做