Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Access Новый топик    Ответить
 Список компьютеров и пользователей в сети  [new]
Polev
Member

Откуда:
Сообщений: 1359
Подскажите, как программно получить сабж?
18 мар 04, 14:38    [585297]     Ответить | Цитировать Сообщить модератору
 Re: Список компьютеров и пользователей в сети  [new]
Geo
Member

Откуда:
Сообщений: 6883
Посмотри faq по сжатию БД, там список кого-то получают. Только не помню, "кого".
18 мар 04, 16:59    [585771]     Ответить | Цитировать Сообщить модератору
 Re: Список компьютеров и пользователей в сети  [new]
Polev
Member

Откуда:
Сообщений: 1359
Блин.... Я же в этом уже разбирался, но потерял результаты и не помню как это делал.... Кажется через WSH....
19 мар 04, 10:00    [586705]     Ответить | Цитировать Сообщить модератору
 Re: Список компьютеров и пользователей в сети  [new]
Senin Viktor
Member

Откуда: Подмосковье
Сообщений: 5006
https://www.sql.ru/forum/actualthread.aspx?bid=22&tid=56222
В последнем посте - все константы API функции - что они делают - ясно из их названия, сами значения констант брать из API Text Viewer
19 мар 04, 10:51    [586894]     Ответить | Цитировать Сообщить модератору
 Re: Список компьютеров и пользователей в сети  [new]
Polev
Member

Откуда:
Сообщений: 1359
СПАСИБО!!!!!
19 мар 04, 10:58    [586922]     Ответить | Цитировать Сообщить модератору
 Re: Список компьютеров и пользователей в сети  [new]
Polev
Member

Откуда:
Сообщений: 1359
Только вот что... Список компов я получил, а список пользователей можно? Ну в смысле учетных записей?
19 мар 04, 12:24    [587225]     Ответить | Цитировать Сообщить модератору
 Re: Список компьютеров и пользователей в сети  [new]
OldPferd
Member

Откуда: Конопляновка
Сообщений: 1515
Поищи по форуму (и по MS SQL) про ADSI, LDAP

На эту тему сам как-то использовал такое
(должна быть ссылка на Active DS Type Library):

Private Const ADS_SCOPE_BASE = 0
Private Const ADS_SCOPE_ONELEVEL = 1
Private Const ADS_SCOPE_SUBTREE = 2
Private Const ADS_CHASE_REFERRALS_NEVER = 0
Private Const ADS_CHASE_REFERRALS_SUBORDINATE = &H20
Private Const ADS_CHASE_REFERRALS_EXTERNAL = &H40
Private Const ADS_CHASE_REFERRALS_ALWAYS = ADS_CHASE_REFERRALS_SUBORDINATE Or ADS_CHASE_REFERRALS_EXTERNAL

Function SamAccountNameGet(SamAccountName As String, SamAccountNameProp As String) As String
Dim sMsg As String, sObjectDN As String, sDomain As String
Dim rootDSE As IADs, oIADs As IADs, con As Connection, rs As Recordset, Com As Command
SamAccountNameGet = ""
On Error GoTo Err_
Set rootDSE = GetObject("LDAP://RootDSE")
sDomain = rootDSE.Get("defaultNamingContext")
sObjectDN = "LDAP://" & sDomain
Set rootDSE = Nothing
Set oIADs = GetObject(sObjectDN)
Set con = New Connection
con.Provider = "ADsDSOObject"
con.Open "Active Directory Provider"

Set Com = New Command
Set Com.ActiveConnection = con
Com.CommandText = "select " & SamAccountNameProp & " from '" & oIADs.ADsPath & "' where samaccountname='" & SamAccountName & "'"
Com.Properties("Page Size") = 1000
Com.Properties("Timeout") = 30
Com.Properties("searchscope") = ADS_SCOPE_SUBTREE
Com.Properties("Chase referrals") = ADS_CHASE_REFERRALS_EXTERNAL
Com.Properties("Cache Results") = False
Com.Properties("Size Limit") = 1

