Private Sub Command1_Click()
Dim Temp As String
subGetComputerUsersInfo
Temp = ComputerUsers.username
'ect...
End Sub
' Module Code
Option Explicit
'by oh1mie
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 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
fullname As String
comment As String
usrcomment As String
End Type
Private Type ComputerUsers
username As String
Computername As String
usrname As String
usrfullname As String
usrcomment As String
usrusrcomment As String
USER_INFO() As USER_INFO
End Type
Private Declare Function GetUserName Lib "advapi32.dll" 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 Function NetUserGetInfo Lib "Netapi32" _
(lpServer As Byte, username As Byte, _
ByVal level As Long, lpBuffer 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 NetApiBufferFree Lib "Netapi32" _
(ByVal Buffer As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString 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
Public ComputerUsers As ComputerUsers
Public Sub subGetComputerUsersInfo()
On Local Error Resume Next
Dim tmp As String
Dim LCID As Long
With ComputerUsers
.username = fcnrgbGetUserName()
.Computername = fcnrgbGetComputerName()
Dim usr As USER_INFO
Dim bUsername() As Byte
Dim bServername() As Byte
If Len(.username) And Len(.Computername) Then
bUsername = .username & Chr(0)
tmp = .Computername
If Len(tmp) Then
If InStr(tmp, "\\") Then
bServername = tmp & Chr(0)
Else: bServername = "\\" & tmp & Chr(0)
End If
End If
usr = fcnGetUserNetworkInfo(bServername(), bUsername())
.usrname = usr.name
.usrfullname = usr.fullname
.usrcomment = usr.comment
.usrusrcomment = usr.usrcomment
End If
Call fcnGetUserEnumInfo(bServername())
End With
End Sub
Private Function fcnrgbGetUserName() As String
On Local Error Resume Next
'return the name of the user
Dim tmp As String
tmp = Space(MAX_USERNAME)
If GetUserName(tmp, Len(tmp)) Then
fcnrgbGetUserName = fcnTrimNull(tmp)
End If
End Function
Private Function fcnGetUserNetworkInfo(bServername() As Byte, _
bUsername() As Byte) As USER_INFO
On Local Error Resume Next
Dim usrapi As USER_INFO_10
Dim buff As Long
If NetUserGetInfo(bServername(0), bUsername(0), 10, buff) = ERROR_SUCCESS Then
'copy the data from buff into the
'API user_10 structure
CopyMemory usrapi, ByVal buff, Len(usrapi)
'extract each member and return
'as members of the UDT
fcnGetUserNetworkInfo.name = fcnGetPointerToByteStringW(usrapi.usr10_name)
fcnGetUserNetworkInfo.fullname = fcnGetPointerToByteStringW(usrapi.usr10_full_name)
fcnGetUserNetworkInfo.comment = fcnGetPointerToByteStringW(usrapi.usr10_comment)
fcnGetUserNetworkInfo.usrcomment = fcnGetPointerToByteStringW(usrapi.usr10_usr_comment)
NetApiBufferFree buff
End If
End Function
Private Function fcnGetPointerToByteStringW(lpString As Long) As String
On Local Error Resume Next
Dim buff() As Byte
Dim nSize As Long
If lpString Then
'its Unicode, so mult. by 2
nSize = lstrlenW(lpString) * 2
If nSize Then
ReDim buff(0 To (nSize - 1)) As Byte
CopyMemory buff(0), ByVal lpString, nSize
fcnGetPointerToByteStringW = buff
End If
End If
End Function
Private Function fcnGetUserEnumInfo(bServername() As Byte)
On Local Error Resume Next
Dim users() As Long
Dim buff As Long
Dim buffsize As Long
Dim entriesread As Long
Dim totalentries As Long
Dim cnt As Integer
Dim StrX(10) As String
Dim tmp As String
Dim usr As USER_INFO
Dim bUsername() As Byte
buffsize = 255
tmp = ComputerUsers.Computername
If Len(tmp) Then
If InStr(tmp, "\\") Then
bServername = tmp & Chr(0)
Else: bServername = "\\" & tmp & Chr(0)
End If
End If
If NetUserEnum(bServername(0), 0, _
FILTER_NORMAL_ACCOUNT, _
buff, buffsize, _
entriesread, _
totalentries, 0&) = ERROR_SUCCESS Then
ReDim users(0 To entriesread - 1) As Long
CopyMemory users(0), ByVal buff, entriesread * 4
For cnt = 0 To entriesread - 1
StrX(cnt) = fcnGetPointerToByteStringW(users(cnt))
bUsername = StrX(cnt) & Chr(0)
usr = fcnGetUserNetworkInfo(bServername(), bUsername())
ReDim Preserve ComputerUsers.USER_INFO(cnt)
ComputerUsers.USER_INFO(cnt).comment = usr.comment
ComputerUsers.USER_INFO(cnt).fullname = usr.fullname
ComputerUsers.USER_INFO(cnt).name = usr.name
ComputerUsers.USER_INFO(cnt).usrcomment = usr.usrcomment
Next cnt
NetApiBufferFree buff
End If
End Function
Private Function fcnrgbGetComputerName() As String
On Local Error Resume Next
'return the name of the computer
Dim tmp As String
tmp = Space(MAX_COMPUTERNAME + 1)
If GetComputerName(tmp, Len(tmp)) <> 0 Then
fcnrgbGetComputerName = fcnTrimNull(tmp)
End If
End Function
Private Function fcnTrimNull(Item As String)
On Local Error Resume Next
Dim pos As Integer
pos = InStr(Item, Chr(0))
If pos Then
fcnTrimNull = Left(Item, pos - 1)
Else: fcnTrimNull = Item
End If
End Function
Obtaining the current users NAME?
Reply With Quote
omainName(),$DC);
I have gone for a cheap and chearful method! As it is for an application which links to a database, I have created a new table with all the current user IDs in, and added the names to these.
