emundisk.frm

转载 EnumDisk.VB版的 转载 EnumDisk.VB版的

Private Const SPDRP_DEVICE_POWER_DATA            As Long = (&H1E)       '// Device Power Data (R)
Private Const SPDRP_REMOVAL_POLICY               As Long = (&H1F)       '// Removal Policy (R)
Private Const SPDRP_REMOVAL_POLICY_HW_DEFAULT    As Long = (&H20)       '// Hardware Removal Policy (R)
Private Const SPDRP_REMOVAL_POLICY_OVERRIDE      As Long = (&H21)       '// Removal Policy Override (RW)
Private Const SPDRP_INSTALL_STATE                As Long = (&H22)       '// Device Install State (R)
Private Const SPDRP_MAXIMUM_PROPERTY             As Long = (&H23)       '// Upper bound on ordinals


'Private Declare Function SetupDiEnumDeviceInfo Lib "setupapi" (ByVal DeviceInfoSet As Long, ByVal MemberIndex As Long, DeviceInfoData As SP_DEVINFO_DATA) As Long
Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByVal ClassGuid As Long, ByVal Enumerator As Long, ByVal HwndParent As Long, ByVal Flags As Long) As Long
Private Declare Function SetupDiEnumDeviceInterfaces Lib "setupapi.dll" (ByVal DeviceInfoSet As Long, ByVal DeviceInfoData As Long, ByRef InterfaceClassGuid As GUID, ByVal MemberIndex As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA) As Long
Private Declare Function SetupDiGetDeviceInterfaceDetail Lib "setupapi.dll" Alias "SetupDiGetDeviceInterfaceDetailA" (ByVal DeviceInfoSet As Long, ByRef DeviceInterfaceData As SP_DEVICE_INTERFACE_DATA, DeviceInterfaceDetailData As Any, ByVal DeviceInterfaceDetailDataSize As Long, ByRef RequiredSize As Long, DeviceInfoData As Any) As Long
Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CM_Get_Parent Lib "cfgmgr32.dll" (pdwDevInst As Long, ByVal dwDevInst As Long, ByVal ulFlags As Long) As Long
Private Declare Function CM_Request_Device_EjectW Lib "setupapi.dll" (ByVal dwDevInst As Long, ByVal pVetoType As Long, ByVal pszVetoName As String, ByVal ulNameLength As Long, ByVal ulFlags 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, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As Any, ByVal nSize As Long, Arguments As Long) As Long

Private DiskClassGuid As GUID
Private GUID_DEVCLASS_DISKDRIVE As GUID
Private DeviceType() As String
Private DriveBusType() As String

Private Function GetRegistryProperty(ByVal DevInfo As Long, ByVal Index As Long) As Boolean
    Dim DeviceInfoData As SP_DEVINFO_DATA
    Dim ErrorCode As Long, BufferSize As Long, DataType As Long
    Dim Buffer() As Byte
    Dim Status As Boolean
    
    DeviceInfoData.cbSize = Len(DeviceInfoData)
    Status = SetupDiEnumDeviceInfo(DevInfo, Index, DeviceInfoData)
    If Status Then
      Status = SetupDiGetDeviceRegistryProperty(DevInfo, DeviceInfoData, SPDRP_HARDWAREID, DataType, 0&, BufferSize, BufferSize)
      ErrorCode = GetLastError
      If Status = False And (BufferSize = 0) Then
        If ErrorCode <> ERROR_INSUFFICIENT_BUFFER Then
          If ErrorCode = ERROR_INVALID_DATA Then
            GetRegistryProperty = True: Exit Function
          Else
            Call DebugPrint(1, "SetupDiGetDeviceInterfaceDetail failed with error: " & GetErrorStr(ErrorCode))
            Exit Function
          End If
        End If
      End If
      If BufferSize <= 0 Then Exit Function
      ReDim Buffer(BufferSize)
      Status = SetupDiGetDeviceRegistryProperty(DevInfo, DeviceInfoData, SPDRP_HARDWAREID, DataType, VarPtr(Buffer(0)), BufferSize, BufferSize)
      If Status Then
        DebugPrint 1, "Device ID: " & StrConv(Buffer, vbUnicode)
      Else
        ErrorCode = GetLastError
        If ErrorCode <> ERROR_INVALID_DATA Then
          DebugPrint 1, "SetupDiGetDeviceInterfaceDetail failed with error:" & GetErrorStr(ErrorCode)
          Exit Function
        End If
      End If
      GetRegistryProperty = True
    Else
      ErrorCode = GetLastError()
      If ErrorCode = ERROR_NO_MORE_ITEMS Then
        DebugPrint 2, "No more devices."
      Else
        DebugPrint 1, "SetupDiEnumDeviceInfo failed with error: " & GetErrorStr(ErrorCode)
      End If
    End If