Set rs = New Recordset
Set rs = Com.Execute
If rs.EOF Then
MsgBox "Учетная запись " & SamAccountName & " не найдена", vbCritical, sDomain
Else
SamAccountNameGet = Nz(rs.Fields(SamAccountNameProp), "")
End If
rs.Close
Exit_:
Set rs = Nothing
Set Com = Nothing
Set con = Nothing
Set oIADs = Nothing
Exit Function
Err_:
Errmsg_cnn con
Resume Exit_
End Function
19 мар 04, 13:05    [587372]     Ответить | Цитировать Сообщить модератору
 Re: Список компьютеров и пользователей в сети  [new]
Senin Viktor
Member

Откуда: Подмосковье
Сообщений: 5006
Только навряд ли сисадмин даст права на чтение - во всяком случае у меня в сети их нет.
Возможно, есть другой способ, как Проводник ихполучает
19 мар 04, 13:33    [587454]     Ответить | Цитировать Сообщить модератору
 Re: Список компьютеров и пользователей в сети  [new]
Senin Viktor
Member

Откуда: Подмосковье
Сообщений: 5006
вот нашел - сразу несколько функций для работы с юзерами и группами
(Knowledge Base:HOWTO: Call LanMan Services from 32-bit Visual Basic Apps (Q159498))

   Option Explicit

Option Base 0 ' Important assumption for this code

Type MungeLong
X As Long
Dummy As Integer
End Type

Type MungeInt
XLo As Integer
XHi As Integer
Dummy As Integer
End Type

Type TUser0 '
Level 0
ptrName As Long
End Type

Type TUser1 ' Level 1
ptrName As Long
ptrPassword As Long
dwPasswordAge As Long
dwPriv As Long
ptrHomeDir As Long
ptrComment As Long
dwFlags As Long
ptrScriptPath As Long
End Type

'

' for dwPriv
'

Const USER_PRIV_MASK = &H3
Const USER_PRIV_GUEST = &H0
Const USER_PRIV_USER = &H1
Const USER_PRIV_ADMIN = &H2

'
'
for dwFlags
'
Const UF_SCRIPT = &H1
Const UF_ACCOUNTDISABLE = &H2
Const UF_HOMEDIR_REQUIRED = &H8
Const UF_LOCKOUT = &H10
Const UF_PASSWD_NOTREQD = &H20
Const UF_PASSWD_CANT_CHANGE = &H40
Const UF_NORMAL_ACCOUNT = &H200 '
Needs to be ORed with the
' other flags

'

' for lFilter
'

Const FILTER_NORMAL_ACCOUNT = &H2

Declare Function NetGetDCName Lib "NETAPI32.DLL" (ServerName As Byte, _
DomainName As Byte, DCNPtr As Long) As Long

Declare Function NetUserDel Lib "NETAPI32.DLL" (ServerName As Byte, _
UserName As Byte) As Long

Declare Function NetGroupAddUser Lib "NETAPI32.DLL" (ServerName As _
Byte, GroupName As Byte, UserName As Byte) As Long

Declare Function NetGroupDelUser Lib "NETAPI32.DLL" (ServerName As _
Byte, GroupName As Byte, UserName As Byte) As Long

' Add using Level 1 user structure
Declare Function NetUserAdd1 Lib "NETAPI32.DLL" Alias "NetUserAdd" _
(ServerName As Byte, ByVal Level As Long, Buffer As TUser1, ParmError _
As Long) As Long

'
Enumerate using Level 0 user structure
Declare Function NetUserEnum0 Lib "NETAPI32.DLL" Alias "NetUserEnum" _
(ServerName As Byte, ByVal Level As Long, ByVal lFilter As Long, _
Buffer As Long, ByVal PrefMaxLen As Long, EntriesRead As Long, _
TotalEntries As Long, ResumeHandle As Long) As Long

