Please Help Me - Hard Question

[Gary007]

I need a way of enumerating the usernames of people on my windows 98 LAN.
Is there a way to do this?

[Serge]

Here's how you can get all computers on the LAN for the current domain. Add a Listbox (List1) and a Command Button (Command1):

Private Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As Long
    lpRemoteName As Long
    lpComment As Long
    lpProvider As Long
End Type
   
Private Type NETRES2
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As String
    lpRemoteName As String
    lpComment As String
    lpProvider As String
End Type

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function lstrcpyA Lib "kernel32" Alias "lstrcpy" (ByVal NewString As String, ByVal OldString As Long) As Long
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, ByVal lpBuffer As Long, ByRef lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long


Private Const RESOURCE_CONNECTED = &H1
Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCE_REMEMBERED = &H3
Private Const RESOURCE_CONTEXT = &H5

Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCETYPE_DISK = &H1
Private Const RESOURCETYPE_PRINT = &H2
Private Const RESOURCETYPE_UNKNOWN = &HFFFF

Private Const RESOURCEUSAGE_CONNECTABLE = &H1
Private Const RESOURCEUSAGE_CONTAINER = &H2
Private Const RESOURCEUSAGE_RESERVED = &H80000000

Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_DISCARDABLE = &H100
Private Const GMEM_DISCARDED = &H4000
Private Const GMEM_FIXED = &H0
Private Const GMEM_INVALID_HANDLE = &H8000
Private Const GMEM_LOCKCOUNT = &HFF
Private Const GMEM_MODIFY = &H80
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_NOT_BANKED = &H1000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_VALID_FLAGS = &H7F72
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Private Const ERROR_MORE_DATA = 234

Private Const RESOURCEDISPLAYTYPE_GENERIC = 0
Private Const RESOURCEDISPLAYTYPE_DOMAIN = 1
Private Const RESOURCEDISPLAYTYPE_SERVER = 2
Private Const RESOURCEDISPLAYTYPE_SHARE = 3
Private Const RESOURCEDISPLAYTYPE_FILE = 4
Private Const RESOURCEDISPLAYTYPE_GROUP = 5
Private Const RESOURCEDISPLAYTYPE_NETWORK = 6
Private Const RESOURCEDISPLAYTYPE_ROOT = 7
Private Const RESOURCEDISPLAYTYPE_SHAREADMIN = 8
Private Const RESOURCEDISPLAYTYPE_DIRECTORY = 9
Private Const RESOURCEDISPLAYTYPE_TREE = &HA
Private Const RESOURCEDISPLAYTYPE_NDSCONTAINER = &HB

Private m_colShares As New Collection

Private Type WKSTA_INFO_101
   wki101_platform_id As Long
   wki101_computername As Long
   wki101_langroup As Long
   wki101_ver_major As Long
   wki101_ver_minor As Long
   wki101_lanroot As Long
End Type

Private Type WKSTA_USER_INFO_1
   wkui1_username As Long
   wkui1_logon_domain As Long
   wkui1_logon_server As Long
   wkui1_oth_domains As Long
End Type

Private Declare Function WNetGetUser Lib "Mpr" Alias "WNetGetUserA" (lpName As Any, ByVal lpUserName As String, lpnLength As Long) As Long
Private Declare Function NetWkstaGetInfo Lib "Netapi32" (strServer As Any, ByVal lLevel As Long, pbBuffer As Any) As Long
Private Declare Function NetWkstaUserGetInfo Lib "Netapi32" (reserved As Any, ByVal lLevel As Long, pbBuffer As Any) As Long
Private Declare Sub lstrcpyW Lib "kernel32" (dest As Any, ByVal src As Any)
Private Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal size&)
Private Declare Function NetApiBufferFree& Lib "Netapi32" (ByVal buffer&)


Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_NOTIFY = &H10
Private Const READ_CONTROL = &H20000
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const SYNCHRONIZE = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const REG_SZ = 1

Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32s = 0

Public Function GetWorkgroup() As String
    Dim lKeyHandle As Long
    Dim lRet As Long
    Dim strBuffer As String
    Dim strKey As String
    Dim strValue As String
    
    strKey = "System\CurrentControlSet\Services\VXD\VNETSUP"
    strValue = "Workgroup"
    lRet = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKey, 0, KEY_READ, lKeyHandle)
    If lRet = ERROR_SUCCESS Then
        strBuffer = Space(255)
        lRet = RegQueryValueEx(lKeyHandle, strValue, 0, REG_SZ, ByVal strBuffer, Len(strBuffer))
        If lRet = ERROR_SUCCESS Then
            GetWorkgroup = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
        End If
        RegCloseKey lKeyHandle
    End If
End Function