End Function

Private Function GetDeviceProperty(ByVal IntDevInfo As Long, ByVal Index As Long) As Boolean
'routine Description:
'    This routine enumerates the disk devices using the Device interface
'    GUID DiskClassGuid. Gets the Adapter & Device property from the port
'    driver. Then sends IOCTL through SPTI to get the device Inquiry data.
'
'Arguments:
'    IntDevInfo - Handles to the interface device information list'
'    Index      - Device member
'
'Return Value:
'
'  TRUE / FALSE. This decides whether to continue or not
  
    Dim interfaceData As SP_DEVICE_INTERFACE_DATA
    Dim interfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
    Dim Query As STORAGE_PROPERTY_QUERY
    Dim adpDesc As STORAGE_ADAPTER_DESCRIPTOR
    Dim devDesc As STORAGE_DEVICE_DESCRIPTOR
    Dim SPTWB As SCSI_PASS_THROUGH_WITH_BUFFERS
    Dim hDevice As Long
    Dim Status As Boolean
    Dim P As String
    Dim OutBuf(0 To 1024) As Byte
    Dim Length As Long
    Dim Returned As Long
    Dim ReturnedLength As Long
    Dim interfaceDetailDataSize As Long
    Dim reqSize As Long
    Dim ErrorCode As Long
    Dim I As Long
    
    On Error Resume Next

    interfaceData.cbSize = Len(interfaceData)
    Status = SetupDiEnumDeviceInterfaces(IntDevInfo, 0&, DiskClassGuid, Index, interfaceData)
    If Not Status Then
      ErrorCode = GetLastError()
      If ErrorCode = ERROR_NO_MORE_ITEMS Then
        Call DebugPrint(2, "No more interfaces")
      Else
        Call DebugPrint(1, "SetupDiEnumDeviceInterfaces failed with error:" & GetErrorStr(ErrorCode))
      End If
    End If
    
    Status = SetupDiGetDeviceInterfaceDetail(IntDevInfo, interfaceData, ByVal 0&, 0&, reqSize, ByVal 0&)
'    这一段是按C的格式直接译过来的，但必须注销，因为VB在调用GetLastError前似乎自动清掉了错误提示，
'    所以GetLastError取不到错误码(GetLastError返回0)？？？但是这种情况是在编译后发生的，在调试状态下却是能正常得到错误码。
'    If Status = False Then
'      ErrorCode = GetLastError
'      If (ErrorCode <> ERROR_INSUFFICIENT_BUFFER) Then
'        Call DebugPrint(1, "SetupDiGetDeviceInterfaceDetail failed with error: " & GetErrorStr(ErrorCode))
'        Exit Function
'      End If
'    End If
    interfaceDetailDataSize = reqSize
    If Len(interfaceDetailData.DevicePath) < interfaceDetailDataSize Then
      Call DebugPrint(1, "Unable to allocate memory to get the interface detail data.")
      Exit Function
    End If
    interfaceDetailData.cbSize = 5
    reqSize = 0
    Status = SetupDiGetDeviceInterfaceDetail(IntDevInfo, interfaceData, interfaceDetailData, interfaceDetailDataSize, reqSize, ByVal 0&)
    If Not Status Then
      Call DebugPrint(1, "Error in SetupDiGetDeviceInterfaceDetail failed with error: " & GetErrorStr(ErrorCode))
      Exit Function
    End If
    
    Call DebugPrint(2, "Interface: " & interfaceDetailData.DevicePath)
    I = InStr(interfaceDetailData.DevicePath, vbNullChar)
    P = IIf(I, Mid(interfaceDetailData.DevicePath, 1, I), interfaceDetailData.DevicePath)
    hDevice = CreateFile(P, _
                         GENERIC_READ Or GENERIC_WRITE, _
                         FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                         ByVal 0&, _
                         OPEN_EXISTING, _
                         0&, _
                         0&)
    If hDevice = INVALID_HANDLE_VALUE Then
      Call DebugPrint(1, "CreateFile failed with error: " & GetErrorStr(GetLastError))
      GetDeviceProperty = True
      Exit Function
    End If
    
    Query.PropertyId = StorageAdapterProperty
    Query.QueryType = PropertyStandardQuery
    adpDesc.Size = Len(adpDesc)
    Status = DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, Query, Len(Query), ByVal VarPtr(OutBuf(0)), 512, ReturnedLength, ByVal 0&)
    If Not Status Then
      Call DebugPrint(1, "IOCTL failed with error code: " & GetErrorStr(GetLastError))
    Else
      GetDeviceProperty = True
      If BuffertoType(adpDesc, OutBuf()) = False Then
        Call DebugPrint(1, "BuffertoType CopyMemory failed with error : Not enough space.")
      End If
