在vb6中从\ Device \ HarddiskVolume1转换为C:

时间:2012-08-03 12:01:28

标签: vb6

在visual basic 6中有没有办法从\Device\HarddiskVolume1\programfile\explorer.exe转换为C:\programfile\explorer.exe

感谢

2 个答案:

答案 0 :(得分:3)

试试这个

Option Explicit

Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long

Private Sub Command1_Click()
    Debug.Print pvReplaceDevice("\Device\HarddiskVolume1\aaa.txt")
End Sub

Private Function pvReplaceDevice(sPath As String) As String
    Dim sDrive          As String
    Dim sDevice         As String
    Dim lIdx            As Long

    For lIdx = 0 To 25
        sDrive = Chr$(65 + lIdx) & ":"
        sDevice = Space(1000)
        If QueryDosDevice(sDrive, sDevice, Len(sDevice)) <> 0 Then
            sDevice = Left$(sDevice, InStr(sDevice, Chr$(0)) - 1)
'            Debug.Print sDrive; "="; sDevice
            If LCase$(Left$(sPath, Len(sDevice))) = LCase$(sDevice) Then
                pvReplaceDevice = sDrive & Mid$(sPath, Len(sDevice) + 1)
                Exit Function
            End If
        End If
    Next
    pvReplaceDevice = sPath
End Function

答案 1 :(得分:0)

如果想要有效使用API​​函数,请创建一个类 - “DiskDevice”

Option Explicit

Private Declare Function GetLogicalDriveStrings Lib "Kernel32" Alias "GetLogicalDriveStringsW" ( _
    ByVal nBufferLength As Long, _
    ByVal lpBuffer As Long _
) As Long

Private Declare Function QueryDosDevice Lib "Kernel32.dll" Alias "QueryDosDeviceW" ( _
    ByVal lpDeviceName As Long, _
    ByVal lpTargetPath As Long, _
    ByVal ucchMax As Long _
) As Long

Private m_colDrivesKeyedByDevice            As VBA.Collection

Private Sub Class_Initialize()

    Dim sDriveStrings               As String
    Dim vasDriveStrings             As Variant
    Dim nIndex                      As Long
    Dim sDrive                      As String

    ' Allocate max size buffer [A-Z]:\\\0  and retrieve all drives on the system.
    sDriveStrings = Space$(105)
    GetLogicalDriveStrings 1000, StrPtr(sDriveStrings)

    ' Split over the null chars between each substring.
    vasDriveStrings = Split(sDriveStrings, vbNullChar)

    Set m_colDrivesKeyedByDevice = New VBA.Collection

    ' Iterate through each drive string (escaping later if any item is null string).
    For nIndex = 0 To UBound(vasDriveStrings)
        sDrive = Left$(vasDriveStrings(nIndex), 2) ' Ignore the backslash.
        If Len(sDrive) = 0 Then
            Exit For
        End If
        ' Create mapping from Drive => Device
        m_colDrivesKeyedByDevice.Add sDrive, GetDeviceForDrive(sDrive)
    Next nIndex

End Sub

' Retrieve the device string \device\XXXXXX for the drive X:
Private Function GetDeviceForDrive(ByRef the_sDrive As String)

    Const knBufferLen       As Long = 1000
    Dim sBuffer             As String
    Dim nRet                As Long

    sBuffer = Space$(knBufferLen)
    nRet = QueryDosDevice(StrPtr(the_sDrive), StrPtr(sBuffer), knBufferLen)
    GetDeviceForDrive = Left$(sBuffer, nRet - 2) ' Ignore 2 terminating null chars.

End Function

Public Function GetFilePathFromDevicePath(ByRef the_sDevicePath As String) As String

    Dim nPosSecondBackslash As Long
    Dim nPosThirdBackslash As Long
    Dim sDevice         As String
    Dim sDisk           As String

    ' Path is always \Device\<device>\path1\path2\etc. Just get everything before the third backslash.
    nPosSecondBackslash = InStr(2, the_sDevicePath, "\")
    nPosThirdBackslash = InStr(nPosSecondBackslash + 1, the_sDevicePath, "\")

    sDevice = Left(the_sDevicePath, nPosThirdBackslash - 1)
    sDisk = m_colDrivesKeyedByDevice.Item(sDevice)          ' Lookup

    ' Reassemble, this time with disk.
    GetFilePathFromDevicePath = sDisk & Mid$(the_sDevicePath, nPosThirdBackslash)

End Function

现在,您使用以下代码:

Set m_oDiskDevice = New DiskDevice

...

sMyPath = m_oDiskDevice.GetFilePathFromDevicePath("\Device\HarddiskVolume1\programfile\explorer.exe")

这样您就不必多次调用API函数 - 只需进行集合查找。