W VB.Net też można uzyskać sporo informacji :mrgreen:
Imports System.DirectoryServices
'Dodaj referencję System.DirectoryServices
Public Class Form1
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'Lista kont z uprawnieniami administratorskimi
Dim MachineName As String = "wpisz nazwę komputera" 'proponują localhost, ale u mnie na Win8 nie działa
Dim Admins As New DirectoryEntry("WinNT://" & MachineName & "/Administratorzy")
Dim Members As Object = Admins.Invoke("Members", Nothing)
For Each Member As Object In CType(Members, IEnumerable)
Dim CurrentMember As New DirectoryEntry(Member)
MsgBox(CurrentMember.Name, , "Grupa administratorzy")
Next
'Lista kont lokalnych
Dim WinNt As New DirectoryServices.DirectoryEntry("WinNT://" & MachineName)
For Each User As DirectoryServices.DirectoryEntry In WinNt.Children
If User.SchemaClassName = "User" Then
MsgBox(User.Name, , "Lista użytkowników")
End If
Next
'Kto jest teraz zalogowany
MsgBox(Environment.UserName, , "Aktualnie zalogowany")
End Sub
End Class
Zauważyłem, że przy kontach Administratora, Gościa i zwykłego usera User.Properities.Count zmienia się na 24, a przy HomeGroupUser$ na 23. Może taki filtr wystarczy. Ale gdy użytkownik należy do grupy zaawansowanych to też wpada do 23
Dim MachineName As String = "localhost"
Dim WinNt As New DirectoryServices.DirectoryEntry("WinNT://" & MachineName)
For Each User As DirectoryServices.DirectoryEntry In WinNt.Children
If User.SchemaClassName = "User" And User.Properties.Count = 24 Then
MsgBox(User.Name, , "Użytkownicy")
End If
Next
Teraz działa poprawnie, ale zauważyłem drugi błąd. I w tym pierwszym sposobie i w tym po przeróbce program zawiesza się po zakończeniu wyświetlania użytkowników tak jakby cały czas tkwił w pętli For Each. Jakieś pomysły?
Trzeba w takim razie podejść do tego z innej strony. Sprawdzimy czy folder danego użytkownika istnieje na dysku
Dim sciezka As String
'ścieżka do profilu aktualnego użytkownika (np.c:\users\ktos, albo c:\documents and settings\ktos)
sciezka = Environment.GetFolderPath(Environment.SpecialFolder.UserProfile)
For Each User As DirectoryServices.DirectoryEntry In WinNt.Children
If User.SchemaClassName = "User" Then
'sprawdzam czy katalog i równocześnie konto usera jest na dysku
If Directory.Exists(Mid(sciezka, 1, InStrRev(sciezka, "\")) & User.Name) = True Then
MsgBox(User.Name, , "Lista uzytkowników")
End If
End If
Next
Pomysł z porównaniem listy użytkowników z folderami jest świetny, ponieważ nie pokazuje mi już Administratora i Gościa.
Niestety to nie rozwiązało problemu bo program dalej się zapętlał, ale znalazłem sposób żeby pomóc mu wyjść z pętli.
Sposób polega na tym że pętla z funkcji ostuser() szuka w nazwach folderu nazwy ostatniego profilu, a następnie program
używa jej do porównania z aktualnie pobranym profilem i jeżeli są identyczne opuszcza pętle (Exit For).
Chyba jedyny problem jaki może wyskoczyć to jak ktoś doda folder w użytkownikach np. na literę Z.
I tutaj daje kod:
Imports System.DirectoryServices
Imports System.IO
Public Class Form1
Dim sciezka As String = System.Environment.GetFolderPath(Environment.SpecialFolder.UserProfile)
Private Sub Form1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Click
Dim local As String = "localhost"
Dim licznik As Byte = 0
Dim WinNt As New DirectoryServices.DirectoryEntry("WinNT://" & local)
Dim ost As String = ostuser()
For Each User As DirectoryServices.DirectoryEntry In WinNt.Children
licznik += 1
If User.SchemaClassName = "User" Then
If Directory.Exists(Mid(sciezka, 1, InStrRev(sciezka, "\")) & User.Name) = True Then
MsgBox(User.Name)
If ost = User.Name Then Exit For
End If
End If
Next
End Sub
Function ostuser()
Dim wynik As String = ""
sciezka = Mid(sciezka, 1, InStrRev(sciezka, "\"))
For Each i As String In Directory.GetDirectories(sciezka)
wynik = New DirectoryInfo(i).Name
Next
Return wynik
End Function
End Class
Na Windows 8 normalnie idzie, na Windows 7 też, na XP też dobrze. Foldery mam takie, ale nie mogą być brane pod uwagę, bo nie ma takich użytkowników. A Twoja funkcja uniemożliwi tym bardziej zakończenie wyliczania.
Spróbuj tego
Imports System.DirectoryServices.AccountManagement 'plus referencja do tego
Imports System.IO
Dim ctx As PrincipalContext = New PrincipalContext(ContextType.Machine)
Dim up As UserPrincipal = New UserPrincipal(ctx)
Dim ps As PrincipalSearcher = New PrincipalSearcher(up)
Dim sciezka As String = System.Environment.GetFolderPath(Environment.SpecialFolder.UserProfile)
Try
Dim results As PrincipalSearchResult(Of Principal) = ps.FindAll
For Each cr As Principal In results
If Directory.Exists(Mid(sciezka, 1, InStrRev(sciezka, "\")) cr.Name) = True Then
MsgBox(cr.Name, , "Użytkownicy lokalni")
End If
Next
Me.Show()
ps.Dispose()
up.Dispose()
ctx.Dispose()
Catch ex As Exception
MsgBox(ex.ToString)
End
End Try