通用对话框问题，怎样只显示网上邻居？

[啊呀]

在CommonDialog中我只想显示网上邻居，就是说使用时不能选择本机的路径，
只能选网络共享的路径，请问有没有高手能够指点一下？

[rainstormmaster]

需要调用WNetEnumResource等相关api函数

[rainstormmaster]

使用vb获取网上邻居里的计算机名


关键词：Visual Basic


Option Explicit

Private Const RESOURCE_CONNECTED As Long = &H1&

Private Const RESOURCE_GLOBALNET As Long = &H2&

Private Const RESOURCE_REMEMBERED As Long = &H3&


Private Const RESOURCEDISPLAYTYPE_DIRECTORY& = &H9

Private Const RESOURCEDISPLAYTYPE_DOMAIN& = &H1

Private Const RESOURCEDISPLAYTYPE_FILE& = &H4

Private Const RESOURCEDISPLAYTYPE_GENERIC& = &H0

Private Const RESOURCEDISPLAYTYPE_GROUP& = &H5

Private Const RESOURCEDISPLAYTYPE_NETWORK& = &H6

Private Const RESOURCEDISPLAYTYPE_ROOT& = &H7

Private Const RESOURCEDISPLAYTYPE_SERVER& = &H2

Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3

Private Const RESOURCEDISPLAYTYPE_SHAREADMIN& = &H8

Private Const RESOURCETYPE_ANY As Long = &H0&

Private Const RESOURCETYPE_DISK As Long = &H1&

Private Const RESOURCETYPE_PRINT As Long = &H2&

Private Const RESOURCETYPE_UNKNOWN As Long = &HFFFF&

Private Const RESOURCEUSAGE_ALL As Long = &H0&

Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&

Private Const RESOURCEUSAGE_CONTAINER As Long = &H2&

Private Const RESOURCEUSAGE_RESERVED As Long = &H80000000

Private Const NO_ERROR = 0

Private Const ERROR_MORE_DATA = 234 注释：L // dderror

Private Const RESOURCE_ENUM_ALL As Long = &HFFFF

Private Type NETRESOURCE

dwScope As Long

dwType As Long

dwDisplayType As Long

dwUsage As Long

pLocalName As Long

pRemoteName As Long

pComment As Long

pProvider As Long

End Type

Private Type NETRESOURCE_REAL

dwScope As Long

dwType As Long

dwDisplayType As Long

dwUsage As Long

sLocalName As String

sRemoteName As String

sComment As String

sProvider As String

End Type

Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long

Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long

Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long

Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long

Private Declare Function VarPtrAny Lib "vb40032.dll" Alias "VarPtr" (lpObject As Any) As Long

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)

Private Declare Sub CopyMemByPtr Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpTo As Long, ByVal lpFrom As Long, ByVal lLen As Long)

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long


Sub main()

Const MAX_RESOURCES = 256

Const NOT_A_CONTAINER = -1


Dim bFirstTime As Boolean

Dim lReturn As Long

Dim hEnum As Long

Dim lCount As Long

Dim lMin As Long

Dim lLength As Long

Dim l As Long

Dim lBufferSize As Long

Dim lLastIndex As Long

Dim uNetApi(0 To MAX_RESOURCES) As NETRESOURCE

Dim uNet() As NETRESOURCE_REAL

bFirstTime = True

Do

If bFirstTime Then

lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)

bFirstTime = False

Else

If uNet(lLastIndex).dwUsage And RESOURCEUSAGE_CONTAINER Then

lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, uNet(lLastIndex), hEnum)

Else

lReturn = NOT_A_CONTAINER

hEnum = 0

End If

lLastIndex = lLastIndex + 1

End If

If lReturn = NO_ERROR Then

lCount = RESOURCE_ENUM_ALL

Do

lBufferSize = UBound(uNetApi) * Len(uNetApi(0)) / 2

lReturn = WNetEnumResource(hEnum, lCount, uNetApi(0), lBufferSize)

If lCount > 0 Then

ReDim Preserve uNet(0 To lMin + lCount - 1) As NETRESOURCE_REAL

For l = 0 To lCount - 1

注释：Each Resource will appear here as uNet(i)