'      PrintDataBuffer OutBuf, ReturnedLength
      Call DebugPrint(1, vbNullString)
      Call DebugPrint(1, "Adapter Properties")
      Call DebugPrint(1, "------------------")
      Call DebugPrint(1, "Bus Type       : " & GetDriveBusType(adpDesc.BusType))
      Call DebugPrint(1, "Max. Tr. Length: 0x" & FormatHex(adpDesc.MaximumTransferLength, 2))
      Call DebugPrint(1, "Max. Phy. Pages: 0x" & FormatHex(adpDesc.MaximumPhysicalPages, 2))
      Call DebugPrint(1, "Alignment Mask : 0x" & FormatHex(adpDesc.AlignmentMask, 2))
      
      Query.PropertyId = StorageDeviceProperty
      Query.QueryType = PropertyStandardQuery
      devDesc.Size = Len(devDesc)
      Status = DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, Query, Len(Query), ByVal VarPtr(OutBuf(0)), 512, ReturnedLength, ByVal 0&)
      If Not Status Then
        Call DebugPrint(1, "IOCTL failed with error code: " & GetErrorStr(GetLastError))
      Else
        DebugPrint 3, "OutBuf Data"
        PrintDataBuffer OutBuf, ReturnedLength
        Call DebugPrint(1, vbNullString)
        Call DebugPrint(1, "Device Properties")
        Call DebugPrint(1, "-----------------")
        If BuffertoTypeDEVICE(devDesc, OutBuf()) = False Then
          Call DebugPrint(1, "BuffertoTypeDEVICE CopyMemory failed with error : Not enough space.")
        End If
        Call DebugPrint(1, "Device Type     : " & DeviceType(IIf(devDesc.DeviceType < &H10, devDesc.DeviceType, &HF)) & " (0x" & FormatHex(devDesc.DeviceType, 2) & ")")
        If devDesc.DeviceTypeModifier Then Call DebugPrint(1, "Device Modifier : 0x" & Hex(devDesc.DeviceTypeModifier))
        Call DebugPrint(1, "Removable Media : " & IIf(devDesc.RemovableMedia, "Yes", "No"))
        
        With devDesc
          If .VendorIdOffset Then
            Call DebugPrint(1, "Vendor ID       : " & GetSTRbyBuff(OutBuf, .VendorIdOffset, ReturnedLength))
          End If
          If .ProductIdOffset Then
            Call DebugPrint(1, "Product ID      : " & GetSTRbyBuff(OutBuf, .ProductIdOffset, ReturnedLength))
          End If
          If .ProductRevisionOffset Then
            Call DebugPrint(1, "Product Revision: " & GetSTRbyBuff(OutBuf, .ProductRevisionOffset, ReturnedLength))
          End If
          If .SerialNumberOffset Then
            Call DebugPrint(1, "Serial Number   : " & GetSTRbyBuff(OutBuf, .SerialNumberOffset, ReturnedLength))
          End If
        End With
      End If
    End If
    
    SPTWB.SPT.Length = Len(SPTWB.SPT)
    SPTWB.SPT.PathId = 0
    SPTWB.SPT.TargetId = 1
    SPTWB.SPT.Lun = 0
    SPTWB.SPT.CdbLength = CDB6GENERIC_LENGTH
    SPTWB.SPT.SenseInfoLength = 24
    SPTWB.SPT.DataIn = SCSI_IOCTL_DATA_IN
    SPTWB.SPT.DataTransferLength = 192
    SPTWB.SPT.TimeOutValue = 2