Declare Function NetGroupEnumUsers0 Lib "NETAPI32.DLL" Alias _
"NetGroupGetUsers" (ServerName As Byte, GroupName As Byte, _
ByVal Level As Long, Buffer As Long, ByVal PrefMaxLen As Long, _
EntriesRead As Long, TotalEntries As Long, ResumeHandle As Long) As Long

Declare Function NetGroupEnum0 Lib "NETAPI32.DLL" Alias "NetGroupEnum" _
(ServerName As Byte, ByVal Level As Long, Buffer As Long, ByVal _
PrefMaxLen As Long, EntriesRead As Long, TotalEntries As Long, _
ResumeHandle As Long) As Long

Declare Function NetUserGetGroups0 Lib "NETAPI32.DLL" Alias _
"NetUserGetGroups" (ServerName As Byte, UserName As Byte, _
ByVal Level As Long, Buffer As Long, ByVal PrefMaxLen As Long, _
EntriesRead As Long, TotalEntries As Long) As Long

Declare Function NetAPIBufferFree Lib "NETAPI32.DLL" Alias _
"NetApiBufferFree" (ByVal Ptr As Long) As Long

Declare Function NetAPIBufferAllocate Lib "NETAPI32.DLL" Alias _
"NetApiBufferAllocate" (ByVal ByteCount As Long, Ptr As Long) As Long

Declare Function PtrToStr Lib "Kernel32" Alias "lstrcpyW" _
(RetVal As Byte, ByVal Ptr As Long) As Long

Declare Function StrToPtr Lib "Kernel32" Alias "lstrcpyW" _
(ByVal Ptr As Long, Source As Byte) As Long

