怎样自动搜索局域网里所有共享的文件夹？

Question

我需要解决的问题是：用VB编个程序，能自动搜索局域网里所有共享的文件夹。局域网里的电脑用的是win2000系统。请高手帮忙。先谢了！

Answer 1

一个可以显示网络邻居以及所有可共享目录的信息的程序:
http://www.applevb.com/sourcecode/nwhood.zip

Answer 2

运行产生错误如下：
行 22: 控件 imlNWImages 的类 MSComctlLib.ImageList 不是一个已加载的控件类。
行 88: 控件 tvwNetwork 的类 MSComctlLib.TreeView 不是一个已加载的控件类。
行 25: 属性名 _ExtentX 在 imlNWImages 中是无效的。
行 26: 属性名 _ExtentY 在 imlNWImages 中是无效的。
行 28: 属性名 ImageWidth 在 imlNWImages 中是无效的。
行 29: 属性名 ImageHeight 在 imlNWImages 中是无效的。
行 30: 属性名 MaskColor 在 imlNWImages 中是无效的。
行 31: 属性名 _Version 在 imlNWImages 中是无效的。
行 86: 属性名 Images 在 imlNWImages 中是无效的。
行 94: 属性名 _ExtentX 在 tvwNetwork 中是无效的。
行 95: 属性名 _ExtentY 在 tvwNetwork 中是无效的。
行 96: 属性名 _Version 在 tvwNetwork 中是无效的。
行 97: 属性名 HideSelection 在 tvwNetwork 中是无效的。
行 98: 属性名 Indentation 在 tvwNetwork 中是无效的。
行 99: 属性名 LabelEdit 在 tvwNetwork 中是无效的。
行 100: 属性名 Style 在 tvwNetwork 中是无效的。

Answer 3

不要抄来抄去，自己花点时间研究，Debug...
Cheers!'列出LAN所有into Treeview
'I have used this code for many years!'a bas fileOption ExplicitPublic 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 TypePublic Const RESOURCE_GLOBALNET As Long = 2
Public Const RESOURCETYPE_ANY As Long = 0
Public Const RESOURCEUSAGE_CONTAINER As Long = 2Public Const ERROR_NO_MORE_ITEMS As Long = 259
Public Const NO_ERROR As Long = 0Public Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Public Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Public Const DEFAULT_LANG_ID As Long = &H400Declare 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 LongDeclare 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 LongDeclare Function WNetCloseEnum Lib "mpr" (ByVal hEnum As Long) As LongDeclare Function WNetEnumResource Lib "mpr" Alias "WNetEnumResourceA" ( _
    ByVal hEnum As Long, _
    ByRef EntryNum As Long, _
    ByRef buf As NETRESOURCE, _
    ByRef BufSize As Long) As LongDeclare Function lstrcpyFromPtr Lib "kernel32" Alias "lstrcpyA" (ByVal S As String, ByVal ptr As Long) As LongDeclare 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 treeviewOption ExplicitPrivate Res(1000) As NETRESOURCE
Private ResCount As LongPrivate 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 hEnumEnd 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 FunctionPrivate Function AllocNewRes() As Long    ResCount = ResCount + 1
       
    AllocNewRes = ResCountEnd FunctionPrivate 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 vbExclamationEnd SubPrivate Sub Form_Load()    
    ResCount = 0
  
    AddNetResourceChilds -1, -1End SubPrivate 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

Answer 4

你自己改一点，Floders 送到一数组，Files送到另外一数组。
Cheers!

Answer 5

在我这里可以运行，LZ有没有把VB打上SP6的补丁？