|
Premium Content |
Membership is entirely free, and allows you to:
access programming projects posted by our partners; publish your articles, news, links; publish a project request; access our VB Careers section.
|
|
|
|
|
Source Codes -
Visual Basic
|
|
Written by Thomas Kaloyani
|
Find all local users and list them.
Usage:
Simply call DisplayInfo()
Declarations:
Private Type USER_INFO_10
usr10_name As Long
usr10_comment As Long
usr10_usr_comment As Long
usr10_full_name As Long
End Type
Private Type USER_INFO
name As String
full_name As String
comment As String
usr_comment As String
End Type
Private Const ERROR_SUCCESS As Long = 0&
Private Const MAX_COMPUTERNAME As Long = 15
Private Const MAX_USERNAME As Long = 256
Private Const FILTER_NORMAL_ACCOUNT As Long = &H2
Private Declare Function NetUserGetInfo Lib "netapi32" _
(lpServer As Byte, _
username As Byte, _
ByVal level As Long, _
lpBuffer As Long) As Long
Private Declare Function NetUserEnum Lib "netapi32" _
(servername As Byte, _
ByVal level As Long, _
ByVal filter As Long, _
buff As Long, _
ByVal buffsize As Long, _
entriesread As Long, _
totalentries As Long, _
resumehandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal Buffer As Long) As Long
Private Declare Function GetUserName Lib "advapi32" _
Alias "GetUserNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nBytes As Long)
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Declare Function StrLen Lib "kernel32" _
Alias "lstrlenW" _
(ByVal lpString As Long) As Long
Code:
Private Sub DisplayUsers()
Dim strTmp As String
Dim bytServername() As Byte
Dim colUsers As Collection
Dim udtUserInfo As USER_INFO
Dim i As Long
strTmp = GetComputersName()
If Len(strTmp) > 0 Then
If InStr(strTmp, "\\") Then
bytServername = strTmp & Chr$(0)
Else
bytServername = "\\" & strTmp & Chr$(0)
End If
End If
Set colUsers = GetUserEnumInfo(bytServername())
For i = 1 To colUsers.Count
udtUserInfo = GetUserInfo(bytServername(), colUsers(i) & Chr$(0))
Debug.Print "User Name: " & udtUserInfo.name
Debug.Print "User Full Name: " & udtUserInfo.full_name
Debug.Print "Comment: " & udtUserInfo.comment
Debug.Print "User Comment: " & udtUserInfo.usr_comment
Next i
End Sub
Private Function GetUserEnumInfo(ByRef bytServername() As Byte) As Collection
Dim lngUsers() As Long
Dim lngBuff As Long
Dim lngBuffSize As Long
Dim lngEntriesRead As Long
Dim lngTotalEntries As Long
Dim intCnt As Integer
Dim colUsers As New Collection
lngBuffSize = 255
If NetUserEnum(bytServername(0), 0, _
FILTER_NORMAL_ACCOUNT, _
lngBuff, lngBuffSize, _
lngEntriesRead, _
lngTotalEntries, 0&) = ERROR_SUCCESS Then
ReDim lngUsers(0 To lngEntriesRead - 1) As Long
CopyMemory lngUsers(0), ByVal lngBuff, lngEntriesRead * 4
For intCnt = 0 To lngEntriesRead - 1
colUsers.Add GetPointerToByteStringW(lngUsers(intCnt))
Next intCnt
NetApiBufferFree lngBuff
End If
Set GetUserEnumInfo = colUsers
End Function
Private Function GetPointerToByteStringW(lpString As Long) As String
Dim bytBuff() As Byte
Dim lngSize As Long
If lpString Then
lngSize = lstrlenW(lpString) * 2
If lngSize Then
ReDim bytBuff(0 To (lngSize - 1)) As Byte
CopyMemory bytBuff(0), ByVal lpString, lngSize
GetPointerToByteStringW = bytBuff
End If
End If
End Function
Private Function GetComputersName() As String
Dim strTmp As String
strTmp = Space$(MAX_COMPUTERNAME + 1)
If GetComputerName(strTmp, Len(strTmp)) <> 0 Then
GetComputersName = TrimNull(strTmp)
End If
End Function
Private Function TrimNull(strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, Chr$(0))
If intPos Then
TrimNull = Left$(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function
Private Function GetUserInfo(bytServername() As Byte, bytUsername() As Byte) As USER_INFO
Dim udtUserInfo As USER_INFO_10
Dim lngBuff As Long
If NetUserGetInfo(bytServername(0), bytUsername(0), 10, lngBuff) = ERROR_SUCCESS Then
CopyMemory udtUserInfo, ByVal lngBuff, Len(udtUserInfo)
GetUserInfo.name = GetPointerToByteStringW(udtUserInfo.usr10_name)
GetUserInfo.full_name = GetPointerToByteStringW(udtUserInfo.usr10_full_name)
GetUserInfo.comment = GetPointerToByteStringW(udtUserInfo.usr10_comment)
GetUserInfo.usr_comment = GetPointerToByteStringW(udtUserInfo.usr10_usr_comment)
NetApiBufferFree lngBuff
End If
End Function
About the author: Thomas is an experienced Visual Basic developer, with expertise of 7+ years developing especially financial applications. His main IT skills are VB, SQL, Crystal Reports - should you need a Visual Basic developer for your projects feel free to contact Thomas through his personal website at www.Kaloyani.com
Source: www.VBprofs.com |
|
|
|
|
Newsflash |
|
PowerRefresh 1.0 released!
A simple yet extremely useful tool for webmasters, publishers and SEO working bees: PowerRefresh allows you to automatically refresh your IE windows every x minutes. It can handle unlimited number of windows and, unlike similar applications, is using full browsers.
Get PowerRefresh from Kaloyani.com: download |
|
|
|
