Dim objContainer
Dim objUser
Dim strIUserName
Dim strIWAMName
Dim strComputerName

strComputerName = GetComputerName()
strIUserName = "IUSR_" + strComputerName
strIWAMName  = "IWAM_" + strComputerName

'
' ADSI call to get the local computer object
Set objContainer = GetObject("WinNT://" + strComputerName )

'
' ADSI call to get the collection of local users
objContainer.Filter = Array("User"

iUserCount = 0
For Each objUser in objContainer

If objUser.UserFlags And CONST_UF_ACCOUNTDISABLE Then
strUserDisabled = L_YES_TEXT
Else
strUserDisabled = L_NO_TEXT
End If

If ( ( StrComp( objUser.Name, strIUserName,1 ) <> 0 ) AND _
     ( StrComp( objUser.Name, strIWAMName,1 ) <> 0 ) ) Then

     If ( Len( g_sSearchColValue ) <= 0 ) Then
     '
     ' Search criteria blank, select all rows
     '
     iUserCount = iUserCount + 1
    
     '
     ' Verify that the current user part of the current page
     If ( IsItemOnPage( iUserCount, g_iPageCurrent, USERS_PER_PAGE) ) Then
     Call OTS_AddTableRow( tableUser, Array(objUser.Name, objUser.FullName,strUserDisabled))
     strFlag="yesval"
     End If
    
     Else
     '
     ' Check the Search criteria
     '
     Select Case (g_iSearchCol)
    
     Case NAME_COLUMN
     If ( InStr(1, objUser.Name, g_sSearchColValue, 1) ) Then
     iUserCount = iUserCount + 1
     '
     ' Verify that the current user part of the current page
     If ( IsItemOnPage( iUserCount, g_iPageCurrent, USERS_PER_PAGE) ) Then
     Call OTS_AddTableRow( tableUser, Array(objUser.Name, objUser.FullName,strUserDisabled))
     strFlag="yesval"
     End If
     End If
    
     Case FULLNAME_COLUMN
     If ( InStr(1, objUser.FullName, g_sSearchColValue, 1) ) Then
     iUserCount = iUserCount + 1
     '
     ' Verify that the current user part of the current page
     If ( IsItemOnPage( iUserCount, g_iPageCurrent, USERS_PER_PAGE) ) Then
     Call OTS_AddTableRow( tableUser, Array(objUser.Name, objUser.FullName,strUserDisabled))
     strFlag="yesval"
     End If
     End If
    
     Case Else
     Call SA_TraceOut(SOURCE_FILE, "Unrecognized search column: " + CStr(g_iSearchCol))
     iUserCount = iUserCount + 1
     '
     ' Verify that the current user part of the current page
     If ( IsItemOnPage( iUserCount, g_iPageCurrent, USERS_PER_PAGE) ) Then
     Call OTS_AddTableRow( tableUser, Array(objUser.Name, objUser.FullName,strUserDisabled))
     strFlag="yesval"
     End If
     End Select
     End If
            End If
Next

Public Declare Function NetUserEnum Lib "netapi32" (lpServer As Any, ByVal level As Long, ByVal Filter As Long, lpBuffer As Long, ByVal PrefMaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long, lpResumeHandle As Long) As Long

Option Explicit

Public UserList As ListOfUserExt

'API Declarations & Constants
Public Const NERR_Success = 0&
Public Const NERR_Access_Denied = 5&
Public Const NERR_MoreData = 234&

Public Const SHORT_LEVEL = 10&
Public Const EXTENDED_LEVEL = 3&

Public Const USER_ACC_NOPWD_CHANGE = 577&
Public Const USER_ACC_NOPWD_EXPIRE = 66049
Public Const USER_ACC_DISABLED = 515&
Public Const USER_ACC_LOCKED = 529&

Private Type USER_INFO_EXT_API
    name As Long
    Password As Long
    PasswordAge As Long
    Privilege As Long
    HomeDir As Long
    Comment As Long
    Flags As Long
    ScriptPath As Long
    AuthFlags As Long
    FullName As Long
    UserComment As Long
    Parms As Long
    Workstations As Long
    LastLogon As Long
    LastLogoff As Long
    AcctExpires As Long
    MaxStorage As Long
    UnitsPerWeek As Long
    LogonHours As Long
    BadPwCount As Long
    NumLogons As Long
    LogonServer As Long
    CountryCode As Long
    CodePage As Long
    UserID As Long
    PrimaryGroupID As Long
    Profile As Long
    HomeDirDrive As Long
    PasswordExpired As Long
End Type

Type UserInfoExt
    name As String
    Password As String
    PasswordAge As String
    Privilege As String
    HomeDir As String
    Comment As String
    Flags As Long
    NoChangePwd As Boolean
    NoExpirePwd As Boolean
    AccDisabled As Boolean
    AccLocked As Boolean
    ScriptPath As String
    AuthFlags As Long
    FullName As String
    UserComment As String
    Parms As String
    Workstations As String
    LastLogon As String
    LastLogoff As String
    AcctExpires As String
    MaxStorage As Long
    UnitsPerWeek As Long
    LogonHours As String
    BadPwCount As Long
    NumLogons As Long
    LogonServer As String
    CountryCode As Long
    CodePage As Long
    UserID As Long
    PrimaryGroupID As Long
    Profile As String
    HomeDirDrive As String
    PasswordExpired As Boolean
End Type

Type ListOfUserExt
    Init As Boolean
    LastErr As Long
    list() As UserInfoExt
End Type

Public Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
        pTo As Any, _
         uFrom As Any, _
         ByVal lSize As Long)