Function GetDomainName()
    Dim lngRet As Long
    Dim arrByteBuffer(512) As Byte
    Dim i As Integer
    Dim tWK_INFO As WKSTA_INFO_101
    Dim lngWK_Ptr As Long
    Dim tWK_USER As WKSTA_USER_INFO_1
    Dim lngWK_USER_Ptr As Long
    Dim strDomain As String

    If IfWinNT Then
        lngRet = NetWkstaGetInfo(ByVal 0&, 101, lngWK_Ptr)
        RtlMoveMemory tWK_INFO, ByVal tWK_INFO, Len(tWK_INFO)
        lngRet = NetWkstaUserGetInfo(ByVal 0&, 1, lngWK_USER_Ptr)
        RtlMoveMemory tWK_USER, ByVal lngWK_USER_Ptr, Len(tWK_USER)
        lstrcpyW arrByteBuffer(0), tWK_USER.wkui1_logon_domain
        'Get Every other byte of the array
        i = 0
        Do While arrByteBuffer(i) <> 0
            strDomain = strDomain & Chr(arrByteBuffer(i))
            i = i + 2
        Loop
        lngRet = NetApiBufferFree(lngWK_USER_Ptr)

        GetDomainName = strDomain
    Else
        'For Win9X get Workgroup
        GetDomainName = GetWorkgroup()
    End If
End Function

Private Function IfWinNT() As Boolean
    Dim os As OSVERSIONINFO
    Dim lngRet As Long
    
    os.dwOSVersionInfoSize = Len(os)
    lngRet = GetVersionEx(os)
    
    If lngRet <> 0 Then
        Select Case os.dwPlatformId
            Case VER_PLATFORM_WIN32_NT
                IfWinNT = True
            Case Else
                IfWinNT = False
        End Select
    End If
End Function

Public Sub LoadLANComps(p_strDomain As String)
    Dim tNetRes As NETRES2
    Dim lngRet As Long
    Dim lngHndEnum As Long
    Dim lngBuffer As Long
    Dim lngBufferPtr As Long
    Dim lngBufferPtrTemp As Long
    Dim lngCount As Long
    Dim tNR As NETRESOURCE
    Dim i As Integer
    Dim strCompName As String
    
    On Error Resume Next
    
    With tNetRes
        .lpRemoteName = p_strDomain
        .dwDisplayType = 1
    End With
    
    lngRet = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, tNetRes, lngHndEnum)
    
    If lngRet <> 0 Then
        MsgBox "Error getting computers on the LAN.", vbCritical, "Error"
        Exit Sub
    End If
    
    lngBuffer = 1024 * 10
    
    lngBufferPtr = GlobalAlloc(GPTR, lngBuffer)
    
    Do
        'Number of entries to return from enumeration: -1 causes all objects to be returned
        lngCount = -1
        lngRet = WNetEnumResource(lngHndEnum, lngCount, lngBufferPtr, lngBuffer)
        If lngRet = ERROR_MORE_DATA Then
            'Enumeration indicates that the lngBufferPtr is not big enough to hold all of the information in the
            'NETRESOURCE structure. lngBuffer has been updated to hold the required amount of space.
            GlobalFree lngBufferPtr   'Free up memory
            lngBufferPtr = GlobalAlloc(GPTR, lngBuffer)  'Allocate a new space for the lngBuffer requested by the enumeration
        Else
            If lngRet = 0 Then
                lngBufferPtrTemp = lngBufferPtr
                For i = 1 To lngCount
                    CopyMemory tNR, ByVal lngBufferPtrTemp, LenB(tNR)
                    strCompName = lstrcpy(tNR.lpRemoteName)
                    
                    'Trim 2 double slashes
                    If strCompName <> "" Then
                        strCompName = Mid(strCompName, InStr(strCompName, "\\") + 2)
                        'Add computer name to the collection
                        m_colShares.Add strCompName, strCompName
                    End If
                    
                    'Step forward in the buffer by the length of the copied structure
                    lngBufferPtrTemp = lngBufferPtrTemp + LenB(tNR)
                Next
            End If
        End If
    Loop Until lngCount = 0
    
    WNetCloseEnum lngHndEnum
    'Free up memory
    GlobalFree lngBufferPtr
End Sub

Private Function lstrcpy(lStrPointer As Long) As String
    Dim strBuffer As String

    strBuffer = String(255, vbNullChar)
    lstrcpyA strBuffer, lStrPointer
    lstrcpy = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
End Function

Private Sub Command1_Click()
    Dim strDomain As String
    Dim objCollItem As Variant
    
    strDomain = GetDomainName
    
    Call LoadLANComps(strDomain)
    
    For Each objCollItem In m_colShares
        List1.AddItem objCollItem
    Next
End Sub