Declare Function PtrToInt Lib "Kernel32" Alias "lstrcpynW" _
(RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long

Declare Function StrLen Lib "Kernel32" Alias "lstrlenW" _
(ByVal Ptr As Long) As Long

Function AddUserToGroup(ByVal SName As String, _
ByVal GName As String, ByVal UName As String) As Long
'
'
This only adds users to global groups - not to local groups
'
Dim SNArray() As Byte, GNArray() As Byte, UNArray() As Byte, _
Result As Long
SNArray = SName & vbNullChar
GNArray = GName & vbNullChar
UNArray = UName & vbNullChar
Result = NetGroupAddUser(SNArray(0), GNArray(0), UNArray(0))
If Result = 2220 Then Debug.Print _
"There is no **GLOBAL** group '
" & GName & "'"
AddUserToGroup = Result
End Function

Function DelUser(ByVal SName As String, ByVal UName As String) As Long
Dim UNArray() As Byte, SNArray() As Byte
UNArray = UName & vbNullChar
SNArray = SName & vbNullChar
DelUser = NetUserDel(SNArray(0), UNArray(0))
End Function

Function DelUserFromGroup(ByVal SName As String, _
ByVal GName As String, ByVal UName As String) As Long
'

' This only deletes users from global groups - not local groups
'

Dim SNArray() As Byte, GNArray() As Byte, UNArray() As Byte, _
Result As Long
SNArray = SName & vbNullChar
GNArray = GName & vbNullChar
UNArray = UName & vbNullChar
Result = NetGroupDelUser(SNArray(0), GNArray(0), UNArray(0))
If Result = 2220 Then Debug.Print _
"There is no **GLOBAL** group '" & GName & "'"
DelUserFromGroup = Result
End Function

Function EnumerateGroups(ByVal SName As String, _
ByVal UName As String) As Long
'
'
Enumerates global groups only - not local groups
'
'
The buffer is filled from the left with pointers to user names that
' are filled from the right side. For example:
'

' ptr1|ptr2|...|ptrn|<garbage>|strn|...|str2|str1
'
^-------------- BufPtr buffer ----------------^

'
'
On NT, TotalEntries is the number of entries left to be read including
' the currently read entries.
'

' On LanMan and OS/2, it is the total number of entries, period. Code
'
would have to be changed to reflect this if the Domain controller
' wasn't an NT machine.
'
'
BufPtr gets the address of the buffer (or ptr1 - add 4 to BufPtr for
' each additional pointer)
'

Dim Result As Long, BufPtr As Long, EntriesRead As Long, _
TotalEntries As Long, ResumeHandle As Long, BufLen As Long, _
SNArray() As Byte, GNArray(99) As Byte, UNArray() As Byte, _
GName As String, I As Integer, UNPtr As Long, _
TempPtr As MungeLong, TempStr As MungeInt

SNArray = SName & vbNullChar ' Move to byte array
UNArray = UName & vbNullChar '
Move to Byte array
BufLen = 255 ' Buffer size
ResumeHandle = 0 '
Start with the first entry

Do
If UName = "" Then
Result = NetGroupEnum0(SNArray(0), 0, BufPtr, BufLen, _
EntriesRead, TotalEntries, ResumeHandle)
Else
Result = NetUserGetGroups0(SNArray(0), UNArray(0), 0, BufPtr, _
BufLen, EntriesRead, TotalEntries)
End If
EnumerateGroups = Result
If Result <> 0 And Result <> 234 Then ' 234 means multiple reads
'
required
Debug.Print "
Error " & Result & " enumerating group " & _
EntriesRead & "
of " & TotalEntries
Exit Function
End If
For I = 1 To EntriesRead
' Get pointer to string from beginning of buffer
'
Copy 4 byte block of memory in 2 steps
Result = PtrToInt(TempStr.XLo, BufPtr + (I - 1) * 4, 2)
Result = PtrToInt(TempStr.XHi, BufPtr + (I - 1) * 4 + 2, 2)
LSet TempPtr = TempStr ' munge 2 Integers to a Long
'
Copy string to array and convert to a string
Result = PtrToStr(GNArray(0), TempPtr.X)
GName = Left(GNArray, StrLen(TempPtr.X))
Debug.Print "
Group: " & GName
Next I
Loop Until EntriesRead = TotalEntries
' The above condition only valid for reading accounts on NT
'
but not OK for OS/2 or LanMan

Result = NetAPIBufferFree(BufPtr) ' Don't leak memory

End Function

Function EnumerateUsers(ByVal SName As String, ByVal GName As String) _
As Long
'
'
If a group name is specified, it must be a global group
' and not a local group.
'

' The buffer is filled from the left with pointers to user names that
'
are filled from the right side. For example:
'
'
ptr1|ptr2|...|ptrn|<garbage>|strn|...|str2|str1
' ^-------------- BufPtr buffer ----------------^
'

' On Windows NT, TotalEntries is the number of entries left to be read,
'
including the currently read entries.
' On LanMan and OS/2, it is the total number of entries, period. Code
'
would have to be changed to reflect this if the Domain controller
' wasn't an NT machine.
'
'
BufPtr gets the address of the buffer (or ptr1 - add 4 to BufPtr for
' each additional pointer)
'

' SName should be "\\servername"
'

Dim Result As Long, BufPtr As Long, EntriesRead As Long, _
TotalEntries As Long, ResumeHandle As Long, BufLen As Long, _
SNArray() As Byte, GNArray() As Byte, UNArray(99) As Byte, _
UName As String, I As Integer, UNPtr As Long, TempPtr As MungeLong, _
TempStr As MungeInt

SNArray = SName & vbNullChar ' Move to byte array
GNArray = GName & vbNullChar '
Move to Byte array
BufLen = 255 ' Buffer size
ResumeHandle = 0 '
Start with the first entry

Do
If GName = "
" Then
Result = NetUserEnum0(SNArray(0), 0, FILTER_NORMAL_ACCOUNT, _
BufPtr, BufLen, EntriesRead, TotalEntries, ResumeHandle)
Else
Result = NetGroupEnumUsers0(SNArray(0), GNArray(0), 0, BufPtr, _
BufLen, EntriesRead, TotalEntries, ResumeHandle)
End If
EnumerateUsers = Result
If Result <> 0 And Result <> 234 Then ' 234 means multiple reads
'
required
Debug.Print "
Error " & Result & " enumerating user " _
& EntriesRead & "
of " & TotalEntries
If Result = 2220 Then Debug.Print _
"
There is no **GLOBAL** group '" & GName & "'"
Exit Function
End If
For I = 1 To EntriesRead
' Get pointer to string from beginning of buffer
'
Copy 4-byte block of memory in 2 steps
Result = PtrToInt(TempStr.XLo, BufPtr + (I - 1) * 4, 2)
Result = PtrToInt(TempStr.XHi, BufPtr + (I - 1) * 4 + 2, 2)
LSet TempPtr = TempStr ' munge 2 integers into a Long
'
Copy string to array
Result = PtrToStr(UNArray(0), TempPtr.X)
UName = Left(UNArray, StrLen(TempPtr.X))
Debug.Print "
User: " & UName
Next I
Loop Until EntriesRead = TotalEntries
' The above condition is only valid for reading accounts on Windows NT,
'
but is not OK for OS/2 or LanMan

Result = NetAPIBufferFree(BufPtr) ' Don't leak memory

End Function

Function GetPrimaryDCName(ByVal MName As String, _
ByVal DName As String) As String
Dim Result As Long, DCName As String, DCNPtr As Long
Dim DNArray() As Byte, MNArray() As Byte, DCNArray(100) As Byte
MNArray = MName & vbNullChar
DNArray = DName & vbNullChar
Result = NetGetDCName(MNArray(0), DNArray(0), DCNPtr)
If Result <> 0 Then
Debug.Print "
Error: " & Result
Exit Function
End If
Result = PtrToStr(DCNArray(0), DCNPtr)
Result = NetAPIBufferFree(DCNPtr)
DCName = DCNArray()
GetPrimaryDCName = DCName
End Function

Function AddUser(ByVal SName As String, ByVal UName As String, _
ByVal PWD As String) As Long
Dim Result As Long, UNPtr As Long, PWDPtr As Long, ParmError As Long
Dim SNArray() As Byte, UNArray() As Byte, PWDArray() As Byte
Dim UserStruct As TUser1
'
'
Move to byte arrays
'
SNArray = SName & vbNullChar
UNArray = UName & vbNullChar
PWDArray = PWD & vbNullChar
'

' Allocate buffer space
'

Result = NetAPIBufferAllocate(UBound(UNArray) + 1, UNPtr)
Result = NetAPIBufferAllocate(UBound(PWDArray) + 1, PWDPtr)
'
'
Copy arrays to the buffer
'
Result = StrToPtr(UNPtr, UNArray(0))
Result = StrToPtr(PWDPtr, PWDArray(0))
'

' Fill the structure
'

With UserStruct
.ptrName = UNPtr
.ptrPassword = PWDPtr
.dwPasswordAge = 3
.dwPriv = USER_PRIV_USER
.ptrHomeDir = 0
.ptrComment = 0
.dwFlags = UF_NORMAL_ACCOUNT Or UF_SCRIPT
.ptrScriptPath = 0
End With
'
'
Add the user
'
Result = NetUserAdd1(SNArray(0), 1, UserStruct, ParmError)
AddUser = Result
If Result <> 0 Then
Debug.Print "Error " & Result & " in parameter " & ParmError _
& " when adding user " & UName
End If
'

' Release buffers from memory
'

Result = NetAPIBufferFree(UNPtr)
Result = NetAPIBufferFree(PWDPtr)

End Function
19 мар 04, 13:52    [587515]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Access Ответить