Declare Function lstrlenW Lib "kernel32" _
        ByVal lpString As Long) As Long

Declare Function NetApiBufferFree Lib "netapi32" _
        ByVal lBuffer& As Long

Declare Function NetUserEnum Lib "netapi32" _
        lpServer As Any, ByVal Level As Long, _
         ByVal Filter As Long, lpBuffer As Long, _
         ByVal PrefMaxLen As Long, lpEntriesRead As Long, _
         lpTotalEntries As Long, lpResumeHandle As Long) As Long

Public Function LongEnumUsers(Server As String, lst As ListBox) As ListOfUserExt
Dim yServer() As Byte, lRetCode As Long
Dim nRead As Long, nTotal As Long
Dim nRet As Long, nResume As Long
Dim PrefMaxLen As Long
Dim i As Long, x As Long
Dim lUserInfo As Long
Dim lUserInfoPtr As Long
Dim UserInfo As UserInfoExt
Dim UserList As ListOfUserExt
Dim tUserInfo As USER_INFO_EXT_API
    yServer = MakeServerName(ByVal Server)
    PrefMaxLen = 65536
    lst.Clear
    Form1.MousePointer = 11
    nRet = NERR_MoreData
    Do While (nRet = NERR_MoreData)
        nRet = NetUserEnum(yServer(0), EXTENDED_LEVEL, 2, _
                           lUserInfo, PrefMaxLen, nRead, _
                           nTotal, nResume)
        If (nRet <> NERR_Success And _
             nRet <> NERR_MoreData) Then
            UserList.Init = False
            UserList.LastErr = nRet
            NetError nRet
            Exit Do
        End If
        lUserInfoPtr = lUserInfo
        x = 1
        Do While x <= nRead
            CopyMem tUserInfo, ByVal lUserInfoPtr, Len(tUserInfo)
            UserInfo.name = PointerToStringW(tUserInfo.name)
            UserInfo.Password = PointerToStringW(tUserInfo.Password)
            UserInfo.PasswordAge = GetNormalTime(tUserInfo.PasswordAge)
            Select Case tUserInfo.Privilege
            Case 0
                UserInfo.Privilege = "Guest"
            Case 1
                UserInfo.Privilege = "User"
            Case 2
                UserInfo.Privilege = "Administrator"
            End Select
            UserInfo.HomeDir = PointerToStringW(tUserInfo.HomeDir)
            UserInfo.Comment = PointerToStringW(tUserInfo.Comment)
            UserInfo.Flags = tUserInfo.Flags
            UserInfo.NoChangePwd = CBool((tUserInfo.Flags Or USER_ACC_NOPWD_CHANGE) = tUserInfo.Flags)
            UserInfo.NoExpirePwd = CBool((tUserInfo.Flags Or USER_ACC_NOPWD_EXPIRE) = tUserInfo.Flags)
            UserInfo.AccDisabled = CBool((tUserInfo.Flags Or USER_ACC_DISABLED) = tUserInfo.Flags)
            UserInfo.AccLocked = CBool((tUserInfo.Flags Or USER_ACC_LOCKED) = tUserInfo.Flags)
            UserInfo.ScriptPath = PointerToStringW(tUserInfo.ScriptPath)
            UserInfo.AuthFlags = tUserInfo.AuthFlags
            UserInfo.FullName = PointerToStringW(tUserInfo.FullName)
            UserInfo.UserComment = PointerToStringW(tUserInfo.UserComment)
            UserInfo.Parms = PointerToStringW(tUserInfo.Parms)
            UserInfo.Workstations = PointerToStringW(tUserInfo.Workstations)
            UserInfo.LastLogon = tUserInfo.LastLogon
            UserInfo.LastLogoff = tUserInfo.LastLogoff
            If tUserInfo.AcctExpires = -1& Then
                UserInfo.AcctExpires = "Never"
            Else
                UserInfo.AcctExpires = GetTimeFrom(tUserInfo.AcctExpires)
            End If
            UserInfo.MaxStorage = tUserInfo.MaxStorage
            UserInfo.UnitsPerWeek = tUserInfo.UnitsPerWeek
            UserInfo.LogonHours = GetNormalTime(tUserInfo.LogonHours)
            UserInfo.BadPwCount = tUserInfo.BadPwCount
            UserInfo.NumLogons = tUserInfo.NumLogons
            UserInfo.LogonServer = PointerToStringW(tUserInfo.LogonServer)
            UserInfo.CountryCode = tUserInfo.CountryCode
            UserInfo.CodePage = tUserInfo.CodePage
            UserInfo.UserID = tUserInfo.UserID
            UserInfo.PrimaryGroupID = tUserInfo.PrimaryGroupID
            UserInfo.Profile = PointerToStringW(tUserInfo.Profile)
            UserInfo.HomeDirDrive = PointerToStringW(tUserInfo.HomeDirDrive)
            UserInfo.PasswordExpired = CBool(tUserInfo.PasswordExpired)
            lst.AddItem UserInfo.name
            i = i + 1
            ReDim Preserve UserList.list(1 To i) As UserInfoExt
            UserList.list(i) = UserInfo
            x = x + 1
            DoEvents
            lUserInfoPtr = lUserInfoPtr + Len(tUserInfo)
        Loop
        lRetCode = NetApiBufferFree(lUserInfo)
        UserList.Init = (x > 1)
    Loop
    LongEnumUsers = UserList
