[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
Кто-нибудь знает, как в VB (а точнее, в VBScript) получить список компов в сети. Наверное это можно сделать, просмотрев пространство мен оболочки, но как это сделать из VB?
Здравствуйте 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.