پیدا کردن کاربران ویندوز

[s7004u]

سلام

چطور میتونم کلیه user های ویندوز رو با برنامم بگیرم ؟
اگه سطح کاربریشونم بگه عالیه

[Router]

بنده کاربری که با اون برنامه رو اجرا میکنه رو میتونم بگیرم
شاید به کارتون بیاد

کد:

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Sub Command1_Click()
Dim Buffer As String
Buffer = String(255, 0)
GetUserName Buffer, 255
Buffer = Left(Buffer, InStr(Buffer, Chr(0)) - 1)
Text1 = Buffer
End Sub

[lord_viper]

با استفاده از تابع

کد:

function NetUserEnum(ServerName: PWideChar;
Level,
fliter: DWORD;
var Buffer: Pointer;
PrefMaxLen: DWORD;
var EntriesRead,
TotalEntries,
ResumeHandle: DWORD): Longword; stdcall; external 'netapi32.dll';

[Payman62]

سلام.
این کد رو در ماژول قرار بده.

کد:

Option Explicit

'API types
Private Type USER_INFO
    Name As String
    Comment As String
    UserComment As String
    FullName As String
End Type

Private Type USER_INFO_API
    Name As Long
    Comment As Long
    UserComment As Long
    FullName As Long
End Type

Public UserInfo(0 To 1000) As USER_INFO

'API calls
Private Declare Function NetUserEnum Lib "netapi32.dll" (lpServer As Any, ByVal Level As Long, ByVal fliter As Long, lpBuffer As Long, ByVal PrefMaxLen As Long, EntriesRead As Long, TotalEntries As Long, ResumeHandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal pBuffer As Long) As Long

Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long

'API Constants
Private Const NERR_Success As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&

Private Const FILTER_TEMP_DUPLICATE_ACCOUNT As Long = &H1&
Private Const FILTER_NORMAL_ACCOUNT As Long = &H2&
Private Const FILTER_PROXY_ACCOUNT As Long = &H4&
Private Const FILTER_INTERDOMAIN_TRUST_ACCOUNT As Long = &H8&
Private Const FILTER_WORKSTATION_TRUST_ACCOUNT As Long = &H10&
Private Const FILTER_SERVER_TRUST_ACCOUNT As Long = &H20&


Private Function PtrToString(lpwString As Long) As String
    'Convert a LPWSTR pointer to a VB string
    Dim Buffer() As Byte
    Dim nLen As Long

    If lpwString Then
        nLen = lstrlenW(lpwString) * 2
        If nLen Then
            ReDim Buffer(0 To (nLen - 1)) As Byte
            CopyMem Buffer(0), ByVal lpwString, nLen
            PtrToString = Buffer
        End If
    End If
End Function

Public Function GetUsers(ServerName As String) As Long
    Dim lpBuffer As Long
    Dim nRet As Long
    Dim EntriesRead As Long
    Dim TotalEntries As Long
    Dim ResumeHandle As Long
    Dim uUser As USER_INFO_API
    Dim bServer() As Byte
    Dim i As Integer

    If Trim(ServerName) = "" Then
        'Local users
        bServer = vbNullString
    Else
        'Check the syntax of the ServerName string
        If InStr(ServerName, "\\") = 1 Then
            bServer = ServerName & vbNullChar
        Else
            bServer = "\\" & ServerName & vbNullChar
        End If
    End If
    i = 0
    ResumeHandle = 0
    Do
        'Start to enumerate the Users
        If Trim(ServerName) = "" Then
            nRet = NetUserEnum(vbNullString, 10, FILTER_NORMAL_ACCOUNT, lpBuffer, 1, EntriesRead, TotalEntries, ResumeHandle)
        Else
            nRet = NetUserEnum(bServer(0), 10, FILTER_NORMAL_ACCOUNT, lpBuffer, 1, EntriesRead, TotalEntries, ResumeHandle)
        End If
        'Fill the data structure for the User
        If nRet = ERROR_MORE_DATA Then
            CopyMem uUser, ByVal lpBuffer, Len(uUser)
            UserInfo(i).Name = PtrToString(uUser.Name)
            UserInfo(i).Comment = PtrToString(uUser.Comment)
            UserInfo(i).UserComment = PtrToString(uUser.UserComment)
            UserInfo(i).FullName = PtrToString(uUser.FullName)
            i = i + 1
        End If
        If lpBuffer Then
            Call NetApiBufferFree(lpBuffer)
        End If
    Loop While nRet = ERROR_MORE_DATA
    'Return the number of Users
    GetUsers = i
