2012-08-03 180 views

回答

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 
+0

感谢ü非常代码为我工作的感谢 – user757321 2012-08-03 12:48:04

+1

如果这个答案对你有帮助,@ user757321,那么请考虑将其标记为接受的答案,以便其他人可以更容易地在未来找到它。这也是一种礼貌的方式来感谢回答你的问题的人帮助你。 – Gaffi 2012-08-03 13:28:10

0

如果你想有效地使用API​​函数,创建一个类 - “磁盘设备”

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函数 - 你只是做一个集合查找。