Listing 1: EnumerateNR Function

Function EnumerateNR(nrParent As NETRESOURCE) As Collection
Dim EnumerationHandle&
Dim res&
Dim tbuf()      As Byte
Dim BufferSize  As Long
Dim lLength     As Long
Dim nrl         As NETRESOURCELONG  ' Temporary structure for copying
Dim sLocalName  As String
Dim sRemoteName As String
Dim sComment    As String
Dim sProvider   As String
Dim colObjects  As New Collection
Dim oServer     As CServer
Dim oDomain     As CDomain
 
[** Begin Callout A **]   
    res = WNetOpenEnum(RESOURCE_PUBLICNET, RESOURCETYPE_ANY, 0, nrParent, EnumerationHandle)
[** End Callout A **]

    If res <> 0 Then
        If Err.LastDllError = ERROR_EXTENDED_ERROR Then
            Dim oErr As New CNetErr
            Err.Raise oErr.dwErrorCode, App.EXEName & ".EnumerateNR", oErr.szDescription
        End If
    End If
   
    ' Create a big buffer to work with. Dim it here instead of
    ' at the declaration to make sure it's allocated off the heap and not the stack
    ReDim tbuf(16384)
    BufferSize = 16384

    Do

[** Begin Callout B **]
        res = WNetEnumResource(EnumerationHandle, 1, tbuf(0), BufferSize)
[** End Callout B **]
        ' Check for errors
        Select Case res
            Case 0   ' Success
                ' Copy the necessary data
                CopyMemory nrl, ByVal VarPtr(tbuf(0)), Len(nrl)
                
[** Begin Callout C **]
                Select Case nrl.dwDisplayType
                    Case RESOURCEDISPLAYTYPE_DOMAIN
                        Set oDomain = New CDomain
                        oDomain.Init nrl
                        colObjects.Add oDomain, Key:=oDomain.RemoteName
                    Case RESOURCEDISPLAYTYPE_SERVER
                        Set oServer = New CServer
                        oServer.Init nrl
                        colObjects.Add oServer, Key:=oServer.RemoteName
                End Select
[** End Callout C **]
                
            Case ERROR_NO_MORE_ITEMS
            Case Else
                If Err.LastDllError = ERROR_MORE_DATA Then
                    ' A buffer too small error should be very rare, but
                    ' the case is handled just to be through. The code
                    ' will drop down and try again
                    ReDim tbuf(BufferSize + 1)
                Else
                    ' This type of error can't be handled, so exit
                    Exit Function
                End If
        End Select
    Loop While res = 0

[** Begin Callout D **]
    WNetCloseEnum EnumerationHandle
[** End Call0out D **]

    Set EnumerateNR = colObjects
    
End Function