End Function

اینم روش استفادش.

کد:

'Usage: Create a Form with a Command Button and a ListBox
Private Sub Command1_Click()
    Dim i As Integer
    Dim NumUsers As Integer

    NumUsers = GetUsers("") 'For local users use "" as Server Parameter
    'Fill the List
    List1.Clear
    For i = 0 To NumUsers - 1
        List1.AddItem UserInfo(i).Name
    Next
End Sub

[s7004u]

سلام.
این کد رو در ماژول قرار بده.

کد:

Option Explicit

'API types
Private Type USER_INFO
Name As String
Comment As String
UserComment As String
FullName As String
End Type

Private Type USER_INFO_API
Name As Long
Comment As Long
UserComment As Long
FullName As Long
End Type

Public UserInfo(0 To 1000) As USER_INFO

'API calls
Private Declare Function NetUserEnum Lib "netapi32.dll" (lpServer As Any, ByVal Level As Long, ByVal fliter As Long, lpBuffer As Long, ByVal PrefMaxLen As Long, EntriesRead As Long, TotalEntries As Long, ResumeHandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal pBuffer As Long) As Long

Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long

'API Constants
Private Const NERR_Success As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&

Private Const FILTER_TEMP_DUPLICATE_ACCOUNT As Long = &H1&
Private Const FILTER_NORMAL_ACCOUNT As Long = &H2&
Private Const FILTER_PROXY_ACCOUNT As Long = &H4&
Private Const FILTER_INTERDOMAIN_TRUST_ACCOUNT As Long = &H8&
Private Const FILTER_WORKSTATION_TRUST_ACCOUNT As Long = &H10&
Private Const FILTER_SERVER_TRUST_ACCOUNT As Long = &H20&


Private Function PtrToString(lpwString As Long) As String
'Convert a LPWSTR pointer to a VB string
Dim Buffer() As Byte
Dim nLen As Long

If lpwString Then
nLen = lstrlenW(lpwString) * 2
If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
CopyMem Buffer(0), ByVal lpwString, nLen
PtrToString = Buffer
End If
End If
End Function

Public Function GetUsers(ServerName As String) As Long
Dim lpBuffer As Long
Dim nRet As Long
Dim EntriesRead As Long
Dim TotalEntries As Long
Dim ResumeHandle As Long
Dim uUser As USER_INFO_API
Dim bServer() As Byte
Dim i As Integer

If Trim(ServerName) = "" Then
'Local users
bServer = vbNullString
Else
'Check the syntax of the ServerName string
If InStr(ServerName, "\\") = 1 Then
bServer = ServerName & vbNullChar
Else
bServer = "\\" & ServerName & vbNullChar
End If
End If
i = 0
ResumeHandle = 0
Do
'Start to enumerate the Users
If Trim(ServerName) = "" Then
nRet = NetUserEnum(vbNullString, 10, FILTER_NORMAL_ACCOUNT, lpBuffer, 1, EntriesRead, TotalEntries, ResumeHandle)
Else
nRet = NetUserEnum(bServer(0), 10, FILTER_NORMAL_ACCOUNT, lpBuffer, 1, EntriesRead, TotalEntries, ResumeHandle)
End If
'Fill the data structure for the User
If nRet = ERROR_MORE_DATA Then
CopyMem uUser, ByVal lpBuffer, Len(uUser)
UserInfo(i).Name = PtrToString(uUser.Name)
UserInfo(i).Comment = PtrToString(uUser.Comment)
UserInfo(i).UserComment = PtrToString(uUser.UserComment)
UserInfo(i).FullName = PtrToString(uUser.FullName)
i = i + 1
End If
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
Loop While nRet = ERROR_MORE_DATA
'Return the number of Users
GetUsers = i
End Function

اینم روش استفادش.

کد:

'Usage: Create a Form with a Command Button and a ListBox
Private Sub Command1_Click()
Dim i As Integer
Dim NumUsers As Integer

NumUsers = GetUsers("") 'For local users use "" as Server Parameter
'Fill the List
List1.Clear
For i = 0 To NumUsers - 1
List1.AddItem UserInfo(i).Name
Next
End Sub

از پاسخ کامل و عالی شما ممنونم.
حالا اگر بخوام یوزر های disable شده و نشده رو هم نشون بده و خودمم بتونم disable کنم یا enable ،باید چیکار کنم؟

[s7004u]

حالا اگر بخوام یوزر های disable شده و نشده رو هم نشون بده و خودمم بتونم disable کنم یا enable ،باید چیکار کنم؟