uNet(lMin + l).dwScope = uNetApi(l).dwScope

uNet(lMin + l).dwType = uNetApi(l).dwType

uNet(lMin + l).dwDisplayType = uNetApi(l).dwDisplayType

uNet(lMin + l).dwUsage = uNetApi(l).dwUsage

If uNetApi(l).pLocalName Then

lLength = lstrlen(uNetApi(l).pLocalName)

uNet(lMin + l).sLocalName = Space$(lLength)

CopyMem ByVal uNet(lMin + l).sLocalName, ByVal uNetApi(l).pLocalName, lLength

End If

If uNetApi(l).pRemoteName Then

lLength = lstrlen(uNetApi(l).pRemoteName)

uNet(lMin + l).sRemoteName = Space$(lLength)

CopyMem ByVal uNet(lMin + l).sRemoteName, ByVal uNetApi(l).pRemoteName, lLength

End If

If uNetApi(l).pComment Then

lLength = lstrlen(uNetApi(l).pComment)

uNet(lMin + l).sComment = Space$(lLength)

CopyMem ByVal uNet(lMin + l).sComment, ByVal uNetApi(l).pComment, lLength

End If

If uNetApi(l).pProvider Then

lLength = lstrlen(uNetApi(l).pProvider)

uNet(lMin + l).sProvider = Space$(lLength)

CopyMem ByVal uNet(lMin + l).sProvider, ByVal uNetApi(l).pProvider, lLength

End If

Next l

End If

lMin = lMin + lCount

Loop While lReturn = ERROR_MORE_DATA

End If

If hEnum Then

l = WNetCloseEnum(hEnum)

End If

Loop While lLastIndex < lMin

If UBound(uNet) > 0 Then

For l = 0 To UBound(uNet)

Select Case uNet(l).dwDisplayType

Case RESOURCEDISPLAYTYPE_DIRECTORY&

Debug.Print "Directory...",

Case RESOURCEDISPLAYTYPE_DOMAIN

Debug.Print "Domain...",

Case RESOURCEDISPLAYTYPE_FILE

Debug.Print "File...",

Case RESOURCEDISPLAYTYPE_GENERIC

Debug.Print "Generic...",

Case RESOURCEDISPLAYTYPE_GROUP

Debug.Print "Group...",

Case RESOURCEDISPLAYTYPE_NETWORK&

Debug.Print "Network...",

Case RESOURCEDISPLAYTYPE_ROOT&

Debug.Print "Root...",

Case RESOURCEDISPLAYTYPE_SERVER

Debug.Print "Server...",

Case RESOURCEDISPLAYTYPE_SHARE

Debug.Print "Share...",

Case RESOURCEDISPLAYTYPE_SHAREADMIN&

Debug.Print "ShareAdmin...",

End Select

Debug.Print uNet(l).sRemoteName, uNet(l).sComment

Next l

End If

End Sub

[rainstormmaster]

标 题: Re: 急！请问那里可以找到带“网上邻居”的open file
发信站: BBS 水木清华站 (Thu Apr 27 12:15:22 2000)

用API就行啦。
给你一个yucheng给我的例程。

模块段：
Public 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 Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const MAX_PATH = 256

Public Declare Function SHGetPathFromIDList _
Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Public Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Form段：
Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim pos As Integer

lblSelected = ""

'Fill the BROWSEINFO structure with the
'needed data. To accomodate comments, the
'With/End With sytax has not been used, though
'it should be your 'final' version.

'hwnd of the window that receives messages
'from the call. Can be your application
'or the handle from GetDesktopWindow().
bi.hOwner = Me.hWnd

'Pointer to the item identifier list specifying
'the location of the "root" folder to browse from.
'If NULL, the desktop folder is used.
bi.pidlRoot = 0&

'message to be displayed in the Browse dialog
bi.lpszTitle = "请选择目标文件夹"

'the type of folder to return.
bi.ulFlags = BIF_RETURNONLYFSDIRS

'show the browse for folders dialog
pidl = SHBrowseForFolder(bi)

'the dialog has closed, so parse & display the
'user's returned folder selection contained in pidl
path = Space$(MAX_PATH)

