Привет всем.

Кто-нибудь знает, как в VB (а точнее, в VBScript) получить список компов в сети. Наверное это можно сделать, просмотрев пространство мен оболочки, но как это сделать из VB?

[VB & VBA]
Может и Вам пригодиться. Работает в локальной сети. Надеюсь разберётесь что к чему

Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function NetServerEnum Lib "netapi32" (Servername As Any, ByVal Level As Long, Address As Long, ByVal prefmaxlen As Long, ServersCount As Long, Count As Long, ByVal ServerType As Long, strDomain As Any, resumehandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long


Private Const SV_TYPE_SERVER As Long = &H2
Private Const SV_TYPE_SQLSERVER As Long = &H4

Private Type SV_100
  platform As Long
  name As Long
End Type

Public Function GetServers(Domain As String) As String
'
    Dim Response As Long
    Dim ServersCount As Long
    Dim Count As Long
    Dim hResume As Long
    Dim Address As Long
    Dim Level As Long
    Dim prefmaxlen As Long
    Dim ServerType As Long
    Dim Buffer() As Byte
    Dim Iterator As Long
    Dim sv100 As SV_100

    Level = 100
    prefmaxlen = -1

    ServerType = SV_TYPE_SERVER
    
    Buffer = Domain & vbNullChar
    Response = NetServerEnum(ByVal 0&, Level, Address, prefmaxlen, ServersCount, Count, ServerType, Buffer(0), hResume)
    
    If Response = 0 Or Response = 234& Then
        For Iterator = 0 To ServersCount - 1
            CopyMemory sv100, ByVal Address, Len(sv100)
            GetServers = GetServers & vbLf & Pointer2StringW(sv100.name)
            Address = Address + Len(sv100)
        Next
    Else
        GetServers = "#Error"
    End If
    NetApiBufferFree Address
End Function

Private Function Pointer2StringW(ByVal Address As Long) As String
    Dim Buffer() As Byte
    Dim Count As Long
    
    Count = lstrlenW(Address) * 2
    If Count Then
        ReDim Buffer(0 To (Count - 1)) As Byte
        CopyMemory Buffer(0), ByVal Address, Count
        Pointer2StringW = Buffer
    End If
End Function

Здравствуйте ma3ai, Вы писали:

M>[VB & VBA]
M>Может и Вам пригодиться. Работает в локальной сети. Надеюсь разберётесь что к чему

Спасибо!!! Разобрался!!! Но не подскажете ли вы как сделать то же самое через COM?

Здравствуйте Lonely Dog, Вы писали:

LD>Спасибо!!! Разобрался!!! Но не подскажете ли вы как сделать то же самое через COM?


"как сделать то же самое через COM" — слишком неоднозначно. Поподробнее пожалуйста.

M>"как сделать то же самое через COM" — слишком неоднозначно. Поподробнее пожалуйста.

Э... Ну например через интерфейсы оболочки или Active Directory.Я правда не знаю, как с ними работать.

Здравствуйте Lonely Dog, Вы писали:

LD>Здравствуйте ma3ai, Вы писали:

M>>[VB & VBA]
M>>Может и Вам пригодиться. Работает в локальной сети. Надеюсь разберётесь что к чему

LD>Спасибо!!! Разобрался!!! Но не подскажете ли вы как сделать то же самое через COM?

Если есть домен или ADS, то никаких проблем. Читаем Q194115 (HOWTO: Use ADSI in VB to Enumerate the Computers in an NT Domain)

Здравствуйте ma3ai, Вы писали:

M>[VB & VBA]
M>Может и Вам пригодиться. Работает в локальной сети. Надеюсь разберётесь что к чему

M>[vb]
M>Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
M>Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

M>Private Declare Function NetServerEnum Lib "netapi32" (Servername As Any, ByVal Level As Long, Address As Long, ByVal prefmaxlen As Long, ServersCount As Long, Count As Long, ByVal ServerType As Long, strDomain As Any, resumehandle As Long) As Long
M>Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long

M>
M>Private Const SV_TYPE_SERVER As Long = &H2
M>Private Const SV_TYPE_SQLSERVER As Long = &H4

M>Private Type SV_100
M> platform As Long
M> name As Long
M>End Type

M>Public Function GetServers(Domain As String) As String
M>'
M> Dim Response As Long
M> Dim ServersCount As Long
M> Dim Count As Long
M> Dim hResume As Long
M> Dim Address As Long
M> Dim Level As Long
M> Dim prefmaxlen As Long
M> Dim ServerType As Long
M> Dim Buffer() As Byte
M> Dim Iterator As Long
M> Dim sv100 As SV_100

M> Level = 100
M> prefmaxlen = -1

M> ServerType = SV_TYPE_SERVER
M>
M> Buffer = Domain & vbNullChar
M> Response = NetServerEnum(ByVal 0&, Level, Address, prefmaxlen, ServersCount, Count, ServerType, Buffer(0), hResume)
M>
M> If Response = 0 Or Response = 234& Then
M> For Iterator = 0 To ServersCount — 1
M> CopyMemory sv100, ByVal Address, Len(sv100)
M> GetServers = GetServers & vbLf & Pointer2StringW(sv100.name)
M> Address = Address + Len(sv100)
M> Next
M> Else
M> GetServers = "#Error"
M> End If
M> NetApiBufferFree Address
M>End Function

Здесь ошибка. Переменную Address нужно сохранять куда-нибудь еще. Т.к. вы ее сначала изменяете, а потом вызываете NetApiBufferFree.

Здравствуйте Lonely Dog, Вы писали:

LD>Здесь ошибка. Переменную Address нужно сохранять куда-нибудь еще. Т.к. вы ее сначала изменяете, а потом вызываете NetApiBufferFree.

Верно — не заметил. Спасибо.