Attribute VB_Name = "Module1"
Option Explicit

Public 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

Public 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

Public Declare Function WNetEnumResource Lib "mpr.dll" Alias _
    "WNetEnumResourceA" ( _
    ByVal hEnum As Long, _
    lpcCount As Long, _
    ByVal lpBuffer As Long, _
    lpBufferSize As Long) As Long

Public Declare Function WNetCloseEnum Lib "mpr.dll" ( _
    ByVal hEnum As Long) As Long

'RESOURCE ENUMERATION.
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCE_REMEMBERED = &H3

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

Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2
Public Const RESOURCEUSAGE_RESERVED = &H80000000
 
' Messages d'erreur
Public Const ERROR_NOT_CONTAINER = 1207&
Public Const ERROR_INVALID_PARAMETER = 87
Public Const ERROR_NO_NETWORK = 1222&
Public Const ERROR_EXTENDED_ERROR = 1208&
Public Const ERROR_NO_MORE_ITEMS = 259&
Public Const ERROR_MORE_DATA = 234
Public Const ERROR_INVALID_HANDLE = 6&
 
Public Const RESOURCEDISPLAYTYPE_DOMAIN As Long = &H1&
Public Const RESOURCEDISPLAYTYPE_GENERIC As Long = &H0&
Public Const RESOURCEDISPLAYTYPE_SERVER As Long = &H2&
Public Const RESOURCEDISPLAYTYPE_SHARE = &H3
  

Public Const GMEM_FIXED = &H0
Public Const GMEM_ZEROINIT = &H40
Public Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Public Declare Function GlobalAlloc Lib "KERNEL32" ( _
    ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "KERNEL32" ( _
    ByVal hMem As Long) As Long

Public Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
    (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Declare Function CopyPointer2String Lib "KERNEL32" _
    Alias "lstrcpyA" ( _
    ByVal NewString As String, ByVal OldString As Long) As Long
Public Function PointerToString(p As Long) As String

'The values returned in the NETRESOURCE structures are pointers to
'ANSI strings so they need to be converted to Visual Basic Strings.
Dim s As String
s = String(255, Chr$(0))
CopyPointer2String s, p
PointerToString = Left(s, InStr(s, Chr$(0)) - 1)

End Function

Public Function doEnum(level As Integer, nr As NETRESOURCE) As Integer
Dim rc As Long
Dim stype As String
Dim scont As String
Dim hEnum As Long, lpBuff As Long
Dim cbBuff As Long, cCount As Long
Dim p As Long
Dim i As Integer

rc = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, nr, hEnum)
If rc <> 0 Then
    MsgBox "Error: " & Err.LastDllError, vbOKOnly, "WNetEnumResources"
    Exit Function
End If

Do While 1
    cbBuff = 1000
    cCount = &HFFFFFFFF
    lpBuff = GlobalAlloc(GPTR, cbBuff)
    rc = WNetEnumResource(hEnum, cCount, lpBuff, cbBuff)
    If rc <> 0 Then
        Exit Do
    End If
    p = lpBuff
    For i = 1 To cCount
        CopyMemory nr, ByVal p, LenB(nr)
        Select Case nr.dwDisplayType
            Case RESOURCEDISPLAYTYPE_DOMAIN
                stype = "domaine"
            Case RESOURCEDISPLAYTYPE_GENERIC
                stype = "generic"
            Case RESOURCEDISPLAYTYPE_SERVER:
                stype = "serveur"
            Case RESOURCEDISPLAYTYPE_SHARE:
                stype = "partage"
            Case Else
                stype = "inconnu"
        End Select
        If nr.dwUsage And RESOURCEUSAGE_CONTAINER Then
            scont = "recipient"
        Else
            scont = ""
        End If
        
        Form1.List1.AddItem stype & vbTab & scont & vbTab & level & vbTab & PointerToString(nr.lpLocalName) & vbTab & PointerToString(nr.lpRemoteName)
        If nr.dwUsage And RESOURCEUSAGE_CONTAINER Then
            doEnum level + 1, nr
        End If
        p = p + LenB(nr)
    Next i
Loop
If rc <> ERROR_NO_MORE_ITEMS Then
    MsgBox "Error: " & Err.LastDllError, vbOKOnly, "WNetEnumResources"
End If

WNetCloseEnum (hEnum)

End Function