VERSION 1.0 CLASS
BEGIN
MultiUse = -1
'True
Persistable = 0
'NotPersistable
 
ataBindingBehavior = 0
'vbNone
 
ataSourceBehavior = 0
'vbNone
MTSTransactionMode = 0
'NotAnMTSObject
END
Attribute VB_Name = "CNetworkEnum"
Attribute VB_GlobalNameSpace =
False
Attribute VB_Creatable =
True
Attribute VB_PredeclaredId =
False
Attribute VB_Exposed =
False
' Класс выполняет функции перечисления компьютеров в сети.
' Показывает все сервера, совместно используемые ресурсы и принтеры в данной сети.
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
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_EXTENDED
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
'WNet API resources
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
Private Declare Function GetUserName
Lib "advapi32.dll"
Alias "GetUserNameA" (
ByVal lpBuffer
As String, nSize
As Long)
As Long
Private Declare Function GetComputerName
Lib "kernel32"
Alias "GetComputerNameA" (
ByVal lpBuffer
As String, nSize
As Long)
As Long
' Переменные для хранения отфильтрованных данных
Private sUserName
As String
Private sMachineName
As String
Private sServerList
As String
Private sPrinterList
As String
Private sShareList
As String
Private sDirectoryList
As String
Private sDomainList
As String
Private sFileList
As String
Private sGenericList
As String
Private sGroupList
As String
Private sNetworkList
As String
Private sRootList
As String
Private sShareAdminList
As String
' Устанавливает типы ресурса, которые будут перечислены (диск, принтер и т.д)
Private lResType
As Long
' Ограничение
Private Const MAX_RESOURCES = 256
Private Const NOT_A_CONTAINER = -1
' Хранение результатов перечисления
Private uNetApi(0
To MAX_RESOURCES)
As NETRESOURCE
Private uNet()
As NETRESOURCE_EXTENDED
Private Sub Class_Initialize()
'Установленно по умолчанию
Call SetResourceType(RESOURCETYPE_ANY)
End Sub
' Перезагрузка списков перечисленных объектов сети
Public Sub Reset()
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
bFirstTime =
True
Do
'Создание перечисления, используемого типа ресурса
If bFirstTime
Then
lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, GetResourceType, RESOURCEUSAGE_ALL,
ByVal 0&, hEnum)
bFirstTime =
False
Else
If uNet(lLastIndex).dwUsage
And RESOURCEUSAGE_CONTAINER
Then
lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, GetResourceType, 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_EXTENDED
For l = 0
To lCount - 1
'Каждый Ресурс будет появляться здесь как 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
'Расшифровка результатов
Call DecodeEnum
End Sub
Private Sub DecodeLocalInfo()
On Error Resume Next
'Создание буфера
sUserName =
String(255, Chr(0))
'Получение имени юзера
Call GetUserName(sUserName, 255)
'Отсечение остальной части буфера
sUserName = Left(sUserName, InStr(sUserName, Chr(0)) - 1)
'Создание буфера
sMachineName =
String(255, Chr(0))
Call GetComputerName(sMachineName, 255)
'Удаление ненужного знака chr(0)'s
sMachineName = Left$(sMachineName, InStr(1, sMachineName, Chr(0)) - 1)
End Sub
'Установка типа ресурса для перечисления
'(поставте ограничения для успешной работы)
'0 RESOURCETYPE_ANY = все
'1 RESOURCETYPE_DISK = машины и разделенные ресурсы
'2 RESOURCETYPE_PRINT = Только принтеры
'Default is RESOURCETYPE_DISK
Public Sub SetResourceType(lResourceType
As Long)
lResType = lResourceType
End Sub
' Возвращает текущий тип ресурса для просмотра
Public Function GetResourceType()
As Long
GetResourceType = lResType
End Function
' Расшифровка сетевой информации в упорядоченный набор
Private Sub DecodeEnum()
Dim l
As Long
If UBound(uNet) > 0
Then
' Получение информации о локальном компьютере (о вашем компьютере)
Call DecodeLocalInfo
' Анализ перечисление сети
For l = 0
To UBound(uNet)
Select Case uNet(l).dwDisplayType
Case RESOURCEDISPLAYTYPE_DIRECTORY&
sDirectoryList = sDirectoryList + uNet(l).sRemoteName + "|"
Case RESOURCEDISPLAYTYPE_DOMAIN
sDomainList = sDomainList + uNet(l).sRemoteName + ", "
Case RESOURCEDISPLAYTYPE_FILE
sFileList = sFileList + uNet(l).sRemoteName + "|"
Case RESOURCEDISPLAYTYPE_GENERIC
sGenericList = sGenericList + uNet(l).sRemoteName + "|"
Case RESOURCEDISPLAYTYPE_GROUP
sGroupList = sGroupList + uNet(l).sRemoteName + "|"
Case RESOURCEDISPLAYTYPE_NETWORK&
sNetworkList = sNetworkList + uNet(l).sRemoteName + "|"
Case RESOURCEDISPLAYTYPE_ROOT&
sRootList = sRootList + uNet(l).sRemoteName + "|"
Case RESOURCEDISPLAYTYPE_SERVER
sServerList = sServerList + uNet(l).sRemoteName + ","
Case RESOURCEDISPLAYTYPE_SHARE
sShareList = sShareList + uNet(l).sRemoteName + "|"
Case RESOURCEDISPLAYTYPE_SHAREADMIN&
sShareAdminList = sShareAdminList + uNet(l).sRemoteName + "|"
End Select
Next l
End If
End Sub
' Выдает имя юзера текущее
Public Function GetLocalUserName()
As String
GetLocalUserName = sUserName
End Function
' Выдает текущее имя машины
Public Function GetLocalMachineName()
As String
GetLocalMachineName = sMachineName
End Function
' Возвращает | разграниченный список всех компьютеров в сети
Public Function GetServerList()
As String
GetServerList = sServerList
End Function
' Возвращает | разграниченный список всех доступов в сети
Public Function GetShareList()
As String
GetShareList = sShareList
End Function
' Возвращает | разграниченный список всех принтеров в сети
Public Function GetPrinterList()
As String
GetPrinterList = sPrinterList
End Function
' Возвращает | разграниченный список всех директорий в сети
Public Function GetDirectoryList()
As String
GetDirectoryList = sDirectoryList
End Function
'Возвращает | разграниченный список всех доменов в сети
Public Function GetDomainList()
As String
GetDomainList = sDomainList
End Function
' Возвращает | разграниченный список всех файлов в сети
Public Function GetFileList()
As String
GetFileList = sFileList
End Function
'Возвращает | разграниченный список всех главных единиц в сети
Public Function GetGenericList()
As String
GetGenericList = sGenericList
End Function
' Возвращает | разграниченный список всех групп в сети
Public Function GetGroupList()
As String
GetGroupList = sGroupList
End Function
' Возвращает | разграниченный список всех подсетей в сети
Public Function GetNetworkList()
As String
GetNetworkList = sNetworkList
End Function
' Возвращает | разграниченный список всех корней в сети
Public Function GetRootList()
As String
GetRootList = sRootList
End Function
' Возвращает | разграниченный список всех admin доступов в сети
Public Function GetShareAdminList()
As String
GetShareAdminList = sShareAdminList
End Function