'   // SPTWB.Spt.DataBufferOffset = offsetof(SCSI_PASS_THROUGH_WITH_BUFFERS,DataBuf);
'   // SPTWB.spt.SenseInfoOffset = offsetof(SCSI_PASS_THROUGH_WITH_BUFFERS, SenseBuf)
    SPTWB.SPT.SenseInfoOffset = SPTWB.SPT.Length + 4
    SPTWB.SPT.DataBufferOffset = SPTWB.SPT.SenseInfoOffset + UBound(SPTWB.SenseBuf) + 1
    SPTWB.SPT.Cdb(0) = SCSIOP_INQUIRY
    SPTWB.SPT.Cdb(4) = &HC0
    Length = SPTWB.SPT.DataBufferOffset + SPTWB.SPT.DataTransferLength
    Length = Len(SPTWB)
    Status = DeviceIoControl(hDevice, IOCTL_SCSI_PASS_THROUGH, SPTWB, SPTWB.SPT.Length, SPTWB, Length, Returned, ByVal 0&)
    ErrorCode = GetLastError
    Call DebugPrint(1, "")
    Call DebugPrint(1, "Inquiry Data from Pass Through")
    Call DebugPrint(1, "------------------------------")
    If Status Then
      PrintStatusResults Returned, SPTWB
    Else
      Call DebugPrint(1, "DeviceIoControl Error: " & GetErrorStr(ErrorCode))
    End If
    If CloseHandle(hDevice) = 0 Then Call DebugPrint(2, "Failed to close device.")
    GetDeviceProperty = True
End Function

Private Sub PrintStatusResults(ByVal Returned As Long, PSPTWB As SCSI_PASS_THROUGH_WITH_BUFFERS)
  Dim ErrorCode As Long, I As Integer, devType As Integer
  
  If (PSPTWB.SPT.ScsiStatus) Then
    PrintSenseInfo PSPTWB
  Else
    devType = PSPTWB.DataBuf(0) And &H1F
    Call DebugPrint(1, "Device Type: " & DeviceType(IIf(devType > &HF, &HF, devType)) & " (0x" & Hex(devType) & ")")
    If PSPTWB.DataBuf(8) Then Call DebugPrint(1, "Vendor ID  : " & GetSTRbyBuff(PSPTWB.DataBuf, 8, 15, False))
    If PSPTWB.DataBuf(16) Then Call DebugPrint(1, "Product ID : " & GetSTRbyBuff(PSPTWB.DataBuf, 16, 31, False))
    If PSPTWB.DataBuf(32) Then Call DebugPrint(1, "Product Rev: " & GetSTRbyBuff(PSPTWB.DataBuf, 32, 35, False))
    If PSPTWB.DataBuf(36) Then Call DebugPrint(1, "Vendor Str : " & GetSTRbyBuff(PSPTWB.DataBuf, 36, 55, False))
    Call DebugPrint(1, "")
    Call DebugPrint(3, "Scsi status: 0x" & FormatHex(PSPTWB.SPT.ScsiStatus, 2) & ", Bytes returned: 0x" & Hex(Returned))
    Call DebugPrint(3, "Data buffer length:  0x" & Hex(PSPTWB.SPT.DataTransferLength))
    Call DebugPrint(1, "")
    DebugPrint 3, "************ Data with PSPTWB.DataBuf ************"
    DebugPrint 3, ""