End Function

Public Function MakeServerName(ByVal ServerName As String)
Dim yServer() As Byte
    If ServerName <> "" Then
        If InStr(1, ServerName, "\\" = 0 Then
            ServerName = "\\" & ServerName
        End If
    End If
    yServer = ServerName & vbNullChar
    MakeServerName = yServer
End Function

Public Function NetError(nErr As Long, Optional Ret) As String
Dim Msg As String
    If IsMissing(Ret) Then Ret = False
    Select Case nErr
        Case 5
            Msg = "Access Denied!"
        Case 1722
            Msg = "Server not accessible!"
        Case 1326
            Msg = " Sie besitzen nicht die Berechtigungen dafьr"
        Case Else
            Msg = "Error Nr. (" & nErr & " !"
    End Select
    
    If Not Ret Then
        Beep
        MsgBox Msg, vbCritical, "Net Error"
    Else
        NetError = Msg
    End If
    
End Function

Public Function PointerToStringW(lpStringW As Long) As String
Dim buffer() As Byte
Dim nLen As Long
    If lpStringW Then
        nLen = lstrlenW(lpStringW) * 2
        If nLen Then
            ReDim buffer(0 To (nLen - 1)) As Byte
            CopyMem buffer(0), ByVal lpStringW, nLen
            PointerToStringW = buffer
        End If
    End If
End Function

Public Function GetNormalTime(itime As Long) As String
Dim d As Long
Dim h As Long
Dim m As Long
Dim s As Long
    d = Int(itime / 86400)
    itime = itime - d * 3600 * 24
    h = Int(itime / 3600)
    itime = itime - h * 3600
    m = Int(itime / 60)
    itime = itime - m * 60
    s = itime
    GetNormalTime = d & "d." & h & "h." & m & "m." & s & "s."
End Function

Public Function GetTimeFrom(itime As Long) As String
    GetTimeFrom = DateAdd("s", itime, "1/1/1970"
End Function

, lst As ListBox