读书人

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

发布时间: 2012-01-30 21:15:58 作者: rapoo

怎样自动搜索局域网里所有共享的文件夹?
我需要解决的问题是:用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的补丁?

读书人网 >VB

热点推荐