哪个控件可以实现读取网络驱动器？明天早上起来结贴，谢谢各位！

Question

' *********************************************************************
'  Copyright ?998-99 Karl E. Peterson, All Rights Reserved
'  http://www.mvps.org/vb
' *********************************************************************
'  You are free to use this code within your own applications, but you
'  are expressly forbidden from selling or otherwise distributing this
'  source code without prior written consent.
' *********************************************************************
Option ExplicitPrivate Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As LongPrivate Const NO_ERROR = 0
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&Private Sub Command1_Click()
   Dim d As Integer
   Dim sRet As String
   Dim Msg As String   List1.Clear
   List2.Clear
   For d = Asc("C") To Asc("Z")
      sRet = DriveLetterToUNC(Chr(d))
      If Len(sRet) Then
         List1.AddItem Chr(d) & ": --> " & sRet
      End If
   Next d
End SubPrivate Function DriveLetterToUNC(ByVal DriveLetter As String) As String
   Dim nRet As Long
   Dim Drv As String
   Dim Dbg As String
   Dim Buffer As String
   Dim BufLen As Long
   Const MAX_PATH = 260   If Len(DriveLetter) Then
      ' massage input string and create buffer
      Drv = UCase(Left(DriveLetter, 1)) & ":"
      Buffer = Space(MAX_PATH)
      BufLen = Len(Buffer)
   
      ' attempt to get UNC info
      nRet = WNetGetConnection(Drv, Buffer, BufLen)
      If nRet = ERROR_MORE_DATA Then
         ' increase buffer and call again
         Buffer = Space(BufLen)
         nRet = WNetGetConnection(Drv, Buffer, BufLen)
      End If      If nRet = NO_ERROR Then
         ' return UNC name by trimming at first null
         DriveLetterToUNC = Left(Buffer, InStr(Buffer, vbNullChar) - 1)
      Else
         ' optionally output debugging info...
         Select Case nRet
            Case ERROR_BAD_DEVICE
               Dbg = Drv & " --> "
               Dbg = Dbg & "The specified device name is invalid."
            Case ERROR_NOT_CONNECTED
               Dbg = Drv & " --> "
               Dbg = Dbg & "This network connection does not exist."
            Case ERROR_CONNECTION_UNAVAIL
               Dbg = Drv & " --> "
               Dbg = Dbg & "The device is not currently connected but it is a remembered connection."
            Case ERROR_NO_NETWORK
               Dbg = "The network is not present or not started."
            Case ERROR_MORE_DATA
               Dbg = "Buffer is too small!"
            Case ERROR_EXTENDED_ERROR
               Dbg = "An error has occurred, call WNetGetLastError."
            Case Else
               Dbg = "Unknown error code: " & nRet
         End Select
         List2.AddItem Dbg
      End If
   End If
End FunctionPrivate Sub Command2_Click()
   Unload Me
End SubPrivate Sub Form_Load()
   Me.Caption = "Convert Drive Letter to UNC Sharename"
   Set Me.Icon = Nothing
End Sub

Answer 1

Private Type BrowseInfo
    lngHwnd        As Long
    pIDLRoot       As Long
    pszDisplayName As Long
    lpszTitle      As Long
    ulFlags        As Long
    lpfnCallback   As Long
    lParam         As Long
    iImage         As Long
End TypePrivate Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
    (ByVal hMem As Long)Private Declare Function lstrcat Lib "Kernel32" _
   Alias "lstrcatA" (ByVal lpString1 As String, _
   ByVal lpString2 As String) As Long
   
Private Declare Function SHBrowseForFolder Lib "shell32" _
   (lpbi As BrowseInfo) As Long
   
Private Declare Function SHGetPathFromIDList Lib "shell32" _
   (ByVal pidList As Long, ByVal lpBuffer As String) As LongPrivate Function BrowseForFolder(ByVal lngHwnd As Long, ByVal strPrompt As String) As String    On Error GoTo ehBrowseForFolder 'Trap for errors    Dim intNull As Integer
    Dim lngIDList As Long, lngResult As Long
    Dim strPath As String
    Dim udtBI As BrowseInfo    'Set API properties (housed in a UDT)
    With udtBI
        .lngHwnd = lngHwnd
        .lpszTitle = lstrcat(strPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With    'Display the browse folder...
    lngIDList = SHBrowseForFolder(udtBI)    If lngIDList <> 0 Then
        'Create string of nulls so it will fill in with the path
        strPath = String(MAX_PATH, 0)        'Retrieves the path selected, places in the null
         'character filled string
        lngResult = SHGetPathFromIDList(lngIDList, strPath)        'Frees memory
        Call CoTaskMemFree(lngIDList)        'Find the first instance of a null character,
         'so we can get just the path
        intNull = InStr(strPath, vbNullChar)
        'Greater than 0 means the path exists...
        If intNull > 0 Then
            'Set the value
            strPath = Left(strPath, intNull - 1)
        End If
    End If    'Return the path name
    BrowseForFolder = strPath
    Exit Function 'AbortehBrowseForFolder:    'Return no value
    BrowseForFolder = EmptyEnd FunctionPrivate Sub Command1_Click()
aa = BrowseForFolder(Me.hWnd, "")
MsgBox aa
End Sub

Answer 2

'在模块中输入
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As LongPublic Type BROWSEINFO
     hOwner As Long
     pidlRoot As Long
     pszDisplayName As String
     lpszTitle As String
     ulFlags As Long
     lpfn As Long
     lParam As Long
     iImage As Long
End Type
     
Public Const BIF_RETURNONLYFSDIRS = &H1
'*********************************************************************************
'自定义函数。打开浏览对话框，并返回所选文件夹的路径Public Function GetBrowseDir(Message As String) As String
    Dim bi As BROWSEINFO
    Dim tmpPath As String
    Dim pidl As Long
    
    bi.hOwner = 0&
    bi.pidlRoot = 0&
    bi.lpszTitle = Message
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    pidl = SHBrowseForFolder(bi)
    tmpPath = Space$(512)
    Rtn = SHGetPathFromIDList(ByVal pidl&, ByVal tmpPath)
    tmpPath = RTrim(tmpPath)
    GetBrowseDir = Left(tmpPath, Len(tmpPath) - 1)
End Function
'*********************************************************************************
'在form中输入
Private Sub Command1_Click()
    dim sPath as string
    sPath=GetBrowseDir ("YourTitle")
    '选择网络邻居后，spath就是你要的
End Sub

Answer 3

lxcc(虫莲) :你的代码我已经调试通过了,谢谢!