'модуль NetBrowse.bas
Option Explicit
Private Enum nbResourceScopes
nbRecourceScope_Connected = &H1&
nbRecourceScope_GlobalNet = &H2&
nbRecourceScope_Remembered = &H3&
nbRecourceScope_Recent = &H4&
nbResourceScope_Context = &H5&
End Enum
Private Enum nbResourceDisplayTypes
nbResourceDisplayType_Generic = &H0&
nbResourceDisplayType_Domain = &H1&
nbResourceDisplayType_Server = &H2&
nbResourceDisplayType_Share = &H3&
nbResourceDisplayType_File = &H4&
nbResourceDisplayType_Group = &H5&
nbResourceDisplayType_Network = &H6&
nbResourceDisplayType_Root = &H7&
nbResourceDisplayType_ShareAdmin = &H8&
nbResourceDisplayType_Directory = &H9&
nbResourceDisplayType_Tree = &HA&
nbResourceDisplayType_NDSContainer = &HB&
End Enum
Private Enum nbResourceTypes
nbResourceType_Any = &H0&
nbResourceType_Disk = &H1&
nbResourceType_Print = &H2&
nbResourceType_Reserver = &H8&
nbResourceType_Unknown = &HFFFF&
End Enum
Private Enum nbResourceUsages
nbResourceUsage_All = &H0&
nbResourceUsage_Connectable = &H1&
nbResourceUsage_Container = &H2&
nbResourceUsage_NoLocalDevice = &H4&
nbResourceUsage_Sibling = &H8&
nbResourceUsage_Attached = &H10&
nbResourceUsage_Reserved = &H80000000
End Enum
Private Enum nbErrors
nbNoError = 0&
nbErrorMoreData = 234&
End Enum
Private Const MAX_RESOURCES As Long = 256&
Private Type NETRESOURCE_API
dwScope As nbResourceScopes
dwType As nbResourceTypes
dwDisplayType As nbResourceDisplayTypes
dwUsage As nbResourceUsages
pLocalName As Long
pRemoteName As Long
pComment As Long
pProvider As Long
End Type
Private Type NETRESOURCE_REAL
dwScope As nbResourceScopes
dwType As nbResourceTypes
dwDisplayType As nbResourceDisplayTypes
dwUsage As nbResourceUsages
sLocalName As String
sRemoteName As String
sComment As String
sProvider As String
End Type
Private Declare Function WNetEnumResource Lib "mpr.dll" _
Alias "WNetEnumResourceA" ( _
ByVal hEnum As Long, _
lpcCount As Long, _
lpBuffer As NETRESOURCE_API, _
lpBufferSize As Long) _
As Long
Private Declare Function WNetOpenEnum Lib "mpr.dll" _
Alias "WNetOpenEnumA" ( _
ByVal dwScope As nbResourceScopes, _
ByVal dwType As nbResourceTypes, _
ByVal dwUsage As nbResourceUsages, _
lpNetResource As Any, _
lphEnum As Long) _
As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" ( _
lpTo As Any, _
lpFrom As Any, _
ByVal lLen As Long)
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenA" ( _
ByVal lpString As Any) _
As Long
Private Declare Function APIGetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) _
As Long
Private Declare Function APIGetComputerName Lib "kernel32" _
Alias "GetComputerNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) _
As Long
Public Function GetUserName()
Dim V As String, N As Long
N = 255&
V = String$(N, vbNullChar)
If APIGetUserName(V, N) <> 0 Then
GetUserName = Left$(V, N - 1)
End If
End Function
Public Function GetComputerName()
Dim V As String, N As Long
N = 255&
V = String$(N, vbNullChar)
If APIGetComputerName(V, N) <> 0 Then
GetComputerName = Left$(V, N)
End If
End Function
Public Function GetDomainName()
GetDomainName = Environ$("UserDomain")
End Function
Public Function ListResources() As Long
Const RESOURCE_ENUM_ALL As Long = &HFFFFFFFF
Const NOT_A_CONTAINER As Long = -1&
Dim hEnum As Long, ret As Long, flgFirst As Boolean
Dim I As Long, LastIndex As Long, MinIndex As Long, Count As Long
Dim BufferSize As Long, L As Long
Dim NetApi(0 To MAX_RESOURCES) As NETRESOURCE_API
Dim Net() As NETRESOURCE_REAL
flgFirst = True
Do
If flgFirst Then
ret = WNetOpenEnum(nbRecourceScope_GlobalNet, nbResourceType_Any, nbResourceUsage_All, ByVal 0&, hEnum)
flgFirst = False
Else
If Net(LastIndex).dwUsage And nbResourceUsage_Container = nbResourceUsages.nbResourceUsage_Container Then
ret = WNetOpenEnum(nbRecourceScope_GlobalNet, nbResourceType_Any, nbResourceUsage_All, Net(LastIndex), hEnum)
Else
ret = NOT_A_CONTAINER
hEnum = 0
End If
LastIndex = LastIndex + 1
End If
If ret = nbErrors.nbNoError Then
Count = RESOURCE_ENUM_ALL
Do
BufferSize = UBound(NetApi) * Len(NetApi(0)) / 2
ret = WNetEnumResource(hEnum, Count, NetApi(0), BufferSize)
If Count > 0 Then
ReDim Preserve Net(0 To MinIndex + Count - 1)
For I = 0 To Count - 1
Net(MinIndex + I).dwScope = NetApi(I).dwScope
Net(MinIndex + I).dwType = NetApi(I).dwType
Net(MinIndex + I).dwDisplayType = NetApi(I).dwDisplayType
Net(MinIndex + I).dwUsage = NetApi(I).dwUsage
Net(MinIndex + I).sLocalName = NetApi(I).pLocalName
Net(MinIndex + I).sRemoteName = NetApi(I).pRemoteName
Net(MinIndex + I).sComment = NetApi(I).pComment
Net(MinIndex + I).sProvider = NetApi(I).pProvider
If NetApi(I).pLocalName <> 0 Then
L = lstrlen(NetApi(I).pLocalName)
Net(MinIndex + I).sLocalName = String$(L, vbNullChar)
CopyMemory ByVal Net(MinIndex + I).sLocalName, ByVal NetApi(I).pLocalName, L
End If
If NetApi(I).pRemoteName <> 0 Then
L = lstrlen(NetApi(I).pRemoteName)
Net(MinIndex + I).sRemoteName = String$(L, vbNullChar)
CopyMemory ByVal Net(MinIndex + I).sRemoteName, ByVal NetApi(I).pRemoteName, L
End If
If NetApi(I).pComment <> 0 Then
L = lstrlen(NetApi(I).pComment)
Net(MinIndex + I).sComment = String$(L, vbNullChar)
CopyMemory ByVal Net(MinIndex + I).sComment, ByVal NetApi(I).pComment, L
End If
If NetApi(I).pProvider <> 0 Then
L = lstrlen(NetApi(I).pProvider)
Net(MinIndex + I).sProvider = String$(L, vbNullChar)
CopyMemory ByVal Net(MinIndex + I).sProvider, ByVal NetApi(I).pProvider, L
End If
Debug.Print Net(MinIndex + I).sLocalName & "*", Net(MinIndex + I).sRemoteName & "*", Net(MinIndex + I).sComment & "*", Net(MinIndex + I).sProvider & "*"
Next I
End If
MinIndex = MinIndex + Count
Loop While ret = nbErrors.nbErrorMoreData
End If
If hEnum <> 0 Then Call WNetCloseEnum(hEnum)
Loop While LastIndex < MinIndex
ListResources = UBound(Net)
End Function
Public Function ListWorkstations(WSArray() As String) As Long
Const RESOURCE_ENUM_ALL As Long = &HFFFFFFFF
Const NOT_A_CONTAINER As Long = -1&
Dim hEnum As Long, ret As Long, Count As Long, BufferSize As Long
Dim Index As Long, I As Long, L As Long
Dim NetApi(0 To MAX_RESOURCES) As NETRESOURCE_API
ReDim WSArray(0 To 1, 0)
ret = WNetOpenEnum(nbResourceScope_Context, nbResourceType_Any, nbResourceUsage_All, NetApi(0), hEnum)
If ret = nbErrors.nbNoError Then
Count = RESOURCE_ENUM_ALL
Do
BufferSize = UBound(NetApi) * Len(NetApi(0)) / 2
ret = WNetEnumResource(hEnum, Count, NetApi(0), BufferSize)
If Count > 0 Then
ReDim Preserve WSArray(0 To 1, 0 To Index + Count)
For I = 0 To Count - 1
If NetApi(I).dwDisplayType = nbResourceDisplayType_Server Then
Index = Index + 1
If NetApi(I).pRemoteName <> 0 Then
L = lstrlen(NetApi(I).pRemoteName)
WSArray(0, Index) = String$(L, vbNullChar)
CopyMemory ByVal WSArray(0, Index), ByVal NetApi(I).pRemoteName, L
End If
If NetApi(I).pComment <> 0 Then
L = lstrlen(NetApi(I).pComment)
WSArray(1, Index) = String$(L, vbNullChar)
CopyMemory ByVal WSArray(1, Index), ByVal NetApi(I).pComment, L
End If
Debug.Print Index, WSArray(0, Index), WSArray(1, Index)
End If
Next I
End If
Index = Index + Count
Loop While ret = nbErrors.nbErrorMoreData
ReDim Preserve WSArray(0 To 1, 0 To Index)
End If
If hEnum <> 0 Then Call WNetCloseEnum(hEnum)
ListWorkstations = UBound(WSArray, 2)
End Function
Сейчас этот форум просматривают: AhrefsBot и гости: 9