If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
pos = InStr(path, Chr$(0))
TextFolder.Text = Left(path, pos - 1)
'lblSelected = Left(path, pos - 1)
End If

Call CoTaskMemFree(pidl)

[啊呀]

rainstormmaster(rainstormmaster)
谢谢，但是你没理解我的意思
我是要一个从根上就没有其他的列表，即根不是从“桌面”
开始的，而是从“网上邻居”开始的
不显示本地磁盘，只显示网络中的共享文件夹，
第一个方法要自己遍历
第二个方法我已经会了，不能满足要求
更改pidlRoot不行啊~~~

[啊呀]

up!

[yoki]

加一模块，代码如下：

Option Explicit

Type SHITEMID 'mkid
cb As Long 'Size of the ID (including cb itself)
abID As Byte 'The item ID (variable length)
End Type

Type ITEMIDLIST 'idl
mkid As SHITEMID
End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Public Const NOERROR = 0

Public Const CSIDL_DESKTOP = &H0 ' Windows desktop
Public Const CSIDL_PROGRAMS = &H2
Public Const CSIDL_CONTROLS = &H3 ' Control Panel ?
Public Const CSIDL_PRINTERS = &H4 ' Printers folder ?
Public Const CSIDL_PERSONAL = &H5 ' (Documents folder)
Public Const CSIDL_FAVORITES = &H6
Public Const CSIDL_STARTUP = &H7
Public Const CSIDL_RECENT = &H8 ' (Recent folder)
Public Const CSIDL_SENDTO = &H9
Public Const CSIDL_BITBUCKET = &HA
Public Const CSIDL_STARTMENU = &HB
Public Const CSIDL_DESKTOPDIRECTORY = &H10
Public Const CSIDL_DRIVES = &H11
Public Const CSIDL_NETWORK = &H12
Public Const CSIDL_NETHOOD = &H13
Public Const CSIDL_FONTS = &H14
Public Const CSIDL_TEMPLATES = &H15 ' (ShellNew folder)

Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

'///////////////////////////////////////////////////////////////////////////////////////////////////////////

' Displays a dialog box that enables the user to select a shell folder.
' Returns a pointer to an item identifier list that specifies the location
' of the selected folder relative to the root of the name space. If the user
' chooses the Cancel button in the dialog box, the return value is NULL.
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
Public Type BROWSEINFO 'bi
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 Function GetBrowsPath(frm As Form) As String
'在当前窗体打开选择目录对话框，返回选择的路径
Dim bi As BROWSEINFO
Dim idl As ITEMIDLIST
Dim rtn&, pidl&, path$, pos%

bi.lpszTitle = "请选择要保存的目录："
' the calling app
bi.hOwner = frm.hWnd
rtn& = SHGetSpecialFolderLocation(ByVal frm.hWnd, 0, idl)
bi.pidlRoot = idl.mkid.cb

' set the type of folder to return
' play with these option constants to see what can be returned
bi.ulFlags = BIF_RETURNONLYFSDIRS

' show the browse folder dialog
pidl& = SHBrowseForFolder(bi)

' if displaying the return value, get the selected folder
path$ = Space$(512)
rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
If rtn& Then
pos% = InStr(path$, Chr$(0))
GetBrowsPath = Left(path$, pos - 1)
Else
GetBrowsPath = ""
End If
End Function

然后在窗体中调用msgbox GetBrowsPath（formname)即可

[yoki]

至于你要显示哪个不显示哪个你可以设置bi.ulFlags

[啊呀]

up!up!

[啊呀]

yoki(小马哥)的方法和我用的一样啊，
ulFlags这个常数值和含义从哪里查呢？

[啊呀]

up!

[啊呀]

每日一顶！

[高高兴兴的晶晶]

学ing

[Surpass]

关注

[啊呀]

每日一顶！

[啊呀]

每日一顶！

[啊呀]

又顶！

[apple_boy]

再顶……

[啊呀]

不顶了，结贴！

[fangyds]

ulFlags:
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_BROWSEINCLUDEURLS = &H80
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_EDITBOX = &H10
Public Const BIF_NEWDIALOGSTYLE = &H40
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_SHAREABLE = &H8000
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_USENEWUI = &H40
Public Const BIF_VALIDATE = &H20