怎样自动搜索局域网里所有共享的文件夹？
我需要解决的问题是：用VB编个程序，能自动搜索局域网里所有共享的文件夹。局域网里的电脑用的是win2000系统。请高手帮忙。先谢了！
[解决办法]
一个可以显示网络邻居以及所有可共享目录的信息的程序:
http://www.applevb.com/sourcecode/nwhood.zip
[解决办法]
测试了一下，没发现问题，检查一下你的系统是否有问题，同时确认你的工程没有丢失对有关部件或组件的引用
[解决办法]
不要抄来抄去，自己花点时间研究，Debug...
Cheers!
'列出LAN所有。。。into Treeview
'I have used this code for many years!
'a bas file
Option Explicit
Public Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
buf(1000) As Byte
End Type
Public Const RESOURCE_GLOBALNET As Long = 2
Public Const RESOURCETYPE_ANY As Long = 0
Public Const RESOURCEUSAGE_CONTAINER As Long = 2
Public Const ERROR_NO_MORE_ITEMS As Long = 259
Public Const NO_ERROR As Long = 0
Public Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Public Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Public Const DEFAULT_LANG_ID As Long = &H400
Declare Function WNetOpenEnum Lib "mpr " Alias "WNetOpenEnumA " ( _
ByVal ResScope As Long, _
ByVal ResType As Long, _
ByVal ResUsage As Long, _
ByRef Res As NETRESOURCE, _
ByRef hEnum As Long) As Long
Declare Function WNetOpenEnumForRoot Lib "mpr " Alias "WNetOpenEnumA " ( _
ByVal ResScope As Long, _
ByVal ResType As Long, _
ByVal ResUsage As Long, _
ByVal pRes As Long, _
ByRef hEnum As Long) As Long
Declare Function WNetCloseEnum Lib "mpr " (ByVal hEnum As Long) As Long
Declare Function WNetEnumResource Lib "mpr " Alias "WNetEnumResourceA " ( _
ByVal hEnum As Long, _
ByRef EntryNum As Long, _
ByRef buf As NETRESOURCE, _
ByRef BufSize As Long) As Long
Declare Function lstrcpyFromPtr Lib "kernel32 " Alias "lstrcpyA " (ByVal S As String, ByVal ptr As Long) As Long
Declare Function FormatMessage Lib "kernel32 " Alias "FormatMessageA " ( _
ByVal Flags As Long, _
ByVal pSource As Long, _
ByVal MessageID As Long, _
ByVal LangID As Long, _
ByVal Message As String, _
ByVal MessageSize As Long, _
ByVal pArgs As Long) As Long
Public Function PtrToStr(ptr As Long) As String
Dim S As String * 1000
lstrcpyFromPtr S, ptr
PtrToStr = Left(S, InStr(S, vbNullChar) - 1)
End Function
'A form with treeview
Option Explicit
Private Res(1000) As NETRESOURCE
Private ResCount As Long
Private Const RESIDX_PREFIX As String = "RESIDX: "
Private Const INTERNAL_NODE_NAME As String = "internal node "
Private Sub AddNetResourceChilds(ParentNodeIdx As Long, ContainterIdx As Long)
Dim lResult As Long
Dim ResIdx As Long
Dim EntryNum As Long
Dim BufSize As Long
Dim hEnum As Long
If ContainterIdx = -1 Then
lResult = WNetOpenEnumForRoot(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, 0, hEnum)
Else
lResult = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, Res(ContainterIdx), hEnum)
End If
If lResult <> NO_ERROR Then
DispDllError
Exit Sub
End If
Do '???????
ResIdx = AllocNewRes()
EntryNum = 1
BufSize = 1000
lResult = WNetEnumResource(hEnum, EntryNum, Res(ResIdx), BufSize)
If lResult = ERROR_NO_MORE_ITEMS Then Exit Do
If lResult <> NO_ERROR Then
DispDllError
Exit Do
End If
AddNewNetResourceNode ParentNodeIdx, ResIdx
Loop
WNetCloseEnum hEnum
End Sub
' ?????????????
Private Function AddNewNetResourceNode(ParentIdx As Long, ResIdx As Long) As Long
Dim RemoteName As String
Dim NewNode As Node
RemoteName = PtrToStr(Res(ResIdx).lpRemoteName)
If ParentIdx <> -1 Then
Set NewNode = tvwNetView.Nodes.Add(tvwNetView.Nodes(ParentIdx), tvwChild, RESIDX_PREFIX & ResIdx, RemoteName)
Else
Set NewNode = tvwNetView.Nodes.Add(, , RESIDX_PREFIX & ResIdx, RemoteName)
End If
If (Res(ResIdx).dwUsage And RESOURCEUSAGE_CONTAINER) <> 0 Then
tvwNetView.Nodes.Add NewNode.Index, tvwChild, , INTERNAL_NODE_NAME
End If
End Function
Private Function AllocNewRes() As Long
ResCount = ResCount + 1
AllocNewRes = ResCount
End Function
Private Sub DispDllError()
Dim errno As Long
Dim buf As String * 1000
errno = Err.LastDllError
errno = FormatMessage( _
FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
0, errno, DEFAULT_LANG_ID, buf, 1000, 0)
MsgBox Left(buf, InStr(buf, vbNullChar) - 1), vbOKOnly Or vbExclamation
End Sub
Private Sub Form_Load()
ResCount = 0
AddNetResourceChilds -1, -1
End Sub
Private Sub tvwNetView_Expand(ByVal Node As MSComctlLib.Node)
Dim hEnum As Long
Dim ParentIdx As Long
Dim lResult As Long
Dim ResIdx As Long
Dim EntryNum As Long
Dim BufSize As Long
If Node.Children > 0 Then
If Node.Child.Text = INTERNAL_NODE_NAME Then
tvwNetView.MousePointer = ccHourglass
tvwNetView.Nodes.Remove Node.Child.Index
tvwNetView.Refresh
ParentIdx = CLng(Mid(Node.Key, Len(RESIDX_PREFIX) + 1))
AddNetResourceChilds Node.Index, CLng(Mid(Node.Key, Len(RESIDX_PREFIX) + 1))
tvwNetView.MousePointer = ccDefault
End If
End If
End Sub
[解决办法]
在我这里可以运行，LZ有没有把VB打上SP6的补丁？
