Option Explicit
 
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias _
        "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal _
        lpPassword As String, ByVal lpUserName As String, ByVal _
        dwFlags 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, _
        lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
 
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum _
        As Long) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (lpTo As Any, lpFrom As Any, ByVal lLen As Long)
 
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
        (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
 
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
        (ByVal lpString As Any) As Long
 
Private Type NETRESOURCE
  dwScope As Long
  dwType As Long
  dwDisplayType As Long
  dwUsage As Long
  pLocalName As Long
  pRemoteName As Long
  pComment As Long
  pProvider As Long
End Type
 
Private Type NETRESOURCE_REAL
  dwScope As Long
  dwType As Long
  dwDisplayType As Long
  dwUsage As Long
  sLocalName As String
  sRemoteName As String
  sComment As String
  sProvider As String
End Type
 
Const RESOURCE_CONNECTED As Long = &H1&
Const RESOURCE_GLOBALNET As Long = &H2&
Const RESOURCE_REMEMBERED As Long = &H3&
 
Const RESDTYPE_DIRECTORY& = &H9
Const RESDTYPE_DOMAIN& = &H1
Const RESDTYPE_FILE& = &H4
Const RESDTYPE_GENERIC& = &H0
Const RESDTYPE_GROUP& = &H5
Const RESDTYPE_NETWORK& = &H6
Const RESDTYPE_ROOT& = &H7
Const RESDTYPE_SERVER& = &H2
Const RESDTYPE_SHARE& = &H3
Const RESDTYPE_SHAREADMIN& = &H8
 
Const RESOURCETYPE_ANY As Long = &H0&
Const RESOURCETYPE_DISK As Long = &H1&
Const RESOURCETYPE_PRINT As Long = &H2&
Const RESOURCETYPE_UNKNOWN As Long = &HFFFF&
 
Const RESOURCEUSAGE_ALL As Long = &H0&
Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&
Const RESOURCEUSAGE_CONTAINER As Long = &H2&
Const RESOURCEUSAGE_RESERVED As Long = &H80000000
 
Const NO_ERROR = 0
Const ERROR_MORE_DATA = 234
Const RESOURCE_ENUM_ALL As Long = &HFFFF
 
Private Sub Command1_Click()
  Dim aa As Collection, x%
    MousePointer = vbHourglass
    DoEvents
 
    Set aa = GetNetRessources
 
    For x = 1 To aa.Count
      List1.AddItem aa.Item(x)
    Next x
 
    MousePointer = vbDefault
 
End Sub
 
Private Function GetNetRessources() As Collection
  Const MAX_RESOURCES = 256
  Const NOT_A_CONTAINER = -1
 
  Dim bFirstTime As Boolean
  Dim lRet&, hEnum&, lCnt&, lMin&, lLen&, l&, lBufSize&, lLastIx&
  Dim nRem$, F$
  Dim ResList As Collection
  Dim uNetApi(0 To MAX_RESOURCES) As NETRESOURCE
  Dim uNet() As NETRESOURCE_REAL
 
    Set ResList = New Collection
    bFirstTime = True
 
    '### Ressourcen Auslesen
    Do
      If bFirstTime Then
        lRet = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, _
                            RESOURCEUSAGE_ALL, ByVal 0&, hEnum)
        bFirstTime = False
      Else
        If uNet(lLastIx).dwUsage And RESOURCEUSAGE_CONTAINER Then
          lRet = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, _
                              RESOURCEUSAGE_ALL, uNet(lLastIx), hEnum)
        Else
          lRet = NOT_A_CONTAINER
          hEnum = 0
        End If
 
        lLastIx = lLastIx + 1
      End If
 
      If lRet = NO_ERROR Then
        lCnt = RESOURCE_ENUM_ALL
        Do
          lBufSize = UBound(uNetApi) * Len(uNetApi(0)) / 2
          lRet = WNetEnumResource(hEnum, lCnt, uNetApi(0), lBufSize)
          If lCnt > 0 Then
 
            ReDim Preserve uNet(0 To lMin + lCnt - 1) _
                           As NETRESOURCE_REAL
 
            For l = 0 To lCnt - 1
 
              uNet(lMin + l).dwScope = uNetApi(l).dwScope
              uNet(lMin + l).dwType = uNetApi(l).dwType
              uNet(lMin + l).dwDisplayType = uNetApi(l).dwDisplayType
              uNet(lMin + l).dwUsage = uNetApi(l).dwUsage
 
              If uNetApi(l).pLocalName Then
                lLen = lstrlen(uNetApi(l).pLocalName)
                uNet(lMin + l).sLocalName = Space$(lLen)
                CopyMemory ByVal uNet(lMin + l).sLocalName, _
                           ByVal uNetApi(l).pLocalName, lLen
              End If
 
              If uNetApi(l).pRemoteName Then
                lLen = lstrlen(uNetApi(l).pRemoteName)
                uNet(lMin + l).sRemoteName = Space$(lLen)
                CopyMemory ByVal uNet(lMin + l).sRemoteName, _
                           ByVal uNetApi(l).pRemoteName, lLen
              End If
 
              If uNetApi(l).pComment Then
                lLen = lstrlen(uNetApi(l).pComment)
                uNet(lMin + l).sComment = Space$(lLen)
                CopyMemory ByVal uNet(lMin + l).sComment, _
                           ByVal uNetApi(l).pComment, lLen
              End If
 
              If uNetApi(l).pProvider Then
                lLen = lstrlen(uNetApi(l).pProvider)
                uNet(lMin + l).sProvider = Space$(lLen)
                CopyMemory ByVal uNet(lMin + l).sProvider, _
                           ByVal uNetApi(l).pProvider, lLen
              End If
            Next l
          End If
 
          lMin = lMin + lCnt
        Loop While lRet = ERROR_MORE_DATA
      End If
      If hEnum Then l = WNetCloseEnum(hEnum)
 
    Loop While lLastIx < lMin
 
    '### Auswerten
    If UBound(uNet) > 0 Then
      For l = 0 To UBound(uNet)
        Select Case uNet(l).dwDisplayType
          Case RESDTYPE_DIRECTORY:  nRem = "Ordner"
          Case RESDTYPE_DOMAIN:     nRem = "Domäne"
          Case RESDTYPE_FILE:       nRem = "Datei"
          Case RESDTYPE_GENERIC:    nRem = "Generic"
          Case RESDTYPE_GROUP:      nRem = "Gruppe"
          Case RESDTYPE_NETWORK:    nRem = "Netzwerk"
          Case RESDTYPE_ROOT:       nRem = "Root"
          Case RESDTYPE_SERVER:     nRem = "Rechner"
          Case RESDTYPE_SHARE:      nRem = "Freigabe"
          Case RESDTYPE_SHAREADMIN: nRem = "Freigaben Admin"
        End Select
 
        '### Formatieren und speichern
        F = uNet(l).sRemoteName & uNet(l).sComment
        F = F & Space(35 - Len(F)) & nRem
        ResList.Add F
      Next l
    End If
 
    Set GetNetRessources = ResList
End Function